VolksForth/sources/AtariST/GEM/AES.FB.src

681 lines
44 KiB
Plaintext
Raw Normal View History

2020-06-20 16:59:55 +00:00
Screen 0 not modified
0 \\ *** AES -Funktionen *** 26may86we
1
2 Dieses File enth<74>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