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 bersehbaren Parametern zur Verfgung stellt.                   
 5                                                                 
 6 Bei der Entwicklung des Editors sind bereits einige solche      
 7 Routinen entstanden.                                            
 8                                                                 
 9 Fr 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 fr 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ž immer vor der weiteren Arbeit mit  
 4  Objekten geschehen.                                            
 5 liefert die 32-Bit-Adresse des Objekts mit der Nummer object#.  
 6  tree! muž 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„tigte Knopf. Die Maus wird vorher eingeschaltet und hinter-
13  her gl”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 zurckgegeben. 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”že des Objekts.        
 4                                                                 
 5 initialisiert little und big auf die Gr”žen des darzustellenden 
 6  Objekts. Die Koordinaten des Objekts werden in der Resource (!)
 7  so ge„ndert, daž 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ž 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                                                                 
