DataMuseum.dk

top - metrics - download

    Length: 49408 (0xc100)
    Types: TextFile
    Names: »VDIBND.PAS«

└─⟦4fbcde1e4⟧ Bits:30003931/GEM_Development-A.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
    └─⟦this⟧ »VDIBND.PAS« 

TextFile

(*****************************************************************)
(**    File Name   :  VDIBND.PAS                                **)
(**                                                             **)
(**    Modified for Turbo Pascal                                **)
(**                                                             **)
(**    Comments    :  All these language bindings               **)
(**                   use array's relative to 0.                **)
(**                                                             **)
(**     Author         : Athol M Foden                          **)
(**     History        : Feb 1985                               **)
(**     Last Modified  : 12 February 1986                       **)
(**     Digital Research Inc.                                   **)
(**                                                             **)
(*****************************************************************)

(* reuires gempcon.i, gemptype.i, gempvar.i *)

(*****************************************************************)

PROCEDURE GVDI (VAR gptsout : ptsout_ARRAY;
                VAR gintout : intout_ARRAY;
                VAR gptsin : ptsin_ARRAY;
                VAR gintin : intin_ARRAY;
                VAR gcontrl : contrl_ARRAY);

CONST
        VDIinterruptVector = $EF;
        VDImagicConstant = $0473;

TYPE
        ADDRESS = ^BYTE;

VAR
        parameterBlock : RECORD
                controlArray : ADDRESS;
                inputParameterArray : ADDRESS;
                inputPointCoordinateArray : ADDRESS;
                outputParameterArray : ADDRESS;
                outputPointCoordinateArray : ADDRESS;
        END (* RECORD *);

        registers : RECORD
                ax, bx, cx, dx, bp, si, di, ds, es, flags : INTEGER;
        END (* RECORD *);

BEGIN (* GVDI *)

        parameterBlock.controlArray := ADDR(gcontrl);
        parameterBlock.inputParameterArray := ADDR(gintin);
        parameterBlock.inputPointCoordinateArray := ADDR(gptsin);
        parameterBlock.outputParameterArray := ADDR(gintout);
        parameterBlock.outputPointCoordinateArray := ADDR(gptsout);

        registers.cx := VDImagicConstant;
        registers.ds := SEG(parameterBlock);
        registers.dx := OFS(parameterBlock);

        swint(VDIinterruptvector, registers);

END (* GVDI *);

(**************************************************************)
(* general (and only) call to GEM VDI *)

FUNCTION gemvdif(opcode, handle : INTEGER) : INTEGER;
BEGIN
        contrlÆ0Å := opcode;
        contrlÆ6Å := handle;
        (* in gempcall - gdos interrupt*)
        GVDI(ptsout, intout, ptsin, intin, contrl);
        gemvdif := intoutÆ0Å;
END;

(********************************************************************)
        (*** CONTROL FUNCTIONS ***)
(*****************************************************************)
(** open workstation **)

FUNCTION v_opnwk (workin : intin_ARRAY;
                  VAR  handle : INTEGER;
                  VAR workout : ARRAY_57) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        FOR i:=0 TO intin_max DO
                intinÆiÅ := workinÆiÅ;
        contrlÆ1Å := 0;
        contrlÆ3Å := 11;
        v_opnwk := gemvdif(1,handle);             (* opcode = 1 *)
        handle := contrlÆ6Å;
        FOR i:=0 TO 44 DO
                workoutÆiÅ := intoutÆiÅ;
        FOR i:=0 TO 11 DO
                workoutÆi + 44Å := ptsoutÆiÅ;
END;

(****************************************************************)
(** close workstation **)

FUNCTION v_clswk (handle : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        v_clswk := gemvdif(2,handle);
END;

(*****************************************************************)
(** open virtual workstation **)

FUNCTION v_opnvwk (workin : intin_ARRAY;
                   VAR handle : INTEGER;
                   VAR workout : ARRAY_57) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;           (* no of input vertices *)
        contrlÆ3Å := 11;          (* length of intin *)
        FOR i:=0 TO intin_max DO
                intinÆiÅ := workinÆiÅ;
        v_opnvwk := gemvdif(100,handle);
        (* handle from previously opened screen device *)
        handle := contrlÆ6Å;
        FOR i:=0 TO 44 DO
                workoutÆiÅ := intoutÆiÅ;
        FOR i:=0 TO 11 DO
                workoutÆi + 44Å := ptsoutÆiÅ;
END;

(****************************************************************)
(** close virtual workstation **)

FUNCTION v_clsvwk (handle : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        v_clsvwk := gemvdif(101,handle);
END;

(*****************************************************************)
(** clear workstation **)

FUNCTION v_clrwk (handle : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        v_clrwk := gemvdif(3,handle);
END;

(******************************************************************)
(** update workstation **)

FUNCTION v_updwk ( handle : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        v_updwk := gemvdif(4,handle);
END;

(**************************************************************************)
(** Load extra fonts into memory - caller must free up some memory space **)

FUNCTION vst_load_fonts(handle, select : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := select;
        vst_load_fonts := gemvdif(119,handle);
END;

(********************************************************************)
(** Unload those extra fonts **)

FUNCTION vst_unload_fonts(handle, select : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := select;
        vst_unload_fonts := gemvdif(120,handle);
END;

(**************************************************************************)
(** set clipping rectangle **)

FUNCTION vs_clip (handle : INTEGER;
                  clipflag : INTEGER;
                  pxyarray : ARRAY_4) : INTEGER;

VAR
        i:      INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 1;
        intinÆ0Å := clipflag;
        FOR i:=0 TO 3 DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        vs_clip := gemvdif(129,handle);
END;

        (************************)
        (**  OUTPUT FUNCTIONS  **)
(***************************************************************)
(** polyline **)

FUNCTION v_pline (handle, count : INTEGER;
                  pxyarray : ptsin_ARRAY) : INTEGER;

VAR
        i, n :  INTEGER;
BEGIN
        contrlÆ1Å := count;       (* number of vertices to follow *)
        contrlÆ3Å := 0;
        n := count * 2 - 1;               (* twice as many numbers as there are coords *)
        FOR i:=0 TO n DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        v_pline := gemvdif(6,handle);
END;

(****************************************************************)
(** polymarker **)

FUNCTION v_pmarker (handle, count : INTEGER;
                        pxyarray : ptsin_ARRAY) : INTEGER;

VAR
        i, n :  INTEGER;
BEGIN
        contrlÆ1Å := count;       (* number of markers *)
        contrlÆ3Å := 0;
        n := count * 2 - 1;
        FOR i:=0 TO n DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        v_pmarker := gemvdif(7,handle);
END;

(**************************************************************)
(** text **)

FUNCTION v_gtext (handle, x, y : INTEGER;
                  chstring : CharString) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := LEN(chstring);
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        FOR i:=1 TO LEN(chstring) DO
                intinÆi- 1Å := ORD(chstringÆiÅ);
        intinÆLEN(chstring)Å := 0;
        v_gtext := gemvdif(8,handle);
END;

(***************************************************************)
(** filled area **)

FUNCTION  v_fillarea(handle, count : INTEGER;
                        pxyarray : ptsin_ARRAY) : INTEGER;

VAR
        i, n  : INTEGER;
BEGIN
        contrlÆ1Å := count;
        contrlÆ3Å := 0;
        n := count * 2 - 1;
        FOR i:=0 TO n DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        v_fillarea := gemvdif(9,handle);
END;

(**************************************************************)
(** cell array **)

FUNCTION v_cellarray (handle : INTEGER;
pxyarray : ARRAY_4;
                rowlength, elused, numrows, wrtmode : INTEGER;
                        colorlen : INTEGER;
colarray : intin_ARRAY) : INTEGER;

VAR 
        i, j :  INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := colorlen;
        contrlÆ7Å := rowlength;
        contrlÆ8Å := elused;
        contrlÆ9Å := numrows;
        contrlÆ10Å := wrtmode;
        FOR i:=0 TO 3 DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        j := colorlen - 1 ;
        FOR i:=0 TO j DO
                intinÆiÅ := colarrayÆiÅ;
        v_cellarray := gemvdif(10,handle);
END;

(***************************************************************)
(** contour fill **)

FUNCTION v_contour (handle, x, y, index : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 1;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        intinÆ0Å := index;
        v_contour := gemvdif(103,handle);
END;

(***********************************************************)
(** fill rectangle **)

FUNCTION vr_recfl(handle : INTEGER;
                  pxyarray : ARRAY_4) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 0;
        FOR i:=0 TO 3 DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        vr_recfl := gemvdif(114,handle);
END;

                (*****************)
                (**   GDP 's    **)
(****************************************************************)
(** gdp - bar **)

FUNCTION v_bar (handle : INTEGER;
                                pxyarray : ARRAY_4) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 0;
        contrlÆ5Å := 1;
        FOR i:=0 TO 3 DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        v_bar := gemvdif(11,handle);
END;

(****************************************************************)
(** GDP - arc **)

FUNCTION v_arc (handle, x, y, radius, begang, endang : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 4;
        contrlÆ3Å := 2;
        contrlÆ5Å := 3;
        intinÆ0Å := begang;
        intinÆ1Å := endang;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        ptsinÆ6Å := radius;
        v_arc := gemvdif(11,handle);
END;

(********************************************************************)
(** GDP - pieslice **)

FUNCTION v_pieslice (handle, x, y, radius, begang, endang : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 4;
        contrlÆ3Å := 2;
        contrlÆ5Å := 3;
        intinÆ0Å := begang;
        intinÆ1Å := endang;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        ptsinÆ6Å := radius;
        v_pieslice := gemvdif(11,handle);
END;

(**********************************************************************)
(** GDP - circle **)

FUNCTION v_circle (handle, x, y, radius : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 3;
        contrlÆ3Å := 0;
        contrlÆ5Å := 4;
        contrlÆ6Å := handle;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        ptsinÆ4Å := radius;
        v_circle := gemvdif(11,handle);
END;

(********************************************************************)
(** GDP - elliptical arc **)

FUNCTION v_ellarc (handle, x, y, xradius, yradius, 
                   begang, endang : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 2;
        contrlÆ5Å := 6;
        intinÆ0Å := begang;
        intinÆ1Å := endang;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        ptsinÆ2Å := xradius;
        ptsinÆ3Å := yradius;
        v_ellarc := gemvdif(11,handle);
END;

(*****************************************************************)
(** GDP - elliptical pie **)

FUNCTION v_ellpie (handle, x, y, xradius, yradius, 
                                        begang, endang : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 2;
        contrlÆ5Å := 7;
        intinÆ0Å := begang;
        intinÆ1Å := endang;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        ptsinÆ2Å := xradius;
        ptsinÆ3Å := yradius;
        v_ellpie := gemvdif(11,handle);
END;

(*****************************************************************)
(** GDP - Ellipse **)

FUNCTION v_ellipse (handle, x, y, xradius, yradius : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 0;
        contrlÆ5Å := 5;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        ptsinÆ2Å := xradius;
        ptsinÆ3Å := yradius;
        v_ellipse := gemvdif(11,handle);
END;

(****************************************************************)
(** GDP rounded rectangle **)

FUNCTION v_rbox (handle : INTEGER;
                 xyarray : ARRAY_4) : INTEGER;

VAR 
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 0;
        contrlÆ5Å := 8;
        FOR i:=0 TO 3 DO
                ptsinÆiÅ := xyarrayÆiÅ;
        v_rbox := gemvdif(11,handle);
END;

(****************************************************************)
(** GDP Filled rounded rectangle **)

FUNCTION v_rfbox (handle : INTEGER;
                        xyarray : ARRAY_4) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 0;
        contrlÆ5Å := 9;
        FOR i:=0 TO 3 DO
                ptsinÆiÅ := xyarrayÆiÅ;
        v_rfbox := gemvdif(11,handle);
END;

(**************************************************************)
(**  Justified graphics text **)

FUNCTION v_justified(handle, x, y, jlength : INTEGER;
                     gstring : CharString;
                     wordspace, charspace : INTEGER) : INTEGER;

VAR
        i:      INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := LEN(gstring) + 2;
        FOR i:=1 TO LEN(gstring) DO
                intinÆi+1Å := ORD(gstringÆiÅ);
        intinÆLEN(gstring)Å := 0;
        intinÆ0Å := wordspace;
        intinÆ1Å := charspace;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        ptsinÆ2Å := jlength;
        v_justified := gemvdif(10,handle);
END;

                (*******************************)
                (*** SET ATTRIBUTE FUNCTIONS ***)
(**********************************************************)
(** general set routine, called by many procedures below **)

FUNCTION genset(opcode, handle, param : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := param;
        genset := gemvdif(opcode,handle);         (* return value suggested *)
END;

(***************************************************************)
(** set writing mode **)

FUNCTION vswr_mode (handle, mode : INTEGER) : INTEGER;
BEGIN
        vswr_mode := genset(32,handle,mode);
END;

(**************************************************************)
(** set color representation **)

FUNCTION vs_color (handle, index : INTEGER;
                         rgbin : ARRAY_3) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 4;
        intinÆ0Å := index;
        intinÆ1Å := rgbinÆ0Å;
        intinÆ2Å := rgbinÆ1Å;
        intinÆ3Å := rgbinÆ2Å;
        vs_color := gemvdif(14,handle);
END;


(***********************************************************)
(** set polyline line type **)

FUNCTION vsl_type ( handle, style : INTEGER) : INTEGER;
BEGIN
        vsl_type := genset(15,handle,style);
END;

(***********************************************************)
(** set user defined line style pattern **)

FUNCTION vsl_udsty (handle, pattern : INTEGER) : INTEGER;
BEGIN
        vsl_udsty := genset(113,handle,pattern);
END;

(**********************************************************)
(** set polyline linewidth **)

FUNCTION vsl_width (handle, width : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 0;
        ptsinÆ0Å := width;
        ptsinÆ1Å := 0;
        vsl_width := gemvdif(16,handle);
        vsl_width := ptsoutÆ0Å;
END;

(***********************************************************)
(** set polyline color index **)

FUNCTION vsl_color (handle, colindex : INTEGER) : INTEGER;
BEGIN
        vsl_color := genset(17,handle,colindex);
END;

(*************************************************************)
(** set polyline end style **)

FUNCTION vsl_ends (handle, begstyle, endstyle : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 2;
        intinÆ0Å := begstyle;
        intinÆ1Å := endstyle;
        vsl_ends := gemvdif(108,handle);
END;

(**************************************************************)
(** set polymarker type **)

FUNCTION vsm_type (handle, symbol : INTEGER) : INTEGER;
BEGIN
        vsm_type := genset(18,handle,symbol);
END;

(***************************************************************)
(** set polymarker height **)

FUNCTION vsm_height (handle, height : INTEGER) : INTEGER;
BEGIN
        contrlÆ0Å := 19;
        contrlÆ1Å := 1;
        contrlÆ3Å := 0;
        contrlÆ6Å := handle;
        ptsinÆ0Å := 0;
        ptsinÆ1Å := height;
        vsm_height := gemvdif(19,handle);
        vsm_height := ptsoutÆ1Å;
END;

(*************************************************************)
(** set polymarker color index **)

FUNCTION vsm_color (handle, colindex : INTEGER) : INTEGER;
BEGIN
        vsm_color := genset(20,handle,colindex);
END;

(***************************************************************)
(** set character height, absolute mode **)

FUNCTION vst_height (handle, height : INTEGER;

VAR     charwidth, charheight, 
                        cellwidth, cellheight : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 0;
        ptsinÆ0Å := 0;
        ptsinÆ1Å := height;
        vst_height := gemvdif(12,handle);
        charwidth := ptsoutÆ0Å;
        charheight := ptsoutÆ1Å;
        cellwidth := ptsoutÆ2Å;
        cellheight := ptsoutÆ3Å;
END;

(**********************************************************************)
(** set character cell height, points mode **)

FUNCTION vst_point (handle, point : INTEGER;

VAR     charwidth, charheight, 
                        cellwidth, cellheight : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := point;
        vst_point := gemvdif(107,handle);
        charwidth := ptsoutÆ0Å;
        charheight := ptsoutÆ1Å;
        cellwidth := ptsoutÆ2Å;
        cellheight := ptsoutÆ3Å;
END;

(*********************************************************************)
(** set text character baseline vector - rotation **)

FUNCTION vst_rotation (handle, angle : INTEGER) : INTEGER;
BEGIN
        vst_rotation := genset(13,handle,angle);
END;

(******************************************************************)
(** set text font **)

FUNCTION vst_font (handle, font : INTEGER) : INTEGER;
BEGIN
        vst_font := genset(21,handle,font);
END;

(******************************************************************)
(** set text color **)

FUNCTION vst_color (handle, colindex : INTEGER) : INTEGER;
BEGIN
        vst_color := genset(22,handle,colindex);
END;

(*****************************************************************)
(** set text special effects **)

FUNCTION vst_effects (handle, effects : INTEGER) : INTEGER;
BEGIN
        vst_effects := genset(106,handle,effects);
END;

(****************************************************************)
(** set graphics text alignment **)

FUNCTION vst_alignment (handle, horin, vertin : INTEGER;
                        VAR horout, vertout : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 2;
        intinÆ0Å := horin;
        intinÆ1Å := vertin;
        vst_alignment := gemvdif(39,handle);
        horout := intoutÆ0Å;
        vertout := intoutÆ1Å;
END;


(*****************************************************************)
(** set fill interior style **)

FUNCTION vsf_interior (handle, style : INTEGER) : INTEGER;
BEGIN
        vsf_interior := genset(23,handle,style);
END;

(****************************************************************)
(** set fill style index **)

FUNCTION vsf_style (handle, styleindex : INTEGER) : INTEGER;
BEGIN
        vsf_style := genset(24,handle,styleindex);
END;

(***************************************************************)
(** set fill color index **)

FUNCTION vsf_color ( handle, colorindex : INTEGER) : INTEGER;
BEGIN
        vsf_color := genset(25,handle,colorindex);
END;

(****************************************************************)
(** set fill perimeter visibility **)

FUNCTION vsf_perimeter (handle, pervis : INTEGER) : INTEGER;
BEGIN
        vsf_perimeter := genset(104,handle,pervis);
END;

(********************************************************************)
(** Exchange fill pattern **)

FUNCTION vsf_udpat (handle : INTEGER;
pfillpat, poldfpat : gempoint) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ7Å := pfillpat.hi;
        contrlÆ8Å := pfillpat.lo;
        contrlÆ9Å := poldfpat.hi;
        contrlÆ10Å := poldfpat.lo;
        vsf_udpat := gemvdif(112,handle);
END;


                    (***********************)
                    (***** RASTOR OPS ******)
(****************************************************************)
(** Copy rastor , Opaque **)

FUNCTION vro_cpyfm (handle, wrmode : INTEGER;
                        pxyarray : ARRAY_8;
                        psrcMFDB, pdesMFDB : MFDB) : INTEGER;

VAR
        i :     INTEGER;
        gtemp1, gtemp2 : gempoint;
        sm, dm : MFDB;
BEGIN
        contrlÆ1Å := 4;
        contrlÆ3Å := 1;
        (* ensure MFDB is local to get right segment address *)
        sm := psrcMFDB;   
        gtemp1.gp := ADDR(sm);            (* long address *)
        contrlÆ7Å := gtemp1.hi;           (* offset of MFDB *)
        contrlÆ8Å := gtemp1.lo;           (* segemnt of MFDB *)
        dm := pdesMFDB;
        gtemp2.gp := ADDR(dm);
        contrlÆ9Å := gtemp2.hi;
        contrlÆ10Å := gtemp2.lo;
        intinÆ0Å := wrmode;               (* logic operation write mode *)
        FOR i:=0 TO 7 DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        vro_cpyfm := gemvdif(109,handle);
END;

(****************************************************************)
(** Copy rastor , Transparent **)

FUNCTION vrt_cpyfm (handle, wrmode : INTEGER;
                    pxyarray : ARRAY_8;
                    psrcMFDB, pdesMFDB : MFDB;
                    color1, color0 : INTEGER) : INTEGER;

VAR     i :     INTEGER;
        gemp1, gemp2 : gempoint;
        sm, dm : MFDB;
BEGIN
        contrlÆ1Å := 4;
        contrlÆ3Å := 3;
        sm := psrcMFDB;                   (* local MFDB *)
        gemp1.gp := ADDR(sm);
        contrlÆ7Å := gemp1.hi;            (* hi order word of address ptr *)
        contrlÆ8Å := gemp1.lo;            (* lo order word *)
        dm := pdesMFDB;
        gemp2.gp := ADDR(dm);
        contrlÆ9Å := gemp2.hi;
        contrlÆ10Å := gemp2.lo;
        intinÆ0Å := wrmode;               (* logic operation write mode *)
        intinÆ1Å := color1;
        intinÆ2Å := color0;
        FOR i:=0 TO 7 DO
                ptsinÆiÅ := pxyarrayÆiÅ;
        vrt_cpyfm := gemvdif(121,handle);
END;

(*************************************************************)
(** Transform Form **)

FUNCTION vr_trn_fm (handle : INTEGER;
                    psrcMFDB, pdesMFDB : MFDB) : INTEGER;

VAR 
        gemp1, gemp2 : gempoint;
        sm, dm : MFDB;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        sm := psrcMFDB;
        gemp1.gp := ADDR(sm);
        contrlÆ7Å := gemp1.hi;
        contrlÆ8Å := gemp1.lo;
        dm := pdesMFDB;
        gemp2.gp := ADDR(dm);
        contrlÆ9Å := gemp2.hi;
        contrlÆ10Å := gemp2.lo;
        vr_trn_fm := gemvdif(110,handle);
END;

                   (*************************)
                   (**** INPUT FUNCTIONS ****)
(*********************************************************************)
(** Set Input Mode **)

FUNCTION vsin_mode (handle, devtype, mode : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 2;
        intinÆ0Å := devtype;
        intinÆ1Å := mode;
        vsin_mode := gemvdif(33,handle);
        vsin_mode := intoutÆ0Å;
END;

(************************************************************************)
(**  Input locator, request mode **)
(**********************************)

FUNCTION vrq_locator (handle, x, y : INTEGER;
                     VAR xout, yout : INTEGER;
                     VAR term :  CHAR) : INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 0;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        vrq_locator := gemvdif(28,handle);
        xout := ptsoutÆ0Å;
        yout := ptsoutÆ1Å;
        term := CHR(intoutÆ0Å);           (* return single byte character *)
END;

(******************************************************************)
(** Input Locator , Sample mode **)

FUNCTION vsm_locator (handle, x, y : INTEGER;
                VAR xout, yout, term, coorchg, keypress : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 0;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        vsm_locator := gemvdif(28,handle);
        xout := ptsoutÆ0Å;
        yout := ptsoutÆ1Å;
        term := intoutÆ0Å;
        coorchg := contrlÆ2Å;
        keypress := contrlÆ4Å;
END;

(********************************************************************)
(**  Input Valuator, Request Mode **)

FUNCTION vrq_valuator (handle, valin : INTEGER;
                       VAR valout : INTEGER;
                       VAR term :  CHAR) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := valin;
        vrq_valuator := gemvdif(29,handle);
        valout := intoutÆ0Å;
        term := CHR(intoutÆ1Å);
END;

(*******************************************************************)
(** Input Valuator, Sample Mode **)    (* check this !!!*)

FUNCTION vsm_valuator (handle, valin : INTEGER;
                       VAR valout : INTEGER;
                       VAR     term :  CHAR;
                       VAR     status : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := valin;
        vsm_valuator := gemvdif(29,handle);
        valout := intoutÆ0Å;
        status := contrlÆ4Å;
        term := CHR(intoutÆ1Å);
END;

(*****************************************************************)
(** Input Choice, request Mode **)

FUNCTION vrq_choice (handle: INTEGER;
                     VAR     choice : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := choice;
        vrq_choice := gemvdif(30,handle);
        choice := intoutÆ0Å;
END;

(*******************************************************************)
(** Input Choice, Sample Mode **)

FUNCTION vsm_choice (handle : INTEGER;
                        VAR choice, status : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vsm_choice := gemvdif(30,handle);
        choice := intoutÆ0Å;
        status := contrlÆ4Å;
END;

(******************************************************************)
(** Input String, Request Mode **)

FUNCTION vrq_string (handle, maxlen, echomode, 
                     echox, echoy : INTEGER;
                     VAR     instring : CharString) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 2;
        intinÆ0Å := 0-maxlen;             (* force standard keyboard input *)
        intinÆ1Å := echomode;
        ptsinÆ0Å := echox;
        ptsinÆ1Å := echoy;
        vrq_string := gemvdif(31,handle);
        instring := '';                           (* null string *)
        FOR i:=1 TO contrlÆ4Å DO
                instring := CONCAT(instring,CHR(intoutÆi-1Å));
                                        (* into string char form *)
END;

(****************************************************************)
(** Input String, Sample Mode **)

FUNCTION vsm_string (handle, maxlen, echomode,
                    echox, echoy : INTEGER;
                    VAR     instring : CharString;
                        VAR status : INTEGER) : INTEGER;

VAR
        I :     INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 2;
        intinÆ0Å := 0-maxlen;             (* force standard keyboard input  *)
        intinÆ1Å := echomode;
        ptsinÆ0Å := echox;
        ptsinÆ1Å := echoy;
        vsm_string := gemvdif(31,handle);
        instring := '';                           (* null string *)
        FOR i:=1 TO contrlÆ4Å DO
                instring := CONCAT(instring,CHR(intoutÆi-1Å));
                                        (* into string char form *)
        status := contrlÆ4Å;
END;

(*******************************************************************)
(** Set Moose Form **)

FUNCTION vsc_form (handle : INTEGER;
                         pcurform : ARRAY_37) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 37;
        FOR i:=0 TO 36 DO
                intinÆiÅ := pcurformÆiÅ;
        vsc_form := gemvdif(111,handle);
END;


(********************************************************************)
(** Exchange Mouse Movement Vector **)

FUNCTION vex_motv (handle : INTEGER;
                   pusrcode : gempoint;
                   VAR psavcode : gempoint) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ7Å := pusrcode.hi;         (* check this !!*)
        contrlÆ8Å := pusrcode.lo;
        vex_motv := gemvdif(126,handle);
        psavcode.hi := contrlÆ9Å;
        psavcode.lo := contrlÆ10Å;
END;

(****************************************************************)
(*** show graphic cursor ****)

FUNCTION v_show_c (handle, reset : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := reset;
        v_show_c := gemvdif(122,handle);
END;

(*******************************************************)
(** hide graphic cursor **)

FUNCTION v_hide_c (handle : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        v_hide_c := gemvdif(123,handle);
END;

(********************************************************************)
(** Exchange Button Change Vector **)

FUNCTION vex_butv (handle : INTEGER;
                        pusrcode : gempoint;
                        VAR psavcode : gempoint) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ7Å := pusrcode.hi;         (* CHECK THIS *)
        contrlÆ8Å := pusrcode.lo;
        vex_butv := gemvdif(125,handle);
        psavcode.hi := contrlÆ8Å;
        psavcode.lo := contrlÆ9Å;
END;

(**********************************************************************)
(** Exchange Cursor Change  Vector **)

FUNCTION vex_curv (handle : INTEGER;
                        pusrcode : gempoint;
                        VAR psavcode : gempoint) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ7Å := pusrcode.hi;         (* CHECK THIS *)
        contrlÆ8Å := pusrcode.lo;
        vex_curv := gemvdif(127,handle);
        psavcode.hi := contrlÆ8Å;
        psavcode.lo := contrlÆ9Å;
END;

(***********************************************************************)
(** Sample Keyboard State Information **)

FUNCTION vq_key_s (handle : INTEGER;
                  VAR     pstatus : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vq_key_s := gemvdif(128,handle);
        pstatus := intoutÆ0Å;
END;

(********************************************************************)
(** Sample Mouse Button State **)

FUNCTION vq_mouse (handle : INTEGER;
                   VAR pstatus, x, y : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vq_mouse := gemvdif(124,handle);
        pstatus := intoutÆ0Å;
        x := ptsoutÆ0Å;
        y := ptsoutÆ1Å;
END;

(********************************************************************)
(** Exchange Timer Interrupt Vector **)

FUNCTION vex_timv (handle : INTEGER;
                  timaddr : gempoint;
                  VAR otimaddr : gempoint;
                  VAR     timconv : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ7Å := timaddr.hi;                  (* CHECK THIS *)
        contrlÆ8Å := timaddr.lo;
        vex_timv := gemvdif(118,handle);
        otimaddr.hi := contrlÆ9Å;
        otimaddr.lo := contrlÆ10Å;
        timconv := intoutÆ0Å;
END;

(*********************************************************************)


                (**** INQUIRE FUNCTIONS *******)
(**********************************************************************)
(** Extended Inquire Function **)

FUNCTION vq_extend (handle, owflag : INTEGER;
                   VAR workout : ARRAY_57) : INTEGER;

VAR
        i:      INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := owflag;
        vq_extend := gemvdif(102,handle);
        FOR i:=0 TO 44 DO
                workoutÆiÅ := intoutÆiÅ;
        FOR i:=45 TO 56 DO
                workoutÆiÅ := ptsoutÆi-45Å;
END;

(*********************************************************************)
(** Inquire color representation **)

FUNCTION vq_color (handle, colorindex, setflag : INTEGER;
                   VAR rgb : ARRAY_3) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 2;
        intinÆ0Å := colorindex;
        intinÆ1Å := setflag;
        vq_color := gemvdif(26,handle);
        FOR i:=0 TO 2 DO
                rgbÆiÅ := intoutÆiÅ;
END;

(********************************************************)
(** Inquire polyline attributes *)

FUNCTION vql_attributes (handle :INTEGER;
                        VAR attrib : ARRAY_4) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vql_attributes := gemvdif(35,handle);
        FOR i:=0 TO 2 DO
                attribÆiÅ := intoutÆiÅ;
        attribÆ3Å := ptsoutÆ0Å;
END;

(*********************************************************)
(** Inquire polymarker attributes **)

FUNCTION vqm_attributes (handle :INTEGER;
                        VAR attrib : ARRAY_4) : INTEGER;

VAR
        I :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vqm_attributes := gemvdif(36,handle);
        FOR i:= 0 TO 2 DO
                attribÆiÅ := intoutÆiÅ;
        attribÆ3Å := ptsoutÆ0Å;
END;

(***********************************************************)
(** Inquire fill area attributes **)

FUNCTION vqf_attributes (handle :INTEGER;
                        VAR attrib : ARRAY_4) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vqf_attributes := gemvdif(37,handle);
        FOR i:=0 TO 3 DO
                attribÆiÅ := intoutÆiÅ;
                (* what about fill perim status **)
END;

(******************************************************************)
(** Inquire current Graphic text attributes **)

FUNCTION vqt_attributes (handle :INTEGER;
                        VAR attrib : ARRAY_10) : INTEGER;

VAR
        i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vqt_attributes := gemvdif(38,handle);
        FOR i:=0 TO 5 DO
                attribÆiÅ := intoutÆiÅ;
        FOR i:=6 TO 9 DO
                attribÆiÅ := ptsoutÆi-6Å;
END;

(*******************************************************************)
(** Inquire Text Extent **)

FUNCTION vqt_extent (handle : INTEGER;
                     chstring: CharString;
                     VAR extent : ARRAY_8) : INTEGER;

VAR     I :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := LEN(chstring);
        FOR i:=1 TO LEN(chstring) DO intinÆi-1Å := ORD(chstringÆiÅ);
        intinÆLEN(chstring)Å := 0;
        vqt_extent := gemvdif(116,handle);
        FOR i:=0 TO 7 DO extentÆiÅ := ptsoutÆiÅ;
END;

(**********************************************************************)
(** Inquire character cell width **)

FUNCTION vqt_width (handle : INTEGER;
                   character : CHAR;
                   VAR cellwidth, leftdelta, rightdelta : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := ORD(character);
        vqt_width := gemvdif(117,handle);
        cellwidth := ptsoutÆ0Å;
        leftdelta := ptsoutÆ2Å;
        rightdelta := ptsoutÆ4Å;
END;

(********************************************************************)
(*** Inquire font name and index **)

FUNCTION vqt_name (handle, elementnum : INTEGER;
                   VAR name : CharString) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        intinÆ0Å := elementnum;
        vqt_name := gemvdif(130,handle);
        name := '';                       (* initialize string to null *)
        FOR i:=1 TO 32 DO
                name := CONCAT(name,CHR(intoutÆiÅ));
END;

(**********************************************************************)
(** Inquire Cell Array **)

FUNCTION vq_cellarray (handle : INTEGER;
                      pxyarray : ARRAY_4;
                      rowlen, numrows : INTEGER;
                      VAR elused, rowsused, status : INTEGER;
                      VAR     colarray : intout_ARRAY) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ7Å := rowlen;
        contrlÆ8Å := numrows;
        FOR i:=0 TO 3 DO ptsinÆiÅ := pxyarrayÆiÅ;
        vq_cellarray := gemvdif(27,handle);
        elused := contrlÆ9Å;
        rowsused := contrlÆ10Å;
        status := contrlÆ11Å;
        FOR i:=0 TO intout_max DO colarrayÆiÅ := intoutÆiÅ;
END;

(**********************************************************************)
(** Inquire Input Mode **)

FUNCTION vqn_mode (handle :INTEGER;
                  VAR     inputmode : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        vqn_mode := gemvdif(115,handle);
        inputmode := intoutÆ0Å;
END;



(********************************************************************)
(** Inquire Current Font Information **)

FUNCTION vqt_fontinfo (handle : INTEGER;
                       VAR minADE, maxADE : INTEGER;
                       VAR distances : ARRAY_4;
                       VAR maxwidth : INTEGER;
                       effects : ARRAY_3) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        vqt_fontinfo := gemvdif(131,handle);
        minADE := intoutÆ0Å;
        maxADE := intoutÆ1Å;
        distancesÆ0Å := ptsoutÆ1Å;
        distancesÆ1Å := ptsoutÆ3Å;
        distancesÆ2Å := ptsoutÆ5Å;
        distancesÆ3Å := ptsoutÆ7Å;
        maxwidth := ptsoutÆ0Å;
        effectsÆ0Å := ptsoutÆ2Å;
        effectsÆ1Å := ptsoutÆ4Å;
        effectsÆ2Å := ptsoutÆ6Å;
END;

                (*********************)
                (******  ESCAPES *****)
(********************************************************************)
(** escape : inquire addressable alpha char cells **)

FUNCTION vq_chcells (handle : INTEGER;
                    VAR     rows, columns : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ5Å := 1;
        vq_chcells := gemvdif(5,handle);
        rows := intoutÆ0Å;
        columns := intoutÆ1Å;
END;

(************************************************************)
(*** general escape routine..called by many of those below **)

FUNCTION genescape (fid, handle : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ5Å := fid;         (* function id *)
        genescape := gemvdif(5,handle);
END;

(**************************************************************)

FUNCTION v_exit_cur (handle : INTEGER) : INTEGER;
BEGIN
        v_exit_cur := genescape(2,handle);
END;

FUNCTION v_enter_cur (handle : INTEGER) : INTEGER;
BEGIN
        v_enter_cur := genescape(3,handle);
END;

FUNCTION v_curup (handle : INTEGER) : INTEGER;
BEGIN
        v_curup := genescape(4,handle);
END;

FUNCTION v_curdown (handle : INTEGER) : INTEGER;
BEGIN
        v_curdown := genescape(5,handle);
END;

FUNCTION v_curright (handle : INTEGER) : INTEGER;
BEGIN
        v_curright := genescape(6,handle);
END;

FUNCTION v_curleft (handle : INTEGER) : INTEGER;
BEGIN
        v_curleft := genescape(7,handle);
END;

FUNCTION v_curhome (handle : INTEGER) : INTEGER;
BEGIN
        v_curhome := genescape(8,handle);
END;

FUNCTION v_eeos (handle : INTEGER) : INTEGER;
BEGIN
        v_eeos := genescape(9,handle);
END;

FUNCTION v_eeol (handle : INTEGER) : INTEGER;
BEGIN
        v_eeol := genescape(10,handle);
END;

(*******************************************************************)
(** direct alpha cursor address **)

FUNCTION vs_curaddress (handle, row, column : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 2;
        contrlÆ5Å := 11;
        intinÆ0Å := row;
        intinÆ1Å := column;
        vs_curaddress := gemvdif(5,handle);
END;

(**************************************************************)
(** output cursor addressable text **)

FUNCTION v_curtext (handle : INTEGER;
                   chstring : CharString) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := LEN(chstring);
        contrlÆ5Å := 12;
        FOR i:=1 TO LEN(chstring) DO intinÆi- 1Å := ORD(chstringÆiÅ);
        intinÆLEN(chstring)Å := 0;
        v_curtext := gemvdif(5,handle);
END;

(**************************************************************)

FUNCTION v_rvon (handle : INTEGER) : INTEGER;
BEGIN
        v_rvon := genescape(13,handle);
END;

FUNCTION v_rvoff (handle : INTEGER) : INTEGER;
BEGIN
        v_rvoff := genescape(14,handle);
END;

(***************************************************************)
(** inquire current alpha cursor address **)

FUNCTION vq_curaddress (handle : INTEGER;
                        VAR     row, column : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ5Å := 15;
        vq_curaddress := gemvdif(5,handle);
        row := intoutÆ0Å;
        column := intoutÆ1Å;
END;

(**************************************************************)
(** inquire tablet status **)

FUNCTION vq_tabstatus (handle : INTEGER;
                      VAR     status : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ5Å := 16;
        vq_tabstatus := gemvdif(5,handle);
        status := intoutÆ0Å;
END;

(***************************************************************)
(** Hard Copy **)

FUNCTION v_hardcopy (handle : INTEGER) : INTEGER;
BEGIN
        v_hardcopy := genescape(17,handle);
END;

(******************************************************************)
(** place a graphic cursor at the specifeid location **)

FUNCTION v_dspcur (handle, x, y : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 1;
        contrlÆ3Å := 0;
        contrlÆ5Å := 18;
        ptsinÆ0Å := x;
        ptsinÆ1Å := y;
        v_dspcur := gemvdif(5,handle);
END;

(**************************************************************)

FUNCTION v_rmcur (handle : INTEGER) : INTEGER;
BEGIN
        v_rmcur := genescape(19,handle);
END;

(**************************************************************)
(***    Form advance **)

FUNCTION v_form_adv(handle : INTEGER) : INTEGER;
BEGIN
        v_form_adv := genescape(20,handle);
END;

(**************************************************************)
(** Output Window **)

FUNCTION v_output_window(handle : INTEGER;
                         xyarray : ARRAY_4) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 2;
        contrlÆ3Å := 0;
        contrlÆ5Å := 21;
        FOR i:=0 TO 3 DO ptsinÆiÅ := xyarrayÆiÅ;
        v_output_window := gemvdif(5,handle);
END;

(***************************************************************)
(** Clear display list **)

FUNCTION v_clear_display_list (handle : INTEGER) : INTEGER;
BEGIN
        v_clear_display_list := genescape(22,handle);
END;


(**************************************************************)
(** selection of IBM color palette 0 = red,green,yelllow 1=cyan,blue,magenta *)

FUNCTION vs_palette(handle, palette : INTEGER) : INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 1;
        contrlÆ5Å := 60;
        intinÆ0Å := palette;
        vs_palette := gemvdif(5,handle);
END;

(**************************************************************)
(** Inquire Palette Film Types **)

FUNCTION vqp_films(handle : INTEGER;
                   VAR     filmnames : CharString) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ5Å := 91;
        vqp_films := gemvdif(5,handle);
        filmnames := '';
        FOR i:=0 TO 127 DO filmnames := CONCAT(filmnames,CHR(intoutÆiÅ));
END;

(**************************************************************)
(** Inquire Palette Driver State **)

FUNCTION vqp_state (handle : INTEGER;
                    VAR port, filmname, lightness, interlace, planes : INTEGER;
                    VAR indexes : ARRAY_16) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 0;
        contrlÆ5Å := 92;
        vqp_state := gemvdif(5,handle);
        port := intoutÆ0Å;
        filmname := intoutÆ1Å;
        lightness := intoutÆ2Å;
        interlace := intoutÆ3Å;
        planes := intoutÆ4Å;
        FOR i:=0 TO 15 DO indexesÆiÅ := intoutÆi+5Å;
END;

(*****************************************************************)
(** Set Palette Driver State **)

FUNCTION vsp_state (handle : INTEGER;
                    port, filmname, lightness, interlace, planes : INTEGER;
                    indexes : ARRAY_16) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := 20;
        contrlÆ5Å := 93;
        contrlÆ6Å := 93;
        intinÆ0Å := port;
        intinÆ1Å := filmname;
        intinÆ2Å := lightness;
        intinÆ3Å := interlace;
        intinÆ4Å := planes;
        FOR i:=0 TO 15 DO intinÆi+4Å := indexesÆiÅ;               (* CHECK *)
        vsp_state := gemvdif(5,handle);
END;

(*************************************************************)
(** Save Palette Driver State **)

FUNCTION vsp_save (handle : INTEGER) : INTEGER;
BEGIN
        vsp_save := genescape(94, handle);
END;

(**************************************************************)
(** suppress polaroid palette messages **)

FUNCTION vsp_message (handle : INTEGER) : INTEGER;
BEGIN
        vsp_message := genescape(95,handle);
END;

(**************************************************************)
(** Palette Error Inquiries **)

FUNCTION vqp_error (handle : INTEGER) : INTEGER;
BEGIN
        vqp_error := genescape(96,handle);
END;

(*******************************************************************)
(*** write gsx metafile ***)

FUNCTION v_write_meta (handle, numintin : INTEGER;
                       intin : intin_ARRAY;
                       numptsin : INTEGER;
                       ptsin : ptsin_ARRAY) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := numptsin;
        contrlÆ3Å := numintin;
        contrlÆ5Å := 99;
        contrlÆ6Å := handle;
        v_write_meta := gemvdif(5,handle);        (* CHECK *)
END;

(******************************************************************)
(** change gsx metafile filename from  gsxfile.gsx **)

FUNCTION vm_filename (handle : INTEGER;
                      filename : CharString) : INTEGER;

VAR     i :     INTEGER;
BEGIN
        contrlÆ1Å := 0;
        contrlÆ3Å := LEN(filename);
        contrlÆ5Å := 100;
        FOR i:=1 TO LEN(filename) DO intinÆi- 1Å := ORD(filenameÆiÅ);
        intinÆLEN(filename)Å := 0;
        vm_filename := gemvdif(5,handle);
END;

(********************************************************************)