From b66802a14e9851e542d4483b250555fdd0946f77 Mon Sep 17 00:00:00 2001 From: Thorsten Otto Date: Wed, 2 Feb 2022 12:06:25 +0100 Subject: [PATCH] atari: add missing AES/VDI definitions and functions --- packages/tosunits/fpmake.pp | 1 + packages/tosunits/src/aes.pas | 751 ++++++++++++++++++++++++++++++++-- packages/tosunits/src/gem.pas | 162 ++++++++ packages/tosunits/src/vdi.pas | 125 +++++- 4 files changed, 995 insertions(+), 44 deletions(-) create mode 100644 packages/tosunits/src/gem.pas diff --git a/packages/tosunits/fpmake.pp b/packages/tosunits/fpmake.pp index b22d4d9549..e2505ca125 100644 --- a/packages/tosunits/fpmake.pp +++ b/packages/tosunits/fpmake.pp @@ -34,6 +34,7 @@ begin T:=P.Targets.AddUnit('tos.pas'); T:=P.Targets.AddUnit('vdi.pas'); T:=P.Targets.AddUnit('aes.pas'); + T:=P.Targets.AddUnit('gem.pas'); P.ExamplePath.Add('examples'); T:=P.Targets.AddExampleProgram('higem.pas'); diff --git a/packages/tosunits/src/aes.pas b/packages/tosunits/src/aes.pas index 0f73e025cb..761575967d 100644 --- a/packages/tosunits/src/aes.pas +++ b/packages/tosunits/src/aes.pas @@ -17,8 +17,10 @@ unit aes; interface +uses sysutils; + { The API description of this file is based on the information available - online at: http://toshyp.atari.org } + online at: https://freemint.github.io/tos.hyp/en/index.html } type PAESContrl = ^TAESContrl; @@ -63,6 +65,151 @@ type const AES_TRAP_MAGIC = $C8; +{ object flags } +const + NONE = 0; + SELECTABLE = 1; + DEFAULT = 2; + F_EXIT = 4; + EDITABLE = 8; + RBUTTON = 16; + LASTOB = 32; + TOUCHEXIT = 64; + HIDETREE = 128; + INDIRECT = 256; + FL3DMASK = $0600; + FL3DNONE = $0000; + FL3DIND = $0200; + FL3DBAK = $0400; + FL3DACT = $0600; + SUBMENU = $0800; {* falcon aes hierarchical menus *} + +{ object state } +const + NORMAL = $0000; + SELECTED = $0001; + CROSSED = $0002; + CHECKED = $0004; + DISABLED = $0008; + OUTLINED = $0010; + SHADOWED = $0020; + WHITEBAK = $0040; + DRAW3D = $0080; + +{ AES object types } +const + G_BOX = 20; + G_TEXT = 21; + G_BOXTEXT = 22; + G_IMAGE = 23; + G_USERDEF = 24; + G_IBOX = 25; + G_BUTTON = 26; + G_BOXCHAR = 27; + G_STRING = 28; + G_FTEXT = 29; + G_FBOXTEXT = 30; + G_ICON = 31; + G_TITLE = 32; + G_CICON = 33; + G_SWBUTTON = 34; + G_POPUP = 35; + G_WINTITLE = 36; + G_EDIT = 37; + G_SHORTCUT = 38; + G_SLIST = 39; + G_EXTBOX = 40; + G_OBLINK = 41; + + +type + PTEDINFO = ^TTEDINFO; + TTEDINFO = record + te_ptext : Pchar; + te_ptmplt : Pchar; + te_pvalid : Pchar; + te_font : Integer; + te_resvd1 : Integer; + te_just : Integer; + te_color : Integer; + te_resvd2 : Integer; + te_thickness : Integer; + te_txtlen : Integer; + te_tmplen : Integer; + end; + + PICONBLK = ^TICONBLK; + TICONBLK = record + ib_pmask : Pointer; + ib_pdata : Pointer; + ib_ptext : Pchar; + ib_char : smallint; + ib_xchar : smallint; + ib_ychar : smallint; + ib_xicon : smallint; + ib_yicon : smallint; + ib_wicon : smallint; + ib_hicon : smallint; + ib_xtext : smallint; + ib_ytext : smallint; + ib_wtext : smallint; + ib_htext : smallint; + end; + + PCICON = ^TCICON; + TCICON = record + num_planes : smallint; + col_data : Pointer; + col_mask : Pointer; + sel_data : Pointer; + sel_mask : Pointer; + next_res : PCICON; + end; + + PCICONBLK = ^TCICONBLK; + TCICONBLK = record + monoblk : TICONBLK; + mainlist : PCICON; + end; + + PBITBLK = ^TBITBLK; + TBITBLK = record + bi_pdata : Pointer; + bi_wb : smallint; + bi_hl : smallint; + bi_x : smallint; + bi_y : smallint; + bi_color : smallint; + end; + + PUSERBLK = ^TUSERBLK; + TUSERBLK = record + ub_code : Pointer; + ub_parm : LongInt; + end; + + POBSPEC = ^TOBSPEC; + TOBSPEC = record + case smallint of + 0, + G_BOX, + G_IBOX, + G_BOXCHAR: ( index: LongInt ); + G_BOXTEXT, + G_TEXT, + G_FTEXT, + G_FBOXTEXT: ( ted_info: PTEDINFO ); + G_IMAGE: ( bit_blk: PBITBLK ); + G_USERDEF: ( user_blk: PUSERBLK ); + G_BUTTON, + G_STRING, + G_TITLE: ( free_string: Pchar ); + G_ICON: ( icon_blk: PICONBLK ); + G_CICON: ( cicon_blk: PCICONBLK ); + + INDIRECT: ( ob_spec: POBSPEC ); + end; + type PAESOBJECT = ^TAESOBJECT; TAESOBJECT = record @@ -72,13 +219,92 @@ type ob_type: word; {* Object type *} ob_flags: word; {* Manipulation flags *} ob_state: word; {* Object status *} - ob_spec: pointer; {* More under object type *} + ob_spec: TOBSPEC; {* More under object type *} ob_x: smallint; {* X-coordinate of the object *} ob_y: smallint; {* Y-coordinate of the object *} ob_width: smallint; {* Width of the object *} ob_height: smallint; {* Height of the object *} end; + PAESTree = ^TAESTree; + TAESTree = Array[0..2339] of TAESOBJECT; + + PPARMBLK = ^TPARMBLK; + TPARMBLK = record + pb_tree : PAESTree; + pb_obj : smallint; + pr_prevstate : smallint; + pr_currstate : smallint; + pb_x : smallint; + pb_y : smallint; + pb_w : smallint; + pb_h : smallint; + pb_xc : smallint; + pb_yc : smallint; + pb_wc : smallint; + pb_hc : smallint; + pb_parm : LongInt; + end; + + PRSHDR = ^TRSHDR; + TRSHDR = record + rsh_vrsn: Word; + rsh_object: Word; + rsh_tedinfo: Word; + rsh_iconblk: Word; + rsh_bitblk: Word; + rsh_frstr: Word; + rsh_string: Word; + rsh_imdata: Word; + rsh_frimg: Word; + rsh_trindex: Word; + rsh_nobs: Word; + rsh_ntree: Word; + rsh_nted: Word; + rsh_nib: Word; + rsh_nbb: Word; + rsh_nstring: Word; + rsh_nimages: Word; + rsh_rssize: Word; + end; + +type + ARRAY_2 = ARRAY[0..1] of smallint; + ARRAY_3 = ARRAY[0..2] of smallint; + ARRAY_4 = ARRAY[0..3] of smallint; + ARRAY_5 = ARRAY[0..4] of smallint; + ARRAY_6 = ARRAY[0..5] of smallint; + ARRAY_8 = ARRAY[0..7] of smallint; + ARRAY_10 = ARRAY[0..9] of smallint; + + PEVENT = ^TEVENT; + TEVENT = record + ev_mflags: smallint; { input parameters } + ev_mbclicks: smallint; + ev_bmask: smallint; + ev_mbstate: smallint; + ev_mm1flags: smallint; + ev_mm1x: smallint; + ev_mm1y: smallint; + ev_mm1width: smallint; + ev_mm1height: smallint; + ev_mm2flags: smallint; + ev_mm2x: smallint; + ev_mm2y: smallint; + ev_mm2width: smallint; + ev_mm2height: smallint; + ev_mtlocount: smallint; + ev_mthicount: smallint; + ev_mwich: smallint; { output parameters } + ev_mmox: smallint; + ev_mmoy: smallint; + ev_mmobutton: smallint; + ev_mmokstate: smallint; + ev_mkreturn: smallint; + ev_mbreturn: smallint; + ev_mmgpbuf: ARRAY_8; + end; + type PGRECT = ^TGRECT; TGRECT = record @@ -102,28 +328,86 @@ const LFARROW = $200; { Window has a left arrow. } RTARROW = $400; { Window has a right arrow. } HSLIDE = $800; { Window has a horizontal slider. } + MENUBAR = $1000; { Window has a menu bar (XaAES) } SMALLER = $4000; { Window has an iconifier. } + BORDER = $8000; { Window has an sizeing border } { messages as used by evnt_mesag() } const - WM_REDRAW = $0014; - WM_TOPPED = $0015; - WM_CLOSED = $0016; - WM_FULLED = $0017; - WM_ARROWED = $0018; - WM_HSLID = $0019; - WM_VSLID = $001a; - WM_SIZED = $001b; - WM_MOVED = $001c; - WM_NEWTOP = $001d; - WM_UNTOPPED = $001e; - WM_ONTOP = $001f; - WM_OFFTOP = $0020; - WM_BOTTOMED = $0021; - WM_ICONIFY = $0022; - WM_UNICONIFY = $0023; - WM_ALLICONIFY = $0024; - WM_TOOLBAR = $0025; + MN_SELECTED = 10; + WM_REDRAW = 20; + WM_TOPPED = 21; + WM_CLOSED = 22; + WM_FULLED = 23; + WM_ARROWED = 24; + WM_HSLID = 25; + WM_VSLID = 26; + WM_SIZED = 27; + WM_MOVED = 28; + WM_NEWTOP = 29; + WM_UNTOPPED = 30; + WM_ONTOP = 31; + WM_OFFTOP = 32; + WM_BOTTOMED = 33; + WM_ICONIFY = 34; + WM_UNICONIFY = 35; + WM_ALLICONIFY = 36; + WM_TOOLBAR = 37; + AC_OPEN = 40; + AC_CLOSE = 41; + CT_UPDATE = 50; + CT_MOVE = 51; + CT_NEWTOP = 52; + AP_TERM = 50; + AP_TFAIL = 51; + AP_RESCHG = 57; + SHUT_COMPLETED = 60; + RESCHG_COMPLETED = 61; + AP_DRAGDROP = 63; + SH_EXIT = 68; {* AES 4.0 *} + SH_START = 69; {* AES 4.0 *} + SH_WDRAW = 72; {* AES 4.0 *} + SC_CHANGED = 80; + PRN_CHANGED = 82; {* NVDI *} + FNT_CHANGED = 83; {* NVDI *} + COLORS_CHANGED = 84; {* NVDI *} + THR_EXIT = 88; {* MagiC 4.5 *} + PA_EXIT = 89; {* MagiC 3 *} + CH_EXIT = 90; + WM_WHEEL = 345; {* XaAES *} + WM_MOUSEWHEEL = 2352; + WM_SHADED = 22360; {* WiNX *} + WM_UNSHADED = 22361; {* WinX *} + + WA_UPPAGE = 0; + WA_DNPAGE = 1; + WA_UPLINE = 2; + WA_DNLINE = 3; + WA_LFPAGE = 4; + WA_RTPAGE = 5; + WA_LFLINE = 6; + WA_RTLINE = 7; + +{* AP_DRAGDROP return codes *} +const + DD_OK = 0; + DD_NAK = 1; + DD_EXT = 2; + DD_LEN = 3; + DD_TRASH = 4; + DD_PRINTER = 5; + DD_CLIPBOARD = 6; + + DD_TIMEOUT = 4000; {* Timeout in ms *} + + DD_NUMEXTS = 8; {* Number of formats *} + DD_EXTLEN = 4; + DD_EXTSIZE = DD_NUMEXTS * DD_EXTLEN; + + DD_FNAME = 'U:\\PIPE\\DRAGDROP.AA'; + DD_NAMEMAX = 128; {* Maximum length of a format name *} + DD_HDRMIN = 9; {* Minimum length of Drag&Drop headers *} + DD_HDRMAX = 8 + DD_NAMEMAX; {* Maximum length *} { message flags as used by evnt_multi() } const @@ -140,6 +424,7 @@ const BEG_UPDATE = (1); { Screen redraw starts, rectangle lists are frozen, flag is set to prevent any other processes updating the screen } END_MCTRL = (2); { Application releases control of the mouse to the AES and resumes mouse click message reactions } BEG_MCTRL = (3); { The application wants to have sole control over mouse button messages } + BEG_CHECK = $100; { window flags as used by wind_set()/wind_get() } const @@ -159,14 +444,60 @@ const WF_HSLSIZE = (15); WF_VSLSIZE = (16); WF_SCREEN = (17); + WF_TATTRB = 18; + WF_DCOLOR = 19; + WF_SIZTOP = 19; + WF_OWNER = 20; + WF_BEVENT = 24; + WF_BOTTOM = 25; + WF_ICONIFY = 26; + WF_UNICONIFY = 27; + WF_UNICONIFYXYWH = 28; WF_TOOLBAR = (30); + WF_FTOOLBAR = 31; + WF_NTOOLBAR = 32; WF_MENU = (33); + WF_WIDGET = 34; + WF_OPTS = 41; + WF_WINX = $5758; + WF_WINXCFG = $5759; + WF_DDELAY = $575a; + WF_SHADE = $575d; + WF_STACK = $575e; + WF_TOPALL = $575f; + WF_BOTTOMALL = $5760; + WF_XAAES = $5841; { window calculation types as used by wind_calc() } const WC_BORDER = 0; WC_WORK = 1; +{ WF_DCOLOR objects } +const + W_BOX = 0; + W_TITLE = 1; + W_CLOSER = 2; + W_NAME = 3; + W_FULLER = 4; + W_INFO = 5; + W_DATA = 6; + W_WORK = 7; + W_SIZER = 8; + W_VBAR = 9; + W_UPARROW = 10; + W_DNARROW = 11; + W_VSLIDE = 12; + W_VELEV = 13; + W_HBAR = 14; + W_LFARROW = 15; + W_RTARROW = 16; + W_HSLIDE = 17; + W_HELEV = 18; + W_SMALLER = 19; + W_BOTTOMER = 20; + W_HIDER = 30; + { AES standard object colors } const WHITE = (00); { White 1000, 1000, 1000 } @@ -186,6 +517,47 @@ const DYELLOW = (14); { Dark yellow 713, 713, 0 } DMAGENTA = (15); { Dark magenta 713, 0, 713 } +{* editable text justification *} +const + TE_LEFT = 0; + TE_RIGHT = 1; + TE_CNTR = 2; + TE_JUST_MASK = 3; + +{* font types *} +const + GDOS_PROP = 0; {* Speedo GDOS font *} + GDOS_MONO = 1; {* Speedo GDOS font, force monospace output *} + GDOS_BITM = 2; {* GDOS bit map font *} + IBM = 3; + SMALL = 5; + TE_FONT_MASK = 7; + +{* editable text field definitions *} +const + ED_START = 0; + ED_INIT = 1; + ED_CHAR = 2; + ED_END = 3; + ED_CRSR = 100; {* MAG!X *} + ED_DRAW = 103; {* MAG!X 2.00 *} + EDSTART = 0; + EDINIT = 1; + EDCHAR = 2; + EDEND = 3; + +{* inside patterns *} + IP_HOLLOW = 0; + IP_1PATT = 1; + IP_2PATT = 2; + IP_3PATT = 3; + IP_4PATT = 4; + IP_5PATT = 5; + IP_6PATT = 6; + IP_SOLID = 7; + + ROOT = 0; + MAX_DEPTH = 8; { AES mouse form structure } type @@ -254,18 +626,50 @@ const R_FRIMG = 16; { ad_frimg free image } +type + PMENU = ^TMENU; + TMENU = record + mn_tree: PAESTree; + mn_menu: smallint; + mn_item: smallint; + mn_scroll: smallint; + mn_keystate: smallint; + end; + + PMN_SET = ^TMN_SET; + TMN_SET = record + Display: LongInt; + Drag: LongInt; + Delay: LongInt; + Speed: LongInt; + Height: smallint; + end; + function appl_exit: smallint; function appl_read(ap_rid: smallint; ap_rlength: smallint; ap_rpbuff: pointer): smallint; function appl_write(ap_wid: smallint; ap_wlength: smallint; ap_wpbuff: pointer): smallint; function appl_find(fname: PChar): smallint; +function appl_find(ap_fpname: String): smallint; +function appl_tplay(ap_tpmem: Pointer; ap_tpnum, ap_tpscale: smallint): smallint; +function appl_trecord(ap_trmem: Pointer; ap_trcount: smallint): smallint; +function appl_bvset(ap_bvdisk, ap_bvhard: Word): smallint; +function appl_yield: smallint; +procedure _appl_yield; +function appl_search(ap_smode: smallint; ap_sname: Pchar; var ap_stype, ap_sid: smallint): smallint; +function appl_search(ap_smode: smallint; var ap_sname: String; var ap_stype, ap_sid: smallint): smallint; +function appl_getinfo(ap_gtype: smallint; var ap_gout1, ap_gout2, ap_gout3, ap_gout4: smallint): smallint; function appl_init: smallint; function evnt_keybd: smallint; function evnt_button(ev_bclicks: smallint; ev_bmask: smallint; ev_bstate: smallint; ev_bmx: psmallint; ev_bmy: psmallint; ev_bbutton: psmallint; ev_bkstate: psmallint): smallint; +function evnt_button(ev_bclicks, ev_bmask, ev_bstate: smallint; var ev_bmx, ev_bmy, ev_bbutton, ev_bkstate: smallint): smallint; function evnt_mouse(ev_moflags: smallint; ev_mox: smallint; ev_moy: smallint; ev_mowidth: smallint; ev_moheight: smallint; ev_momx: psmallint; ev_momy: psmallint; ev_mobutton: psmallint; ev_mokstate: psmallint): smallint; +function evnt_mouse(ev_moflags, ev_mox, ev_moy, ev_mowidth, ev_moheight: smallint; + var ev_momx, ev_momy, ev_mobutton, ev_mokstate: smallint): smallint; function evnt_mesag(msg: psmallint): smallint; +function evnt_mesag(var ev_mgpbuff: ARRAY_8): smallint; function evnt_timer(ev_tlocount: smallint; ev_thicount: smallint): smallint; function evnt_multi(ev_mflags: smallint; ev_mbclicks: smallint; ev_mbmask: smallint; ev_mbstate: smallint; ev_mm1flags: smallint; ev_mm1x: smallint; ev_mm1y: smallint; ev_mm1width: smallint; ev_mm1height: smallint; @@ -273,6 +677,17 @@ function evnt_multi(ev_mflags: smallint; ev_mbclicks: smallint; ev_mbmask: small ev_mmgpbuff: psmallint; ev_mtlocount: smallint; ev_mthicount: smallint; ev_mmox: psmallint; ev_mmoy: psmallint; ev_mmbutton: psmallint; ev_mmokstate: psmallint; ev_mkreturn: psmallint; ev_mbreturn: psmallint): smallint; +function evnt_multi(ev_mflags, ev_mbclicks, ev_mbmask, + ev_mbstate, ev_mm1flags, ev_mm1x, + ev_mm1y, ev_mm1width, ev_mm1height, + ev_mm2flags, ev_mm2x, ev_mm2y, + ev_mm2width, ev_mm2height: smallint; + var ev_mmgpbuf: ARRAY_8; + ev_mtlocount, ev_mthicount: smallint; + var ev_mmox, ev_mmoy, ev_mmobutton, + ev_mmokstate, ev_mkreturn, + ev_mbreturn: smallint): smallint; +function EvntMulti(var evnt_struct: TEVENT): smallint; function evnt_dclick(ev_dnew: smallint; ev_dgetset: smallint): smallint; function menu_bar(me_btree: PAESOBJECT; me_bshow: smallint): smallint; @@ -339,9 +754,12 @@ function wind_delete(handle: smallint): smallint; function wind_get(wi_ghandle: smallint; wi_gfield: smallint; wi_gw1: psmallint; wi_gw2: psmallint; wi_gw3: psmallint; wi_gw4: psmallint): smallint; +function wind_get(wi_ghandle: smallint; wi_gfield: smallint; gr: PGRECT): smallint; function wind_set(wi_shandle: smallint; wi_sfield: smallint; wi_sw1: smallint; wi_sw2: smallint; wi_sw3: smallint; wi_sw4: smallint): smallint; +function wind_set(wi_shandle: smallint; wi_sfield: smallint; ptr: Pointer): smallint; +function wind_set(wi_shandle: smallint; wi_sfield: smallint; gr: PGRECT): smallint; function wind_find(wi_fmx: smallint; wi_fmy: smallint): smallint; function wind_update(wi_ubegend: smallint): smallint; function wind_calc(wi_ctype: smallint; wi_ckind: smallint; @@ -368,6 +786,8 @@ function shel_envrn(sh_epvalue: ppchar; sh_eparm: pchar): smallint; function crys_if(_opcode: dword): smallint; +function vq_aes: smallint; +procedure _crystal(pb: PAESPB); implementation @@ -377,11 +797,11 @@ const ( 2, 1, 1, 0 ), // 11, appl_read ( 2, 1, 1, 0 ), // 12, appl_write ( 0, 1, 1, 0 ), // 13, appl_find - ( 2, 1, 1, 0 ), // 14, appl_tplay ! - ( 1, 1, 1, 0 ), // 15, appl_trecord ! - ( 0, 0, 0, 0 ), // 16 - ( 0, 0, 0, 0 ), // 17 - ( 1, 3, 1, 0 ), // 18, appl_search (V4.0) ! + ( 2, 1, 1, 0 ), // 14, appl_tplay + ( 1, 1, 1, 0 ), // 15, appl_trecord + ( 2, 1, 0, 0 ), // 16, appl_bvset + ( 0, 0, 0, 0 ), // 17, appl_yield + ( 1, 3, 1, 0 ), // 18, appl_search (V4.0) ( 0, 1, 0, 0 ), // 19, appl_exit ( 0, 1, 0, 0 ), // 20, evnt_keybd ( 3, 5, 0, 0 ), // 21, evnt_button @@ -493,7 +913,7 @@ const ( 0, 0, 0, 0 ), // 127 ( 0, 0, 0, 0 ), // 128 ( 0, 0, 0, 0 ), // 129 - ( 1, 5, 0, 0 ) // 130, appl_getinfo (V4.0) ! + ( 1, 5, 0, 0 ) // 130, appl_getinfo (V4.0) ); var @@ -514,9 +934,9 @@ const addrout: @_addrout; ); -function appl_exit: smallint; +function appl_init: smallint; begin - appl_exit:=crys_if($13); + appl_init:=crys_if(10); end; function appl_read(ap_rid: smallint; ap_rlength: smallint; ap_rpbuff: pointer): smallint; @@ -525,7 +945,7 @@ begin _intin[1]:=ap_rlength; _addrin[0]:=ap_rpbuff; - appl_read:=crys_if($0b); + appl_read:=crys_if(11); end; function appl_write(ap_wid: smallint; ap_wlength: smallint; ap_wpbuff: pointer): smallint; @@ -534,24 +954,97 @@ begin _intin[1]:=ap_wlength; _addrin[0]:=ap_wpbuff; - appl_write:=crys_if($0c); + appl_write:=crys_if(12); end; function appl_find(fname: PChar): smallint; begin _addrin[0]:=fname; - appl_find:=crys_if($0d); + appl_find:=crys_if(13); end; -function appl_init: smallint; +function appl_find(ap_fpname: String): smallint; +var s: array[0..255] of char; begin - appl_init:=crys_if($0a); + StrPCopy(s, ap_fpname); + _addrin[0]:=@s; + appl_find:=crys_if(13); +end; + +function appl_tplay(ap_tpmem: Pointer; ap_tpnum, ap_tpscale: smallint): smallint; +begin + _intin[0]:=ap_tpnum; + _intin[1]:=ap_tpscale; + _addrin[0]:=ap_tpmem; + appl_tplay:=crys_if(14); +end; + +function appl_trecord(ap_trmem: Pointer; ap_trcount: smallint): smallint; +begin + _intin[0]:=ap_trcount; + _addrin[0]:=ap_trmem; + appl_trecord:=crys_if(15); +end; + +function appl_bvset(ap_bvdisk, ap_bvhard: Word): smallint; +begin + _intin[0]:=ap_bvdisk; + _intin[1]:=ap_bvhard; + appl_bvset:=crys_if(16); +end; + +function appl_yield: smallint; +begin + appl_yield:=crys_if(17); +end; + +procedure _appl_yield; +begin + asm + move.w #$c9,d0 + trap #2 + end; +end; + +function appl_search(ap_smode: smallint; ap_sname: Pchar; var ap_stype, ap_sid: smallint): smallint; +begin + _intin[0]:=ap_smode; + _addrin[0]:=ap_sname; + appl_search:=crys_if(18); + ap_stype:=_intout[1]; + ap_sid:=_intout[2]; +end; + +function appl_search(ap_smode: smallint; var ap_sname: String; var ap_stype, ap_sid: smallint): smallint; +var s: array[0..255] of char; +begin + _intin[0]:=ap_smode; + StrPCopy(s, ap_sname); + _addrin[0]:=@s[0]; + appl_search:=crys_if(18); + ap_stype:=_intout[1]; + ap_sid:=_intout[2]; +end; + +function appl_exit: smallint; +begin + appl_exit:=crys_if(19); +end; + +function appl_getinfo(ap_gtype: smallint; var ap_gout1, ap_gout2, ap_gout3, ap_gout4: smallint): smallint; +begin + _intin[0]:=ap_gtype; + appl_getinfo:=crys_if(130); + ap_gout1:=_intout[1]; + ap_gout2:=_intout[2]; + ap_gout3:=_intout[3]; + ap_gout4:=_intout[4]; end; function evnt_keybd: smallint; begin - evnt_keybd:=crys_if($14); + evnt_keybd:=crys_if(20); end; function evnt_button(ev_bclicks: smallint; ev_bmask: smallint; ev_bstate: smallint; @@ -561,7 +1054,7 @@ begin _intin[1]:=ev_bmask; _intin[2]:=ev_bstate; - crys_if($15); + crys_if(21); ev_bmx^:=_intout[1]; ev_bmy^:=_intout[2]; @@ -571,6 +1064,22 @@ begin evnt_button:=_intout[0]; end; +function evnt_button(ev_bclicks, ev_bmask, ev_bstate: smallint; var ev_bmx, ev_bmy, ev_bbutton, ev_bkstate: smallint): smallint; +begin + _intin[0]:=ev_bclicks; + _intin[1]:=ev_bmask; + _intin[2]:=ev_bstate; + + crys_if(21); + + ev_bmx:=_intout[1]; + ev_bmy:=_intout[2]; + ev_bbutton:=_intout[3]; + ev_bkstate:=_intout[4]; + + evnt_button:=_intout[0]; +end; + function evnt_mouse(ev_moflags: smallint; ev_mox: smallint; ev_moy: smallint; ev_mowidth: smallint; ev_moheight: smallint; ev_momx: psmallint; ev_momy: psmallint; ev_mobutton: psmallint; ev_mokstate: psmallint): smallint; begin @@ -580,7 +1089,7 @@ begin _intin[3]:=ev_mowidth; _intin[4]:=ev_moheight; - crys_if($16); + crys_if(22); ev_momx^:=_intout[1]; ev_momy^:=_intout[2]; @@ -590,10 +1099,35 @@ begin evnt_mouse:=_intout[0]; end; +function evnt_mouse(ev_moflags, ev_mox, ev_moy, ev_mowidth, ev_moheight: smallint; + var ev_momx, ev_momy, ev_mobutton, ev_mokstate: smallint): smallint; +begin + _intin[0]:=ev_moflags; + _intin[1]:=ev_mox; + _intin[2]:=ev_moy; + _intin[3]:=ev_mowidth; + _intin[4]:=ev_moheight; + + crys_if(22); + + ev_momx:=_intout[1]; + ev_momy:=_intout[2]; + ev_mobutton:=_intout[3]; + ev_mokstate:=_intout[4]; + + evnt_mouse:=_intout[0]; +end; + function evnt_mesag(msg: psmallint): smallint; begin _addrin[0]:=msg; - evnt_mesag:=crys_if($17); + evnt_mesag:=crys_if(23); +end; + +function evnt_mesag(var ev_mgpbuff: ARRAY_8): smallint; +begin + _addrin[0]:=@ev_mgpbuff; + evnt_mesag:=crys_if(23); end; function evnt_timer(ev_tlocount: smallint; ev_thicount: smallint): smallint; @@ -601,7 +1135,7 @@ begin _intin[0]:=ev_tlocount; _intin[1]:=ev_thicount; - evnt_timer:=crys_if($18); + evnt_timer:=crys_if(24); end; function evnt_multi(ev_mflags: smallint; ev_mbclicks: smallint; ev_mbmask: smallint; ev_mbstate: smallint; @@ -629,7 +1163,7 @@ begin _intin[15]:=ev_mthicount; _addrin[0]:=ev_mmgpbuff; - crys_if($19); + crys_if(25); ev_mmox^:=_intout[1]; ev_mmoy^:=_intout[2]; @@ -641,12 +1175,86 @@ begin evnt_multi:=_intout[0]; end; +function evnt_multi(ev_mflags, ev_mbclicks, ev_mbmask, + ev_mbstate, ev_mm1flags, ev_mm1x, + ev_mm1y, ev_mm1width, ev_mm1height, + ev_mm2flags, ev_mm2x, ev_mm2y, + ev_mm2width, ev_mm2height: smallint; + var ev_mmgpbuf: ARRAY_8; + ev_mtlocount, ev_mthicount: smallint; + var ev_mmox, ev_mmoy, ev_mmobutton, + ev_mmokstate, ev_mkreturn, + ev_mbreturn: smallint): smallint; +begin + _intin[0]:=ev_mflags; + _intin[1]:=ev_mbclicks; + _intin[2]:=ev_mbmask; + _intin[3]:=ev_mbstate; + _intin[4]:=ev_mm1flags; + _intin[5]:=ev_mm1x; + _intin[6]:=ev_mm1y; + _intin[7]:=ev_mm1width; + _intin[8]:=ev_mm1height; + _intin[9]:=ev_mm2flags; + _intin[10]:=ev_mm2x; + _intin[11]:=ev_mm2y; + _intin[12]:=ev_mm2width; + _intin[13]:=ev_mm2height; + _intin[14]:=ev_mtlocount; + _intin[15]:=ev_mthicount; + _addrin[0]:=@ev_mmgpbuf; + + crys_if(25); + + ev_mmox:=_intout[1]; + ev_mmoy:=_intout[2]; + ev_mmobutton:=_intout[3]; + ev_mmokstate:=_intout[4]; + ev_mkreturn:=_intout[5]; + ev_mbreturn:=_intout[6]; + + evnt_multi:=_intout[0]; +end; + +function EvntMulti(var evnt_struct: TEVENT): smallint; +begin + _intin[0]:=evnt_struct.ev_mflags; + _intin[1]:=evnt_struct.ev_mbclicks; + _intin[2]:=evnt_struct.ev_bmask; + _intin[3]:=evnt_struct.ev_mbstate; + _intin[4]:=evnt_struct.ev_mm1flags; + _intin[5]:=evnt_struct.ev_mm1x; + _intin[6]:=evnt_struct.ev_mm1y; + _intin[7]:=evnt_struct.ev_mm1width; + _intin[8]:=evnt_struct.ev_mm1height; + _intin[9]:=evnt_struct.ev_mm2flags; + _intin[10]:=evnt_struct.ev_mm2x; + _intin[11]:=evnt_struct.ev_mm2y; + _intin[12]:=evnt_struct.ev_mm2width; + _intin[13]:=evnt_struct.ev_mm2height; + _intin[14]:=evnt_struct.ev_mtlocount; + _intin[15]:=evnt_struct.ev_mthicount; + _addrin[0]:=@evnt_struct.ev_mmgpbuf; + + crys_if(25); + + evnt_struct.ev_mwich:=_intout[0]; + evnt_struct.ev_mmox:=_intout[1]; + evnt_struct.ev_mmoy:=_intout[2]; + evnt_struct.ev_mmobutton:=_intout[3]; + evnt_struct.ev_mmokstate:=_intout[4]; + evnt_struct.ev_mkreturn:=_intout[5]; + evnt_struct.ev_mbreturn:=_intout[6]; + + EvntMulti:=_intout[0]; +end; + function evnt_dclick(ev_dnew: smallint; ev_dgetset: smallint): smallint; begin _intin[0]:=ev_dnew; _intin[1]:=ev_dgetset; - evnt_dclick:=crys_if($1a); + evnt_dclick:=crys_if(26); end; @@ -1020,6 +1628,21 @@ begin wind_get:=_intout[0]; end; +function wind_get(wi_ghandle: smallint; wi_gfield: smallint; gr: PGRECT): smallint; +begin + _intin[0]:=wi_ghandle; + _intin[1]:=wi_gfield; + + crys_if($68); + + gr^.x:=_intout[1]; + gr^.y:=_intout[2]; + gr^.w:=_intout[3]; + gr^.h:=_intout[4]; + + wind_get:=_intout[0]; +end; + function wind_set(wi_shandle: smallint; wi_sfield: smallint; wi_sw1: smallint; wi_sw2: smallint; wi_sw3: smallint; wi_sw4: smallint): smallint; @@ -1034,6 +1657,30 @@ begin wind_set:=crys_if($69); end; +function wind_set(wi_shandle: smallint; wi_sfield: smallint; ptr: Pointer): smallint; +begin + _intin[0]:=wi_shandle; + _intin[1]:=wi_sfield; + _intin[2]:=dword(ptr) shr 16; + _intin[3]:=dword(ptr); + _intin[4]:=0; + _intin[5]:=0; + + wind_set:=crys_if($69); +end; + +function wind_set(wi_shandle: smallint; wi_sfield: smallint; gr: PGRECT): smallint; +begin + _intin[0]:=wi_shandle; + _intin[1]:=wi_sfield; + _intin[2]:=gr^.x; + _intin[3]:=gr^.y; + _intin[4]:=gr^.w; + _intin[5]:=gr^.h; + + wind_set:=crys_if($69); +end; + function wind_find(wi_fmx: smallint; wi_fmy: smallint): smallint; begin _intin[0]:=wi_fmx; @@ -1179,13 +1826,31 @@ begin nums:=ops_table[_opcode-10]; end; asm - lea.l aespb, a0 - move.l a0, d1 - move.w #AES_TRAP_MAGIC, d0 + lea.l aespb,a0 + move.l a0, 1 + move.w #AES_TRAP_MAGIC,d0 trap #2 end; crys_if:=_intout[0]; end; +function vq_aes: smallint; +begin + _global[0] := 0; + vq_aes := appl_init; + if (_global[0] = 0) then + vq_aes := -1; +end; + +procedure _crystal(pb: PAESPB); +begin + asm + move.l pb,a0 + move.l a0,d1 + move.w #AES_TRAP_MAGIC,d0 + trap #2 + end; +end; + end. diff --git a/packages/tosunits/src/gem.pas b/packages/tosunits/src/gem.pas new file mode 100644 index 0000000000..0de406c37c --- /dev/null +++ b/packages/tosunits/src/gem.pas @@ -0,0 +1,162 @@ +{ + Copyright (c) 2022 by Free Pascal development team + + GEM interface unit for Atari TOS + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ + This is used for Pure-Pascal compatibility. For newly written code, + consider using the aes/vdi units instead. +} + +unit gem; + +interface + +uses aes, vdi, sysutils; + +const + LWhite = DWHITE; + LBlack = DBLACK; + LRed = DRED; + LGreen = DGREEN; + LBlue = DBLUE; + LCyan = DCYAN; + LYellow = DYELLOW; + LMagenta = DMAGENTA; + +type + AESPB = TAESPB; + AESPBPtr = ^AESPB; + AESOBJECT = TAESOBJECT; + VDIPB = TVDIPB; + VDIPBPtr = ^VDIPB; + TEDINFO = TTEDINFO; + TEDINFOPtr = ^TEDINFO; + ICONBLK = TICONBLK; + ICONBLKPtr = ^ICONBLK; + CICON = TCICON; + CICONPtr = ^CICON; + CICONBLK = TCICONBLK; + CICONBLKPtr = ^CICONBLK; + BITBLK = TBITBLK; + BITBLKPtr = ^BITBLK; + MFORM = TMFORM; + MFORMPtr = ^MFORM; + USERBLK = TUSERBLK; + USERBLKPtr = ^USERBLK; + OBSPEC = TOBSPEC; + OBSPECPtr = ^OBSPEC; + PARMBLK = TPARMBLK; + PARMBLKPtr = ^PARMBLK; + AESTree = TAESTree; + AESTreePtr = ^AESTree; + RSHDR = TRSHDR; + RSHDRPtr = ^RSHDR; + EVENT = TEVENT; + EVENTPtr = ^EVENT; + MENU = TMENU; + MENUPtr = ^MENU; + MN_SET = TMN_SET; + MN_SETPtr = ^MN_SET; + FONT_HDR = TFONT_HDR; + FONT_HDRPtr = ^FONT_HDR; + MFDB = TMFDB; + MFDBPtr = ^MFDB; + +procedure SetFreeString(tree: PAESTree; obj: smallint; const str: String); +procedure GetFreeString(tree: PAESTree; obj: smallint; var str: String); +procedure SetPtext(tree: PAESTree; obj: smallint; const str: String); +procedure GetPtext(tree: PAESTree; obj: smallint; var str: String); +procedure SetPtmplt(tree: PAESTree; obj: smallint; const str: String); +procedure GetPtmplt(tree: PAESTree; obj: smallint; var str : String); +procedure SetPvalid(tree: PAESTree; obj: smallint; const str: String); +procedure GetPvalid(tree: PAESTree; obj: smallint; var str: String); +procedure SetIcontext(tree: PAESTree; obj: smallint; const str: String); +procedure GetIcontext(tree: PAESTree; obj: smallint; var str: String); +procedure WindSetTitle(handle: smallint; const str: String; var buf: String); +procedure WindSetInfo(handle: smallint; const str: String; var buf: String); +procedure WindSetNewDesk(tree: PAESTree; firstObj: smallint); + +implementation + +procedure SetFreeString(tree: PAESTree; obj: smallint; const str: String); +begin + StrPCopy(tree^[obj].ob_spec.free_string, str); +end; + +procedure GetFreeString(tree: PAESTree; obj: smallint; var str: String); +begin + str := StrPas(tree^[obj].ob_spec.free_string); +end; + +procedure SetPtext(tree: PAESTree; obj: smallint; const str: String); +begin + StrPCopy(tree^[obj].ob_spec.ted_info^.te_ptext, str); +end; + +procedure GetPtext(tree: PAESTree; obj: smallint; var str: String); +begin + str := StrPas(tree^[obj].ob_spec.ted_info^.te_ptext); +end; + +procedure SetPtmplt(tree: PAESTree; obj: smallint; const str: String); +begin + StrPCopy(tree^[obj].ob_spec.ted_info^.te_ptmplt, str); +end; + +procedure GetPtmplt(tree: PAESTree; obj: smallint; var str : String); +begin + str := StrPas(tree^[obj].ob_spec.ted_info^.te_ptmplt); +end; + +procedure SetPvalid(tree: PAESTree; obj: smallint; const str: String); +begin + StrPCopy(tree^[obj].ob_spec.ted_info^.te_pvalid, str); +end; + +procedure GetPvalid(tree: PAESTree; obj: smallint; var str: String); +begin + str := StrPas(tree^[obj].ob_spec.ted_info^.te_pvalid); +end; + +procedure SetIcontext(tree: PAESTree; obj: smallint; const str: String); +begin + StrPCopy(tree^[obj].ob_spec.icon_blk^.ib_ptext, str); +end; + +procedure GetIcontext(tree: PAESTree; obj: smallint; var str: String); +begin + str := StrPas(tree^[obj].ob_spec.icon_blk^.ib_ptext); +end; + +procedure WindSetTitle(handle: smallint; const str: String; var buf: String); +var pstr: Pchar; +begin + pstr := @buf[0]; + StrPCopy(pstr, str); + wind_set(handle, WF_NAME, Pointer(pstr)); +end; + +procedure WindSetInfo(handle: smallint; const str: String; var buf: String); +var pstr: Pchar; +begin + pstr := @buf[0]; + StrPCopy(pstr, str); + wind_set(handle, WF_INFO, Pointer(pstr)); +end; + +procedure WindSetNewDesk(tree: PAESTree; firstObj: smallint); +begin + wind_set(0, WF_NEWDESK, dword(tree) shr 16, word(tree), firstObj, 0); +end; + +end. diff --git a/packages/tosunits/src/vdi.pas b/packages/tosunits/src/vdi.pas index 0e653e968e..c12a0b3701 100644 --- a/packages/tosunits/src/vdi.pas +++ b/packages/tosunits/src/vdi.pas @@ -18,7 +18,96 @@ unit vdi; interface { The API description of this file is based on the information available - online at: http://toshyp.atari.org } + online at: https://freemint.github.io/tos.hyp/en/index.html } + +const + GDOS_NONE = -2; (* no GDOS installed *) + GDOS_FSM = $5F46534D; (* '_FSM' - FSMGDOS installed *) + GDOS_FNT = $5F464E54; (* '_FNT' - FONTGDOS installed *) + +const +{* vst_alignment modes *} + TA_LEFT = 0; + TA_CENTER = 1; + TA_RIGHT = 2; + TA_BASELINE = 0; + TA_HALF = 1; + TA_ASCENT = 2; + TA_BOTTOM = 3; + TA_DESCENT = 4; + TA_TOP = 5; + +{* gsx modes *} + MD_REPLACE = 1; + MD_TRANS = 2; + MD_XOR = 3; + MD_ERASE = 4; + +{* gsx styles *} + FIS_HOLLOW = 0; + FIS_SOLID = 1; + FIS_PATTERN = 2; + FIS_HATCH = 3; + FIS_USER = 4; + +{* polymarker types *} + MT_DOT = 1; + MT_PLUS = 2; + MT_ASTERISK = 3; + MT_SQUARE = 4; + MT_DCROSS = 5; + MT_DIAMOND = 6; + +{* linetypes *} + LT_SOLID = 1; + LT_LONGDASH = 2; + LT_DOTTED = 3; + LT_DASHDOT = 4; + LT_DASHED = 5; + LT_DASHDOTDOT = 6; + LT_USERDEF = 7; + +{* line ends *} + LE_SQUARED = 0; + LE_ARROWED = 1; + LE_ROUNDED = 2; + +{* text effects *} + TF_NORMAL = 0; + TF_THICKENED = 1; + TF_LIGHTENED = 2; + TF_SLANTED = 4; + TF_UNDERLINED = 8; + TF_OUTLINED = 16; + TF_SHADOWED = 32; + +{* bit blt rules *} + ALL_WHITE = 0; + S_AND_D = 1; + S_AND_NOTD = 2; + S_ONLY = 3; + NOTS_AND_D = 4; + D_ONLY = 5; + S_XOR_D = 6; + S_OR_D = 7; + NOT_SORD = 8; + NOT_SXORD = 9; + D_INVERT = 10; + S_OR_NOTD = 11; + NOT_D = 12; + NOTS_OR_D = 13; + NOT_SANDD = 14; + ALL_BLACK = 15; + +{* input mode *} + MODE_REQUEST = 1; + MODE_SAMPLE = 2; + +{* vqin_mode & vsin_mode modes *} + DEV_LOCATOR = 1; + DEV_VALUATOR = 2; + DEV_CHOICE = 3; + DEV_STRING = 4; type PCOLOR_RGB = ^TCOLOR_RGB; @@ -105,6 +194,11 @@ type fd_r3: smallint; {* Reserved, must be 0 *} end; +type + String33 = String[33]; + String80 = String[80]; + String125 = String[125]; + type PVDIContrl = ^TVDIContrl; TVDIContrl = array[0..11] of smallint; @@ -131,6 +225,35 @@ type ptsout: PVDIPtsOut; {* Pointer to ptsout array *} end; + PFONT_HDR = ^TFONT_HDR; + TFONT_HDR = record + font_id : smallint; + point : smallint; + name : Array[0..31] of Char; + first_ade : Word; + last_ade : Word; + top : Word; + ascent : Word; + half : Word; + descent : Word; + bottom : Word; + max_char_width : Word; + max_cell_width : Word; + left_offset : Word; + right_offset : Word; + thicken : Word; + ul_size : Word; + lighten : Word; + skew : Word; + flags : Word; + hor_table : Pointer; + off_table : Pointer; + dat_table : Pointer; + form_width : Word; + form_height : Word; + next_font : PFONT_HDR; + end; + const VDI_TRAP_MAGIC = $73;