Screen 0 not modified 0 \\ *** AES -Funktionen *** 26may86we 1 2 Dieses File enth„lt alle AES-Funktionen. 3 4 Zur genauren Beschreibung verweisen wir auf die Dokumentation 5 von Digital Research. 6 7 8 9 10 11 12 13 14 15 Screen 1 not modified 0 \ AES Loadscreen cas20130105 1 2 \needs GEM include gem\basics.fb 3 Onlyforth 4 \needs 2over include double.fb 5 Onlyforth GEM also definitions 6 1 +load cr .( Eventwords loaded) cr 7 7 +load cr .( Menuwords loaded) cr 8 $0C +load cr .( Objectwords loaded) cr 9 $10 +load cr .( Formwords loaded) cr 10 $14 +load cr .( Graphicswords loaded) cr 11 $19 +load cr .( Fileselect loaded) cr 12 $1C +load cr .( Windowwords loaded) cr 13 $22 +load cr .( RSRCwords loaded) cr 14 15 Screen 2 not modified 0 \ Event Loadscreen 01feb86we 1 2 Onlyforth GEM also definitions 3 4 1 5 +thru 5 6 7 8 9 10 11 12 13 14 15 Screen 3 not modified 0 \ event_keybd event_button 06aug86we 1 2 : evnt_keybd ( -- key ) &20 0 1 0 AES ; 3 4 : evnt_button ( #clicks0 bmask bstate -- #clicks1 ) 5 intin 3 array! &21 3 5 0 AES ; 6 7 \\ #clicks0 is awaitet # of clicks 8 bmask is a button mask 9 bstate is the awaitet state of mouse-button(s) 10 #clicks1 is the actually entered # of clicks 11 bmask + bstate use the convention: 12 lowest bit is leftmost button etc. 13 bit = 0 is button up 14 bit = 1 is button down 15 more return parameters are in intout-array Screen 4 not modified 0 \ event_mouse event_mesag 02nov86we 1 2 : evnt_mouse ( f leftX topY widht heigth -- ) 3 intin 5 array! &22 5 5 0 AES drop ; 4 5 \ f = 0 is return on entry of mouse in rectangle 6 \ f = 1 is return on exit ... 7 \ more parameters are in intout 8 9 Create message $10 allot 10 11 : evnt_mesag ( -- ) 12 message >absaddr addrin 2! &23 0 1 1 AES drop ; 13 14 \ see description of messages in AES documentation 15 Screen 5 not modified 0 \ event_timer 06aug86we 1 2 : evnt_timer ( dtime -- ) 3 intin 2 array! &24 2 1 0 AES drop ; 4 5 \ dtime is a double number for timer count down in milliseconds 6 7 8 9 10 11 12 13 14 15 Screen 6 not modified 0 \ evnt_multi bp 12oct86 1 2 \ because there are too much parameters: 3 4 Create events 5 %00110011 , \ timer, message, button + keyboard events on 6 2 , 1 , 1 , \ 2 clicks down on left mouse-button 7 here $14 allot $14 erase \ rectangles unspecified 8 0 , 0 , \ 0 millisecond timer-delay 9 10 : prepare events intin $20 cmove 11 message >absaddr addrin 2! ; 12 13 : evnt_multi ( -- which ) &25 &16 7 1 AES ; 14 15 Screen 7 not modified 0 \ evnt_dclick 06aug86we 1 2 : evnt_dclick ( dnew dgetset -- dspeed ) 3 intin 2 array! &26 2 1 0 AES ; 4 5 6 7 8 9 10 11 12 13 14 15 Screen 8 not modified 0 \ Menu Loadscreen 12aug86we 1 2 Onlyforth GEM also definitions 3 4 1 4 +thru 5 6 7 8 9 10 11 12 13 14 15 Screen 9 not modified 0 \ objc_tree menuAES bp 12oct86 1 2 | : ?menuerror ( flag -- ) 0= abort" Menu-Error" ; 3 4 | : menuAES ( opcode #intin #intout #addrin -- intout@ ) 5 objc_tree 2@ addrin 2! AES ; 6 7 8 9 10 11 12 13 14 15 Screen 10 not modified 0 \ menu_bar menu_icheck 09aug86we 1 2 : menu_bar ( showflag -- ) 3 intin ! &30 1 1 1 menuAES ?menuerror ; 4 5 \ showflag = 0 is menubar off, = 1 is menubar on 6 7 8 : menu_icheck ( item showflag -- ) 9 intin 2 array! &31 2 1 1 menuAES ?menuerror ; 10 11 \ item is the menu item 12 \ showflag = 0 is checkmark off, = 1 is checkmark on 13 14 15 Screen 11 not modified 0 \ menu_ienable menu_tnormal 09aug86we 1 2 : menu_ienable ( item enableflag -- ) 3 intin 2 array! &32 2 1 1 menuAES ?menuerror ; 4 5 \ item is the menuitem# 6 \ enableflag = 0 is disable item, = 1 is enable item 7 8 9 : menu_tnormal ( title normalflag -- ) 10 intin 2 array! &33 2 1 1 menuAES ?menuerror ; 11 12 \ title is the title# 13 \ normalflag = 0 is title reverse, = 1 is title normal 14 15 Screen 12 not modified 0 \ menu_text menu_register 02nov86we 1 2 : menu_text ( item laddr -- ) 3 addrin 4+ 2! intin ! &34 1 1 2 menuAES ?menuerror ; 4 5 \ item is the menuitem# 6 \ laddr is the address of a 0-terminated replace-string 7 8 9 : menu_register ( apid laddr -- menuid ) 10 addrin 2! intin ! &35 1 1 1 AES dup 0< not ?menuerror ; 11 12 \ apid is the application-ID from ACC's applinit 13 \ laddr is the address of a 0-terminated string for menutext 14 \ menuid is ACC's menu-identifier (0-5) 15 Screen 13 not modified 0 \ Object Loadscreen 01feb86we 1 2 Onlyforth GEM also definitions 3 4 1 3 +thru 5 6 7 8 9 10 11 12 13 14 15 Screen 14 not modified 0 \ objc_tree objcAES objc_add objc_delete 06aug86we 1 2 | : ?objcerror ( flag -- ) 0= abort" Object-Error" ; 3 4 | : objcAES ( opcode #intin #intout #addrin -- intout@ ) 5 objc_tree 2@ addrin 2! 1 AES ; 6 7 : objc_add ( parent child -- ) 8 intin 2 array! &40 2 1 objcAES ?objcerror ; 9 10 : objc_delete ( object -- ) 11 intin ! &41 1 1 objcAES ?objcerror ; 12 13 14 15 Screen 15 not modified 0 \ objc_draw objc_find objc_offset bp 12oct86 1 2 : objc_draw ( startob depth x y width height -- ) 3 intin 6 array! &42 6 1 objcAES ?objcerror ; 4 5 : objc_find ( startob depth x y -- obnum ) 6 intin 4 array! &43 4 1 objcAES ; 7 8 : objc_offset ( object -- x y ) 9 intin ! &44 1 3 objcAES ?objcerror 10 intout 2+ @ intout 4+ @ ; 11 12 13 14 15 Screen 16 not modified 0 \ objc_order objc_edit objc_change 02feb86we 1 2 : objc_order ( object newpos -- ) 3 intin 2 array! &45 2 1 objcAES ?objcerror ; 4 5 : objc_edit ( object char index kind -- newindex ) 6 intin 4 array! &46 4 2 objcAES ?objcerror intout 2+ @ ; 7 8 : objc_change ( object x y width height newstate redraw -- ) 9 intin 4+ 6 array! intin ! intin 2+ off 10 &47 8 1 objcAES ?objcerror ; 11 12 13 14 15 Screen 17 not modified 0 \ Object Loadscreen 09aug86we 1 2 Onlyforth GEM also definitions 3 1 2 +thru 4 5 6 7 8 9 10 11 12 13 14 15 Screen 18 not modified 0 \ form_do form_dial bp 12oct86 1 2 : form_do ( startobj -- objectno ) 3 intin ! objc_tree 2@ addrin 2! &50 1 1 1 AES ; 4 5 : form_dial ( diflag lix liy liw lih bix biy biw bih ) 6 intin 9 array! &51 9 1 0 AES drop ; 7 \ li means little bi means big 8 9 10 11 12 13 14 15 Screen 19 not modified 0 \ form_alert form_error form_center 07a09sep86we 1 2 : form_alert ( defbttn 0string -- exbttn ) 3 >absaddr addrin 2! intin ! &52 1 1 1 AES ; 4 5 : form_error ( enum -- exbttn ) 6 intin ! &53 1 1 0 AES ; 7 8 : form_center ( -- x y width height ) 9 objc_tree 2@ addrin 2! &54 0 5 1 AES drop intout 2+ 4@ ; 10 11 12 13 14 15 Screen 20 not modified 0 \ form_alert tests bp 12oct86 1 2 : test ( -- button ) 3 2 0" [1][Dies ist ein Test!|2.Zeile][OK|JA|NEIN]" 4 form_alert ; 5 6 7 8 9 10 11 12 13 14 15 Screen 21 not modified 0 \ Graphics Loadscreen 02feb86we 1 2 Onlyforth GEM also definitions 3 4 1 4 +thru 5 6 7 8 9 10 11 12 13 14 15 Screen 22 not modified 0 \ graf_dragbox graf_movebox 06aug86we 1 2 | : ?graferror ( flag -- ) 0= abort" Graphic-Error" ; 3 4 : graf_dragbox 5 ( startx starty width height boundx boundy boundw boundh -- 6 finishx finishy ) 7 intin 8 + 4 array! intin 2 array! intin 4+ 2 array! 8 &71 8 3 0 AES ?graferror intout 2+ @ intout 4+ @ ; 9 10 : graf_movebox 11 ( sourcex sourcey width height destx desty -- ) 12 intin 8 + 2 array! intin 2 array! intin 4+ 2 array! 13 &72 6 1 0 AES ?graferror ; 14 15 Screen 23 not modified 0 \ graf_growbox graf_shrinkbox 06aug86we 1 2 : graf_growbox ( stx sty stw sth fix fiy fiw fih -- ) 3 intin 8 array! &73 8 1 0 AES ?graferror ; 4 5 : graf_shrinkbox ( fix fiy fiw fih stx sty stw sth -- ) 6 intin 8 array! &74 8 1 0 AES ?graferror ; 7 8 \ st means start fi means finish 9 10 11 12 13 14 15 Screen 24 not modified 0 \ graf_watchbox graf_slidebox bp 12oct86 1 2 : graf_watchbox ( object instate outstate -- inside/outside ) 3 objc_tree 2@ addrin 2! intin 2+ 3 array! 4 &75 4 1 1 AES ; 5 6 : graf_slidebox ( parent object vhflag -- vhpos ) 7 objc_tree 2@ addrin 2! intin 3 array! 8 &76 3 1 1 AES ; 9 10 11 \\ graf_handle is defined in BASICS.SCR ! 12 13 14 15 Screen 25 not modified 0 \ graf_mouse graf_mkstate bp 12oct86 1 2 2Variable mofaddr 0. mofaddr 2! 3 4 : graf_mouse ( mouseform -- ) 5 intin ! mofaddr 2@ addrin 2! &78 1 1 1 AES ?graferror ; 6 7 : graf_mkstate ( -- ) &79 0 5 0 AES drop ; 8 9 \ Werte in intout 10 11 12 13 14 15 Screen 26 not modified 0 \ File Selection Loadscreen bp 11oct86 1 2 Onlyforth 3 GEM also definitions 4 5 1 +load 6 7 \\ 8 9 : test ( -- button ) 10 show_c inpath &30 erase name count inpath place 11 insel $10 erase name count insel place 12 fs_label &30 erase name count fs_label place 13 fsel_exinput hide_c ; 14 15 test A:\GEM\*.SCR AES.SCR Dies_ist_eine_Textbox! Screen 27 not modified 0 \ File Selection bp 11oct86 1 2 Create inpath ," \*.SCR" here &30 allot &30 erase 3 Create insel here $10 allot $10 erase 4 5 | : count? ( addr -- ) 6 dup 1+ BEGIN count 0= UNTIL over - 2- swap c! ; 7 8 : fsel_input ( -- button ) 9 inpath 1+ >absaddr addrin 2! insel 1+ >absaddr addrin 4+ 2! 10 &90 0 2 2 AES 0= abort" File Error" 11 inpath count? insel count? intout 2+ @ ; 12 --> 13 \\ button = 0 is ABBRUCH, = 1 is OK; the returned strings 14 are in inpath and insel (counted and 0-terminated) 15 Screen 28 not modified 0 \ File selection mit FSEL_EXINPUT 13jan90 m.bitter 1 2 Create fs_label ," May the volks4TH be with you!" 0 c, 3 4 : fsel_exinput ( -- button ) 5 inpath 1+ >absaddr addrin 2! insel 1+ >absaddr addrin 4+ 2! 6 fs_label 1+ >absaddr addrin 8 + 2! 7 &91 0 2 3 AES 0= abort" File Error" 8 inpath count? insel count? intout 2+ @ ; 9 10 11 12 13 \\ button = 0 is ABBRUCH, = 1 is OK; the returned strings 14 are in inpath and insel (counted and 0-terminated) 15 Screen 29 not modified 0 \ Windows Loadscreen 28jan86we 1 2 Onlyforth GEM also definitions 3 4 1 4 +thru 5 6 7 8 9 10 11 12 13 14 15 Screen 30 not modified 0 \ windows 21aug86we 1 2 | : ?winderror ( flag -- ) 0= abort" Window-Error" ; 3 4 : wind_create 5 ( components leftX topY maxWidth maxHeight -- handle ) 6 intin 5 array! &100 5 1 0 AES dup 0> ?winderror ; 7 8 \\ component bits set mean: 9 10 $0001 title bar $0002 close box 11 $0004 full box $0008 move bar 12 $0010 info line $0020 size box 13 $0040 up arrow $0080 down arrow 14 $0100 vertical slider $0200 left arrow 15 $0400 right arrow $0800 horizontal slider Screen 31 not modified 0 \ windows 06aug86we 1 2 : wind_open ( W-handle leftX topY width heigth -- ) 3 intin 5 array! &101 5 1 0 AES ?winderror ; 4 5 6 7 8 9 10 11 12 13 14 15 Screen 32 not modified 0 \ windows 06aug86we 1 2 : wind_close ( Whandle -- ) 3 intin ! &102 1 1 0 AES ?winderror ; 4 5 : wind_delete ( Whandle -- ) 6 intin ! &103 1 1 0 AES ?winderror ; 7 8 : wind_get ( Whandle funktion# -- ) 9 intin 2 array! &104 2 5 0 AES ?winderror ; 10 11 : wind_set ( Whandle funktion# par0 par1 par2 par3 -- ) 12 intin 6 array! &105 6 1 0 AES ?winderror ; 13 14 : wind_find ( mouseX mouseY -- Whandle ) 15 intin 2 array! &106 2 1 0 AES ; Screen 33 not modified 0 \ windows 06aug86we 1 2 : wind_update ( funktion# -- ) 3 intin ! &107 1 1 0 AES ?winderror ; 4 5 : wind_calc ( 0/1 components leftX topY width heigth -- ) 6 intin 6 array! &108 6 5 0 AES ?winderror ; 7 8 9 10 11 12 13 14 15 Screen 34 not modified 0 \ window test 02feb86we 1 2 $0FEF &0 &20 &600 &300 wind_create Constant wtesthandle 3 4 : windowtest page 5 wtesthandle 1 &20 &500 &300 wind_open 6 $20 0 DO wtesthandle 5 1 &20 &500 I - &300 I - wind_set 7 2 +LOOP 8 ." Hit any key to continue " key drop 9 wtesthandle wind_close ; 10 11 : end wtesthandle wind_delete ; 12 13 14 15 Screen 35 not modified 0 \ RSRC Loadscreen 21nov86we 1 2 Onlyforth GEM also definitions 3 4 \needs 0" include strings.scr 5 6 7 1 4 +thru 8 9 10 11 12 13 14 15 Screen 36 not modified 0 \ RSRC words bp 12oct86 1 2 | : ?rsrcerror ( f -- ) 0= abort" Resource-Error" ; 3 4 : rsrc_load ( 0$ -- ) \ needs address of 0-terminated $ 5 >absaddr addrin 2! &110 0 1 1 AES ?rsrcerror ; 6 7 : rsrc_load" [compile] 0" compile rsrc_load ; 8 immediate restrict 9 10 11 12 13 14 15 Screen 37 not modified 0 \ rsrc_gaddr 20aug86mawe 1 2 : rsrc_free ( -- ) &111 0 1 0 AES ?rsrcerror ; 3 4 : rsrc_gaddr ( type index -- laddr ) 5 intin 2 array! &112 2 1 0 AES ?rsrcerror addrout 2@ ; 6 7 \\ type is one of the following: 8 0 tree 1 object 2 tedinfo 3 iconblk 9 4 bitblk 5 string 6 imagedata 7 obspec 10 8 te_ptext 9 te_ptmplt $A te_pvalid $B ib_pmask 11 $C ib_pdata $D ib_ptext $E bi_pdata $F ad_frstr 12 $10 ad_frimg 13 index is the index of the data structure 14 laddr is the long (double) address of the data structure 15 specified by type and index Screen 38 not modified 0 \ rsrc_saddr 06aug86we 1 2 : rsrc_saddr ( type index laddr --) 3 addrin 2! intin 2 array! &113 2 1 1 AES ?rsrcerror ; 4 5 \\ for type index and f see rsrc_gaddr 6 laddr is the address of a data structure 7 8 9 10 11 12 13 14 15 Screen 39 not modified 0 \ rsrc_obfix 06aug86we 1 2 : rsrc_obfix ( index laddr --) 3 addrin 2! intin ! &114 1 1 1 AES drop ; 4 5 \ index is index of object 6 \ laddr is addr of tree that contains object 7 8 9 10 11 12 13 14 15