mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-10 05:29:31 +00:00
681 lines
44 KiB
Plaintext
681 lines
44 KiB
Plaintext
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
|