mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-23 12:34:53 +00:00
273 lines
17 KiB
Plaintext
273 lines
17 KiB
Plaintext
|
Screen 0 not modified
|
|||
|
0 \\ *** SUPERGEM.SCR *** 16sep86we
|
|||
|
1
|
|||
|
2 In diesem File soll eine GEM-Library aufgebaut werden, die
|
|||
|
3 komfortablere Routinen als die Standardbefehle mit Ihren un-
|
|||
|
4 <20>bersehbaren Parametern zur Verf<72>gung stellt.
|
|||
|
5
|
|||
|
6 Bei der Entwicklung des Editors sind bereits einige solche
|
|||
|
7 Routinen entstanden.
|
|||
|
8
|
|||
|
9 F<>r Anregungen gerade in diesem Bereich sind wir dankbar....
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 1 not modified
|
|||
|
0 \ GEM-Library Loadscreen cas20130105
|
|||
|
1
|
|||
|
2 Onlyforth GEM also
|
|||
|
3
|
|||
|
4 \needs scr>mem $10 loadfrom gem\vdi.fb
|
|||
|
5
|
|||
|
6 Onlyforth GEM also definitions
|
|||
|
7
|
|||
|
8 1 4 +thru
|
|||
|
9
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 2 not modified
|
|||
|
0 \ Resource Trees and objects 02sep86we
|
|||
|
1
|
|||
|
2 : tree! ( tree -- )
|
|||
|
3 0 swap rsrc_gaddr objc_tree 2! ;
|
|||
|
4
|
|||
|
5 : objc_gaddr ( object# -- laddr )
|
|||
|
6 &24 * extend objc_tree 2@ d+ ;
|
|||
|
7
|
|||
|
8 : text_gaddr ( object# -- laddr )
|
|||
|
9 objc_gaddr &12 extend d+ l2@ l2@ ;
|
|||
|
10
|
|||
|
11 : alert ( n -- button )
|
|||
|
12 show_c
|
|||
|
13 5 swap rsrc_gaddr addrin 2! 1 intin ! &52 1 1 1 AES
|
|||
|
14 hide_c ;
|
|||
|
15
|
|||
|
Screen 3 not modified
|
|||
|
0 \ Move text to Objects and back 02nov86we
|
|||
|
1
|
|||
|
2 : putstring ( addr object# -- ) >r
|
|||
|
3 count under >r >absaddr r> r@ text_gaddr rot lcmove
|
|||
|
4 0 swap extend r> text_gaddr d+ lc! ;
|
|||
|
5
|
|||
|
6 : getstring ( object# addr -- ) >r text_gaddr
|
|||
|
7 0 BEGIN >r 2dup r@ extend d+ lc@ WHILE r> 1+ REPEAT r>
|
|||
|
8 r> 2dup c! 1+ >absaddr rot lcmove ;
|
|||
|
9
|
|||
|
10 : getnumber ( object# -- d )
|
|||
|
11 pad getstring pad count bl skip swap 1- dup >r c!
|
|||
|
12 r@ capitalize c@ IF r> number ELSE rdrop 0 0 THEN ;
|
|||
|
13
|
|||
|
14 : putnumber ( d object# -- ) >r
|
|||
|
15 <# #s #> over 1- c! 1- r> putstring ;
|
|||
|
Screen 4 not modified
|
|||
|
0 \ init_object select deselect 02nov86we
|
|||
|
1
|
|||
|
2 Create little &320 , &200 , &10 , &10 ,
|
|||
|
3 Create big 8 allot
|
|||
|
4
|
|||
|
5 : init_object ( -- )
|
|||
|
6 &320 &200 &10 &10 little 4! form_center big 4! ;
|
|||
|
7
|
|||
|
8 : state_gaddr ( object -- laddr ) objc_gaddr &10. d+ ;
|
|||
|
9
|
|||
|
10 : select ( object -- ) 1 swap state_gaddr l! ;
|
|||
|
11 : deselect ( object -- ) 0 swap state_gaddr l! ;
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 5 not modified
|
|||
|
0 \ show_object hide_object objc_setpos objc_getwh 12aug86we
|
|||
|
1
|
|||
|
2 : show_object ( -- ) init_object
|
|||
|
3 big 4@ scr>mem1 1 little 4@ big 4@ form_dial
|
|||
|
4 0 ( install) 3 ( depth) big 4@ objc_draw show_c ;
|
|||
|
5
|
|||
|
6 : hide_object ( -- ) hide_c
|
|||
|
7 2 little 4@ big 4@ form_dial big 4@ mem1>scr ;
|
|||
|
8
|
|||
|
9 : objc_setpos ( x y object# -- )
|
|||
|
10 dup >r objc_gaddr $0.12 d+ l! r> objc_gaddr $0.10 d+ l! ;
|
|||
|
11
|
|||
|
12 : objc_getwh ( object# -- width height )
|
|||
|
13 dup objc_gaddr $0.14 d+ l@ swap objc_gaddr $0.16 d+ l@ ;
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 6 not modified
|
|||
|
0 \
|
|||
|
1
|
|||
|
2
|
|||
|
3
|
|||
|
4
|
|||
|
5
|
|||
|
6
|
|||
|
7
|
|||
|
8
|
|||
|
9
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 7 not modified
|
|||
|
0 \
|
|||
|
1
|
|||
|
2
|
|||
|
3
|
|||
|
4
|
|||
|
5
|
|||
|
6
|
|||
|
7
|
|||
|
8
|
|||
|
9
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 8 not modified
|
|||
|
0
|
|||
|
1
|
|||
|
2
|
|||
|
3
|
|||
|
4
|
|||
|
5
|
|||
|
6
|
|||
|
7
|
|||
|
8
|
|||
|
9
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 9 not modified
|
|||
|
0 \ GEM-Library Loadscreen 16sep86we
|
|||
|
1
|
|||
|
2 nimmt GEM in die Suchordnung auf (Fehlermeldung, falls nicht
|
|||
|
3 vorhanden)
|
|||
|
4 wird f<>r die Rasteroperationen gebraucht, die den Bildschirm-
|
|||
|
5 inhalt schnell restaurieren.
|
|||
|
6 Alle folgenden Definitionen werden Bestandteil des Vokabulars
|
|||
|
7 GEM
|
|||
|
8 falls die Mausroutinen noch nicht vorhanden sind.
|
|||
|
9
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 10 not modified
|
|||
|
0 \ Resource Trees and objects 16sep86we
|
|||
|
1
|
|||
|
2 speichert die Kennummer eines Trees in der FORTH-internen
|
|||
|
3 Variablen objc_tree ab. Mu<4D> immer vor der weiteren Arbeit mit
|
|||
|
4 Objekten geschehen.
|
|||
|
5 liefert die 32-Bit-Adresse des Objekts mit der Nummer object#.
|
|||
|
6 tree! mu<6D> vorher aufgerufen worden sein.
|
|||
|
7
|
|||
|
8 laddr ist die 32-Bit-Adresse des 0-terminated Strings mit der
|
|||
|
9 Objektnummer object#.
|
|||
|
10
|
|||
|
11 n ist die Objektnummer der Alertbox, button ist der vom Benutzer
|
|||
|
12 bet<65>tigte Knopf. Die Maus wird vorher eingeschaltet und hinter-
|
|||
|
13 her gl<67>scht.
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 11 not modified
|
|||
|
0 \ Move text to Objects and back 16sep86we
|
|||
|
1
|
|||
|
2 addr ist die Adresse eines 0-terminated Strings innerhalb des
|
|||
|
3 FORTH-Systems. Dieser wird in das Objekt object# transportiert.
|
|||
|
4
|
|||
|
5
|
|||
|
6 Der Text im Objekt object# wird nach addr transportiert.
|
|||
|
7
|
|||
|
8
|
|||
|
9
|
|||
|
10 wie oben, jedoch wir der String in eine doppelt genaue Zahl
|
|||
|
11 gewandelt. Ist der String leer wird 0.0 zur<75>ckgegeben. Ein
|
|||
|
12 Abbruch erfolgt, wenn der String nicht gewandelt werden kann.
|
|||
|
13
|
|||
|
14 wandelt die doppelt genaue Zahl d in einen 0-terminated String
|
|||
|
15 und transportiert ihn in das Objekt object#.
|
|||
|
Screen 12 not modified
|
|||
|
0 \ init_object select deselect 16sep86we
|
|||
|
1
|
|||
|
2 little beschreibt ein kleines Rechteck in Bildschirmmitte.
|
|||
|
3 big beschreibt ein Rechteck in der Gr<47><72>e des Objekts.
|
|||
|
4
|
|||
|
5 initialisiert little und big auf die Gr<47><72>en des darzustellenden
|
|||
|
6 Objekts. Die Koordinaten des Objekts werden in der Resource (!)
|
|||
|
7 so ge<67>ndert, da<64> es auf dem Bildschirm zentriert erscheint.
|
|||
|
8 laddr ist die Langadresse des Statuswortes des Objekts object#.
|
|||
|
9 setzt den Status des Objekts object# auf selected (revers).
|
|||
|
10 setzt den Status des Objekts object# auf deselected (normal).
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 13 not modified
|
|||
|
0 \ show_object hide_object objc_setpos objc_getwh 16sep86we
|
|||
|
1
|
|||
|
2 zeichnet das Objekt auf dem Bildschirm und rettet den Hinter-
|
|||
|
3 grund. Die Treenummer des Objekts mu<6D> mit tree! gesetzt sein.
|
|||
|
4 Das Objekt wird mit (bis zu) drei Unterebenen gezeichnet.
|
|||
|
5 Die Maus wird eingeschaltet.
|
|||
|
6 entfernt das Objekt vom Bildschirm und restauriert den Hinter-
|
|||
|
7 grund.
|
|||
|
8
|
|||
|
9 x und y sind die Koordinaten der oberen rechten Ecke, an der
|
|||
|
10 das Objekt object# auf dem Bildschirm erscheinen soll.
|
|||
|
11
|
|||
|
12 width und height sind Breite und H<>he des Objekts object#.
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 14 not modified
|
|||
|
0
|
|||
|
1
|
|||
|
2
|
|||
|
3
|
|||
|
4
|
|||
|
5
|
|||
|
6
|
|||
|
7
|
|||
|
8
|
|||
|
9
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|
|||
|
Screen 15 not modified
|
|||
|
0
|
|||
|
1
|
|||
|
2
|
|||
|
3
|
|||
|
4
|
|||
|
5
|
|||
|
6
|
|||
|
7
|
|||
|
8
|
|||
|
9
|
|||
|
10
|
|||
|
11
|
|||
|
12
|
|||
|
13
|
|||
|
14
|
|||
|
15
|