Screen 0 not modified     
 0 \\                   *** GEM - Basics ***              26may86we
 1                                                                 
 2 Die Routinen in dieser Library entsprechen dem, was auch dem    
 3 Pascal-, C- oder Modula-Programmierer zur Verfgung steht.      
 4 Fr eine genaue Beschreibung der einzelnen Routinen verweisen   
 5 wir auf die GEM-Dokumentation des ST-Entwicklungspaketes bzw.   
 6 entsprechende Literatur.                                        
 7                                                                 
 8 Aus diesem Grunde wurden die - teilweise kryptischen - Namen    
 9 von Digital Research beibehalten; auch die šbergabeparameter    
10 der einzelnen Funktionen sind unver„ndert geblieben.            
11 Der Aufbau einer FORTH-Library mit 'Super-Befehlen' ist in      
12 Arbeit.                                                         
13                                                                 
14 Die Worte in diesem File werden sowohl fr VDI- als auch fr    
15 AES-Funktionen ben”tigt.                                        
Screen 1 not modified     
 0 \ VDI GEM Arrays and Controls Loadscreen               02nov86we
 1                                                                 
 2 Onlyforth                                                       
 3                                                                 
 4 \needs >absaddr     : >absaddr   0 forthstart d+ ;              
 5 \needs Code         2 loadfrom assemble.scr                     
 6                                                                 
 7 Vocabulary GEM   GEM definitions also                           
 8                                                                 
 9  1  8 +thru                                                     
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 2 not modified     
 0 \  VDI GEM Arrays                                      05aug86we
 1                                                                 
 2 Create intin   &60 allot        Create ptsin   &256 allot       
 3 Create intout  &90 allot        Create ptsout  &24  allot       
 4 Create addrin    8 allot        Create addrout   4  allot       
 5 Variable grhandle                                               
 6                                                                 
 7 | : gemconstant  ( addr n -- addr+n)      over Constant + ;     
 8                                                                 
 9 Create contrl   $16 allot                                       
10 contrl 2 gemconstant opcode                                     
11        2 gemconstant #intin                                     
12        2 gemconstant #intout     ' #intout Alias #ptsout        
13        2 gemconstant #addrin                                    
14        2 gemconstant #addrout                                   
15        2 gemconstant function     drop                          
Screen 3 not modified     
 0 \  global array, Parameter blocks                      02nov86we
 1                                                                 
 2 Create global   $20 allot                                       
 3 global &10 + Constant ap_ptree                                  
 4                                                                 
 5 | : gemarray   ( n0 ... nk-1 k --)    Create 0 ?DO  , LOOP ;    
 6                                                                 
 7 addrout addrin intout intin global contrl 6 gemarray (AESpb     
 8         ptsout intout ptsin intin  contrl 5 gemarray (VDIpb     
 9                                                                 
10 Create AESpb  &24 allot         Create VDIpb  &20 allot         
11                                                                 
12 : setarrays                                                     
13    6 0 DO  (AESpb I 2* + @ >absaddr  AESpb I 2* 2* + 2!  LOOP   
14    5 0 DO  (VDIpb I 2* + @ >absaddr  VDIpb I 2* 2* + 2!  LOOP ; 
15                                                                 
Screen 4 not modified     
 0 \  Array-Handling                                      09sep86we
 1                                                                 
 2 Code array!   ( n0 ... nk-1 adr k --)                           
 3    SP )+ D0 move  SP )+ D6 move  D6 reg) A0 lea                 
 4    D0 A0 adda  D0 A0 adda  1 D0 subq                            
 5    D0 DO  SP )+ A0 -) move  LOOP    Next end-code               
 6                                                                 
 7 Code 4!   ( n1 .. n4 addr -- )                                  
 8    SP )+ D6 move  8 D6 addq  D6 reg) A0 lea   3 # D0 move       
 9      D0 DO  SP )+ A0 -) move  LOOP     Next end-code            
10                                                                 
11 Code 4@   ( addr -- n1 .. n4 )                                  
12    SP )+ D6 move  D6 reg) A0 lea   3 # D0 move                  
13      D0 DO  A0 )+ SP -) move  LOOP     Next end-code            
14                                                                 
15                                                                 
Screen 5 not modified     
 0 \  AES-Aufruf                                          09sep86we
 1                                                                 
 2 Code AES   ( opcode #intin #intout #addrin -- intout@ )         
 3    SP )+ contrl 6 + R#) move                    \ #addrin       
 4    SP )+ contrl 4 + R#) move                    \ #intout       
 5    SP )+ contrl 2+  R#) move                    \ #intin        
 6    SP ) D0 move   SP )+ contrl R#) move         \ opcode        
 7    contrl 8 + R#) clr                           \ #addrout      
 8    &112 D0 cmpi              \ Funktions-Nr. von rsrc_gaddr     
 9         0= IF  1 # contrl 8 + R#) move  THEN                    
10    AESpb # D6 move   D6 reg) A0 lea   A0 D1 lmove               
11    .w $C8 # D0 move   2 trap                                    
12    intout R#) SP -) move   Next   end-code                      
13                                                                 
14                                                                 
15                                                                 
Screen 6 not modified     
 0 \  VDI-Aufruf                                          09sep86we
 1                                                                 
 2 Code VDI  ( opcode #ptsin #intin --)                            
 3    SP )+ contrl 6 + R#) move                                    
 4    SP )+ contrl 2+  R#) move   SP )+ contrl  R#) move           
 5    grhandle R#)  contrl &12 + R#) move                          
 6    VDIpb # D6 move   D6 reg) A0 lea   A0 D1 lmove               
 7    $73 D0 moveq  2 trap                                         
 8    Next   end-code                                              
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 7 not modified     
 0 \  appl_init appl_exit graf_handle                    bp 12oct86
 1                                                                 
 2 : appl_init    global &14 + $10 erase   &10 0 1 0 AES drop ;    
 3 : appl_exit    &19 0 1 0 AES drop ;                             
 4                                                                 
 5                                                                 
 6 | : sizeconstant  ( addr n -- addr+n@ )                         
 7      over Create , +   Does>  @ @ ;                             
 8                                                                 
 9 Create sizes 8 allot       $08 $10 $13 $13  sizes 4!            
10 sizes 2 sizeconstant cwidth     2 sizeconstant cheight          
11       2 sizeconstant bwidth     2 sizeconstant bheight   drop   
12                                                                 
13 : graf_handle       &77 0 5 0 AES grhandle !                    
14    intout 2+ sizes 8 cmove ;                                    
15                                                                 
Screen 8 not modified     
 0 \  opnvwk clrwk clsvwk updwk                           02nov86we
 1                                                                 
 2 : opnvwk                                                        
 3    intin &10 0 DO  1 over I 2* + !  LOOP  drop                  
 4    2 intin &20 + !   &100 0 &11 VDI                             
 5    contrl &12 + @  grhandle ! ;                                 
 6                                                                 
 7 : clrwk        3 0 0 VDI ;                                      
 8 : clsvwk    &101 0 0 VDI ;                                      
 9                                                                 
10 : updwk      4 0 0 VDI  ;                                       
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 9 not modified     
 0 \  s_clip grinit grexit show_c hide_c                  02nov86we
 1                                                                 
 2 : s_clip      ( x1 y1 x2 y2 clipflag -- )                       
 3    intin !  ptsin 4 array!   &129 2 1 VDI  ;                    
 4                                                                 
 5 : grinit    setarrays  appl_init  graf_handle  opnvwk ;         
 6 : grexit    clsvwk appl_exit ;                                  
 7                                                                 
 8 2Variable objc_tree             0. objc_tree 2!                 
 9                                                                 
10 Variable c_flag       c_flag off                                
11 : show_c   ( -- )     c_flag @ intin !  &122 0 1 VDI  ;         
12 : hide_c   ( -- )     &123 0 0 VDI  ;                           
13                                                                 
14 \\ st_load_fonts  st_unload_fonts                               
15    w„r auch ganz hbsch, hamse aber nich!                       
