|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 29312 (0x7280)
Types: TextFile
Names: »AESBND.PAS«
└─⟦4fbcde1e4⟧ Bits:30003931/GEM_Development-A.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
└─⟦this⟧ »AESBND.PAS«
(*****************************************************************)
(** File Name : AESBND.PAS **)
(** **)
(** Modified for Turbo Pascal. **)
(** **)
(** Comments : All these language bindings use **)
(** array's relative to zero to match the **)
(** Programmer's Guide (GEM AES VOL 2) **)
(** **)
(** Author : Athol M. Foden **)
(** History : Feb 1985 **)
(** Last Modified : 12 February 1986 **)
(** Digital Research Inc **)
(*****************************************************************)
PROCEDURE GAES (VAR a_addrout : aad_ARRAY;
VAR a_addrin : aad_ARRAY;
VAR aintout : ao_ARRAY;
VAR aintin : ai_ARRAY;
VAR aglobal : ag_ARRAY;
VAR acontrol : ac_ARRAY);
CONST
AESinterruptVector = $EF;
AESmagicConstant = 200;
TYPE
ADDRESS = ^BYTE;
VAR
parameterBlock : RECORD
controlArray : ADDRESS;
globalArray : ADDRESS;
inputParameterArray : ADDRESS;
outputParameterArray : ADDRESS;
inputAddressArray : ADDRESS;
outputAddressArray : ADDRESS;
END (* RECORD *);
registers : RECORD
ax, bx, cx, dx, bp, si, di, ds, es, flags : INTEGER;
END (* RECORD *);
BEGIN (* GAES *)
parameterBlock.controlArray := ADDR(acontrol);
parameterBlock.globalArray := ADDR(aglobal);
parameterBlock.inputParameterArray := ADDR(aintin);
parameterBlock.outputParameterArray := ADDR(aintout);
parameterBlock.inputAddressArray := ADDR(a_addrin);
parameterBlock.outputAddressArray := ADDR(a_addrout);
registers.cx := AESmagicConstant;
registers.es := SEG(parameterBlock);
registers.bx := OFS(parameterBlock);
swint(AESinterruptvector, registers);
END (* GAES *);
(*---------------------------------------------------------------------*)
(** Common call to the GEM AES routines - used by all other functions *)
FUNCTION GEMAES(opcode, c1, c2, c3, c4 : INTEGER) : INTEGER;
BEGIN
gcontrolÆ0Å := opcode;
gcontrolÆ1Å := c1; (* number of params in gintin *)
gcontrolÆ2Å := c2; (* number of params in gintout *)
gcontrolÆ3Å := c3; (* number of params in addrin *)
gcontrolÆ4Å := c4; (* number of params in addrout *)
GAES(addr_out, addr_in, gintout, gintin, global, gcontrol);
GEMAES := gintoutÆ0Å; (* return value if any *)
END;
(***********************************************************************)
(*** APPLICATION LIBRARY ***)
(*---------------------------------------------------------------------*)
FUNCTION appl_init : INTEGER;
VAR ap_id : INTEGER ;
BEGIN
ap_id := GEMAES(10,0,1,0,0);
globalÆ 2 Å := ap_id ;
appl_init := ap_id;
END ;
(*---------------------------------------------------------------------*)
FUNCTION appl_read ( ap_rid, ap_rlength: INTEGER;
ap_rpbuff: ADDRESS ) : INTEGER;
BEGIN
gintinÆ 0 Å := ap_rid;
gintinÆ 1 Å := ap_rlength;
addr_inÆ 0 Å := ap_rpbuff;
appl_read := GEMAES(11,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION appl_write( ap_wid, ap_wlength : INTEGER;
ap_wpbuff: ADDRESS ) : INTEGER;
BEGIN
gintinÆ 0 Å := ap_wid;
gintinÆ 1 Å := ap_wlength;
addr_inÆ 0 Å := ap_wpbuff;
appl_write := GEMAES(12,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION appl_find (ap_fpname : ADDRESS) : INTEGER;
BEGIN
addr_inÆ0Å := ap_fpname;
appl_find := GEMAES(13,0,1,1,0);
END;
(*---------------------------------------------------------------------*)
FUNCTION appl_tplay (ap_tpmem : ADDRESS;
ap_tpnum, ap_tpscale : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := ap_tpnum;
gintinÆ1Å := ap_tpscale;
addr_inÆ0Å := ap_tpmem;
appl_tplay := GEMAES(14,2,1,1,0);
END;
(*---------------------------------------------------------------------*)
FUNCTION appl_trecord (ap_trmem : ADDRESS;
ap_trcount : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := ap_trcount;
addr_inÆ0Å := ap_trmem;
appl_trecord := GEMAES(15,1,1,1,0);
END;
(*---------------------------------------------------------------------*)
FUNCTION appl_exit : INTEGER;
BEGIN
appl_exit := GEMAES(19,0,1,0,0);
END ;
(***********************************************************************)
(** EVENT LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION evnt_keybd : INTEGER;
BEGIN
evnt_keybd := GEMAES(20,0,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION evnt_button(ev_bclicks, ev_bmask, ev_bstate : INTEGER;
VAR ev_bmx, ev_bmy, ev_bmb, ev_bks : INTEGER) : INTEGER ;
BEGIN
gintinÆ 0 Å := ev_bclicks;
gintinÆ 1 Å := ev_bmask;
gintinÆ 2 Å := ev_bstate;
evnt_button := GEMAES(21,3,5,0,0);
ev_bmx := gintoutÆ1Å;
ev_bmy := gintoutÆ2Å;
ev_bmb := gintoutÆ3Å;
ev_bks := gintoutÆ4Å;
END ;
(*---------------------------------------------------------------------*)
FUNCTION evnt_mouse( ev_moflags, ev_mox, ev_moy, ev_mowidth,
ev_moheight : INTEGER;
VAR ev_momx, ev_momy, ev_momb, ev_momks : INTEGER) : INTEGER;
BEGIN
gintinÆ 0 Å := ev_moflags;
gintinÆ 1 Å := ev_mox;
gintinÆ 2 Å := ev_moy;
gintinÆ 3 Å := ev_mowidth;
gintinÆ 4 Å := ev_moheight;
evnt_mouse := GEMAES(22,5,5,0,0);
ev_momx := gintoutÆ1Å;
ev_momy := gintoutÆ2Å;
ev_momb := gintoutÆ3Å;
ev_momks := gintoutÆ4Å;
END ;
(*---------------------------------------------------------------------*)
FUNCTION evnt_mesag( ev_mgpbuff : ADDRESS ) : INTEGER;
BEGIN
addr_inÆ 0 Å := ev_mgpbuff;
evnt_mesag := GEMAES(23,0,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION evnt_timer( ev_tlocount, ev_thicount : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := ev_tlocount;
gintinÆ 1 Å := ev_thicount;
evnt_timer := GEMAES(24,2,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION evnt_multi( ev_mflags, ev_mbclicks, ev_mbmask, ev_mbstate,
ev_mm1flags, ev_mm1x, ev_mm1y, ev_mm1width, ev_m1height,
ev_mm2flags, ev_mm2x, ev_mm2y, ev_mm2width, ev_mm2height : INTEGER ;
ev_mmgpbuff : ADDRESS ;
ev_mtlocount, ev_mthicount : INTEGER ;
VAR ev_mmox, ev_mmoy, ev_mmobutton, ev_mmokstate,
ev_mkreturn, ev_mbreturn : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := ev_mflags;
gintinÆ 1 Å := ev_mbclicks;
gintinÆ 2 Å := ev_mbmask;
gintinÆ 3 Å := ev_mbstate;
gintinÆ 4 Å := ev_mm1flags;
gintinÆ 5 Å := ev_mm1x;
gintinÆ 6 Å := ev_mm1y;
gintinÆ 7 Å := ev_mm1width;
gintinÆ 8 Å := ev_m1height;
gintinÆ 9 Å := ev_mm2flags;
gintinÆ 10 Å := ev_mm2x;
gintinÆ 11 Å := ev_mm2y;
gintinÆ 12 Å := ev_mm2width;
gintinÆ 13 Å := ev_mm2height;
addr_inÆ 0 Å := ev_mmgpbuff ;
gintinÆ 14 Å := ev_mtlocount;
gintinÆ 15 Å := ev_mthicount;
EVNT_MULTI := GEMAES(25,16,7,1,0);
ev_mmox := gintoutÆ 1 Å ;
ev_mmoy := gintoutÆ 2 Å ;
ev_mmobutton := gintoutÆ 3 Å ;
ev_mmokstate := gintoutÆ4Å;
ev_mkreturn := gintoutÆ5Å;
ev_mbreturn := gintoutÆ6Å;
END ;
(*----------------------------------------------------------------------*)
FUNCTION evnt_dclick(ev_dnew, ev_dgtest : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := ev_dnew;
gintinÆ1Å := ev_dgtest;
evnt_dclick := GEMAES(26,2,1,0,0);
END;
(************************************************************************)
(** MENU LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION menu_bar( me_btree : ADDRESS ;
me_bshow : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := me_btree;
gintinÆ 0 Å := me_bshow;
menu_bar := GEMAES(30,1,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION menu_icheck( me_ctree : ADDRESS ;
me_citem, me_ccheck : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := me_ctree;
gintinÆ 0 Å := me_citem;
gintinÆ 1 Å := me_ccheck;
menu_icheck := GEMAES(31,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION menu_ienable( me_etree : ADDRESS ;
me_eitem, me_eenable : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := me_etree;
gintinÆ 0 Å := me_eitem;
gintinÆ 1 Å := me_eenable;
menu_ienable := GEMAES(32,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION menu_tnormal( me_ntree : ADDRESS ;
me_ntitle, me_nnormal : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := me_ntree;
gintinÆ 0 Å := me_ntitle;
gintinÆ 1 Å := me_nnormal;
menu_tnormal := GEMAES(33,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION menu_text( me_ttree : ADDRESS ;
me_titem : INTEGER ;
me_ttext : ADDRESS ) : INTEGER;
BEGIN
addr_inÆ 0 Å := me_ttree;
gintinÆ 0 Å := me_titem;
addr_inÆ 1 Å := me_ttext;
menu_text := GEMAES(34,1,1,2,0);
END ;
(*----------------------------------------------------------------------*)
FUNCTION menu_register( me_raccapid : INTEGER;
me_rpstring : ADDRESS) : INTEGER;
BEGIN
gintinÆ0Å := me_raccapid;
addr_inÆ0Å := me_rpstring;
menu_register := GEMAES(35,1,1,1,0);
END;
(************************************************************************)
(** OBJECT LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION objc_add( ob_atree : ADDRESS ;
ob_aparent, ob_achild : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_atree;
gintinÆ 0 Å := ob_aparent;
gintinÆ 1 Å := ob_achild;
objc_add := GEMAES(40,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION objc_delete( ob_dltree : ADDRESS ;
ob_dlobject : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_dltree;
gintinÆ 0 Å := ob_dlobject;
objc_delete := GEMAES(41,1,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION objc_draw( ob_dtree : ADDRESS ;
ob_drstartob, ob_drdepth, ob_drxclip,
ob_dryclip, ob_drwclip, ob_drhclip : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_dtree;
gintinÆ 0 Å := ob_drstartob;
gintinÆ 1 Å := ob_drdepth;
gintinÆ 2 Å := ob_drxclip;
gintinÆ 3 Å := ob_dryclip;
gintinÆ 4 Å := ob_drwclip;
gintinÆ 5 Å := ob_drhclip;
objc_draw := GEMAES(42,6,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION objc_find( ob_ftree : ADDRESS ;
ob_fstartob, ob_fdepth, ob_fmx, ob_fmy : INTEGER) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_ftree;
gintinÆ 0 Å := ob_fstartob;
gintinÆ 1 Å := ob_fdepth;
gintinÆ 2 Å := ob_fmx;
gintinÆ 3 Å := ob_fmy;
objc_find := GEMAES(43,4,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION objc_offset( ob_oftree : ADDRESS ;
ob_ofobject : INTEGER ;
VAR ob_ofxoff, ob_ofyoff : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_oftree;
gintinÆ 0 Å := ob_ofobject;
objc_offset := GEMAES(44,1,3,1,0);
ob_ofxoff := gintoutÆ 1 Å ;
ob_ofyoff := gintoutÆ 2 Å ;
END ;
(*---------------------------------------------------------------------*)
FUNCTION objc_order( ob_ortree : ADDRESS ;
ob_orobject, ob_ornewpos : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_ortree;
gintinÆ 0 Å := ob_orobject;
gintinÆ 1 Å := ob_ornewpos;
objc_order := GEMAES(45,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION objc_edit( ob_edtree : ADDRESS ;
ob_edobject : INTEGER;
ob_edchar : char;
ob_edidx, ob_edkind : INTEGER;
VAR ob_ednewidx : INTEGER) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_edtree;
gintinÆ 0 Å := ob_edobject;
gintinÆ 1 Å := ORD(ob_edchar);
gintinÆ 2 Å := ob_edidx;
gintinÆ 3 Å := ob_edkind;
objc_edit := GEMAES(46,4,2,1,0);
ob_ednewidx := gintoutÆ1Å;
END ;
(*---------------------------------------------------------------------*)
FUNCTION objc_change(ob_ctree : ADDRESS;
ob_cobject, ob_cresvd,
ob_cxclip, ob_cyclip, ob_cwclip, ob_chclip,
ob_cnewstate, ob_credraw : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := ob_ctree;
gintinÆ 0 Å := ob_cobject;
gintinÆ 1 Å := ob_cresvd;
gintinÆ 2 Å := ob_cxclip;
gintinÆ 3 Å := ob_cyclip;
gintinÆ 4 Å := ob_cwclip;
gintinÆ 5 Å := ob_chclip;
gintinÆ 6 Å := ob_cnewstate;
gintinÆ 7 Å := ob_credraw;
objc_change := GEMAES(47,8,1,1,0);
END ;
(**********************************************************************)
(** FORM LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION form_do( fo_dotree: ADDRESS ;
fo_dostartob : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := fo_dostartob;
addr_inÆ 0 Å := fo_dotree;
form_do := GEMAES(50,1,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION form_dial(fo_diflag, fo_dilx, fo_dily, fo_dilw,
fo_dilh, fo_dibigx, fo_dibigy,
fo_dibigw, fo_dibigh : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := fo_diflag;
gintinÆ 1 Å := fo_dilx ;
gintinÆ 2 Å := fo_dily ;
gintinÆ 3 Å := fo_dilw ;
gintinÆ 4 Å := fo_dilh ;
gintinÆ 5 Å := fo_dibigx ;
gintinÆ 6 Å := fo_dibigy ;
gintinÆ 7 Å := fo_dibigw ;
gintinÆ 8 Å := fo_dibigh ;
form_dial := GEMAES(51,9,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION form_alert(fo_adefbttn : INTEGER;
fo_aastring : ADDRESS ) : INTEGER ;
BEGIN
addr_inÆ 0 Å := fo_aastring ;
gintinÆ 0 Å := fo_adefbttn ;
form_alert := GEMAES(52,1,1,1,0);
END ;
(*-------------------------------------------------------------------*)
FUNCTION form_error (fo_enum : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := fo_enum;
form_error := GEMAES(53,1,1,0,0);
END;
(*---------------------------------------------------------------------*)
FUNCTION form_center (fo_ctree : ADDRESS;
VAR fo_cx, fo_cy, fo_cw, fo_ch : INTEGER) : INTEGER;
BEGIN
addr_inÆ0Å := fo_ctree;
form_center := GEMAES(54,0,5,1,0);
fo_cx := gintoutÆ1Å;
fo_cy := gintoutÆ2Å;
fo_cw := gintoutÆ3Å;
fo_ch := gintoutÆ4Å;
END;
(**********************************************************************)
(** GRAPHICS LIBRARY **)
(*--------------------------------------------------------------------*)
FUNCTION graf_rubbox ( gr_rx, gr_ry, gr_rminwidth, gr_rminheight : INTEGER;
VAR gr_rlastwidth, gr_rlastheight : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := gr_rx;
gintinÆ1Å := gr_ry;
gintinÆ2Å := gr_rminwidth;
gintinÆ3Å := gr_rminheight;
graf_rubbox := GEMAES(70,4,3,0,0);
gr_rlastwidth := gintoutÆ1Å;
gr_rlastheight := gintoutÆ2Å;
END;
(*-------------------------------------------------------------------*)
FUNCTION graf_dragbox (gr_dwidth, gr_dheight, gr_dstx, gr_dsty,
gr_dbndx, gr_dbndy, gr_dbndw, gr_dbndh : INTEGER;
VAR gr_dfinx, gr_dfiny : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := gr_dwidth;
gintinÆ1Å := gr_dheight;
gintinÆ2Å := gr_dstx;
gintinÆ3Å := gr_dsty;
gintinÆ4Å := gr_dbndx;
gintinÆ5Å := gr_dbndy;
gintinÆ6Å := gr_dbndw;
gintinÆ7Å := gr_dbndh;
graf_dragbox := GEMAES(71,8,3,0,0);
gr_dfinx := gintoutÆ1Å;
gr_dfiny := gintoutÆ2Å;
END;
(*--------------------------------------------------------------------*)
FUNCTION graf_movebox (gr_mwidth, gr_mheight, gr_msrcex, gr_msrcey,
gr_mdestx, gr_mdesty : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := gr_mwidth;
gintinÆ1Å := gr_mheight;
gintinÆ2Å := gr_msrcex;
gintinÆ3Å := gr_msrcey;
gintinÆ4Å := gr_mdestx;
gintinÆ5Å := gr_mdesty;
graf_movebox := GEMAES(72,6,1,0,0);
END;
(*-------------------------------------------------------------------*)
FUNCTION graf_growbox (gr_gstx, gr_gsty, gr_gstwidth, gr_gstheight,
gr_gfinx, gr_gfiny, gr_gfinwidth, gr_gfinheight : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := gr_gstx;
gintinÆ1Å := gr_gsty;
gintinÆ2Å := gr_gstwidth;
gintinÆ3Å := gr_gstheight;
gintinÆ4Å := gr_gfinx;
gintinÆ5Å := gr_gfiny;
gintinÆ6Å := gr_gfinwidth;
gintinÆ7Å := gr_gfinheight;
graf_growbox := GEMAES(73,8,1,0,0);
END;
(*---------------------------------------------------------------------*)
FUNCTION graf_shrinkbox(gr_sstx, gr_ssty, gr_sstwidth, gr_sstheight,
gr_sfinx, gr_sfiny, gr_sfinwidth, gr_sfinheight : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := gr_sstx;
gintinÆ1Å := gr_ssty;
gintinÆ2Å := gr_sstwidth;
gintinÆ3Å := gr_sstheight;
gintinÆ4Å := gr_sfinx;
gintinÆ5Å := gr_sfiny;
gintinÆ6Å := gr_sfinwidth;
gintinÆ7Å := gr_sfinheight;
graf_shrinkbox := GEMAES(74,8,1,0,0);
END;
(*--------------------------------------------------------------------*)
FUNCTION graf_watchbox (gr_wptree : ADDRESS;
gr_wobject, gr_winstate, gr_woutstate : INTEGER) : INTEGER;
BEGIN
gintinÆ1Å := gr_wobject;
gintinÆ2Å := gr_winstate;
gintinÆ3Å := gr_woutstate;
addr_inÆ0Å := gr_wptree;
graf_watchbox := GEMAES(75,4,1,1,0);
END;
(*-------------------------------------------------------------------*)
FUNCTION graf_slidebox(gr_slptree : ADDRESS;
gr_slparent, gr_slobject, gr_slvh : INTEGER) : INTEGER;
BEGIN
gintinÆ0Å := gr_slparent;
gintinÆ1Å := gr_slobject;
gintinÆ2Å := gr_slvh;
graf_slidebox := GEMAES(76,3,1,1,0);
END;
(*-------------------------------------------------------------------*)
FUNCTION graf_handle (VAR gr_hwchar, gr_hhchar, gr_hwbox,
gr_hhbox : INTEGER) : INTEGER;
BEGIN
graf_handle := GEMAES(77,0,5,0,0);
gr_hwchar := gintoutÆ1Å;
gr_hhchar := gintoutÆ2Å;
gr_hwbox := gintoutÆ3Å;
gr_hhbox := gintoutÆ4Å;
END;
(*------------------------------------------------------------------*)
FUNCTION graf_mouse(gr_monumber : INTEGER;
gr_mofaddr : ADDRESS) : INTEGER;
BEGIN
gintinÆ0Å := gr_monumber;
addr_inÆ0Å := gr_mofaddr;
graf_mouse := GEMAES(78,1,1,1,0);
END;
(*------------------------------------------------------------------*)
FUNCTION graf_mkstate (VAR gr_mkmx, gr_mkmy,
gr_mkmstate, gr_mkkstate : INTEGER) : INTEGER;
BEGIN
graf_mkstate := GEMAES(79,0,5,0,0);
gr_mkmx := gintoutÆ1Å;
gr_mkmy := gintoutÆ2Å;
gr_mkmstate := gintoutÆ3Å;
gr_mkkstate := gintoutÆ4Å;
END;
(*********************************************************************)
(** SCRAP LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION scrp_info( sc_idtype : INTEGER ;
VAR sc_ioutdtype, sc_iavail,
sc_iused : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := sc_idtype;
scrp_info := GEMAES(0,1,4,0,0);
sc_ioutdtype := gintoutÆ 1 Å ;
sc_iavail := gintoutÆ 2 Å ;
sc_iused := gintoutÆ 3 Å ;
END ;
(*---------------------------------------------------------------------*)
FUNCTION scrp_read( sc_rdtype, sc_rsize : INTEGER ;
sc_rpbuff : ADDRESS ) : INTEGER;
BEGIN
gintinÆ 0 Å := sc_rdtype;
gintinÆ 1 Å := sc_rsize;
addr_inÆ 0 Å := sc_rpbuff;
scrp_read := GEMAES(81,2,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION scrp_write( sc_wdtype, sc_wsize : INTEGER ;
sc_wpbuff : ADDRESS ) : INTEGER;
BEGIN
gintinÆ 0 Å := sc_wdtype;
gintinÆ 1 Å := sc_wsize;
addr_inÆ 0 Å := sc_wpbuff;
scrp_write := GEMAES(82,2,1,1,0);
END ;
(**********************************************************************)
(** FILE SELECTOR LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION fsel_input( fs_iinpath, fs_iinsel : ADDRESS ;
VAR fs_iexbutton : INTEGER ) : INTEGER;
BEGIN
addr_inÆ 0 Å := fs_iinpath;
addr_inÆ 1 Å := fs_iinsel;
fsel_input := GEMAES(90,0,2,2,0);
fs_iexbutton := gintoutÆ 1 Å ;
END ;
(************************************************************************)
(** WINDOW LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION wind_create( wi_crkind, wi_crwx, wi_crwy,
wi_crww, wi_crwh : INTEGER ) : INTEGER ;
BEGIN
gintinÆ 0 Å := wi_crkind;
gintinÆ 1 Å := wi_crwx;
gintinÆ 2 Å := wi_crwy;
gintinÆ 3 Å := wi_crww;
gintinÆ 4 Å := wi_crwh;
wind_create := GEMAES(100,5,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_open( wi_ohandle, wi_owx, wi_owy,
wi_oww, wi_owh : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := wi_ohandle;
gintinÆ 1 Å := wi_owx;
gintinÆ 2 Å := wi_owy;
gintinÆ 3 Å := wi_oww;
gintinÆ 4 Å := wi_owh;
wind_open := GEMAES(101,5,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_close( wi_clhandle : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := wi_clhandle;
wind_close := GEMAES(102,1,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_delete( wi_dhandle : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := wi_dhandle;
wind_delete := GEMAES(103,1,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_get( wi_ghandle, wi_gfield : INTEGER ;
VAR wi_gw1, wi_gw2, wi_gw3, wi_gw4 : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := wi_ghandle;
gintinÆ 1 Å := wi_gfield;
wind_get := GEMAES(104,2,5,0,0);
wi_gw1 := gintoutÆ 1 Å;
wi_gw2 := gintoutÆ 2 Å;
wi_gw3 := gintoutÆ 3 Å;
wi_gw4 := gintoutÆ 4 Å;
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_set( wi_shandle, wi_sfield,
wi_sw1, wi_sw2, wi_sw3, wi_sw4 : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := wi_shandle;
gintinÆ 1 Å := wi_sfield;
gintinÆ 2 Å := wi_sw1;
gintinÆ 3 Å := wi_sw2;
gintinÆ 4 Å := wi_sw3;
gintinÆ 5 Å := wi_sw4;
wind_set := GEMAES(105,6,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_find( wi_fmx, wi_fmy : INTEGER ) : INTEGER ;
BEGIN
gintinÆ 0 Å := wi_fmx;
gintinÆ 1 Å := wi_fmy;
wind_find := GEMAES(106,2,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_update( wi_ubegend : INTEGER ) : INTEGER;
BEGIN
gintinÆ 0 Å := wi_ubegend;
wind_update := GEMAES(107,1,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION wind_calc( wi_ctype, wi_ckind,
wi_cx, wi_cy, wi_cinwidth, wi_cinheight : INTEGER;
VAR wi_coutx, wi_couty, wi_coutwidth, wi_coutheight : INTEGER ) :
INTEGER;
BEGIN
gintinÆ 0 Å := wi_ctype ;
gintinÆ 1 Å := wi_ckind ;
gintinÆ 2 Å := wi_cx ;
gintinÆ 3 Å := wi_cy ;
gintinÆ 4 Å := wi_cinwidth ;
gintinÆ 5 Å := wi_cinheight ;
wind_calc := GEMAES(108,6,5,0,0);
wi_coutx := gintoutÆ 1 Å ;
wi_couty := gintoutÆ 2 Å ;
wi_coutwidth := gintoutÆ 3 Å ;
wi_coutheight := gintoutÆ 4 Å ;
END ;
(************************************************************************)
(** RESOURCE LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION rsrc_load( re_lpfname : ADDRESS ) : INTEGER;
BEGIN
addr_inÆ 0 Å := re_lpfname ;
rsrc_load := GEMAES(110,0,1,1,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION rsrc_free : INTEGER;
BEGIN
rsrc_free := GEMAES(111,0,1,0,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION rsrc_gaddr( re_gttype, re_gtindex : INTEGER ;
VAR re_gtaddr : ADDRESS ) : INTEGER;
BEGIN
gintinÆ 0 Å := re_gttype ;
gintinÆ 1 Å := re_gtindex ;
rsrc_gaddr := GEMAES(112,2,1,0,1);
re_gtaddr := addr_outÆ 0 Å ;
END ;
(*---------------------------------------------------------------------*)
FUNCTION rsrc_saddr( re_sttype, re_stindex : INTEGER ;
re_staddr : ADDRESS ) : INTEGER;
BEGIN
gintinÆ 0 Å := re_sttype ;
gintinÆ 1 Å := re_stindex ;
addr_inÆ 0 Å := re_staddr ;
rsrc_saddr := GEMAES(113,2,1,1,0);
END ;
(*------------------------------------------------------------------------*)
FUNCTION rsrc_obfix (re_oobject : INTEGER;
re_otree : ADDRESS) : INTEGER;
BEGIN
gintinÆ0Å := re_oobject;
addr_inÆ0Å := re_otree;
rsrc_obfix := GEMAES(114,1,1,1,0);
END;
(***********************************************************************)
(** SHELL LIBRARY **)
(*---------------------------------------------------------------------*)
FUNCTION shel_read( sh_rpcmd, sh_rptail : ADDRESS ) : INTEGER;
BEGIN
addr_inÆ 0 Å := sh_rpcmd;
addr_inÆ 1 Å := sh_rptail;
shel_read := GEMAES(120,0,1,2,0);
END ;
(*---------------------------------------------------------------------*)
FUNCTION shel_write( sh_wdoex, sh_wisgr, sh_wiscr : INTEGER ;
sh_wpcmd, sh_wptail : ADDRESS ) : INTEGER;
BEGIN
gintinÆ 0 Å := sh_wdoex;
gintinÆ 1 Å := sh_wisgr;
gintinÆ 2 Å := sh_wiscr;
addr_inÆ 0 Å := sh_wpcmd;
addr_inÆ 1 Å := sh_wptail;
shel_write := GEMAES(121,3,1,2,0);
END ;