home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / PASVDI.BND < prev    next >
Encoding:
Text File  |  1987-03-01  |  57.0 KB  |  2,024 lines
  1. {.HEModule -  PasVDI- Turbo Pascal GEM binding.   Mass. General Hospital }
  2. {========================================================================}
  3. {                                                                        }
  4. { Module name -> PasVDI          Release date -> 8/10/85   Ver -> 01.0   }
  5. { ---------------------------------------------------------------------- }
  6.  
  7. {**************************************************************************}
  8. {                                                                          }
  9. {  COPYRIGHT (c) 1985                                                      }
  10. {  by the Massachusetts General Hospital, Boston, MA 02114.                }
  11. {                                                                          }
  12. {  This software is furnished under a license and may be used and  copied  }
  13. {  only  in  accordance  with  the  terms  of  such  license and with the  }
  14. {  inclusion of the above copyright notice.  This  software or  any other  }
  15. {  copies thereof may not be  provided or otherwise made available to any  }
  16. {  other person.  No title  to and  ownership of  the  software is hereby  }
  17. {  transferred.                                                            }
  18. {                                                                          }
  19. {  The information in this software  is subject to  change without notice  }
  20. {  and should  not  be  construed  as  a  commitment by the Massachusetts  }
  21. {  General Hospital.                                                       }
  22. {                                                                          }
  23. {  This software is distributed without any express or implied warranties  }
  24. {  whatsoever.  Because of the diversity of conditions and hardware under  }
  25. {  which this program  may  be used,  no warranty of fitness for a parti-  }
  26. {  cular purpose is offered.  The  user  is  advised to test this program  }
  27. {  thoroughly  before  relying  upon it.  The user must assume the entire  }
  28. {  risk of using the program.                                              }
  29. {                                                                          }
  30. {  For more  information as  to  the  specific  rights  granted  by  this  }
  31. {  proviso or to obtain a copy of this software, contact:                  }
  32. {                                                                          }
  33. {   Jaime Taaffe                                                           }
  34. {   Dept. of Radiation Radiology                                           }
  35. {   Massachusetts General Hospital                                         }
  36. {   Boston, MA 02114                                                       }
  37. {                                                                          }
  38. {  (617) 726-8785                                                          }
  39. {                                                                          }
  40. {**************************************************************************}
  41.  
  42.  
  43. { Modified by: James Taaffe and JoAnn Yang of MGH from the Pascal MT+    }
  44. {              package of Digital Research Inc.                          }
  45. {                                                                        }
  46. { Written by: Athol M Foden                                              }
  47. {                                                                        }
  48. { Purpose:   Interface to the Digital Research Gem VDI package.          }
  49. {                                                                        }
  50. { Calling convention: See Gem Manual                                     }
  51. {                                                                        }
  52. {                                                                        }
  53. { Global data accessed:Contrl, Intin, InOut, PtsIn, PtsOut               }
  54. {                                                                        }
  55. { Testing considerations: Run program DmoVdi.pas                         }
  56. {                                                                        }
  57. { ---------------------------------------------------------------------- }
  58. { AUDIT TRAIL                                                            }
  59. { Rev.     Revised   By             Bug                                  }
  60. { x.xx     xx/xx/xx  ?????????????  ??????????????????????????????       }
  61. { x.xx     xx/xx/xx  ?????????????  ??????????????????????????????       }
  62. { x.xx     xx/xx/xx  ?????????????  ??????????????????????????????       }
  63. {========================================================================}
  64. {.PA}
  65. CONST
  66.  
  67.         cntl_max    = 11;       { max sizes for arrays - relative 0.     }
  68.         intin_max   = 131;
  69.         intout_max  = 139;
  70.         pts_max     = 144;      { you may need this larger.              }
  71.  
  72.         white       = 0;        { std colors - not always true.          }
  73.         black       = 1;
  74.         red         = 2;
  75.         green       = 3;
  76.         blue        = 4;
  77.         cyan        = 5;
  78.         yellow      = 6;
  79.         magenta     = 7;
  80.  
  81.         hollow      = 0;        { std fill interior styles.             }
  82.         solid       = 1;
  83.         pattern     = 2;
  84.         hatch       = 3;
  85.  
  86.         longdash    = 2;        { line styles, solid as above.         }
  87.         dshdot      = 4;
  88.  
  89.         maxndc      = 32767;    { max coord in NDC space.              }
  90.  
  91.         normal    = 0; { graphic text styles - combinations ok as well }
  92.         bold      = 1;
  93.         light     = 2;
  94.         skew      = 4;
  95.         underline = 8;
  96.         outline   = 16;
  97.         shadow    = 32;
  98.  
  99.         request   = 1;         { input modes }
  100.         sample    = 2;
  101.  
  102.         replace     = 1;       { write modes }
  103.         transparent = 2;
  104.         GemXor      = 3;
  105.         erase       = 4;
  106.  
  107. {.PA}
  108. TYPE
  109.  
  110.                 {* All arrays relative to zero here *}
  111.  
  112.         contrl_ARRAY = ARRAY [0..cntl_max]   OF INTEGER;
  113.         intin_ARRAY  = ARRAY [0..intin_max]  OF INTEGER;
  114.         intout_ARRAY = ARRAY [0..intout_max] OF INTEGER;
  115.         ptsin_ARRAY  = ARRAY [0..pts_max]    OF INTEGER;
  116.         ptsout_ARRAY = ARRAY [0..pts_max]    OF INTEGER;
  117.  
  118.  
  119.         STRING80 = String[80];
  120.                                         { type defns for gemtools }
  121.         LongInt  = Array[0..3] of byte;
  122.         gptr     = ^LONGINT;            { general 32 bit pointer }
  123.         gempoint = RECORD               { ptr redefined so each part avail }
  124.                 CASE BOOLEAN OF
  125.                     TRUE : (gp : gptr);
  126.                     FALSE : (hi : INTEGER;
  127.                     lo : INTEGER);
  128.                  END;
  129.  
  130.         ARRAY_57 = ARRAY [0..56] OF INTEGER;    { std arrray sizes }
  131.         ARRAY_3  = ARRAY [0..2]  OF INTEGER;
  132.         ARRAY_4  = ARRAY [0..3]  OF INTEGER;
  133.         ARRAY_8  = ARRAY [0..7]  OF INTEGER;
  134.         ARRAY_10 = ARRAY [0..9]  OF INTEGER;
  135.         ARRAY_16 = ARRAY [0..15] OF INTEGER;
  136.         ARRAY_37 = ARRAY [0..36] OF INTEGER;
  137.  
  138.         MFDB =
  139.          record                                 { MFDB layout }
  140.           mptr       : gempoint;                { 32 bit pointer }
  141.           formwidth  : INTEGER;
  142.           formheight : INTEGER;
  143.           widthword  : INTEGER;
  144.           formatflag : INTEGER;
  145.           memplanes  : INTEGER;
  146.           res1       : INTEGER;                 { reserved for futures }
  147.           res2       : INTEGER;
  148.           res3       : INTEGER;
  149.          END;
  150.  
  151.  
  152. VAR                                     { global gem vdi arrays }
  153.         contrl : contrl_ARRAY;          { global arrays reqd by gemvdi }
  154.         intin  : intin_ARRAY;
  155.         intout : intout_ARRAY;
  156.         ptsin  : ptsin_ARRAY;
  157.         ptsout : ptsout_ARRAY;
  158.  
  159. {.pa}
  160. {========================================================================}
  161. {                                                                        }
  162. { Procedure name -> GVDI                                                 }
  163. { Release date   -> ../../..             Ver -> xx.x                     }
  164. { ---------------------------------------------------------------------- }
  165. { Written by: JoAnn Yang.            Checked by:                         }
  166. {                                                                        }
  167. { Purpose: Performs the interface between Gem and Turbo Pascal-3.        }
  168. {          In particular, it invokes the GEM VDI sub system via a        }
  169. {          software interupt.                                            }
  170. {                                                                        }
  171. { Calling convention:  Load_PB_and_Call_GEM( Contrl, intin, intout       }
  172. {                                            ptsin, ptsout        )      }
  173. {                                                                        }
  174. { Input data: contrl, intin, and ptsin : arrays of integers.             }
  175. {                                                                        }
  176. { Output data:intout and ptsout : arrays of integer.                     }
  177. {                                                                        }
  178. { Global data accessed: NONE except that in GEM VDI.                     }
  179. {                                                                        }
  180. { Other procedures used: NONE except for the GEM package.                }
  181. {                                                                        }
  182. { Testing considerations: GEM VDI must be loaded into memory.            }
  183. {                                                                        }
  184. { Revisions:                                                             }
  185. {                                                                        }
  186. {========================================================================}
  187.  
  188. { This procedure loads the contents of the parameter block }
  189.  
  190. procedure GVDI(var contrl: Contrl_Array;
  191.                var intin : Intin_Array;
  192.                var intout: Intout_Array;
  193.                var ptsin : Ptsin_Array;
  194.                var ptsout: Ptsout_Array );
  195.  
  196. const
  197.       vdi       = $ef;             { interrupt number for GEM VDI. }
  198.       vdi_const = $0473;           { GEM VDI function number       }
  199.  
  200.  
  201. type
  202.       i8088_RegsType   = record    { i8088 processors registers.   }
  203.                            ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  204.                          end;
  205.  
  206.       GemPB_Type       = array[1..10]  of integer;
  207.  
  208. Var
  209.     i8088_Regs: i8088_RegsType; { i8088 processor registers.        }
  210.     pb        : GemPB_Type;     { Parameter block points to arrays. }
  211.  
  212. begin   { Load_PB_and_Call_GEM }
  213.  
  214.   { Let array pb contain the address of all the GEM arrays. }
  215.   pb[1]  := ofs(contrl);
  216.   pb[2]  := seg(contrl);
  217.   pb[3]  := ofs(intin);
  218.   pb[4]  := seg(intin);
  219.   pb[5]  := ofs(ptsin);
  220.   pb[6]  := seg(ptsin);
  221.   pb[7]  := ofs(intout);
  222.   pb[8]  := seg(intout);
  223.   pb[9]  := ofs(ptsout);
  224.   pb[10] := seg(ptsout);
  225.  
  226.   { Now let the i8088 registers point to the parameter block.            }
  227.   i8088_Regs.cx := vdi_const;     { Load GEM VDI function number into cx.}
  228.   i8088_Regs.dx := ofs(pb);       { Load the address of the parameter    }
  229.   i8088_Regs.ds := seg(pb);       {  block into dx and ds.               }
  230.  
  231.   { Let GEM handlet the request.                                         }
  232.   intr(vdi, i8088_Regs);          { Call interrupt procedure.            }
  233.  
  234. end;  { GVDI }
  235. {.PA}
  236.  
  237. FUNCTION gemvdif(opcode, handle : INTEGER) : INTEGER;
  238.  
  239. BEGIN
  240. contrl[0]:=opcode;
  241. contrl[6]:=handle;
  242. GVDI(contrl, intin, intout, ptsin, ptsout);
  243. gemvdif:=intout[0];
  244. END;
  245.  
  246. {.PA}
  247. {******************************************************************}
  248. {**                CONTROL FUNCTIONS                             **}
  249. {******************************************************************}
  250. {* open workstation *}
  251.  
  252. FUNCTION v_opnwk (workin      : intin_ARRAY;
  253.                   VAR handle  : INTEGER;
  254.                   VAR workout : ARRAY_57     ) : INTEGER;
  255. VAR
  256. i : INTEGER;
  257.  
  258. BEGIN
  259.    FOR i:=0 TO intin_max DO intin[i]:=workin[i];
  260.    contrl[1]:=0;
  261.    contrl[3]:=11;
  262.    v_opnwk:=gemvdif(1,handle);             { opcode = 1 }
  263.    handle:=contrl[6];
  264.    FOR i:=0 TO 44 DO workout[i]:=intout[i];
  265.    FOR i:=0 TO 11 DO workout[i + 44]:=ptsout[i];
  266. END;
  267.  
  268. {**************************************************************}
  269. {* close workstation *}
  270.  
  271. FUNCTION v_clswk (handle : INTEGER) : INTEGER;
  272.  
  273. BEGIN
  274.   contrl[1]:=0;
  275.   contrl[3]:=0;
  276.   v_clswk:=gemvdif(2,handle);
  277. END;
  278.  
  279. {***************************************************************}
  280. {* open virtual workstation *}
  281.  
  282. FUNCTION v_opnvwk (workin     : intin_ARRAY;
  283.                   VAR handle  : INTEGER;
  284.                   VAR workout : ARRAY_57     ) : INTEGER;
  285. VAR
  286.   i : INTEGER;
  287.  
  288. BEGIN
  289.    contrl[1]:=0;                              { no of input vertices }
  290.    contrl[3]:=11;                             { length of intin }
  291.    FOR i:=0 TO intin_max DO intin[i]:=workin[i];
  292.    v_opnvwk:=gemvdif(100,handle); { handle from previously opened screen device }
  293.    handle:=contrl[6];
  294.    FOR i:=0 TO 44 DO workout[i]:=intout[i];
  295.    FOR i:=0 TO 11 DO workout[i + 44]:=ptsout[i];
  296. END;
  297.  
  298. {**************************************************************}
  299. {* close virtual workstation *}
  300.  
  301. FUNCTION v_clsvwk (handle : INTEGER) : INTEGER;
  302.  
  303. BEGIN
  304.    contrl[1]:=0;
  305.    contrl[3]:=0;
  306.    v_clsvwk:=gemvdif(101,handle);
  307. END;
  308.  
  309. {***************************************************************}
  310. {* clear workstation *}
  311.  
  312. FUNCTION v_clrwk (handle : INTEGER) : INTEGER;
  313.  
  314. BEGIN
  315.    contrl[1]:=0;
  316.    contrl[3]:=0;
  317.    v_clrwk:=gemvdif(3,handle);
  318. END;
  319.  
  320. {****************************************************************}
  321. {* update workstation *}
  322.  
  323. FUNCTION v_updwk ( handle : INTEGER) : INTEGER;
  324.  
  325. BEGIN
  326.    contrl[1]:=0;
  327.    contrl[3]:=0;
  328.    v_updwk:=gemvdif(4,handle);
  329. END;
  330.  
  331. {************************************************************************}
  332. {* Load extra fonts into memory - caller must free up some memory space *}
  333.  
  334. FUNCTION vst_load_fonts(handle : INTEGER;
  335.                         select : INTEGER  ) : INTEGER;
  336.  
  337. BEGIN
  338.    contrl[1]:=0;
  339.    contrl[3]:=1;
  340.    intin[0]:=select;
  341.    vst_load_fonts:=gemvdif(119,handle);
  342. END;
  343.  
  344. {******************************************************************}
  345. {* Unload those extra fonts *}
  346.  
  347. FUNCTION vst_unload_fonts(handle : INTEGER;
  348.                           select : INTEGER) : INTEGER;
  349.  
  350. BEGIN
  351.    contrl[1]:=0;
  352.    contrl[3]:=1;
  353.    intin[0]:=select;
  354.    vst_unload_fonts:=gemvdif(120,handle);
  355. END;
  356.  
  357. {************************************************************************}
  358. {* set clipping rectangle *}
  359.  
  360. FUNCTION vs_clip (handle    : INTEGER;
  361.                  clipflag   : INTEGER;
  362.                  pxyarray   : ARRAY_4) : INTEGER;
  363. VAR
  364.    i: INTEGER;
  365.  
  366. BEGIN
  367.    contrl[1]:=2;
  368.    contrl[3]:=1;
  369.    intin[0]:=clipflag;
  370.    FOR i:=0 TO 3 DO ptsin[i]:=pxyarray[i];
  371.    vs_clip:=gemvdif(129,handle);
  372. END;
  373.  
  374.         {**********************}
  375.         {*  OUTPUT FUNCTIONS  *}
  376. {*************************************************************}
  377. {* polyline *}
  378.  
  379. FUNCTION v_pline (handle   : INTEGER;
  380.                   count    : INTEGER;
  381.                   pxyarray : ptsin_ARRAY) : INTEGER;
  382. VAR
  383.   i, n : INTEGER;
  384.  
  385. BEGIN
  386.    contrl[1]:=count;       { number of vertices to follow }
  387.    contrl[3]:=0;
  388.    n:=count * 2 - 1;       { twice as many numbers as there are coords }
  389.    FOR i:=0 TO n DO ptsin[i]:=pxyarray[i];
  390.    v_pline:=gemvdif(6,handle);
  391. END;
  392.  
  393. {**************************************************************}
  394. {* polymarker *}
  395.  
  396. FUNCTION v_pmarker (handle   : INTEGER;
  397.                     count    : INTEGER;
  398.                     pxyarray : ptsin_ARRAY) : INTEGER;
  399. VAR
  400.   i,n : INTEGER;
  401.  
  402. BEGIN
  403.    contrl[1]:=count;       { number of markers }
  404.    contrl[3]:=0;
  405.    n:=count * 2 - 1;
  406.    FOR i:=0 TO n DO ptsin[i]:=pxyarray[i];
  407.    v_pmarker:=gemvdif(7,handle);
  408. END;
  409.  
  410. {************************************************************}
  411. {* text *}
  412.  
  413. FUNCTION v_gtext (handle    : INTEGER;
  414.                   x,y       : INTEGER;
  415.                   chstring  : STRING80) : INTEGER;
  416. VAR
  417.   i : INTEGER;
  418.  
  419. BEGIN
  420.    contrl[1]:=1;
  421.    contrl[3]:=LENGTH(chstring);
  422.    ptsin[0]:=x;
  423.    ptsin[1]:=y;
  424.    FOR i:=1 TO LENGTH(chstring) DO intin[i- 1]:=ORD(chstring[i]);
  425.    v_gtext:=gemvdif(8,handle);
  426. END;
  427.  
  428. {*************************************************************}
  429. {* filled area *}
  430.  
  431. FUNCTION  v_fillarea(handle   : INTEGER;
  432.                      count    : INTEGER;
  433.                      pxyarray : ptsin_ARRAY) : INTEGER;
  434. VAR
  435.    i,n  : INTEGER;
  436.  
  437. BEGIN
  438.    contrl[1]:=count;
  439.    contrl[3]:=0;
  440.    n:=count * 2 - 1;
  441.    FOR i:=0 TO n DO ptsin[i]:=pxyarray[i];
  442.    v_fillarea:=gemvdif(9,handle);
  443. END;
  444.  
  445. {************************************************************}
  446. {* cell array *}
  447.  
  448. FUNCTION v_cellarray (handle    : INTEGER;
  449.                       pxyarray  : ARRAY_4;
  450.                       rowlength : INTEGER;
  451.                       elused    : INTEGER;
  452.                       numrows   : INTEGER;
  453.                       wrtmode   : INTEGER;
  454.                       colorlen  : INTEGER;
  455.                       colarray  : intin_ARRAY) : INTEGER;
  456. VAR
  457.   i,j : INTEGER;
  458.  
  459. BEGIN
  460.    contrl[1]:=2;
  461.    contrl[3]:=colorlen;
  462.    contrl[7]:=rowlength;
  463.    contrl[8]:=elused;
  464.    contrl[9]:=numrows;
  465.    contrl[10]:=wrtmode;
  466.    FOR i:=0 TO 3 DO ptsin[i]:=pxyarray[i];
  467.    j:=colorlen - 1 ;
  468.    FOR i:=0 TO j DO intin[i]:=colarray[i];
  469.    v_cellarray:=gemvdif(10,handle);
  470. END;
  471.  
  472. {*************************************************************}
  473. {* contour fill *}
  474.  
  475. FUNCTION v_contour (handle, x, y, index : INTEGER) : INTEGER;
  476.  
  477. BEGIN
  478.    contrl[1]:=1;
  479.    contrl[3]:=1;
  480.    ptsin[0]:=x;
  481.    ptsin[1]:=y;
  482.    intin[0]:=index;
  483.    v_contour:=gemvdif(103,handle);
  484. END;
  485.  
  486. {*********************************************************}
  487. {* fill rectangle *}
  488.  
  489. FUNCTION vr_recfl(handle   : INTEGER;
  490.                   pxyarray : ARRAY_4) : INTEGER;
  491. VAR
  492.   i : INTEGER;
  493.  
  494. BEGIN
  495.    contrl[1]:=2;
  496.    contrl[3]:=0;
  497.    FOR i:=0 TO 3 DO ptsin[i]:=pxyarray[i];
  498.    vr_recfl:=gemvdif(114,handle);
  499. END;
  500.  
  501.                 {***************}
  502.                 {*   GDP 's    *}
  503. {**************************************************************}
  504. {* gdp - bar *}
  505.  
  506. FUNCTION v_bar (handle   : INTEGER;
  507.                 pxyarray : ARRAY_4  ) : INTEGER;
  508. VAR
  509.    i : INTEGER;
  510.  
  511. BEGIN
  512.    contrl[1]:=2;
  513.    contrl[3]:=0;
  514.    contrl[5]:=1;
  515.    FOR i:=0 TO 3 DO ptsin[i]:=pxyarray[i];
  516.    v_bar:=gemvdif(11,handle);
  517. END;
  518.  
  519. {**************************************************************}
  520. {* GDP - arc *}
  521.  
  522. FUNCTION v_arc (handle   : INTEGER;
  523.                 x        : INTEGER;
  524.                 y        : INTEGER;
  525.                 radius   : INTEGER;
  526.                 begang   : INTEGER;
  527.                 endang   : INTEGER ) : INTEGER;
  528.  
  529. BEGIN
  530.    contrl[1]:=4;
  531.    contrl[3]:=2;
  532.    contrl[5]:=3;
  533.    intin[0]:=begang;
  534.    intin[1]:=endang;
  535.    ptsin[0]:=x;
  536.    ptsin[1]:=y;
  537.    ptsin[6]:=radius;
  538.    v_arc:=gemvdif(11,handle);
  539. END;
  540.  
  541. {******************************************************************}
  542. {* GDP - pieslice *}
  543.  
  544. FUNCTION v_pieslice (handle  : INTEGER;
  545.                      x       : INTEGER;
  546.                      y       : INTEGER;
  547.                      radius  : INTEGER;
  548.                      begang  : INTEGER;
  549.                      endang  : INTEGER ) : INTEGER;
  550.  
  551. BEGIN
  552.    contrl[1]:=4;
  553.    contrl[3]:=2;
  554.    contrl[5]:=3;
  555.    intin[0]:=begang;
  556.    intin[1]:=endang;
  557.    ptsin[0]:=x;
  558.    ptsin[1]:=y;
  559.    ptsin[6]:=radius;
  560.    v_pieslice:=gemvdif(11,handle);
  561. END;
  562.  
  563. {********************************************************************}
  564. {* GDP - circle *}
  565.  
  566. FUNCTION v_circle (handle  : INTEGER;
  567.                    x       : INTEGER;
  568.                    y       : INTEGER;
  569.                    radius  : INTEGER ) : INTEGER;
  570.  
  571. BEGIN
  572.    contrl[1]:=3;
  573.    contrl[3]:=0;
  574.    contrl[5]:=4;
  575.    contrl[6]:=handle;
  576.    ptsin[0]:=x;
  577.    ptsin[1]:=y;
  578.    ptsin[4]:=radius;
  579.    v_circle:=gemvdif(11,handle);
  580. END;
  581.  
  582. {******************************************************************}
  583. {* GDP - elliptical arc *}
  584.  
  585. FUNCTION v_ellarc (handle  : INTEGER;
  586.                    x       : INTEGER;
  587.                    y       : INTEGER;
  588.                    xradius : INTEGER;
  589.                    yradius : INTEGER;
  590.                    begang  : INTEGER;
  591.                    endang  : INTEGER ) : INTEGER;
  592.  
  593. BEGIN
  594.    contrl[1]:=2;
  595.    contrl[3]:=2;
  596.    contrl[5]:=6;
  597.    intin[0]:=begang;
  598.    intin[1]:=endang;
  599.    ptsin[0]:=x;
  600.    ptsin[1]:=y;
  601.    ptsin[2]:=xradius;
  602.    ptsin[3]:=yradius;
  603.    v_ellarc:=gemvdif(11,handle);
  604. END;
  605.  
  606. {***************************************************************}
  607. {* GDP - elliptical pie *}
  608.  
  609. FUNCTION v_ellpie (handle  : INTEGER;
  610.                    x       : INTEGER;
  611.                    y       : INTEGER;
  612.                    xradius : INTEGER;
  613.                    yradius : INTEGER;
  614.                    begang  : INTEGER;
  615.                    endang  : INTEGER ) : INTEGER;
  616.  
  617. BEGIN
  618.    contrl[1]:=2;
  619.    contrl[3]:=2;
  620.    contrl[5]:=7;
  621.    intin[0]:=begang;
  622.    intin[1]:=endang;
  623.    ptsin[0]:=x;
  624.    ptsin[1]:=y;
  625.    ptsin[2]:=xradius;
  626.    ptsin[3]:=yradius;
  627.    v_ellpie:=gemvdif(11,handle);
  628. END;
  629.  
  630. {***************************************************************}
  631. {* GDP - Ellipse *}
  632.  
  633. FUNCTION v_ellipse (handle  : INTEGER;
  634.                     x       : INTEGER;
  635.                     y       : INTEGER;
  636.                     xradius : INTEGER;
  637.                     yradius : INTEGER ) : INTEGER;
  638.  
  639. BEGIN
  640.    contrl[1]:=2;
  641.    contrl[3]:=0;
  642.    contrl[5]:=5;
  643.    ptsin[0]:=x;
  644.    ptsin[1]:=y;
  645.    ptsin[2]:=xradius;
  646.    ptsin[3]:=yradius;
  647.    v_ellipse:=gemvdif(11,handle);
  648. END;
  649.  
  650. {**************************************************************}
  651. {* GDP rounded rectangle *}
  652.  
  653. FUNCTION v_rbox (handle  : INTEGER;
  654.                  xyarray : ARRAY_4 ) : INTEGER;
  655. VAR
  656.    i : INTEGER;
  657.  
  658. BEGIN
  659.    contrl[1]:=2;
  660.    contrl[3]:=0;
  661.    contrl[5]:=8;
  662.    FOR i:=0 TO 3 DO ptsin[i]:=xyarray[i];
  663.    v_rbox:=gemvdif(11,handle);
  664. END;
  665.  
  666. {**************************************************************}
  667. {* GDP Filled rounded rectangle *}
  668.  
  669. FUNCTION v_rfbox (handle  : INTEGER;
  670.                   xyarray : ARRAY_4 ) : INTEGER;
  671. VAR
  672.    i : INTEGER;
  673.  
  674. BEGIN
  675.    contrl[1]:=2;
  676.    contrl[3]:=0;
  677.    contrl[5]:=9;
  678.    FOR i:=0 TO 3 DO ptsin[i]:=xyarray[i];
  679.    v_rfbox:=gemvdif(11,handle);
  680. END;
  681.  
  682. {************************************************************}
  683. {*  Justified graphics text *}
  684.  
  685. FUNCTION v_justified(handle    : INTEGER;
  686.                      x         : INTEGER;
  687.                      y         : INTEGER;
  688.                      jlength   : INTEGER;
  689.                      gstring   : STRING80;
  690.                      wordspace : INTEGER;
  691.                      charspace : INTEGER ) : INTEGER;
  692. VAR
  693.   i: INTEGER;
  694.  
  695. BEGIN
  696.    contrl[1]:=2;
  697.    contrl[3]:=LENGTH(gstring) + 2;
  698.    FOR i:=1 TO LENGTH(gstring) DO intin[i+1]:=ORD(gstring[i]);
  699.    intin[0]:=wordspace;
  700.    intin[1]:=charspace;
  701.    ptsin[0]:=x;
  702.    ptsin[1]:=y;
  703.    ptsin[2]:=jlength;
  704.    v_justified:=gemvdif(10,handle);
  705. END;
  706.  
  707.                 {*****************************}
  708.                 {** SET ATTRIBUTE FUNCTIONS **}
  709. {********************************************************}
  710. {* general set routine, called by many procedures below *}
  711.  
  712. FUNCTION genset(opcode  : INTEGER;
  713.                 handle  : INTEGER;
  714.                 param   : INTEGER ) : INTEGER;
  715.  
  716. BEGIN
  717.    contrl[1]:=0;
  718.    contrl[3]:=1;
  719.    intin[0]:=param;
  720.    genset:=gemvdif(opcode,handle);         { return value suggested }
  721. END;
  722.  
  723. {*************************************************************}
  724. {* set writing mode *}
  725.  
  726. FUNCTION vswr_mode (handle, mode : INTEGER) : INTEGER;
  727.  
  728. BEGIN
  729.    vswr_mode:=genset(32,handle,mode);
  730. END;
  731.  
  732. {************************************************************}
  733. {* set color representation *}
  734.  
  735. FUNCTION vs_color (handle  : INTEGER;
  736.                    index   : INTEGER;
  737.                    rgbin   : ARRAY_3 ) : INTEGER;
  738.  
  739. BEGIN
  740.    contrl[1]:=0;
  741.    contrl[3]:=4;
  742.    intin[0]:=index;
  743.    intin[1]:=rgbin[0];
  744.    intin[2]:=rgbin[1];
  745.    intin[3]:=rgbin[2];
  746.    vs_color:=gemvdif(14,handle);
  747. END;
  748.  
  749.  
  750. {*********************************************************}
  751. {* set polyline line type *}
  752.  
  753. FUNCTION vsl_type ( handle  : INTEGER;
  754.                     style   : INTEGER ) : INTEGER;
  755.  
  756. BEGIN
  757.    vsl_type:=genset(15,handle,style);
  758. END;
  759.  
  760. {*********************************************************}
  761. {* set user defined line style pattern *}
  762.  
  763. FUNCTION vsl_udsty (handle  : INTEGER;
  764.                     pattern : INTEGER ) : INTEGER;
  765.  
  766. BEGIN
  767.    vsl_udsty:=genset(113,handle,pattern);
  768. END;
  769.  
  770. {********************************************************}
  771. {* set polyline linewidth *}
  772.  
  773. FUNCTION vsl_width (handle  : INTEGER;
  774.                     width   : INTEGER ) : INTEGER;
  775.  
  776. BEGIN
  777.    contrl[1]:=1;
  778.    contrl[3]:=0;
  779.    ptsin[0]:=width;
  780.    ptsin[1]:=0;
  781.    vsl_width:=gemvdif(16,handle);
  782.    vsl_width:=ptsout[0];
  783. END;
  784.  
  785. {*********************************************************}
  786. {* set polyline color index *}
  787.  
  788. FUNCTION vsl_color (handle   : INTEGER;
  789.                     colindex : INTEGER ) : INTEGER;
  790.  
  791. BEGIN
  792.    vsl_color:=genset(17,handle,colindex);
  793. END;
  794.  
  795. {***********************************************************}
  796. {* set polyline end style *}
  797.  
  798. FUNCTION vsl_end_s (handle    : INTEGER;
  799.                     begstyle  : INTEGER;
  800.                     endstyle  : INTEGER ) : INTEGER;
  801.  
  802. BEGIN
  803.    contrl[1]:=0;
  804.    contrl[3]:=2;
  805.    intin[0]:=begstyle;
  806.    intin[1]:=endstyle;
  807.    vsl_end_s:=gemvdif(108,handle);
  808. END;
  809.  
  810. {************************************************************}
  811. {* set polymarker type *}
  812.  
  813. FUNCTION vsm_type (handle  : INTEGER;
  814.                    symbol  : INTEGER ) : INTEGER;
  815.  
  816. BEGIN
  817.    vsm_type:=genset(18,handle,symbol);
  818. END;
  819.  
  820. {*************************************************************}
  821. {* set polymarker height *}
  822.  
  823. FUNCTION vsm_height (handle : INTEGER;
  824.                      height : INTEGER ) : INTEGER;
  825.  
  826. BEGIN
  827.    contrl[0]:=19;
  828.    contrl[1]:=1;
  829.    contrl[3]:=0;
  830.    contrl[6]:=handle;
  831.    ptsin[0]:=0;
  832.    ptsin[1]:=height;
  833.    vsm_height:=gemvdif(19,handle);
  834.    vsm_height:=ptsout[1];
  835. END;
  836.  
  837. {***********************************************************}
  838. {* set polymarker color index *}
  839.  
  840. FUNCTION vsm_color (handle   : INTEGER;
  841.                     colindex : INTEGER ) : INTEGER;
  842.  
  843. BEGIN
  844.    vsm_color:=genset(20,handle,colindex);
  845. END;
  846.  
  847. {*************************************************************}
  848. {* set character height, absolute mode *}
  849.  
  850. FUNCTION vst_height (handle         : INTEGER;
  851.                      height         : INTEGER;
  852.                      VAR charwidth  : INTEGER;
  853.                      VAR charheight : INTEGER;
  854.                      VAR cellwidth  : INTEGER;
  855.                      VAR cellheight : INTEGER ) : INTEGER;
  856.  
  857. BEGIN
  858.    contrl[1]:=1;
  859.    contrl[3]:=0;
  860.    ptsin[0]:=0;
  861.    ptsin[1]:=height;
  862.    vst_height:=gemvdif(12,handle);
  863.    charwidth:=ptsout[0];
  864.    charheight:=ptsout[1];
  865.    cellwidth:=ptsout[2];
  866.    cellheight:=ptsout[3];
  867. END;
  868.  
  869. {********************************************************************}
  870. {* set character cell height, points mode *}
  871.  
  872. FUNCTION vst_point (handle         : INTEGER;
  873.                     point          : INTEGER;
  874.                     VAR charwidth  : INTEGER;
  875.                     VAR charheight : INTEGER;
  876.                     VAR cellwidth  : INTEGER;
  877.                     VAR cellheight : INTEGER ) : INTEGER;
  878.  
  879. BEGIN
  880.    contrl[1]:=0;
  881.    contrl[3]:=1;
  882.    intin[0]:=point;
  883.    vst_point:=gemvdif(107,handle);
  884.    charwidth:=ptsout[0];
  885.    charheight:=ptsout[1];
  886.    cellwidth:=ptsout[2];
  887.    cellheight:=ptsout[3];
  888. END;
  889.  
  890. {*******************************************************************}
  891. {* set text character baseline vector - rotation *}
  892.  
  893. FUNCTION vst_rotation (handle  : INTEGER;
  894.                        angle   : INTEGER) : INTEGER;
  895.  
  896. BEGIN
  897.    vst_rotation:=genset(13,handle,angle);
  898. END;
  899.  
  900. {****************************************************************}
  901. {* set text font *}
  902.  
  903. FUNCTION vst_font (handle : INTEGER;
  904.                    font   : INTEGER) : INTEGER;
  905.  
  906. BEGIN
  907.    vst_font:=genset(21,handle,font);
  908. END;
  909.  
  910. {****************************************************************}
  911. {* set text color *}
  912.  
  913. FUNCTION vst_color (handle  : INTEGER;
  914.                    colindex : INTEGER) : INTEGER;
  915.  
  916. BEGIN
  917.    vst_color:=genset(22,handle,colindex);
  918. END;
  919.  
  920. {***************************************************************}
  921. {* set text special effects *}
  922.  
  923. FUNCTION vst_effects (handle  : INTEGER;
  924.                       effects : INTEGER) : INTEGER;
  925.  
  926. BEGIN
  927.    vst_effects:=genset(106,handle,effects);
  928. END;
  929.  
  930. {**************************************************************}
  931. {* set graphics text alignment *}
  932.  
  933. FUNCTION vst_alignment (handle      : INTEGER;
  934.                         horin       : INTEGER;
  935.                         vertin      : INTEGER;
  936.                         VAR horout  : INTEGER;
  937.                         VAR vertout : INTEGER) : INTEGER;
  938.  
  939. BEGIN
  940.    contrl[1]:=0;
  941.    contrl[3]:=2;
  942.    intin[0]:=horin;
  943.    intin[1]:=vertin;
  944.    vst_alignment:=gemvdif(39,handle);
  945.    horout:=intout[0];
  946.    vertout:=intout[1];
  947. END;
  948.  
  949.  
  950. {***************************************************************}
  951. {* set fill interior style *}
  952.  
  953. FUNCTION vsf_interior (handle  : INTEGER;
  954.                        style : INTEGER) : INTEGER;
  955.  
  956. BEGIN
  957.    vsf_interior:=genset(23,handle,style);
  958. END;
  959.  
  960. {**************************************************************}
  961. {* set fill style index *}
  962.  
  963. FUNCTION vsf_style (handle     : INTEGER;
  964.                     styleindex : INTEGER) : INTEGER;
  965.  
  966. BEGIN
  967.    vsf_style:=genset(24,handle,styleindex);
  968. END;
  969.  
  970. {*************************************************************}
  971. {* set fill color index *}
  972.  
  973. FUNCTION vsf_color ( handle     : INTEGER;
  974.                      colorindex : INTEGER) : INTEGER;
  975.  
  976. BEGIN
  977.    vsf_color:=genset(25,handle,colorindex);
  978. END;
  979.  
  980. {**************************************************************}
  981. {* set fill perimeter visibility *}
  982.  
  983. FUNCTION vsf_perimeter (handle     : INTEGER;
  984.                         pervis     : INTEGER) : INTEGER;
  985.  
  986. BEGIN
  987.    vsf_perimeter:=genset(104,handle,pervis);
  988. END;
  989.  
  990. {******************************************************************}
  991. {* Exchange fill pattern *}
  992.  
  993. FUNCTION vsf_udpat (handle  : INTEGER;
  994.                    pfillpat : gempoint;
  995.                    poldfpat : gempoint) : INTEGER;
  996.  
  997. BEGIN
  998.    contrl[1]:=0;
  999.    contrl[3]:=0;
  1000.    contrl[7]:=pfillpat.hi;
  1001.    contrl[8]:=pfillpat.lo;
  1002.    contrl[9]:=poldfpat.hi;
  1003.    contrl[10]:=poldfpat.lo;
  1004.    vsf_udpat:=gemvdif(112,handle);
  1005. END;
  1006.  
  1007.  
  1008.                     {*********************}
  1009.                     {**** RASTOR OPS *****}
  1010. {**************************************************************}
  1011. {* Copy rastor , Opaque *}
  1012.  
  1013. FUNCTION vro_cpyfm (handle   : INTEGER;
  1014.                     wrmode   : INTEGER;
  1015.                     pxyarray : ARRAY_8;
  1016.                     psrcMFDB : MFDB;
  1017.                     pdesMFDB : MFDB) : INTEGER;
  1018. VAR
  1019.    i : INTEGER;
  1020.    gtemp1, gtemp2 : gempoint;
  1021.    sm, dm : MFDB;
  1022.  
  1023. BEGIN
  1024.    contrl[1]:=4;
  1025.    contrl[3]:=1;
  1026.    sm:=psrcMFDB;   { ensure MFDB is local to get right segment address }
  1027.    gtemp1.gp:=ADDR(sm);            { long address }
  1028.    contrl[7]:=gtemp1.hi;           { offset of MFDB }
  1029.    contrl[8]:=gtemp1.lo;           { segemnt of MFDB }
  1030.    dm:=pdesMFDB;
  1031.    gtemp2.gp:=ADDR(dm);
  1032.    contrl[9]:=gtemp2.hi;
  1033.    contrl[10]:=gtemp2.lo;
  1034.    intin[0]:=wrmode;               { logic operation write mode }
  1035.    FOR i:=0 TO 7 DO ptsin[i]:=pxyarray[i];
  1036.    vro_cpyfm:=gemvdif(109,handle);
  1037. END;
  1038.  
  1039. {**************************************************************}
  1040. {* Copy rastor , Transparent *}
  1041.  
  1042. FUNCTION vrt_cpyfm (handle    : INTEGER;
  1043.                     wrmode    : INTEGER;
  1044.                     pxyarray  : ARRAY_8;
  1045.                     psrcMFDB  : MFDB;
  1046.                     pdesMFDB  : MFDB;
  1047.                     color1    : INTEGER;
  1048.                     color0    : INTEGER ) : INTEGER;
  1049. VAR i : INTEGER;
  1050.    gemp1, gemp2 : gempoint;
  1051.    sm, dm : MFDB;
  1052.  
  1053. BEGIN
  1054.    contrl[1]:=4;
  1055.    contrl[3]:=3;
  1056.    sm:=psrcMFDB;                   { local MFDB }
  1057.    gemp1.gp:=ADDR(sm);
  1058.    contrl[7]:=gemp1.hi;            { hi order word of address ptr }
  1059.    contrl[8]:=gemp1.lo;            { lo order word }
  1060.    dm:=pdesMFDB;
  1061.    gemp2.gp:=ADDR(dm);
  1062.    contrl[9]:=gemp2.hi;
  1063.    contrl[10]:=gemp2.lo;
  1064.    intin[0]:=wrmode;               { logic operation write mode }
  1065.    intin[1]:=color1;
  1066.    intin[2]:=color0;
  1067.    FOR i:=0 TO 7 DO ptsin[i]:=pxyarray[i];
  1068.    vrt_cpyfm:=gemvdif(121,handle);
  1069. END;
  1070.  
  1071. {***********************************************************}
  1072. {* Transform Form *}
  1073.  
  1074. FUNCTION vr_trn_fm (handle    : INTEGER;
  1075.                     psrcMFDB  : MFDB;
  1076.                     pdesMFDB  : MFDB      ) : INTEGER;
  1077. VAR
  1078.    gemp1, gemp2 : gempoint;
  1079.    sm, dm : MFDB;
  1080.  
  1081. BEGIN
  1082.    contrl[1]:=0;
  1083.    contrl[3]:=0;
  1084.    sm:=psrcMFDB;
  1085.    gemp1.gp:=ADDR(sm);
  1086.    contrl[7]:=gemp1.hi;
  1087.    contrl[8]:=gemp1.lo;
  1088.    dm:=pdesMFDB;
  1089.    gemp2.gp:=ADDR(dm);
  1090.    contrl[9]:=gemp2.hi;
  1091.    contrl[10]:=gemp2.lo;
  1092.    vr_trn_fm:=gemvdif(110,handle);
  1093. END;
  1094.  
  1095.                    {***********************}
  1096.                    {*** INPUT FUNCTIONS ***}
  1097. {*******************************************************************}
  1098. {* Set Input Mode *}
  1099.  
  1100. FUNCTION vsin_mode (handle    : INTEGER;
  1101.                     devtype   : INTEGER;
  1102.                     mode      : INTEGER ) : INTEGER;
  1103.  
  1104. BEGIN
  1105.    contrl[1]:=0;
  1106.    contrl[3]:=2;
  1107.    intin[0]:=devtype;
  1108.    intin[1]:=mode;
  1109.    vsin_mode:=gemvdif(33,handle);
  1110.    vsin_mode:=intout[0];
  1111. END;
  1112.  
  1113. {**********************************************************************}
  1114. {*  Input locator, request mode *}
  1115. {********************************}
  1116.  
  1117. FUNCTION vrq_locator (handle    : INTEGER;
  1118.                       x         : INTEGER;
  1119.                       y         : INTEGER;
  1120.                       VAR xout  : INTEGER;
  1121.                       VAR yout  : INTEGER;
  1122.                       VAR term  : CHAR      ) : INTEGER;
  1123.  
  1124. BEGIN
  1125.    contrl[1]:=1;
  1126.    contrl[3]:=0;
  1127.    ptsin[0]:=x;
  1128.    ptsin[1]:=y;
  1129.    vrq_locator:=gemvdif(28,handle);
  1130.    xout:=ptsout[0];
  1131.    yout:=ptsout[1];
  1132.    term:=CHR(intout[0]);           { return single byte character }
  1133. END;
  1134.  
  1135. {****************************************************************}
  1136. {* Input Locator , Sample mode *}
  1137.  
  1138. FUNCTION vsm_locator (handle        : INTEGER;
  1139.                       x             : INTEGER;
  1140.                       y             : INTEGER;
  1141.                       VAR xout      : INTEGER;
  1142.                       VAR yout      : INTEGER;
  1143.                       VAR term      : INTEGER;
  1144.                       VAR coorchg   : INTEGER;
  1145.                       VAR keypress  : INTEGER ) : INTEGER;
  1146.  
  1147. BEGIN
  1148.    contrl[1]:=1;
  1149.    contrl[3]:=0;
  1150.    ptsin[0]:=x;
  1151.    ptsin[1]:=y;
  1152.    vsm_locator:=gemvdif(28,handle);
  1153.    xout:=ptsout[0];
  1154.    yout:=ptsout[1];
  1155.    term:=intout[0];
  1156.    coorchg:=contrl[2];
  1157.    keypress:=contrl[4];
  1158. END;
  1159.  
  1160. {******************************************************************}
  1161. {*  Input Valuator, Request Mode *}
  1162.  
  1163. FUNCTION vrq_valuator (handle     : INTEGER;
  1164.                        valin      : INTEGER;
  1165.                        VAR valout : INTEGER;
  1166.                        VAR term : CHAR       ) : INTEGER;
  1167.  
  1168. BEGIN
  1169.    contrl[1]:=0;
  1170.    contrl[3]:=1;
  1171.    intin[0]:=valin;
  1172.    vrq_valuator:=gemvdif(29,handle);
  1173.    valout:=intout[0];
  1174.    term:=CHR(intout[1]);
  1175. END;
  1176.  
  1177. {*****************************************************************}
  1178. {* Input Valuator, Sample Mode *}    { check this !!!}
  1179.  
  1180. FUNCTION vsm_valuator (handle      : INTEGER;
  1181.                        valin       : INTEGER;
  1182.                        VAR valout  : INTEGER;
  1183.                        VAR term    : CHAR;
  1184.                        VAR status  : INTEGER     ) : INTEGER;
  1185.  
  1186. BEGIN
  1187.    contrl[1]:=0;
  1188.    contrl[3]:=1;
  1189.    intin[0]:=valin;
  1190.    vsm_valuator:=gemvdif(29,handle);
  1191.    valout:=intout[0];
  1192.    status:=contrl[4];
  1193.    term:=CHR(intout[1]);
  1194. END;
  1195.  
  1196. {***************************************************************}
  1197. {* Input Choice, request Mode *}
  1198.  
  1199. FUNCTION vrq_choice (handle     : INTEGER;
  1200.                      VAR choice : INTEGER ) : INTEGER;
  1201.  
  1202. BEGIN
  1203.    contrl[1]:=0;
  1204.    contrl[3]:=1;
  1205.    intin[0]:=choice;
  1206.    vrq_choice:=gemvdif(30,handle);
  1207.    choice:=intout[0];
  1208. END;
  1209.  
  1210. {*****************************************************************}
  1211. {* Input Choice, Sample Mode *}
  1212.  
  1213. FUNCTION vsm_choice (handle      : INTEGER;
  1214.                      VAR choice  : INTEGER;
  1215.                      VAR status  : INTEGER ) : INTEGER;
  1216.  
  1217. BEGIN
  1218.    contrl[1]:=0;
  1219.    contrl[3]:=0;
  1220.    vsm_choice:=gemvdif(30,handle);
  1221.    choice:=intout[0];
  1222.    status:=contrl[4];
  1223. END;
  1224.  
  1225. {****************************************************************}
  1226. {* Input String, Request Mode *}
  1227.  
  1228. FUNCTION vrq_string (handle       : INTEGER;
  1229.                      maxlen       : INTEGER;
  1230.                      echomode     : INTEGER;
  1231.                      echox        : INTEGER;
  1232.                      echoy        : INTEGER;
  1233.                      VAR instring : STRING80 ) : INTEGER;
  1234. VAR
  1235.    i : INTEGER;
  1236.  
  1237. BEGIN
  1238.    contrl[1]:=1;
  1239.    contrl[3]:=2;
  1240.    intin[0]:=0-maxlen;             { force standard keyboard input }
  1241.    intin[1]:=echomode;
  1242.    ptsin[0]:=echox;
  1243.    ptsin[1]:=echoy;
  1244.    vrq_string:=gemvdif(31,handle);
  1245.    instring:='';                           { null string }
  1246.    FOR i:=1 TO contrl[4] DO instring:=CONCAT(instring,CHR(intout[i-1]));
  1247.                                         { into string char form }
  1248. END;
  1249.  
  1250. {**************************************************************}
  1251. {* Input String, Sample Mode *}
  1252.  
  1253. FUNCTION vsm_string (handle       : INTEGER;
  1254.                      maxlen       : INTEGER;
  1255.                      echomode     : INTEGER;
  1256.                      echox        : INTEGER;
  1257.                      echoy        : INTEGER;
  1258.                      VAR instring : STRING80;
  1259.                      VAR status   : INTEGER)  : INTEGER;
  1260. VAR
  1261.    I : INTEGER;
  1262.  
  1263. BEGIN
  1264.    contrl[1]:=1;
  1265.    contrl[3]:=2;
  1266.    intin[0]:=0-maxlen;             { force standard keyboard input  }
  1267.    intin[1]:=echomode;
  1268.    ptsin[0]:=echox;
  1269.    ptsin[1]:=echoy;
  1270.    vsm_string:=gemvdif(31,handle);
  1271.    instring:='';                           { null string }
  1272.    FOR i:=1 TO contrl[4] DO instring:=CONCAT(instring,CHR(intout[i-1]));
  1273.                                         { into string char form }
  1274.    status:=contrl[4];
  1275. END;
  1276.  
  1277. {*****************************************************************}
  1278. {* Set Moose Form *}
  1279.  
  1280. FUNCTION vsc_form (handle   : INTEGER;
  1281.                    pcurform : ARRAY_37 ) : INTEGER;
  1282. VAR
  1283.    i : INTEGER;
  1284.  
  1285. BEGIN
  1286.    contrl[1]:=0;
  1287.    contrl[3]:=37;
  1288.    FOR i:=0 TO 36 DO intin[i]:=pcurform[i];
  1289.    vsc_form:=gemvdif(111,handle);
  1290. END;
  1291.  
  1292.  
  1293. {******************************************************************}
  1294. {* Exchange Mouse Movement Vector *}
  1295.  
  1296. FUNCTION vex_motv (handle       : INTEGER;
  1297.                    pusrcode     : gempoint;
  1298.                    VAR psavcode : gempoint ) : INTEGER;
  1299.  
  1300. BEGIN
  1301.    contrl[1]:=0;
  1302.    contrl[3]:=0;
  1303.    contrl[7]:=pusrcode.hi;         { check this !!}
  1304.    contrl[8]:=pusrcode.lo;
  1305.    vex_motv:=gemvdif(126,handle);
  1306.    psavcode.hi:=contrl[9];
  1307.    psavcode.lo:=contrl[10];
  1308. END;
  1309.  
  1310. {****************************************************************}
  1311. {** show graphic cursor ***}
  1312.  
  1313. FUNCTION v_show_c (handle  : INTEGER;
  1314.                    reset   : INTEGER ) : INTEGER;
  1315.  
  1316. BEGIN
  1317.    contrl[1]:=0;
  1318.    contrl[3]:=1;
  1319.    intin[0]:=reset;
  1320.    v_show_c:=gemvdif(122,handle);
  1321. END;
  1322.  
  1323. {*****************************************************}
  1324. {* hide graphic cursor *}
  1325.  
  1326. FUNCTION v_hide_c (handle : INTEGER) : INTEGER;
  1327.  
  1328. BEGIN
  1329.    contrl[1]:=0;
  1330.    contrl[3]:=0;
  1331.    v_hide_c:=gemvdif(123,handle);
  1332. END;
  1333.  
  1334. {******************************************************************}
  1335. {* Exchange Button Change Vector *}
  1336.  
  1337. FUNCTION vex_butv (handle       : INTEGER;
  1338.                    pusrcode     : gempoint;
  1339.                    VAR psavcode : gempoint  ) : INTEGER;
  1340.  
  1341. BEGIN
  1342.    contrl[1]:=0;
  1343.    contrl[3]:=0;
  1344.    contrl[7]:=pusrcode.hi;         { CHECK THIS }
  1345.    contrl[8]:=pusrcode.lo;
  1346.    vex_butv:=gemvdif(125,handle);
  1347.    psavcode.hi:=contrl[8];
  1348.    psavcode.lo:=contrl[9];
  1349. END;
  1350.  
  1351. {********************************************************************}
  1352. {* Exchange Cursor Change  Vector *}
  1353.  
  1354. FUNCTION vex_curv (handle       : INTEGER;
  1355.                    pusrcode     : gempoint;
  1356.                    VAR psavcode : gempoint  ) : INTEGER;
  1357.  
  1358. BEGIN
  1359.    contrl[1]:=0;
  1360.    contrl[3]:=0;
  1361.    contrl[7]:=pusrcode.hi;         { CHECK THIS }
  1362.    contrl[8]:=pusrcode.lo;
  1363.    vex_curv:=gemvdif(127,handle);
  1364.    psavcode.hi:=contrl[8];
  1365.    psavcode.lo:=contrl[9];
  1366. END;
  1367.  
  1368. {*********************************************************************}
  1369. {* Sample Keyboard State Information *}
  1370.  
  1371. FUNCTION vq_key_s (handle      : INTEGER;
  1372.                    VAR pstatus : INTEGER ) : INTEGER;
  1373.  
  1374. BEGIN
  1375.    contrl[1]:=0;
  1376.    contrl[3]:=0;
  1377.    vq_key_s:=gemvdif(128,handle);
  1378.    pstatus:=intout[0];
  1379. END;
  1380.  
  1381. {******************************************************************}
  1382. {* Sample Mouse Button State *}
  1383.  
  1384. FUNCTION vq_mouse (handle       : INTEGER;
  1385.                    VAR pstatus  : INTEGER;
  1386.                    VAR x        : INTEGER;
  1387.                    VAR y        : INTEGER ) : INTEGER;
  1388.  
  1389. BEGIN
  1390.    contrl[1]:=0;
  1391.    contrl[3]:=0;
  1392.    vq_mouse:=gemvdif(124,handle);
  1393.    pstatus:=intout[0];
  1394.    x:=ptsout[0];
  1395.    y:=ptsout[1];
  1396. END;
  1397.  
  1398. {******************************************************************}
  1399. {* Exchange Timer Interrupt Vector *}
  1400.  
  1401. FUNCTION vex_timv (handle       : INTEGER;
  1402.                    timaddr      : gempoint;
  1403.                    VAR otimaddr : gempoint;
  1404.                    VAR timconv  : INTEGER    ) : INTEGER;
  1405.  
  1406. BEGIN
  1407.    contrl[1]:=0;
  1408.    contrl[3]:=0;
  1409.    contrl[7]:=timaddr.hi;                  { CHECK THIS }
  1410.    contrl[8]:=timaddr.lo;
  1411.    vex_timv:=gemvdif(118,handle);
  1412.    otimaddr.hi:=contrl[9];
  1413.    otimaddr.lo:=contrl[10];
  1414.    timconv:=intout[0];
  1415. END;
  1416.  
  1417. {*******************************************************************}
  1418.  
  1419.  
  1420.                 {*** INQUIRE FUNCTIONS ******}
  1421. {********************************************************************}
  1422. {* Extended Inquire Function *}
  1423.  
  1424. FUNCTION vq_extend (handle      : INTEGER;
  1425.                     owflag      : INTEGER;
  1426.                     VAR workout : ARRAY_57  ) : INTEGER;
  1427. VAR
  1428.    i: INTEGER;
  1429.  
  1430. BEGIN
  1431.    contrl[1]:=0;
  1432.    contrl[3]:=1;
  1433.    intin[0]:=owflag;
  1434.    vq_extend:=gemvdif(102,handle);
  1435.    FOR i:=0 TO 44 DO workout[i]:=intout[i];
  1436.    FOR i:=45 TO 56 DO workout[i]:=ptsout[i-45];
  1437. END;
  1438.  
  1439. {*******************************************************************}
  1440. {* Inquire color representation *}
  1441.  
  1442. FUNCTION vq_color (handle     : INTEGER;
  1443.                   colorindex  : INTEGER;
  1444.                   setflag     : INTEGER;
  1445.                   VAR rgb     : ARRAY_3  ) : INTEGER;
  1446. VAR
  1447.    i : INTEGER;
  1448.  
  1449. BEGIN
  1450.    contrl[1]:=0;
  1451.    contrl[3]:=2;
  1452.    intin[0]:=colorindex;
  1453.    intin[1]:=setflag;
  1454.    vq_color:=gemvdif(26,handle);
  1455.    FOR i:=0 TO 2 DO rgb[i]:=intout[i];
  1456. END;
  1457.  
  1458. {******************************************************}
  1459. {* Inquire polyline attributes }
  1460.  
  1461. FUNCTION vql_attributes (handle     : INTEGER;
  1462.                          VAR attrib : ARRAY_4  ) : INTEGER;
  1463. VAR
  1464.    i : INTEGER;
  1465.  
  1466. BEGIN
  1467.    contrl[1]:=0;
  1468.    contrl[3]:=0;
  1469.    vql_attributes:=gemvdif(35,handle);
  1470.    FOR i:=0 TO 2 DO attrib[i]:=intout[i];
  1471.    attrib[3]:=ptsout[0];
  1472. END;
  1473.  
  1474. {*******************************************************}
  1475. {* Inquire polymarker attributes *}
  1476.  
  1477. FUNCTION vqm_attributes (handle      : INTEGER;
  1478.                          VAR attrib  : ARRAY_4) : INTEGER;
  1479. VAR
  1480.    I : INTEGER;
  1481.  
  1482. BEGIN
  1483.    contrl[1]:=0;
  1484.    contrl[3]:=0;
  1485.    vqm_attributes:=gemvdif(36,handle);
  1486.    FOR i:= 0 TO 2 DO attrib[i]:=intout[i];
  1487.    attrib[3]:=ptsout[0];
  1488. END;
  1489.  
  1490. {*********************************************************}
  1491. {* Inquire fill area attributes *}
  1492.  
  1493. FUNCTION vqf_attributes (handle     : INTEGER;
  1494.                          VAR attrib : ARRAY_4 ) : INTEGER;
  1495. VAR
  1496.    i : INTEGER;
  1497.  
  1498. BEGIN
  1499.    contrl[1]:=0;
  1500.    contrl[3]:=0;
  1501.    vqf_attributes:=gemvdif(37,handle);
  1502.    FOR i:=0 TO 3 DO attrib[i]:=intout[i];
  1503.                 { what about fill perim status *}
  1504. END;
  1505.  
  1506. {****************************************************************}
  1507. {* Inquire current Graphic text attributes *}
  1508.  
  1509. FUNCTION vqt_attributes (handle     : INTEGER;
  1510.                          VAR attrib : ARRAY_10 ) : INTEGER;
  1511. VAR
  1512.    i : INTEGER;
  1513.  
  1514. BEGIN
  1515.    contrl[1]:=0;
  1516.    contrl[3]:=0;
  1517.    vqt_attributes:=gemvdif(38,handle);
  1518.    FOR i:=0 TO 5 DO attrib[i]:=intout[i];
  1519.    FOR i:=6 TO 9 DO attrib[i]:=ptsout[i-6];
  1520. END;
  1521.  
  1522. {*****************************************************************}
  1523. {* Inquire Text Extent *}
  1524.  
  1525. FUNCTION vqt_extent (handle     : INTEGER;
  1526.                      chstring   : STRING80;
  1527.                      VAR extent : ARRAY_8   ) : INTEGER;
  1528. VAR
  1529.    I : INTEGER;
  1530.  
  1531. BEGIN
  1532.    contrl[1]:=0;
  1533.    contrl[3]:=LENGTH(chstring);
  1534.    FOR i:=1 TO LENGTH(chstring) DO intin[i-1]:=ORD(chstring[i]);
  1535.    vqt_extent:=gemvdif(116,handle);
  1536.    FOR i:=0 TO 7 DO extent[i]:=ptsout[i];
  1537. END;
  1538.  
  1539. {********************************************************************}
  1540. {* Inquire character cell width *}
  1541.  
  1542. FUNCTION vqt_width (handle         : INTEGER;
  1543.                     character      : CHAR;
  1544.                     VAR cellwidth  : INTEGER;
  1545.                     VAR leftdelta  : INTEGER;
  1546.                     VAR rightdelta : INTEGER  ) : INTEGER;
  1547.  
  1548. BEGIN
  1549.    contrl[1]:=0;
  1550.    contrl[3]:=1;
  1551.    intin[0]:=ORD(character);
  1552.    vqt_width:=gemvdif(117,handle);
  1553.    cellwidth:=ptsout[0];
  1554.    leftdelta:=ptsout[2];
  1555.    rightdelta:=ptsout[4];
  1556. END;
  1557.  
  1558. {******************************************************************}
  1559. {** Inquire font name and index *}
  1560.  
  1561. FUNCTION vqt_name (handle     : INTEGER;
  1562.                    elementnum : INTEGER;
  1563.                    VAR name   : STRING80 ) : INTEGER;
  1564. VAR
  1565.    i : INTEGER;
  1566.  
  1567. BEGIN
  1568.    contrl[1]:=0;
  1569.    contrl[3]:=1;
  1570.    intin[0]:=elementnum;
  1571.    vqt_name:=gemvdif(130,handle);
  1572.    name:='';                       { initialize string to null }
  1573.    FOR i:=1 TO 32 DO name:=CONCAT(name,CHR(intout[i]));
  1574. END;
  1575.  
  1576. {********************************************************************}
  1577. {* Inquire Cell Array *}
  1578.  
  1579. FUNCTION vq_cellarray (handle       : INTEGER;
  1580.                        pxyarray     : ARRAY_4;
  1581.                        rowlen       : INTEGER;
  1582.                        numrows      : INTEGER;
  1583.                        VAR elused   : INTEGER;
  1584.                        VAR rowsused : INTEGER;
  1585.                        status       : INTEGER;
  1586.                        VAR colarray : intout_ARRAY  ) : INTEGER;
  1587. VAR
  1588.    i : INTEGER;
  1589.  
  1590. BEGIN
  1591.    contrl[1]:=2;
  1592.    contrl[7]:=rowlen;
  1593.    contrl[8]:=numrows;
  1594.    FOR i:=0 TO 3 DO ptsin[i]:=pxyarray[i];
  1595.    vq_cellarray:=gemvdif(27,handle);
  1596.    elused:=contrl[9];
  1597.    rowsused:=contrl[10];
  1598.    status:=contrl[11];
  1599.    FOR i:=0 TO intout_max DO colarray[i]:=intout[i];
  1600. END;
  1601.  
  1602. {********************************************************************}
  1603. {* Inquire Input Mode *}
  1604.  
  1605. FUNCTION vqn_mode (handle        : INTEGER;
  1606.                    VAR inputmode : INTEGER ) : INTEGER;
  1607.  
  1608. BEGIN
  1609.    contrl[1]:=0;
  1610.    contrl[3]:=1;
  1611.    vqn_mode:=gemvdif(115,handle);
  1612.    inputmode:=intout[0];
  1613. END;
  1614.  
  1615.  
  1616.  
  1617. {******************************************************************}
  1618. {* Inquire Current Font Information *}
  1619.  
  1620. FUNCTION vqt_fontinfo (handle        : INTEGER;
  1621.                        VAR minADE    : INTEGER;
  1622.                        VAR maxADE    : INTEGER;
  1623.                        VAR distances : ARRAY_4;
  1624.                        VAR maxwidth  : INTEGER;
  1625.                        effects       : ARRAY_3 ) : INTEGER;
  1626.  
  1627. BEGIN
  1628.    contrl[1]:=0;
  1629.    contrl[3]:=0;
  1630.    vqt_fontinfo:=gemvdif(131,handle);
  1631.    minADE:=intout[0];
  1632.    maxADE:=intout[1];
  1633.    distances[0]:=ptsout[1];
  1634.    distances[1]:=ptsout[3];
  1635.    distances[2]:=ptsout[5];
  1636.    distances[3]:=ptsout[7];
  1637.    maxwidth:=ptsout[0];
  1638.    effects[0]:=ptsout[2];
  1639.    effects[1]:=ptsout[4];
  1640.    effects[2]:=ptsout[6];
  1641. END;
  1642.  
  1643.                 {*******************}
  1644.                 {*****  ESCAPES ****}
  1645. {******************************************************************}
  1646. {* escape : inquire addressable alpha char cells *}
  1647.  
  1648. FUNCTION vq_chcells (handle      : INTEGER;
  1649.                      VAR rows    : INTEGER;
  1650.                      VAR columns : INTEGER ) : INTEGER;
  1651.  
  1652. BEGIN
  1653.    contrl[1]:=0;
  1654.    contrl[3]:=0;
  1655.    contrl[5]:=1;
  1656.    vq_chcells:=gemvdif(5,handle);
  1657.    rows:=intout[0];
  1658.    columns:=intout[1];
  1659. END;
  1660.  
  1661. {**********************************************************}
  1662. {** general escape routine..called by many of those below *}
  1663.  
  1664. FUNCTION genescape (fid    : INTEGER;
  1665.                     handle : INTEGER ) : INTEGER;
  1666.  
  1667. BEGIN
  1668.    contrl[1]:=0;
  1669.    contrl[3]:=0;
  1670.    contrl[5]:=fid;         { function id }
  1671.    genescape:=gemvdif(5,handle);
  1672. END;
  1673.  
  1674. {************************************************************}
  1675. FUNCTION v_exit_cur (handle : INTEGER) : INTEGER;
  1676.  
  1677. BEGIN
  1678.    v_exit_cur:=genescape(2,handle);
  1679. END;
  1680.  
  1681. {************************************************************}
  1682. FUNCTION v_enter_cur (handle : INTEGER) : INTEGER;
  1683.  
  1684. BEGIN
  1685.    v_enter_cur:=genescape(3,handle);
  1686. END;
  1687.  
  1688. {************************************************************}
  1689. FUNCTION v_curup (handle : INTEGER) : INTEGER;
  1690.  
  1691. BEGIN
  1692.    v_curup:=genescape(4,handle);
  1693. END;
  1694.  
  1695. {************************************************************}
  1696. FUNCTION v_curdown (handle : INTEGER) : INTEGER;
  1697.  
  1698. BEGIN
  1699.    v_curdown:=genescape(5,handle);
  1700. END;
  1701.  
  1702. {************************************************************}
  1703. FUNCTION v_curright (handle : INTEGER) : INTEGER;
  1704.  
  1705. BEGIN
  1706.    v_curright:=genescape(6,handle);
  1707. END;
  1708.  
  1709. {************************************************************}
  1710. FUNCTION v_curleft (handle : INTEGER) : INTEGER;
  1711.  
  1712. BEGIN
  1713.    v_curleft:=genescape(7,handle);
  1714. END;
  1715.  
  1716. {************************************************************}
  1717. FUNCTION v_curhome (handle : INTEGER) : INTEGER;
  1718.  
  1719. BEGIN
  1720.    v_curhome:=genescape(8,handle);
  1721. END;
  1722.  
  1723. {************************************************************}
  1724. FUNCTION v_eeos (handle : INTEGER) : INTEGER;
  1725.  
  1726. BEGIN
  1727.    v_eeos:=genescape(9,handle);
  1728. END;
  1729.  
  1730. {************************************************************}
  1731. FUNCTION v_eeol (handle : INTEGER) : INTEGER;
  1732.  
  1733. BEGIN
  1734.    v_eeol:=genescape(10,handle);
  1735. END;
  1736.  
  1737. {*****************************************************************}
  1738. {*****************************************************************}
  1739. {* direct alpha cursor address *}
  1740.  
  1741. FUNCTION vs_curaddress (handle, row, column : INTEGER) : INTEGER;
  1742.  
  1743. BEGIN
  1744.    contrl[1]:=0;
  1745.    contrl[3]:=2;
  1746.    contrl[5]:=11;
  1747.    intin[0]:=row;
  1748.    intin[1]:=column;
  1749.    vs_curaddress:=gemvdif(5,handle);
  1750. END;
  1751.  
  1752. {************************************************************}
  1753. {* output cursor addressable text *}
  1754.  
  1755. FUNCTION v_curtext (handle   : INTEGER;
  1756.                     chstring : STRING80) : INTEGER;
  1757. VAR
  1758.    i : INTEGER;
  1759.  
  1760. BEGIN
  1761.    contrl[1]:=0;
  1762.    contrl[3]:=LENGTH(chstring);
  1763.    contrl[5]:=12;
  1764.    FOR i:=1 TO LENGTH(chstring) DO intin[i- 1]:=ORD(chstring[i]);
  1765.    v_curtext:=gemvdif(5,handle);
  1766. END;
  1767.  
  1768. {************************************************************}
  1769. FUNCTION v_rvon (handle : INTEGER) : INTEGER;
  1770.  
  1771. BEGIN
  1772.    v_rvon:=genescape(13,handle);
  1773. END;
  1774.  
  1775. {************************************************************}
  1776. FUNCTION v_rvoff (handle : INTEGER) : INTEGER;
  1777.  
  1778. BEGIN
  1779.    v_rvoff:=genescape(14,handle);
  1780. END;
  1781.  
  1782. {*************************************************************}
  1783. {* inquire current alpha cursor address *}
  1784.  
  1785. FUNCTION vq_curaddress (handle     : INTEGER;
  1786.                         VAR row    : INTEGER;
  1787.                         VAR column : INTEGER ) : INTEGER;
  1788.  
  1789. BEGIN
  1790.    contrl[1]:=0;
  1791.    contrl[3]:=0;
  1792.    contrl[5]:=15;
  1793.    vq_curaddress:=gemvdif(5,handle);
  1794.    row:=intout[0];
  1795.    column:=intout[1];
  1796. END;
  1797.  
  1798. {************************************************************}
  1799. {* inquire tablet status *}
  1800.  
  1801. FUNCTION vq_tabstatus (handle : INTEGER; VAR status : INTEGER) : INTEGER;
  1802.  
  1803. BEGIN
  1804.    contrl[1]:=0;
  1805.    contrl[3]:=0;
  1806.    contrl[5]:=16;
  1807.    vq_tabstatus:=gemvdif(5,handle);
  1808.    status:=intout[0];
  1809. END;
  1810.  
  1811. {*************************************************************}
  1812. {* Hard Copy *}
  1813.  
  1814. FUNCTION v_hardcopy (handle : INTEGER) : INTEGER;
  1815.  
  1816. BEGIN
  1817.    v_hardcopy:=genescape(17,handle);
  1818. END;
  1819.  
  1820. {****************************************************************}
  1821. {* place a graphic cursor at the specifeid location *}
  1822.  
  1823. FUNCTION v_dspcur (handle,x, y : INTEGER) : INTEGER;
  1824.  
  1825. BEGIN
  1826.    contrl[1]:=1;
  1827.    contrl[3]:=0;
  1828.    contrl[5]:=18;
  1829.    ptsin[0]:=x;
  1830.    ptsin[1]:=y;
  1831.    v_dspcur:=gemvdif(5,handle);
  1832. END;
  1833.  
  1834. {************************************************************}
  1835.  
  1836. FUNCTION v_rmcur (handle : INTEGER) : INTEGER;
  1837.  
  1838. BEGIN
  1839.    v_rmcur:=genescape(19,handle);
  1840. END;
  1841.  
  1842. {************************************************************}
  1843. {**    Form advance *}
  1844.  
  1845. FUNCTION v_form_adv(handle : INTEGER) : INTEGER;
  1846.  
  1847. BEGIN
  1848.    v_form_adv:=genescape(20,handle);
  1849. END;
  1850.  
  1851. {************************************************************}
  1852. {* Output Window *}
  1853.  
  1854. FUNCTION v_output_window(handle  : INTEGER;
  1855.                          xyarray : ARRAY_4 ) : INTEGER;
  1856. VAR
  1857.    i : INTEGER;
  1858.  
  1859. BEGIN
  1860.    contrl[1]:=2;
  1861.    contrl[3]:=0;
  1862.    contrl[5]:=21;
  1863.    FOR i:=0 TO 3 DO ptsin[i]:=xyarray[i];
  1864.    v_output_window:=gemvdif(5,handle);
  1865. END;
  1866.  
  1867. {*************************************************************}
  1868. {* Clear display list *}
  1869.  
  1870. FUNCTION v_clear_display_list (handle : INTEGER) : INTEGER;
  1871.  
  1872. BEGIN
  1873.    v_clear_display_list:=genescape(22,handle);
  1874. END;
  1875.  
  1876.  
  1877. {************************************************************}
  1878. {* selection of IBM color palette 0 = red,green,yelllow 1=cyan,blue,magenta }
  1879.  
  1880. FUNCTION vs_palette(handle   : INTEGER;
  1881.                     palette  : INTEGER   ) : INTEGER;
  1882.  
  1883. BEGIN
  1884.    contrl[1]:=0;
  1885.    contrl[3]:=1;
  1886.    contrl[5]:=60;
  1887.    intin[0]:=palette;
  1888.    vs_palette:=gemvdif(5,handle);
  1889. END;
  1890.  
  1891. {************************************************************}
  1892. {* Inquire Palette Film Types *}
  1893.  
  1894. FUNCTION vqp_films(handle        : INTEGER;
  1895.                    VAR filmnames : STRING80  ) : INTEGER;
  1896. VAR
  1897.    i : INTEGER;
  1898.  
  1899. BEGIN
  1900.    contrl[1]:=0;
  1901.    contrl[3]:=0;
  1902.    contrl[5]:=91;
  1903.    vqp_films:=gemvdif(5,handle);
  1904.    filmnames:='';
  1905.    FOR i:=0 TO 127 DO filmnames:=CONCAT(filmnames,CHR(intout[i]));
  1906. END;
  1907.  
  1908. {************************************************************}
  1909. {* Inquire Palette Driver State *}
  1910.  
  1911. FUNCTION vqp_state (handle         : INTEGER;
  1912.                     VAR port       : INTEGER;
  1913.                     VAR filmname   : INTEGER;
  1914.                     VAR lightness  : INTEGER;
  1915.                     VAR interlace  : INTEGER;
  1916.                     VAR planes     : INTEGER;
  1917.                     VAR indexes    : ARRAY_16 ) : INTEGER;
  1918. VAR
  1919.    i : INTEGER;
  1920.  
  1921. BEGIN
  1922.    contrl[1]:=0;
  1923.    contrl[3]:=0;
  1924.    contrl[5]:=92;
  1925.    vqp_state:=gemvdif(5,handle);
  1926.    port:=intout[0];
  1927.    filmname:=intout[1];
  1928.    lightness:=intout[2];
  1929.    interlace:=intout[3];
  1930.    planes:=intout[4];
  1931.    FOR i:=0 to 15 DO indexes[i]:=intout[i+5];
  1932. END;
  1933.  
  1934. {***************************************************************}
  1935. {* Set Palette Driver State *}
  1936.  
  1937. FUNCTION vsp_state (handle     : INTEGER;
  1938.                     port       : INTEGER;
  1939.                     filmname   : INTEGER;
  1940.                     lightness  : INTEGER;
  1941.                     interlace  : INTEGER;
  1942.                     planes     : INTEGER;
  1943.                     indexes    : ARRAY_16) : INTEGER;
  1944. VAR
  1945.    i : INTEGER;
  1946.  
  1947. BEGIN
  1948.    contrl[1]:=0;
  1949.    contrl[3]:=20;
  1950.    contrl[5]:=93;
  1951.    contrl[6]:=93;
  1952.    intin[0]:=port;
  1953.    intin[1]:=filmname;
  1954.    intin[2]:=lightness;
  1955.    intin[3]:=interlace;
  1956.    intin[4]:=planes;
  1957.    FOR i:=0 TO 15 DO intin[i+4]:=indexes[i];               { CHECK }
  1958.    vsp_state:=gemvdif(5,handle);
  1959. END;
  1960.  
  1961. {************************************************************}
  1962. {* Save Palette Driver State *}
  1963.  
  1964. FUNCTION vsp_save (handle : INTEGER) : INTEGER;
  1965.  
  1966. BEGIN
  1967.    vsp_save:=genescape(94, handle);
  1968. END;
  1969.  
  1970. {************************************************************}
  1971. {* suppress polaroid palette messages *}
  1972.  
  1973. FUNCTION vsp_message (handle : INTEGER) : INTEGER;
  1974.  
  1975. BEGIN
  1976.    vsp_message:=genescape(95,handle);
  1977. END;
  1978.  
  1979. {************************************************************}
  1980. {* Palette Error Inquiries *}
  1981.  
  1982. FUNCTION vqp_error (handle : INTEGER) : INTEGER;
  1983.  
  1984. BEGIN
  1985.    vqp_error:=genescape(96,handle);
  1986. END;
  1987.  
  1988. {*****************************************************************}
  1989. {** write gsx metafile **}
  1990.  
  1991. FUNCTION v_write_meta (handle   : INTEGER;
  1992.                        numintin : INTEGER;
  1993.                        intin    : intin_ARRAY;
  1994.                        numptsin : INTEGER;
  1995.                        ptsin    : ptsin_ARRAY  ) : INTEGER;
  1996. VAR
  1997.    i : INTEGER;
  1998.  
  1999. BEGIN
  2000.    contrl[1]:=numintin;
  2001.    contrl[3]:=numptsin;
  2002.    contrl[5]:=99;
  2003.    contrl[6]:=handle;
  2004.    v_write_meta:=gemvdif(5,handle);        { CHECK }
  2005. END;
  2006.  
  2007. {****************************************************************}
  2008. {* change gsx metafile filename from  gsxfile.gsx *}
  2009.  
  2010. FUNCTION vm_filename (handle   : INTEGER;
  2011.                       filename : STRING80 ) : INTEGER;
  2012. VAR
  2013.    i : INTEGER;
  2014.  
  2015. BEGIN
  2016.    contrl[1]:=0;
  2017.    contrl[3]:=LENGTH(filename);
  2018.    contrl[5]:=100;
  2019.    FOR i:=1 TO LENGTH(filename) DO intin[i- 1]:=ORD(filename[i]);
  2020.    vm_filename:=gemvdif(5,handle);
  2021. END;
  2022.  
  2023.  
  2024.