BLOCK NUMBER 81

( PMODE Graphics Word Set - Mode A - Load Block )               
( Copyright [ c ] 1992 by BDS Software )                        
decimal                                                         
cr cr .( Loading General Math Routines - 8 blocks )             
: thrx ( +n1 +n2 -- ) over 1- rot rot 1+ swap cr do i dup 2 pick
     - cr 3 spaces ." Loading Block " . load loop drop ;        
83 90 thrx                                                      
cr cr .( Loading Mode A Graphics Package - 22 blocks )          
91 112 thrx                                                     
cr cr .( Mode A Graphics Package LOADED. )                      
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 82

( PMODE Graphics Word Set - Mode B - Load Block )               
( Copyright [ c ] 1992 by BDS Software )                        
decimal                                                         
cr cr .( Loading General Math Routines - 8 blocks )             
: thrx ( +n1 +n2 -- ) over 1- rot rot 1+ swap cr do i dup 2 pick
     - cr 3 spaces ." Loading Block " . load loop drop ;        
83 90 thrx                                                      
cr cr .( Loading Mode B Graphics Package - 22 blocks )          
113 134 thrx                                                    
cr cr .( Mode B Graphics Package LOADED. )                      
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 83

( Modified Sine Table - 1/1 )                                   
( Copyright [ c ] 1991 by BDS Software )                        
decimal 16 base !                                               
variable sintbl 5A allot                                        
: XX ( addr +n -- addr+2 ) over 2+ rot rot swap ! ;             
sintbl 0 XX 478 XX 8EF XX D66 XX 11DB XX 168C XX 1AC2 XX 1F33   
     XX 23A1 XX 280C XX 2C74 XX 30D9 XX 3539 XX 3996 XX 3DEE XX 
     4242 XX 4690 XX 4AD9 XX 4F1B XX 5358 XX 578E XX 5BBE XX    
     5FE6 XX 6407 XX 681F XX 6C30 XX 7039 XX 7438 XX 782F XX    
     7C1C XX 8000 XX 83D9 XX 87A8 XX 8B6D XX 8F27 XX 92D5 XX    
     9679 XX 9A10 XX 9D9B XX A11B XX A48D XX A7F3 XX AB4B XX    
     AE97 XX B1D4 XX B504 XX                                    
drop                                                            
forget XX                                                       
decimal                                                         
                                                                

BLOCK NUMBER 84

( Modified Cosine Table - 1/1 )                                 
( Copyright [ c ] 1991 by BDS Software )                        
decimal 16 base !                                               
variable costbl 5A allot                                        
: XX ( addr +n -- addr+2 ) over 2+ rot rot swap ! ;             
costbl FFFF XX FFF5 XX FFD7 XX FFA5 XX FF5F XX FF06 XX FE98 XX  
     FE17 XX FD81 XX FCD8 XX FC1B XX FB4B XX FA67 XX F96F XX    
     F864 XX F746 XX F614 XX F4CF XX F377 XX F20C XX F08F XX    
     EEFE XX ED5B XX EBA5 XX E9DD XX E803 XX E616 XX E418 XX    
     E208 XX DFE6 XX DDB3 XX DB6E XX D919 XX D6B2 XX D43B XX    
     D1B3 XX CF1A XX CC73 XX C9BA XX C6F2 XX C41B XX C134 XX    
     BE3E XX BB39 XX B826 XX B504 XX                            
drop                                                            
forget XX                                                       
decimal                                                         
                                                                

BLOCK NUMBER 85

( Modified Sine and Cosine with Quadrant Determination - 1/2 )  
( Copyright [ c ] 1991 by BDS Software )                        
decimal 16 base !                                               
create tsin ( angle -- n1 +n2 ) here dup 2- ! 3416 , 3706 , ED8D
     , 003D , 1083 , 005A , 2318 , 1083 , 00B4 , 2317 , 1083 ,  
     010E , 231D , CC01 , 68A3 , 8D00 , 248E , FFFF , 2017 ,    
     8E00 , 0120 , 12CC , 00B4 , A38D , 0013 , 8E00 , 0120 ,    
     0683 , 00B4 , 8EFF , FF36 , 1635 , 16AE , A16E , 9100 ,    
     0012 ,                                                     
create tcos ( angle -- n1 +n2 ) here dup 2- ! 3416 , 3706 , ED8D
     , 003D , 1083 , 005A , 2318 , 1083 , 00B4 , 2317 , 1083 ,  
     010E , 231D , CC01 , 68A3 , 8D00 , 248E , 0001 , 2017 ,    
     8E00 , 0120 , 12CC , 00B4 , A38D , 0013 , 8EFF , FF20 ,    
     0683 , 00B4 , 8EFF , FF36 , 1635 , 16AE , A16E , 9100 ,    
     0012 ,                                                     
decimal                                                         

BLOCK NUMBER 86

( Modified Sine and Cosine with Quadrant Determination - 2/2 )  
( Copyright [ c ] 1991 by BDS Software )                        
decimal 16 base !                                               
create quadd ( angle -- angle quadrant-number ) here dup 2- !   
     3416 , 3710 , 3610 , 4F5F , 5C8C , 005A , 230D , 5C8C ,    
     00B4 , 2307 , 5C8C , 010E , 2301 , 5C36 , 0635 , 16AE ,    
     A16E , 9112 ,                                              
decimal                                                         
: msin ( angle -- multiplier modified-sine ) tsin dup 45 > if 90
     swap - 2 * costbl + @ else 2 * sintbl + @ then ;           
: mcos ( angle -- multiplier modified-cosine ) tcos dup 45 > if 
     90 swap - 2 * sintbl + @ else 2 * costbl + @ then ;        
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 87

( Integer Square Root - 1/1 )                                   
( Copyright [ c ] 1991 by BDS Software ) decimal 16 base !      
create isqr ( ud -- u ) here dup 2- !   3406 , 4F5F , ED8D ,    
     00B8 , ED8D , 00BA , CCFF , FFED , 8D00 , B5ED , 8D00 ,    
     ABED , 8D00 , A920 , 12EC , 8D00 , A1A3 , 8D00 , 9B44 ,    
     56E3 , 8D00 , 95ED , 8D00 , 95DD , CBDD , CDBD , 4327 ,    
     ECC4 , 1093 , CF25 , 0D22 , 38EC , 4210 , 93D1 , 2504 ,    
     222F , 2066 , EC8D , 0078 , ED8D , 0076 , EC8D , 006E ,    
     10A3 , 8D00 , 6B25 , 10A3 , 8D00 , 6527 , 3E10 , 8300 ,    
     0127 , 38EC , 8D00 , 57ED , 8D00 , 55ED , 8D00 , 4D20 ,    
     A6EC , 8D00 , 4BED , 8D00 , 4910 , A38D , 0040 , 250C ,    
     A38D , 003A , 2715 , 1083 , 0001 , 270F , EC8D , 002E ,    
     ED8D , 002C , ED8D , 0022 , 16FF , 7CEC , 8D00 , 2310 ,    
     A38D , 001A , 2404 , ED8D , 0014 , 3706 , 3706 , EC8D ,    
     000C , 3606 , 3506 , AEA1 , 6E91 , 0000 , 0000 , 0000 ,    
     0000 , 0000 ,                             decimal          

BLOCK NUMBER 88

( Signed Full Result Multiply - 1/1 )                           
( Copyright [ c ] 1991 by BDS Software )                        
decimal                                                         
: sm* ( w1 w2 -- wd ) over over 0< swap 0< and rot rot over over
     0> swap 0> and 3 roll or  rot rot abs swap abs um* rot  not
     if dnegate then ;                                          
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 89

( 32-bit by 32-bit Unsigned Multiply - 1/2 )                    
( Copyright [ c ] 1991 by BDS Software )                        
decimal 16 base !                                               
create dum* ( ud1 ud2 -- u64 ) here dup 2- ! 3416 , 3716 ,      
     9F76 , DD74 , 3716 , 9F72 , DD70 , 0F64 , 0F65 , 0F66 ,    
     0F67 , 0F68 , 0F69 , 0F6A , 0F6B , 9673 , D677 , 3D36 ,    
     0696 , 73D6 , 763D , 3606 , 9673 , D675 , 3D36 , 06DC ,    
     733D , 3606 , 9672 , D677 , 3D36 , 0696 , 72D6 , 763D ,    
     3606 , 9672 , D675 , 3D36 , 0696 , 72D6 , 743D , 3606 ,    
     9671 , D677 , 3D36 , 0696 , 71D6 , 763D , 3606 , 9671 ,    
     D675 , 3D36 , 0696 , 71D6 , 743D , 3606 , 9670 , D677 ,    
     3D36 , 0696 , 70D6 , 763D , 3606 , 9670 , D675 , 3D36 ,    
     0696 , 70D6 , 743D , 3606 , A6C8 , 1F97 , 6BA6 , C81E ,    
     ABC8 , 1D24 , 020C , 69AB , C817 , 2402 , 0C69 , 976A ,    
     9669 , ABC8 , 1C24 , 020C , 68AB , C81B , 2402 , 0C68 ,    
     ABC8 , 1624 , 020C , 68AB , C815 , 2402 , decimal          

BLOCK NUMBER 90

( 32-bit by 32-bit Unsigned Multiply - 2/2 )                    
( Copyright [ c ] 1991 by BDS Software )                        
decimal 16 base !                              0C68 , AB4F ,    
     2402 , 0C68 , 9769 , 9668 , ABC8 , 1A24 , 020C , 67AB ,    
     C819 , 2402 , 0C67 , ABC8 , 1424 , 020C , 67AB , C813 ,    
     2402 , 0C67 , AB4E , 2402 , 0C67 , AB4D , 2404 , 0C67 ,    
     AB47 , 2402 , 0C67 , 9768 , 9667 , ABC8 , 1824 , 020C ,    
     66AB , C812 , 2402 , 0C66 , ABC8 , 1124 , 020C , 66AB ,    
     4C24 , 020C , 66AB , 4B24 , 020C , 66AB , 4624 , 020C ,    
     66AB , 4524 , 020C , 6697 , 6796 , 66AB , C810 , 2402 ,    
     0C65 , AB4A , 2402 , 0C65 , AB49 , 2402 , 0C65 , AB44 ,    
     2402 , 0C65 , AB43 , 2402 , 0C65 , 9766 , 9665 , AB48 ,    
     2402 , 0C64 , AB42 , 2402 , 0C64 , AB41 , 2402 , 0C64 ,    
     9765 , 9664 , ABC4 , 9764 , 33C8 , 209E , 6ADC , 6836 ,    
     169E , 66DC , 6436 , 1635 , 16AE , A16E , 9112 ,           
decimal                                                         

BLOCK NUMBER 91

( PMODE Graphics Word Set - Mode A - 01/22 )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
( Set 4-color mask ) C0 81 c! 30 82 c! 0C 83 c! 03 84 c!        
: pma0 ( -- ) ( 64x64f0 ) FF22 c@ 7 and 80 + FF22 c! 1 FFC1 c!  
     0 FFC2 c! 0 FFC4 c! ;                                      
: pma1 ( -- ) ( 64x64f1 ) FF22 c@ 7 and 88 + FF22 c! 1 FFC1 c!  
     0 FFC2 c! 0 FFC4 c! ;                                      
: pclsa0 ( -- ) 0BA @ 400 0 fill ;                              
: pclsa1 ( -- ) 0BA @ 400 55 fill ;                             
: pclsa2 ( -- ) 0BA @ 400 0AA fill ;                            
: pclsa3 ( -- ) 0BA @ 400 0FF fill ;                            
create pfcola0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 
     02AE , A16E , 9112 ,                                       
decimal                                                         
                                                                

BLOCK NUMBER 92

( PMODE Graphics Word Set - Mode A - 02/22 )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
create pfcola1 ( -- ) here dup 2- ! 3402 , 8601 , 97B2 , 8655 , 
     97B5 , 3502 , AEA1 , 6E91 ,                                
create pfcola2 ( -- ) here dup 2- ! 3402 , 8602 , 97B2 , 86AA , 
     97B5 , 3502 , AEA1 , 6E91 ,                                
create pfcola3 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 
     97B5 , 3502 , AEA1 , 6E91 ,                                
create pseta ( x y -- ) here dup 2- ! 3436 , 3706 , 8610 ,      
     3DD3 , BADD , B037 , 06DD , BD54 , 54D3 , B01F , 014F ,    
     C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 ,    
     B5D7 , AF9A , AFA7 , 8435 , 36AE , A16E , 9112 ,           
decimal                                                         
                                                                
                                                                

BLOCK NUMBER 93

( PMODE Graphics Word Set - Mode A - 03/22 )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create la1 ( -- ) here dup 2- ! 3436 , 1212 , DCCD , D3CD ,     
     DDD1 , 93CB , DDCF , 93CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2444 , DCCF , 1083 , 0000 , 2F0A , D3D3 , DDCF , 0CBE ,    
     0CC0 , 20E6 , D3D1 , DDCF , 0CBE , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,                  
create la2 ( -- ) here dup 2- ! 3436 , DC8A , 93CB , 93CB ,     
     DDD1 , D3CD , DDCF , D3CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2444 , DCCF , 1083 , 0000 , 2F08 , D3D1 , DDCF , 0CC0 ,    
     20E8 , D3D3 , DDCF , 0CBE , 0CC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,   decimal        

BLOCK NUMBER 94

( PMODE Graphics Word Set - Mode A - 04/22 )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create la3 ( -- ) here dup 2- ! 3436 , DC8A , 93CB , 93CB ,     
     DDD1 , 93CD , DDCF , 93CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2444 , DCCF , 1083 , 0000 , 2F0A , D3D3 , DDCF , 0ABE ,    
     0CC0 , 20E6 , D3D1 , DDCF , 0CC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,                  
create la4 ( -- ) here dup 2- ! 3436 , DC8A , 93CD , 93CD ,     
     DDD1 , 93CB , DDCF , 93CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2344 , DCCF , 1083 , 0000 , 2F08 , D3D1 , DDCF , 0ABE ,    
     20E8 , D3D3 , DDCF , 0ABE , 0CC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,   decimal        

BLOCK NUMBER 95

( PMODE Graphics Word Set - Mode A - 05/22 )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create la5 ( -- ) here dup 2- ! 3436 , DC8A , 93CD , 93CD ,     
     DDD1 , D3CB , DDCF , D3CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2344 , DCCF , 1083 , 0000 , 2C08 , D3D1 , DDCF , 0ABE ,    
     20E8 , D3D3 , DDCF , 0ABE , 0AC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,                  
create la6 ( -- ) here dup 2- ! 3436 , 1212 , DCCB , D3CB ,     
     DDD1 , 93CD , DDCF , 93CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2344 , DCCF , 1083 , 0000 , 2C0A , D3D3 , DDCF , 0ABE ,    
     0AC0 , 20E6 , D3D1 , DDCF , 0AC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,   decimal        

BLOCK NUMBER 96

( PMODE Graphics Word Set - Mode A - 06/22 )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create la7 ( -- ) here dup 2- ! 3436 , 1212 , DCCB , D3CB ,     
     DDD1 , D3CD , DDCF , D3CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2344 , DCCF , 1083 , 0000 , 2C08 , D3D1 , DDCF , 0AC0 ,    
     20E8 , D3D3 , DDCF , 0CBE , 0AC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,                  
create la8 ( -- ) here dup 2- ! 3436 , 1212 , DCCD , D3CD ,     
     DDD1 , D3CB , DDCF , D3CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2444 , DCCF , 1083 , 0000 , 2C0A , D3D3 , DDCF , 0CBE ,    
     0AC0 , 20E6 , D3D1 , DDCF , 0CBE , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 ,    
     D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 ,    
     D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 ,   decimal        

BLOCK NUMBER 97

( PMODE Graphics Word Set - Mode A - 07/22 )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
: la18 ( -- ) 0CD @ 0> if la1 else la8 then ;                   
: la27 ( -- ) 0CD @ 0> if la2 else la7 then ;                   
: la36 ( -- ) 0CD @ 0> if la3 else la6 then ;                   
: la45 ( -- ) 0CD @ 0> if la4 else la5 then ;                   
: la1845 ( -- ) 0CB @ 0> if la18 else la45 then ;               
: la2736 ( -- ) 0CB @ 0> if la27 else la36 then ;               
: plinea ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ 
     - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if la1845
     else la2736 then ;                                         
decimal                                                         
                                                                
                                                                
                                                                

BLOCK NUMBER 98

( PMODE Graphics Word Set - Mode A - 08/22 )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
create ppointa ( x y -- c ) here dup 2- ! 3436 , 3706 , 8610 ,  
     3DD3 , BADD , B037 , 06DD , BD54 , 54D3 , B01F , 014F ,    
     C603 , D4BE , CB81 , 1F02 , E6A4 , E484 , C103 , 2304 ,    
     5454 , 20F8 , 4F36 , 0635 , 36AE , A16E , 9112 ,           
decimal                                                         
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 99

( PMODE Graphics Word Set - Mode A - 09/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
variable x     variable y     variable xc    variable yc        
variable xh    variable yh    variable ea    variable eb        
variable a8  2 allot          variable b8  2 allot              
variable d1  2 allot          variable d2  2 allot              
variable de  2 allot          variable dn  2 allot              
variable dse 2 allot          variable dwn 2 allot              
: d- dnegate d+ ;                                               
: 2@ dup 2+ @ swap @ ;                                          
: 2! 2+ swap over 2- ! ! ;                                      
: sa ( angle -- quadrant# y x ) quadd swap dup msin eb @ um*    
     65535 um/mod swap drop * swap mcos ea @ um* 65535 um/mod   
     swap drop * ;                                              
                                                                

BLOCK NUMBER 100

( PMODE Graphics Word Set - Mode A - 10/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
variable xb    variable yb    variable xe    variable ye        
variable qb    variable qe    variable qcodes 6 allot           
: qs1 ( -- ) -1 qcodes ! ;      : qs2 ( -- ) -1 qcodes 2+ ! ;   
: qs3 ( -- ) -1 qcodes 4 + ! ;  : qs4 ( -- ) -1 qcodes 6 + ! ;  
: qset1 ( -- ) qe @ dup 1 = if qs1 else dup 2 = if qs1 qs2 else 
     dup 3 = if qs1 qs2 qs3 else qs1 qs2 qs3 qs4 then then then 
     drop ;                                                     
: qset2 ( -- ) qe @ dup 1 = if qs1 qs2 qs3 qs4 else dup 2 = if  
     qs2 else dup 3 = if qs2 qs3 else qs2 qs3 qs4 then then then
     drop ;                                                     
: qset3 ( -- ) qe @ dup 1 = if qs1 qs3 qs4 else dup 2 = if qs1  
     qs2 qs3 qs4 else dup 3 = if qs3 else qs3 qs4 then then then
     drop ;                                                     

BLOCK NUMBER 101

( PMODE Graphics Word Set - Mode A - 11/22 )                    
( Copyright  [ c ]  1992 by BDS Software )            decimal   
: qset4 ( -- ) qe @ dup 1 = if qs1 qs4 else dup 2 = if qs1 qs2  
     qs4 else dup 3 = if qs1 qs2 qs3 qs4 else qs4 then then then
     drop ;                                                     
: qset ( -- ) qb @ dup 1 = if qset1 else dup 2 = if qset2 else  
     dup 3 = if qset3 else qset4 then then then drop ;          
: setr ( xc yc ea eb beginning-angle ending angle -- ) 5 roll xc
     ! 4 roll yc ! 3 roll ea ! rot eb ! sa xe ! ye ! qe ! sa xb 
     ! yb ! qb ! 4 0 do i i qcodes + + 0 swap ! loop qset ;     
16 base !                                                       
create pcka ( offset-x offset-y -- [ offset-x offset-y true ]   
     or [ false ] ) here dup 2- ! 3406 , EC42 , 2D15 , 1083 ,   
     003F , 2E0F , ECC4 , 2D0B , 1083 , 003F , 2E05 , CCFF ,    
     FF20 , 0533 , 44CC , 0000 , 3606 , 3506 , AEA1 , 6E91 ,    
decimal                                                         

BLOCK NUMBER 102

( PMODE Graphics Word Set - Mode A - 12/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: psqa1 ( -- ) qcodes @ if x @ xb @ > y @ yb @ < or qb @ 1 = and
     not x @ xe @ < y @ ye @ > or qe @ 1 = and not and if x @ xc
     @ + y @ yc @ + pcka if pseta then then then ;              
: psqa2 ( -- ) qcodes 2+ @ if 0 x @ - xb @ > y @ yb @ > or qb @ 
     2 = and not 0 x @ - xe @ < y @ ye @ < or qe @ 2 = and not  
    and if xc @ x @ - y @ yc @ + pcka if pseta then then then ; 
: psqa3 ( -- ) qcodes 4 + @ if 0 x @ - xb @ < 0 y @ - yb @ > or 
     qb @ 3 = and not 0 x @ - xe @ > 0 y @ - ye @ < or qe @ 3 = 
     and not and if xc @ x @ - yc @ y @ - pcka if pseta then    
     then then ;                                                
: psqa4 ( -- ) qcodes 6 + @ if x @ xb @ < 0 y @ - yb @ < or qb @
     4 = and not x @ xe @ > 0 y @ - ye @ > or qe @ 4 = and not  
    and if x @ xc @ + yc @ y @ - pcka if pseta then then then ; 

BLOCK NUMBER 103

( PMODE Graphics Word Set - Mode A - 13/22 )                    
( Copyright  [ c ]  1992 by BDS Software )           decimal    
: psqa ( -- ) psqa1 psqa2 psqa3 psqa4 ;                         
: esu ( -- )                                 0 x ! eb @ y ! eb  
     @ dup um* 4 0 dum* drop drop ea @ dup um* eb @ 4 um* dum*  
     drop drop d- ea @ dup um* d- d1 2! eb @ dup um* 12 0 dum*  
     drop drop de 2! eb @ dup um* 12 0 dum* drop drop ea @ dup  
     um* eb @ 1- 8 um* dum* drop drop d- dse 2! ea @ dup um* 8  
     0 dum* drop drop a8 2! eb @ dup um* 8 0 dum* drop drop b8  
     2! ;                                                       
: esu1 ( -- ) x @ xh ! y @ yh ! ea @ x ! 0 y ! ea @ dup um* 4 0 
     dum* drop drop eb @ dup um* ea @ 4 um* dum* drop drop d- eb
     @ dup um* d+ d2 2! ea @ dup um* 12 0 dum* drop drop dn 2!  
     ea @ dup um* 12 0 dum* drop drop eb @ dup um* ea @ 1- 8 um*
     dum* drop drop d- dwn 2! ;                                 
                                                                

BLOCK NUMBER 104

( PMODE Graphics Word Set - Mode A - 14/22 )                    
( Copyright  [ c ]  1992 by BDS Software )           decimal    
: eq ( -- flag ) x @ xh @ = y @ yh @ = and x @ xh @ < or y @ yh 
     @ > or not ;                                               
: el1 ( -- ) d1 2@ 0 0 d< if de 2@ d1 2@ d+ d1 2! b8 2@ de 2@ d+
     de 2! b8 2@ dse 2@ d+ dse 2! 1 x +! else dse 2@ d1 2@ d+ d1
     2! b8 2@ de 2@ d+ de 2! a8 2@ b8 2@ d+ dse 2@ d+ dse 2! 1 x
     +! -1 y +! then psqa ;                                     
: el2 ( -- ) d2 2@ 0 0 d< if dn 2@ d2 2@ d+ d2 2! a8 2@ dn 2@ d+
     dn 2! a8 2@ dwn 2@ d+ dwn 2! 1 y +! else dwn 2@ d2 2@ d+ d2
     2! a8 2@ dn 2@ d+ dn 2! a8 2@ b8 2@ d+ dwn 2@ d+ dwn 2! -1 
     x +! 1 y +! then psqa ;                                    
: pellipsea ( xc yc ea eb ba qa -- ) setr esu psqa begin dse    
     2@ 0 0 d< while el1 repeat esu1 psqa begin eq while el2    
     repeat ;                                                   
                                                                

BLOCK NUMBER 105

( PMODE Graphics Word Set - Mode A - 15/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: pdlinea ( x0 y0 r angle -- xn yn ) swap dup ea ! eb ! sa rot  
     drop 3 pick + rot rot over + swap 3 roll swap 3 pick 3 pick
     plinea ;                                                   
: pquita ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1      
     65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 !    
     pfcola0 ;                                                  
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 106

( PMODE Graphics Word Set - Mode A - 16/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
variable rx    variable lx    variable dadr  variable dadl      
variable dir   variable wasin                                   
create gpush ( left right dadl dadr y dir -- ) here dup 2- !    
     3416 , 9E88 , 3706 , ED83 , 3706 , ED83 , 3706 , ED83 ,    
     3706 , ED83 , 3706 , ED83 , 3706 , ED83 , 9F88 , 3516 ,    
     AEA1 , 6E91 ,                                              
create gpull ( -- left right dadl dadr y dir ) here dup 2- !    
     3416 , 9E88 , EC81 , 3606 , EC81 , 3606 , EC81 , 3606 ,    
     EC81 , 3606 , EC81 , 3606 , EC81 , 3606 , 9F88 , 3516 ,    
     AEA1 , 6E91 ,                                              
: gpop ( -- ) gpull dir ! y ! dadr ! dadl ! rx ! lx ! ;         
decimal                                                         
                                                                

BLOCK NUMBER 107

( PMODE Graphics Word Set - Mode A - 17/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: putr ( -- ) rx @ dadr @ 1+ > if dadr @ 1+ rx @ lx @ 1- rx @ 1+
     y @ dir @ - dir @ negate gpush then ;                      
: putl ( -- ) lx @ dadl @ 1- < if lx @ dadl @ 1- lx @ 1- rx @ 1+
     y @ dir @ - dir @ negate gpush then ;                      
: pstack ( -- ) wasin @ if lx @ rx @ lx @ 1- rx @ 1+ y @ dir @ +
     dir @ gpush putr putl then ;                               
: psetac ( current-color# x y -- ) rot 178 c@ = not if pseta -1 
     wasin ! else drop drop then ;                              
: psetal ( -- xl ) begin x @ dup 0< not swap y @ ppointa dup 134
     @ = not rot and while x @ y @ psetac -1 x +! repeat drop x 
     @ 1+ ;                                                     
                                                                
                                                                

BLOCK NUMBER 108

( PMODE Graphics Word Set - Mode A - 18/22 )                    
( Copyright  [ c ]  1992 by BDS Software )     decimal          
: psetar ( -- xl ) begin x @ dup  63 > not swap y @ ppointa dup 
     134 @ = not rot and while x @ y @ psetac 1 x +! repeat drop
     x @ 1- ;      : psetalr ( -- ) 0 wasin ! x @ 1+ psetal lx !
     x ! psetar dup rx @ swap rx ! pstack rx ! 1+ x ! ;         
: pmra ( -- ) begin x @ dup dup  63 > not swap y @ ppointa 134 @
     = rot rx @ 1- > not and and while 1 x +! repeat ;          
: pmrta ( -- ) 0 wasin ! pmra x @ dup rx @ 1- > not if lx !     
     psetar dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then
     ;     : pmlba ( -- ) x @ y @ ppointa 134 @ = if pmrta then 
     ;     : pmlaa ( -- ) lx @ x ! pmlba x @ dup 0< not swap y @
     ppointa 134 @ = not and if psetalr then begin x @ rx @ 1- >
     not while pmrta repeat ;                                   
: pmloopa ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not  
     swap  63 > not and if pmlaa then repeat ;                  

BLOCK NUMBER 109

( PMODE Graphics Word Set - Mode A - 19/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: ppainta ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ 
     psetal lx ! x ! psetar 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y 
     @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush     
     pmloopa ;                                                  
16 base !                                                       
: pstora ( +n  -- ) block 0BA @ swap 400 cmove update flush ;   
: ploada ( +n  -- ) block 0BA @ 400 cmove ;                     
decimal                                                         
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 110

( PMODE Graphics Word Set - Mode A - 20/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
create wclrva ( xul yul xlr ylr color -- sb lb code nl ) here   
     dup 2- ! 3416 , EC42 , A346 , 3406 , 3706 , 8655 , 3D34 ,  
     06EC , 42A3 , 4654 , 5434 , 0637 , 1637 , 0686 , 103D ,    
     1F01 , 3706 , 5454 , 3A1F , 10D3 , BA36 , 0635 , 0636 ,    
     0635 , 0636 , 0635 , 0636 , 0635 , 16AE , A16E , 9112 ,    
create xclra ( sb1 lb code -- sb2 lb code sb1 lb code ) here dup
     2- ! 3406 , EC44 , 3606 , C300 , 10ED , 46EC , 4436 ,      
     06EC , 4436 , 0635 , 06AE , A16E , 9112 ,                  
decimal                                                         
: pclra ( xul yul xlr ylr color -- ) wclrva 0 do xclra fill loop
     drop drop drop ;                                           
                                                                
                                                                

BLOCK NUMBER 111

( PMODE Graphics Word Set - Mode A - 21/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
create dbsra ( xul yul xlr ylr -- bsr nl lb ) here dup 2- !     
     3416 , EC42 , A346 , 5454 , 3406 , 3716 , A3C4 , C300 ,    
     0134 , 0637 , 16A6 , 61E6 , 633D , 3606 , 3516 , 1E01 ,    
     3616 , 3516 , AEA1 , 6E91 ,                                
decimal                                                         
: pmakea ( xul yul xlr ylr -- ) dbsra create , , allot ;        
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 112

( PMODE Graphics Word Set - Mode A - 22/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
create wconva ( xul yul tb -- sb tb4 lb nl ) here dup 2- !      
     3436 , 3720 , 3706 , 8610 , 3D1F , 0137 , 0654 , 543A ,    
     1F10 , D3BA , 3606 , AEA4 , EC22 , 3124 , 3636 , 3536 ,    
     AEA1 , 6E91 ,                                              
create xcpya ( sb1 tb1 lb -- sb2 tb2 lb sb1 tb1 lb ) here dup   
     2- ! 3406 , EC44 , 3606 , C300 , 10ED , 46EC , 4436 ,      
     06E3 , 44ED , 46EC , 4436 , 0635 , 06AE , A16E , 9112 ,    
decimal                                                         
: pputa ( xul yul tb -- ) wconva 0 do xcpya cmove loop drop drop
     drop ;                                                     
: pgeta ( xul yul tb -- ) wconva 0 do xcpya swap rot rot cmove  
     loop drop drop drop ;                                      
                                                                

BLOCK NUMBER 113

( PMODE Graphics Word Set - Mode B - 01/xx )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
( Set 2-color mask ) 8040 79 ! 2010 7B ! 0804 7D ! 0201 7F !    
: pmb0 ( -- ) ( 128x64t0 ) FF22 c@ 7 and 90 + FF22 c! 1 FFC1 c! 
      0 FFC2 c! 0 FFC4 c! ;                                     
: pmb1 ( -- ) ( 128x64t1 ) FF22 c@ 7 and 98 + FF22 c! 1 FFC1 c! 
      0 FFC2 c! 0 FFC4 c! ;                                     
: pclsb0 ( -- ) 0BA @ 400 0 fill ;                              
                                                                
                                                                
: pclsb1 ( -- ) 0BA @ 400 0FF fill ;                            
create pfcolb0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 
     02AE , A16E , 9112 ,                                       
decimal                                                         
                                                                

BLOCK NUMBER 114

( PMODE Graphics Word Set - Mode B - 02/xx )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
                                                                
                                                                
                                                                
                                                                
create pfcolb1 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 
     97B5 , 3502 , AEA1 , 6E91 ,                                
create psetb ( x y -- ) here dup 2- ! 3436 , 3706 , 8610 ,      
     3DD3 , BADD , B037 , 06DD , BD54 , 5454 , D3B0 , 1F01 ,    
     4FC6 , 07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 ,    
     D4B5 , D7AF , 9AAF , A784 , 3536 , AEA1 , 6E91 ,           
decimal                                                         
                                                                
                                                                

BLOCK NUMBER 115

( PMODE Graphics Word Set - Mode B - 03/xx )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create lb1 ( -- ) here dup 2- ! 3436 , 1212 , DCCD , D3CD ,     
     DDD1 , 93CB , DDCF , 93CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2445 , DCCF , 1083 , 0000 , 2F0A , D3D3 , DDCF , 0CBE ,    
     0CC0 , 20E6 , D3D1 , DDCF , 0CBE , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 ,           
create lb2 ( -- ) here dup 2- ! 3436 , DC8A , 93CB , 93CB ,     
     DDD1 , D3CD , DDCF , D3CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2445 , DCCF , 1083 , 0000 , 2F08 , D3D1 , DDCF , 0CC0 ,    
     20E8 , D3D3 , DDCF , 0CBE , 0CC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , decimal   

BLOCK NUMBER 116

( PMODE Graphics Word Set - Mode B - 04/xx )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create lb3 ( -- ) here dup 2- ! 3436 , DC8A , 93CB , 93CB ,     
     DDD1 , 93CD , DDCF , 93CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2445 , DCCF , 1083 , 0000 , 2F0A , D3D3 , DDCF , 0ABE ,    
     0CC0 , 20E6 , D3D1 , DDCF , 0CC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 ,           
create lb4 ( -- ) here dup 2- ! 3436 , DC8A , 93CD , 93CD ,     
     DDD1 , 93CB , DDCF , 93CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2345 , DCCF , 1083 , 0000 , 2F08 , D3D1 , DDCF , 0ABE ,    
     20E8 , D3D3 , DDCF , 0ABE , 0CC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , decimal   

BLOCK NUMBER 117

( PMODE Graphics Word Set - Mode B - 05/xx )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create lb5 ( -- ) here dup 2- ! 3436 , DC8A , 93CD , 93CD ,     
     DDD1 , D3CB , DDCF , D3CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2345 , DCCF , 1083 , 0000 , 2C08 , D3D1 , DDCF , 0ABE ,    
     20E8 , D3D3 , DDCF , 0ABE , 0AC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 ,           
create lb6 ( -- ) here dup 2- ! 3436 , 1212 , DCCB , D3CB ,     
     DDD1 , 93CD , DDCF , 93CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2345 , DCCF , 1083 , 0000 , 2C0A , D3D3 , DDCF , 0ABE ,    
     0AC0 , 20E6 , D3D1 , DDCF , 0AC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , decimal   

BLOCK NUMBER 118

( PMODE Graphics Word Set - Mode B - 06/xx )                    
( Copyright [ c ] 1992 by BDS Software ) decimal 16 base !      
create lb7 ( -- ) here dup 2- ! 3436 , 1212 , DCCB , D3CB ,     
     DDD1 , D3CD , DDCF , D3CD , DDD3 , 8D20 , 96C0 , 91C6 ,    
     2345 , DCCF , 1083 , 0000 , 2C08 , D3D1 , DDCF , 0AC0 ,    
     20E8 , D3D3 , DDCF , 0CBE , 0AC0 , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 ,           
create lb8 ( -- ) here dup 2- ! 3436 , 1212 , DCCD , D3CD ,     
     DDD1 , D3CB , DDCF , D3CB , DDD3 , 8D20 , 96BE , 91C4 ,    
     2445 , DCCF , 1083 , 0000 , 2C0A , D3D3 , DDCF , 0CBE ,    
     0AC0 , 20E6 , D3D1 , DDCF , 0CBE , 20DE , D6C0 , 8610 ,    
     3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 ,    
     07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 ,    
     D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , decimal   

BLOCK NUMBER 119

( PMODE Graphics Word Set - Mode B - 07/xx )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
: lb18 ( -- ) 0CD @ 0> if lb1 else lb8 then ;                   
: lb27 ( -- ) 0CD @ 0> if lb2 else lb7 then ;                   
: lb36 ( -- ) 0CD @ 0> if lb3 else lb6 then ;                   
: lb45 ( -- ) 0CD @ 0> if lb4 else lb5 then ;                   
: lb1845 ( -- ) 0CB @ 0> if lb18 else lb45 then ;               
: lb2736 ( -- ) 0CB @ 0> if lb27 else lb36 then ;               
: plineb ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ 
     - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if lb1845
     else lb2736 then ;                                         
decimal                                                         
                                                                
                                                                
                                                                

BLOCK NUMBER 120

( PMODE Graphics Word Set - Mode B - 08/xx )                    
( Copyright [ c ] 1992 by BDS Software )                        
decimal 16 base !                                               
create ppointb ( x y -- c ) here dup 2- ! 3436 , 3706 , 8610 ,  
     3DD3 , BADD , B037 , 06DD , BD54 , 5454 , D3B0 , 1F01 ,    
     4FC6 , 07D4 , BECB , 791F , 02E6 , A4E4 , 84C1 , 0123 ,    
     0354 , 20F9 , 4F36 , 0635 , 36AE , A16E , 9112 ,           
decimal                                                         
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 121

( PMODE Graphics Word Set - Mode B - 09/xx )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
variable x     variable y     variable xc    variable yc        
variable xh    variable yh    variable ea    variable eb        
variable a8  2 allot          variable b8  2 allot              
variable d1  2 allot          variable d2  2 allot              
variable de  2 allot          variable dn  2 allot              
variable dse 2 allot          variable dwn 2 allot              
: d- dnegate d+ ;                                               
: 2@ dup 2+ @ swap @ ;                                          
: 2! 2+ swap over 2- ! ! ;                                      
: sa ( angle -- quadrant# y x ) quadd swap dup msin eb @ um*    
     65535 um/mod swap drop * swap mcos ea @ um* 65535 um/mod   
     swap drop * ;                                              
                                                                

BLOCK NUMBER 122

( PMODE Graphics Word Set - Mode B - 10/xx )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
variable xb    variable yb    variable xe    variable ye        
variable qb    variable qe    variable qcodes 6 allot           
: qs1 ( -- ) -1 qcodes ! ;      : qs2 ( -- ) -1 qcodes 2+ ! ;   
: qs3 ( -- ) -1 qcodes 4 + ! ;  : qs4 ( -- ) -1 qcodes 6 + ! ;  
: qset1 ( -- ) qe @ dup 1 = if qs1 else dup 2 = if qs1 qs2 else 
     dup 3 = if qs1 qs2 qs3 else qs1 qs2 qs3 qs4 then then then 
     drop ;                                                     
: qset2 ( -- ) qe @ dup 1 = if qs1 qs2 qs3 qs4 else dup 2 = if  
     qs2 else dup 3 = if qs2 qs3 else qs2 qs3 qs4 then then then
     drop ;                                                     
: qset3 ( -- ) qe @ dup 1 = if qs1 qs3 qs4 else dup 2 = if qs1  
     qs2 qs3 qs4 else dup 3 = if qs3 else qs3 qs4 then then then
     drop ;                                                     

BLOCK NUMBER 123

( PMODE Graphics Word Set - Mode B - 11/xx )                    
( Copyright  [ c ]  1992 by BDS Software )            decimal   
: qset4 ( -- ) qe @ dup 1 = if qs1 qs4 else dup 2 = if qs1 qs2  
     qs4 else dup 3 = if qs1 qs2 qs3 qs4 else qs4 then then then
     drop ;                                                     
: qset ( -- ) qb @ dup 1 = if qset1 else dup 2 = if qset2 else  
     dup 3 = if qset3 else qset4 then then then drop ;          
: setr ( xc yc ea eb beginning-angle ending angle -- ) 5 roll xc
     ! 4 roll yc ! 3 roll ea ! rot eb ! sa xe ! ye ! qe ! sa xb 
     ! yb ! qb ! 4 0 do i i qcodes + + 0 swap ! loop qset ;     
16 base !                                                       
create pckb ( offset-x offset-y -- [ offset-x offset-y true ]   
     or [ false ] ) here dup 2- ! 3406 , EC42 , 2D15 , 1083 ,   
     007F , 2E0F , ECC4 , 2D0B , 1083 , 003F , 2E05 , CCFF ,    
     FF20 , 0533 , 44CC , 0000 , 3606 , 3506 , AEA1 , 6E91 ,    
decimal                                                         

BLOCK NUMBER 124

( PMODE Graphics Word Set - Mode B - 12/xx )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: psqb1 ( -- ) qcodes @ if x @ xb @ > y @ yb @ < or qb @ 1 = and
     not x @ xe @ < y @ ye @ > or qe @ 1 = and not and if x @ xc
     @ + y @ yc @ + pckb if psetb then then then ;              
: psqb2 ( -- ) qcodes 2+ @ if 0 x @ - xb @ > y @ yb @ > or qb @ 
     2 = and not 0 x @ - xe @ < y @ ye @ < or qe @ 2 = and not  
    and if xc @ x @ - y @ yc @ + pckb if psetb then then then ; 
: psqb3 ( -- ) qcodes 4 + @ if 0 x @ - xb @ < 0 y @ - yb @ > or 
     qb @ 3 = and not 0 x @ - xe @ > 0 y @ - ye @ < or qe @ 3 = 
     and not and if xc @ x @ - yc @ y @ - pckb if psetb then    
     then then ;                                                
: psqb4 ( -- ) qcodes 6 + @ if x @ xb @ < 0 y @ - yb @ < or qb @
     4 = and not x @ xe @ > 0 y @ - ye @ > or qe @ 4 = and not  
    and if x @ xc @ + yc @ y @ - pckb if psetb then then then ; 

BLOCK NUMBER 125

( PMODE Graphics Word Set - Mode B - 13/xx )                    
( Copyright  [ c ]  1992 by BDS Software )           decimal    
: psqb ( -- ) psqb1 psqb2 psqb3 psqb4 ;                         
: esu ( -- )                                 0 x ! eb @ y ! eb  
     @ dup um* 4 0 dum* drop drop ea @ dup um* eb @ 4 um* dum*  
     drop drop d- ea @ dup um* d- d1 2! eb @ dup um* 12 0 dum*  
     drop drop de 2! eb @ dup um* 12 0 dum* drop drop ea @ dup  
     um* eb @ 1- 8 um* dum* drop drop d- dse 2! ea @ dup um* 8  
     0 dum* drop drop a8 2! eb @ dup um* 8 0 dum* drop drop b8  
     2! ;                                                       
: esu1 ( -- ) x @ xh ! y @ yh ! ea @ x ! 0 y ! ea @ dup um* 4 0 
     dum* drop drop eb @ dup um* ea @ 4 um* dum* drop drop d- eb
     @ dup um* d+ d2 2! ea @ dup um* 12 0 dum* drop drop dn 2!  
     ea @ dup um* 12 0 dum* drop drop eb @ dup um* ea @ 1- 8 um*
     dum* drop drop d- dwn 2! ;                                 
                                                                

BLOCK NUMBER 126

( PMODE Graphics Word Set - Mode B - 14/xx )                    
( Copyright  [ c ]  1992 by BDS Software )           decimal    
: eq ( -- flag ) x @ xh @ = y @ yh @ = and x @ xh @ < or y @ yh 
     @ > or not ;                                               
: el1 ( -- ) d1 2@ 0 0 d< if de 2@ d1 2@ d+ d1 2! b8 2@ de 2@ d+
     de 2! b8 2@ dse 2@ d+ dse 2! 1 x +! else dse 2@ d1 2@ d+ d1
     2! b8 2@ de 2@ d+ de 2! a8 2@ b8 2@ d+ dse 2@ d+ dse 2! 1 x
     +! -1 y +! then psqb ;                                     
: el2 ( -- ) d2 2@ 0 0 d< if dn 2@ d2 2@ d+ d2 2! a8 2@ dn 2@ d+
     dn 2! a8 2@ dwn 2@ d+ dwn 2! 1 y +! else dwn 2@ d2 2@ d+ d2
     2! a8 2@ dn 2@ d+ dn 2! a8 2@ b8 2@ d+ dwn 2@ d+ dwn 2! -1 
     x +! 1 y +! then psqb ;                                    
: pellipseb ( xc yc ea eb ba qa -- ) setr esu psqb begin dse    
     2@ 0 0 d< while el1 repeat esu1 psqb begin eq while el2    
     repeat ;                                                   
                                                                

BLOCK NUMBER 127

( PMODE Graphics Word Set - Mode B - 15/xx )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: pdlineb ( x0 y0 r angle -- xn yn ) swap dup ea ! eb ! sa rot  
     drop 3 pick + rot rot over + swap 3 roll swap 3 pick 3 pick
     plineb ;                                                   
: pquitb ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1      
     65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 !    
     pfcolb0 ;                                                  
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 128

( PMODE Graphics Word Set - Mode B - 16/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
variable rx    variable lx    variable dadr  variable dadl      
variable dir   variable wasin                                   
create gpush ( left right dadl dadr y dir -- ) here dup 2- !    
     3416 , 9E88 , 3706 , ED83 , 3706 , ED83 , 3706 , ED83 ,    
     3706 , ED83 , 3706 , ED83 , 3706 , ED83 , 9F88 , 3516 ,    
     AEA1 , 6E91 ,                                              
create gpull ( -- left right dadl dadr y dir ) here dup 2- !    
     3416 , 9E88 , EC81 , 3606 , EC81 , 3606 , EC81 , 3606 ,    
     EC81 , 3606 , EC81 , 3606 , EC81 , 3606 , 9F88 , 3516 ,    
     AEA1 , 6E91 ,                                              
: gpop ( -- ) gpull dir ! y ! dadr ! dadl ! rx ! lx ! ;         
decimal                                                         
                                                                

BLOCK NUMBER 129

( PMODE Graphics Word Set - Mode B - 17/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: putr ( -- ) rx @ dadr @ 1+ > if dadr @ 1+ rx @ lx @ 1- rx @ 1+
     y @ dir @ - dir @ negate gpush then ;                      
: putl ( -- ) lx @ dadl @ 1- < if lx @ dadl @ 1- lx @ 1- rx @ 1+
     y @ dir @ - dir @ negate gpush then ;                      
: pstack ( -- ) wasin @ if lx @ rx @ lx @ 1- rx @ 1+ y @ dir @ +
     dir @ gpush putr putl then ;                               
: psetbc ( current-color# x y -- ) rot 178 c@ = not if psetb -1 
     wasin ! else drop drop then ;                              
: psetbl ( -- xl ) begin x @ dup 0< not swap y @ ppointb dup 134
     @ = not rot and while x @ y @ psetbc -1 x +! repeat drop x 
     @ 1+ ;                                                     
                                                                
                                                                

BLOCK NUMBER 130

( PMODE Graphics Word Set - Mode B - 18/22 )                    
( Copyright  [ c ]  1992 by BDS Software )     decimal          
: psetbr ( -- xl ) begin x @ dup 127 > not swap y @ ppointb dup 
     134 @ = not rot and while x @ y @ psetbc 1 x +! repeat drop
     x @ 1- ;      : psetblr ( -- ) 0 wasin ! x @ 1+ psetbl lx !
     x ! psetbr dup rx @ swap rx ! pstack rx ! 1+ x ! ;         
: pmrb ( -- ) begin x @ dup dup 127 > not swap y @ ppointb 134 @
     = rot rx @ 1- > not and and while 1 x +! repeat ;          
: pmrtb ( -- ) 0 wasin ! pmrb x @ dup rx @ 1- > not if lx !     
     psetbr dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then
     ;     : pmlbb ( -- ) x @ y @ ppointb 134 @ = if pmrtb then 
     ;     : pmlab ( -- ) lx @ x ! pmlbb x @ dup 0< not swap y @
     ppointb 134 @ = not and if psetblr then begin x @ rx @ 1- >
     not while pmrtb repeat ;                                   
: pmloopb ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not  
     swap  63 > not and if pmlab then repeat ;                  

BLOCK NUMBER 131

( PMODE Graphics Word Set - Mode B - 19/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: ppaintb ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ 
     psetbl lx ! x ! psetbr 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y 
     @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush     
     pmloopb ;                                                  
16 base !                                                       
: pstorb ( +n  -- ) block 0BA @ swap 400 cmove update flush ;   
: ploadb ( +n  -- ) block 0BA @ 400 cmove ;                     
decimal                                                         
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 132

( PMODE Graphics Word Set - Mode B - 20/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
create wclrvb ( xul yul xlr ylr color -- sb lb code nl ) here   
     dup 2- ! 3416 , EC42 , A346 , 3406 , 3706 , 8655 , 3D34 ,  
     06EC , 42A3 , 4654 , 5454 , 3406 , 3716 , 3706 , 8610 ,    
     3D1F , 0137 , 0654 , 5454 , 3A1F , 10D3 , BA36 , 0635 ,    
     0636 , 0635 , 0636 , 0635 , 0636 , 0635 , 16AE , A16E ,    
     9112 ,                                                     
create xclrb ( sb1 lb code -- sb2 lb code sb1 lb code ) here dup
     2- ! 3406 , EC44 , 3606 , C300 , 10ED , 46EC , 4436 ,      
     06EC , 4436 , 0635 , 06AE , A16E , 9112 ,                  
decimal                                                         
: pclrb ( xul yul xlr ylr color -- ) wclrvb 0 do xclrb fill loop
     drop drop drop ;                                           
                                                                

BLOCK NUMBER 133

( PMODE Graphics Word Set - Mode B - 21/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
create dbsrb ( xul yul xlr ylr -- bsr nl lb ) here dup 2- !     
     3416 , EC42 , A346 , 5454 , 5434 , 0637 , 16A3 , C4C3 ,    
     0001 , 3406 , 3716 , A661 , E663 , 3D36 , 0635 , 161E ,    
     0136 , 1635 , 16AE , A16E , 9112 ,                         
decimal                                                         
: pmakeb ( xul yul xlr ylr -- ) dbsrb create , , allot ;        
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 134

( PMODE Graphics Word Set - Mode B - 22/22 )                    
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
create wconvb ( xul yul tb -- sb tb4 lb nl ) here dup 2- !      
     3436 , 3720 , 3706 , 8610 , 3D1F , 0137 , 0654 , 5454 ,    
     3A1F , 10D3 , BA36 , 06AE , A4EC , 2231 , 2436 , 3635 ,    
     36AE , A16E , 9112 ,                                       
create xcpyb ( sb1 tb1 lb -- sb2 tb2 lb sb1 tb1 lb ) here dup   
     2- ! 3406 , EC44 , 3606 , C300 , 10ED , 46EC , 4436 ,      
     06E3 , 44ED , 46EC , 4436 , 0635 , 06AE , A16E , 9112 ,    
decimal                                                         
: pputb ( xul yul tb -- ) wconvb 0 do xcpyb cmove loop drop drop
     drop ;                                                     
: pgetb ( xul yul tb -- ) wconvb 0 do xcpyb swap rot rot cmove  
     loop drop drop drop ;