BLOCK NUMBER 1 ( PMODE Graphics Word Set - Mode C - 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 ; 7 14 thrx cr cr .( Loading Mode C Graphics Package - 22 blocks ) 15 36 thrx cr cr .( Mode C Graphics Package LOADED. ) BLOCK NUMBER 2 ( PMODE Graphics Word Set - Mode D - 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 ; 7 14 thrx cr cr .( Loading Mode D Graphics Package - 22 blocks ) 37 58 thrx cr cr .( Mode D Graphics Package LOADED. ) BLOCK NUMBER 3 ( PMODE Graphics Word Set - Mode E - 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 ; 7 14 thrx cr cr .( Loading Mode E Graphics Package - 22 blocks ) 59 80 thrx cr cr .( Mode E Graphics Package LOADED. ) BLOCK NUMBER 4 ( PMODE Graphics Word Set - Mode F - 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 ; 7 14 thrx cr cr .( Loading Mode F Graphics Package - 22 blocks ) 81 102 thrx cr cr .( Mode F Graphics Package LOADED. ) BLOCK NUMBER 5 ( PMODE Graphics Word Set - Mode G - 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 ; 7 14 thrx cr cr .( Loading Mode G Graphics Package - 22 blocks ) 103 124 thrx cr cr .( Mode G Graphics Package LOADED. ) BLOCK NUMBER 6 ( PMODE Graphics Word Set - Mode H - 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 ; 7 14 thrx cr cr .( Loading Mode H Graphics Package - 22 blocks ) 125 146 thrx cr cr .( Mode H Graphics Package LOADED. ) BLOCK NUMBER 7 ( 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 8 ( 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 9 ( 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 10 ( 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 11 ( 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 12 ( 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 13 ( 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 14 ( 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 15 ( PMODE Graphics Word Set - Mode C - 01/xx ) ( 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! : pmc0 ( -- ) ( 128x64f0 ) FF22 c@ 7 and 0A0 + FF22 c! 0 FFC0 c! 1 FFC3 c! 0 FFC4 c! ; : pmc1 ( -- ) ( 128x64f1 ) FF22 c@ 7 and 0A8 + FF22 c! 0 FFC0 c! 1 FFC3 c! 0 FFC4 c! ; : pclsc0 ( -- ) 0BA @ 800 0 fill ; : pclsc1 ( -- ) 0BA @ 800 55 fill ; : pclsc2 ( -- ) 0BA @ 800 0AA fill ; : pclsc3 ( -- ) 0BA @ 800 0FF fill ; create pfcolc0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 02AE , A16E , 9112 , decimal BLOCK NUMBER 16 ( PMODE Graphics Word Set - Mode C - 02/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create pfcolc1 ( -- ) here dup 2- ! 3402 , 8601 , 97B2 , 8655 , 97B5 , 3502 , AEA1 , 6E91 , create pfcolc2 ( -- ) here dup 2- ! 3402 , 8602 , 97B2 , 86AA , 97B5 , 3502 , AEA1 , 6E91 , create pfcolc3 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 97B5 , 3502 , AEA1 , 6E91 , create psetc ( x y -- ) here dup 2- ! 3436 , 3706 , 8620 , 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 17 ( PMODE Graphics Word Set - Mode C - 03/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lc1 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lc2 ( -- ) 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 , 8620 , 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 18 p PMODE Graphics Word Set - Mode C - 04/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lc3 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lc4 ( -- ) 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 , 8620 , 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 19 ( PMODE Graphics Word Set - Mode C - 05/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lc5 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lc6 ( -- ) 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 , 8620 , 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 20 ( PMODE Graphics Word Set - Mode C - 06/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lc7 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lc8 ( -- ) 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 , 8620 , 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 21 ( PMODE Graphics Word Set - Mode C - 07/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! : lc18 ( -- ) 0CD @ 0> if lc1 else lc8 then ; : lc27 ( -- ) 0CD @ 0> if lc2 else lc7 then ; : lc36 ( -- ) 0CD @ 0> if lc3 else lc6 then ; : lc45 ( -- ) 0CD @ 0> if lc4 else lc5 then ; : lc1845 ( -- ) 0CB @ 0> if lc18 else lc45 then ; : lc2736 ( -- ) 0CB @ 0> if lc27 else lc36 then ; : plinec ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if lc1845 else lc2736 then ; decimal BLOCK NUMBER 22 ( PMODE Graphics Word Set - Mode C - 08/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ppointc ( x y -- c ) here dup 2- ! 3436 , 3706 , 8620 , 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 23 ( PMODE Graphics Word Set - Mode C - 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 24 ( PMODE Graphics Word Set - Mode C - 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 25 ( PMODE Graphics Word Set - Mode C - 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 pckc ( 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 26 ( PMODE Graphics Word Set - Mode C - 12/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqc1 ( -- ) 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 @ + pckc if psetc then then then ; : psqc2 ( -- ) 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 @ + pckc if psetc then then then ; : psqc3 ( -- ) 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 @ - pckc if psetc then then then ; : psqc4 ( -- ) 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 @ - pckc if psetc then then then ; BLOCK NUMBER 27 ( PMODE Graphics Word Set - Mode C - 13/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqc ( -- ) psqc1 psqc2 psqc3 psqc4 ; : 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 28 ( PMODE Graphics Word Set - Mode C - 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 psqc ; : 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 psqc ; : pellipsec ( xc yc ea eb ba qa -- ) setr esu psqc begin dse 2@ 0 0 d< while el1 repeat esu1 psqc begin eq while el2 repeat ; BLOCK NUMBER 29 ( PMODE Graphics Word Set - Mode C - 15/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : pdlinec ( 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 plinec ; : pquitc ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1 65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 ! pfcolc0 ; BLOCK NUMBER 30 ( PMODE Graphics Word Set - Mode C - 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 31 ( PMODE Graphics Word Set - Mode C - 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 ; : psetcc ( current-color# x y -- ) rot 178 c@ = not if psetc -1 wasin ! else drop drop then ; : psetcl ( -- xl ) begin x @ dup 0< not swap y @ ppointc dup 134 @ = not rot and while x @ y @ psetcc -1 x +! repeat drop x @ 1+ ; BLOCK NUMBER 32 ( PMODE Graphics Word Set - Mode C - 18/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psetcr ( -- xl ) begin x @ dup 127 > not swap y @ ppointc dup 134 @ = not rot and while x @ y @ psetcc 1 x +! repeat drop x @ 1- ; : psetclr ( -- ) 0 wasin ! x @ 1+ psetcl lx ! x ! psetcr dup rx @ swap rx ! pstack rx ! 1+ x ! ; : pmrc ( -- ) begin x @ dup dup 127 > not swap y @ ppointc 134 @ = rot rx @ 1- > not and and while 1 x +! repeat ; : pmrtc ( -- ) 0 wasin ! pmrc x @ dup rx @ 1- > not if lx ! psetcr dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then ; : pmlbc ( -- ) x @ y @ ppointc 134 @ = if pmrtc then ; : pmlac ( -- ) lx @ x ! pmlbc x @ dup 0< not swap y @ ppointc 134 @ = not and if psetclr then begin x @ rx @ 1- > not while pmrtc repeat ; : pmloopc ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not swap 63 > not and if pmlac then repeat ; BLOCK NUMBER 33 ( PMODE Graphics Word Set - Mode C - 19/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : ppaintc ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ psetcl lx ! x ! psetcr 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush pmloopc ; 16 base ! : pstorc ( +n -- ) dup dup 2+ swap do i block i 2 pick - 400 * 0BA @ + swap 400 cmove update loop flush drop ; : ploadc ( +n -- ) dup dup 2+ swap do i block i 2 pick - 400 * 0BA @ + 400 cmove loop drop ; decimal BLOCK NUMBER 34 ( PMODE Graphics Word Set - Mode C - 20/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wclrvc ( 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 , 203D , 1F01 , 3706 , 5454 , 3A1F , 10D3 , BA36 , 0635 , 0636 , 0635 , 0636 , 0635 , 0636 , 0635 , 16AE , A16E , 9112 , create xclrc ( sb1 lb code -- sb2 lb code sb1 lb code ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : pclrc ( xul yul xlr ylr color -- ) wclrvc 0 do xclrc fill loop drop drop drop ; BLOCK NUMBER 35 ( PMODE Graphics Word Set - Mode C - 21/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create dbsrc ( 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 : pmakec ( xul yul xlr ylr -- ) dbsrc create , , allot ; BLOCK NUMBER 36 ( PMODE Graphics Word Set - Mode C - 22/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wconvc ( xul yul tb -- sb tb4 lb nl ) here dup 2- ! 3436 , 3720 , 3706 , 8620 , 3D1F , 0137 , 0654 , 543A , 1F10 , D3BA , 3606 , AEA4 , EC22 , 3124 , 3636 , 3536 , AEA1 , 6E91 , create xcpyc ( sb1 tb1 lb -- sb2 tb2 lb sb1 tb1 lb ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06E3 , 44ED , 46EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : pputc ( xul yul tb -- ) wconvc 0 do xcpyc cmove loop drop drop drop ; : pgetc ( xul yul tb -- ) wconvc 0 do xcpyc swap rot rot cmove loop drop drop drop ; BLOCK NUMBER 37 ( PMODE Graphics Word Set - Mode D - 01/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! ( Set 2-color mask ) 8040 79 ! 2010 7B ! 0804 7D ! 0201 7F ! : pmd0 ( -- ) ( 128x96t0 ) FF22 c@ 7 and 0B0 + FF22 c! 1 FFC1 c! 1 FFC3 c! 0 FFC4 c! ; : pmd1 ( -- ) ( 128x96t1 ) FF22 c@ 7 and 0B8 + FF22 c! 1 FFC1 c! 1 FFC3 c! 0 FFC4 c! ; : pclsd0 ( -- ) 0BA @ 600 0 fill ; : pclsd1 ( -- ) 0BA @ 600 0FF fill ; create pfcold0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 02AE , A16E , 9112 , decimal BLOCK NUMBER 38 ( PMODE Graphics Word Set - Mode D - 02/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create pfcold1 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 97B5 , 3502 , AEA1 , 6E91 , create psetd ( 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 39 ( PMODE Graphics Word Set - Mode D - 03/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ld1 ( -- ) 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 ld2 ( -- ) 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 40 ( PMODE Graphics Word Set - Mode D - 04/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ld3 ( -- ) 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 ld4 ( -- ) 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 41 ( PMODE Graphics Word Set - Mode D - 05/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ld5 ( -- ) 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 ld6 ( -- ) 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 42 ( PMODE Graphics Word Set - Mode D - 06/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ld7 ( -- ) 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 ld8 ( -- ) 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 43 ( PMODE Graphics Word Set - Mode D - 07/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! : ld18 ( -- ) 0CD @ 0> if ld1 else ld8 then ; : ld27 ( -- ) 0CD @ 0> if ld2 else ld7 then ; : ld36 ( -- ) 0CD @ 0> if ld3 else ld6 then ; : ld45 ( -- ) 0CD @ 0> if ld4 else ld5 then ; : ld1845 ( -- ) 0CB @ 0> if ld18 else ld45 then ; : ld2736 ( -- ) 0CB @ 0> if ld27 else ld36 then ; : plined ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if ld1845 else ld2736 then ; decimal BLOCK NUMBER 44 ( PMODE Graphics Word Set - Mode D - 08/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ppointd ( 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 45 ( PMODE Graphics Word Set - Mode D - 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 46 ( PMODE Graphics Word Set - Mode D - 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 47 ( PMODE Graphics Word Set - Mode D - 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 pckd ( offset-x offset-y -- [ offset-x offset-y true ] or [ false ] ) here dup 2- ! 3406 , EC42 , 2D15 , 1083 , 007F , 2E0F , ECC4 , 2D0B , 1083 , 005F , 2E05 , CCFF , FF20 , 0533 , 44CC , 0000 , 3606 , 3506 , AEA1 , 6E91 , decimal BLOCK NUMBER 48 ( PMODE Graphics Word Set - Mode D - 12/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqd1 ( -- ) 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 @ + pckd if psetd then then then ; : psqd2 ( -- ) 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 @ + pckd if psetd then then then ; : psqd3 ( -- ) 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 @ - pckd if psetd then then then ; : psqd4 ( -- ) 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 @ - pckd if psetd then then then ; BLOCK NUMBER 49 ( PMODE Graphics Word Set - Mode D - 13/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqd ( -- ) psqd1 psqd2 psqd3 psqd4 ; : 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 50 ( PMODE Graphics Word Set - Mode D - 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 psqd ; : 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 psqd ; : pellipsed ( xc yc ea eb ba qa -- ) setr esu psqd begin dse 2@ 0 0 d< while el1 repeat esu1 psqd begin eq while el2 repeat ; BLOCK NUMBER 51 ( PMODE Graphics Word Set - Mode D - 15/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : pdlined ( 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 plined ; : pquitd ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1 65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 ! pfcold0 ; BLOCK NUMBER 52 ( PMODE Graphics Word Set - Mode D - 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 53 ( PMODE Graphics Word Set - Mode D - 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 ; : psetdc ( current-color# x y -- ) rot 178 c@ = not if psetd -1 wasin ! else drop drop then ; : psetdl ( -- xl ) begin x @ dup 0< not swap y @ ppointd dup 134 @ = not rot and while x @ y @ psetdc -1 x +! repeat drop x @ 1+ ; BLOCK NUMBER 54 ( PMODE Graphics Word Set - Mode D - 18/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psetdr ( -- xl ) begin x @ dup 127 > not swap y @ ppointd dup 134 @ = not rot and while x @ y @ psetdc 1 x +! repeat drop x @ 1- ; : psetdlr ( -- ) 0 wasin ! x @ 1+ psetdl lx ! x ! psetdr dup rx @ swap rx ! pstack rx ! 1+ x ! ; : pmrd ( -- ) begin x @ dup dup 127 > not swap y @ ppointd 134 @ = rot rx @ 1- > not and and while 1 x +! repeat ; : pmrtd ( -- ) 0 wasin ! pmrd x @ dup rx @ 1- > not if lx ! psetdr dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then ; : pmlbd ( -- ) x @ y @ ppointd 134 @ = if pmrtd then ; : pmlad ( -- ) lx @ x ! pmlbd x @ dup 0< not swap y @ ppointd 134 @ = not and if psetdlr then begin x @ rx @ 1- > not while pmrtd repeat ; : pmloopd ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not swap 95 > not and if pmlad then repeat ; BLOCK NUMBER 55 ( PMODE Graphics Word Set - Mode D - 19/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : ppaintd ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ psetdl lx ! x ! psetdr 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush pmloopd ; 16 base ! : pstord ( +n -- ) dup 1+ block swap block 0BA @ swap 400 cmove update 0BA @ 400 + swap 200 cmove update flush ; : ploadd ( +n -- ) dup 1+ block swap block 0BA @ 400 cmove 0BA @ 400 + 200 cmove ; decimal BLOCK NUMBER 56 ( PMODE Graphics Word Set - Mode D - 20/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wclrvd ( 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 xclrd ( 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 : pclrd ( xul yul xlr ylr color -- ) wclrvd 0 do xclrd fill loop drop drop drop ; BLOCK NUMBER 57 ( PMODE Graphics Word Set - Mode D - 21/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create dbsrd ( 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 : pmaked ( xul yul xlr ylr -- ) dbsrd create , , allot ; BLOCK NUMBER 58 ( PMODE Graphics Word Set - Mode D - 22/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wconvd ( 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 xcpyd ( 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 : pputd ( xul yul tb -- ) wconvd 0 do xcpyd cmove loop drop drop drop ; : pgetd ( xul yul tb -- ) wconvd 0 do xcpyd swap rot rot cmove loop drop drop drop ; BLOCK NUMBER 59 ( PMODE Graphics Word Set - Mode E - 01/xx ) ( 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! : pme0 ( -- ) ( 128x96f0 ) FF22 c@ 7 and 0C0 + FF22 c! 0 FFC0 c! 0 FFC2 c! 1 FFC5 c! ; : pme1 ( -- ) ( 128x96f1 ) FF22 c@ 7 and 0C8 + FF22 c! 0 FFC0 c! 0 FFC2 c! 1 FFC5 c! ; : pclse0 ( -- ) 0BA @ 0C00 0 fill ; : pclse1 ( -- ) 0BA @ 0C00 55 fill ; : pclse2 ( -- ) 0BA @ 0C00 0AA fill ; : pclse3 ( -- ) 0BA @ 0C00 0FF fill ; create pfcole0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 02AE , A16E , 9112 , decimal BLOCK NUMBER 60 ( PMODE Graphics Word Set - Mode E - 02/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create pfcole1 ( -- ) here dup 2- ! 3402 , 8601 , 97B2 , 8655 , 97B5 , 3502 , AEA1 , 6E91 , create pfcole2 ( -- ) here dup 2- ! 3402 , 8602 , 97B2 , 86AA , 97B5 , 3502 , AEA1 , 6E91 , create pfcole3 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 97B5 , 3502 , AEA1 , 6E91 , create psete ( x y -- ) here dup 2- ! 3436 , 3706 , 8620 , 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 61 ( PMODE Graphics Word Set - Mode E - 03/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create le1 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create le2 ( -- ) 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 , 8620 , 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 62 ( PMODE Graphics Word Set - Mode E - 04/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create le3 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create le4 ( -- ) 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 , 8620 , 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 63 ( PMODE Graphics Word Set - Mode E - 05/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create le5 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create le6 ( -- ) 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 , 8620 , 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 64 ( PMODE Graphics Word Set - Mode E - 06/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create le7 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create le8 ( -- ) 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 , 8620 , 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 65 ( PMODE Graphics Word Set - Mode E - 07/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! : le18 ( -- ) 0CD @ 0> if le1 else le8 then ; : le27 ( -- ) 0CD @ 0> if le2 else le7 then ; : le36 ( -- ) 0CD @ 0> if le3 else le6 then ; : le45 ( -- ) 0CD @ 0> if le4 else le5 then ; : le1845 ( -- ) 0CB @ 0> if le18 else le45 then ; : le2736 ( -- ) 0CB @ 0> if le27 else le36 then ; : plinee ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if le1845 else le2736 then ; decimal BLOCK NUMBER 66 ( PMODE Graphics Word Set - Mode E - 08/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ppointe ( x y -- c ) here dup 2- ! 3436 , 3706 , 8620 , 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 67 ( PMODE Graphics Word Set - Mode E - 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 68 ( PMODE Graphics Word Set - Mode E - 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 69 ( PMODE Graphics Word Set - Mode E - 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 pcke ( offset-x offset-y -- [ offset-x offset-y true ] or [ false ] ) here dup 2- ! 3406 , EC42 , 2D15 , 1083 , 007F , 2E0F , ECC4 , 2D0B , 1083 , 005F , 2E05 , CCFF , FF20 , 0533 , 44CC , 0000 , 3606 , 3506 , AEA1 , 6E91 , decimal BLOCK NUMBER 70 ( PMODE Graphics Word Set - Mode E - 12/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqe1 ( -- ) 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 @ + pcke if psete then then then ; : psqe2 ( -- ) 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 @ + pcke if psete then then then ; : psqe3 ( -- ) 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 @ - pcke if psete then then then ; : psqe4 ( -- ) 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 @ - pcke if psete then then then ; BLOCK NUMBER 71 ( PMODE Graphics Word Set - Mode E - 13/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqe ( -- ) psqe1 psqe2 psqe3 psqe4 ; : 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 72 ( PMODE Graphics Word Set - Mode E - 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 psqe ; : 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 psqe ; : pellipsee ( xc yc ea eb ba qa -- ) setr esu psqe begin dse 2@ 0 0 d< while el1 repeat esu1 psqe begin eq while el2 repeat ; BLOCK NUMBER 73 ( PMODE Graphics Word Set - Mode E - 15/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : pdlinee ( 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 plinee ; : pquite ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1 65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 ! pfcole0 ; BLOCK NUMBER 74 ( PMODE Graphics Word Set - Mode E - 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 75 ( PMODE Graphics Word Set - Mode E - 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 ; : psetec ( current-color# x y -- ) rot 178 c@ = not if psete -1 wasin ! else drop drop then ; : psetel ( -- xl ) begin x @ dup 0< not swap y @ ppointe dup 134 @ = not rot and while x @ y @ psetec -1 x +! repeat drop x @ 1+ ; BLOCK NUMBER 76 ( PMODE Graphics Word Set - Mode E - 18/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : pseter ( -- xl ) begin x @ dup 127 > not swap y @ ppointe dup 134 @ = not rot and while x @ y @ psetec 1 x +! repeat drop x @ 1- ; : psetelr ( -- ) 0 wasin ! x @ 1+ psetel lx ! x ! pseter dup rx @ swap rx ! pstack rx ! 1+ x ! ; : pmre ( -- ) begin x @ dup dup 127 > not swap y @ ppointe 134 @ = rot rx @ 1- > not and and while 1 x +! repeat ; : pmrte ( -- ) 0 wasin ! pmre x @ dup rx @ 1- > not if lx ! pseter dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then ; : pmlbe ( -- ) x @ y @ ppointe 134 @ = if pmrte then ; : pmlae ( -- ) lx @ x ! pmlbe x @ dup 0< not swap y @ ppointe 134 @ = not and if psetelr then begin x @ rx @ 1- > not while pmrte repeat ; : pmloope ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not swap 95 > not and if pmlae then repeat ; BLOCK NUMBER 77 ( PMODE Graphics Word Set - Mode E - 19/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : ppainte ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ psetel lx ! x ! pseter 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush pmloope ; 16 base ! : pstore ( +n -- ) dup dup 3 + swap do i block i 2 pick - 400 * 0BA @ + swap 400 cmove update loop flush drop ; : ploade ( +n -- ) dup dup 3 + swap do i block i 2 pick - 400 * 0BA @ + 400 cmove loop drop ; decimal BLOCK NUMBER 78 ( PMODE Graphics Word Set - Mode E - 20/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wclrve ( 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 , 203D , 1F01 , 3706 , 5454 , 3A1F , 10D3 , BA36 , 0635 , 0636 , 0635 , 0636 , 0635 , 0636 , 0635 , 16AE , A16E , 9112 , create xclre ( sb1 lb code -- sb2 lb code sb1 lb code ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : pclre ( xul yul xlr ylr color -- ) wclrve 0 do xclre fill loop drop drop drop ; BLOCK NUMBER 79 ( PMODE Graphics Word Set - Mode E - 21/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create dbsre ( 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 : pmakee ( xul yul xlr ylr -- ) dbsre create , , allot ; BLOCK NUMBER 80 ( PMODE Graphics Word Set - Mode E - 22/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wconve ( xul yul tb -- sb tb4 lb nl ) here dup 2- ! 3436 , 3720 , 3706 , 8620 , 3D1F , 0137 , 0654 , 543A , 1F10 , D3BA , 3606 , AEA4 , EC22 , 3124 , 3636 , 3536 , AEA1 , 6E91 , create xcpye ( sb1 tb1 lb -- sb2 tb2 lb sb1 tb1 lb ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06E3 , 44ED , 46EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : ppute ( xul yul tb -- ) wconve 0 do xcpye cmove loop drop drop drop ; : pgete ( xul yul tb -- ) wconve 0 do xcpye swap rot rot cmove loop drop drop drop ; BLOCK NUMBER 81 ( PMODE Graphics Word Set - Mode F - 01/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! ( Set 2-color mask ) 8040 79 ! 2010 7B ! 0804 7D ! 0201 7F ! : pmf0 ( -- ) ( 128x192t0 ) FF22 c@ 7 and 0D0 + FF22 c! 1 FFC1 c! 0 FFC2 c! 1 FFC5 c! ; : pmf1 ( -- ) ( 128x192t1 ) FF22 c@ 7 and 0D8 + FF22 c! 1 FFC1 c! 0 FFC2 c! 1 FFC5 c! ; : pclsf0 ( -- ) 0BA @ 0C00 0 fill ; : pclsf1 ( -- ) 0BA @ 0C00 0FF fill ; create pfcolf0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 02AE , A16E , 9112 , decimal BLOCK NUMBER 82 ( PMODE Graphics Word Set - Mode F - 02/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create pfcolf1 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 97B5 , 3502 , AEA1 , 6E91 , create psetf ( 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 83 ( PMODE Graphics Word Set - Mode F - 03/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lf1 ( -- ) 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 lf2 ( -- ) 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 84 ( PMODE Graphics Word Set - Mode F - 04/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lf3 ( -- ) 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 lf4 ( -- ) 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 85 ( PMODE Graphics Word Set - Mode F - 05/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lf5 ( -- ) 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 lf6 ( -- ) 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 86 ( PMODE Graphics Word Set - Mode F - 06/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lf7 ( -- ) 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 lf8 ( -- ) 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 87 ( PMODE Graphics Word Set - Mode F - 07/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! : lf18 ( -- ) 0CD @ 0> if lf1 else lf8 then ; : lf27 ( -- ) 0CD @ 0> if lf2 else lf7 then ; : lf36 ( -- ) 0CD @ 0> if lf3 else lf6 then ; : lf45 ( -- ) 0CD @ 0> if lf4 else lf5 then ; : lf1845 ( -- ) 0CB @ 0> if lf18 else lf45 then ; : lf2736 ( -- ) 0CB @ 0> if lf27 else lf36 then ; : plinef ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if lf1845 else lf2736 then ; decimal BLOCK NUMBER 88 ( PMODE Graphics Word Set - Mode F - 08/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ppointf ( 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 89 ( PMODE Graphics Word Set - Mode F - 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 90 ( PMODE Graphics Word Set - Mode F - 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 91 ( PMODE Graphics Word Set - Mode F - 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 pckf ( offset-x offset-y -- [ offset-x offset-y true ] or [ false ] ) here dup 2- ! 3406 , EC42 , 2D15 , 1083 , 007F , 2E0F , ECC4 , 2D0B , 1083 , 00BF , 2E05 , CCFF , FF20 , 0533 , 44CC , 0000 , 3606 , 3506 , AEA1 , 6E91 , decimal BLOCK NUMBER 92 ( PMODE Graphics Word Set - Mode F - 12/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqf1 ( -- ) 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 @ + pckf if psetf then then then ; : psqf2 ( -- ) 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 @ + pckf if psetf then then then ; : psqf3 ( -- ) 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 @ - pckf if psetf then then then ; : psqf4 ( -- ) 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 @ - pckf if psetf then then then ; BLOCK NUMBER 93 ( PMODE Graphics Word Set - Mode F - 13/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqf ( -- ) psqf1 psqf2 psqf3 psqf4 ; : 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 94 ( PMODE Graphics Word Set - Mode F - 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 psqf ; : 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 psqf ; : pellipsef ( xc yc ea eb ba qa -- ) setr esu psqf begin dse 2@ 0 0 d< while el1 repeat esu1 psqf begin eq while el2 repeat ; BLOCK NUMBER 95 ( PMODE Graphics Word Set - Mode F - 15/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : pdlinef ( 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 plinef ; : pquitf ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1 65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 ! pfcolf0 ; BLOCK NUMBER 96 ( PMODE Graphics Word Set - Mode F - 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 97 ( PMODE Graphics Word Set - Mode F - 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 ; : psetfc ( current-color# x y -- ) rot 178 c@ = not if psetf -1 wasin ! else drop drop then ; : psetfl ( -- xl ) begin x @ dup 0< not swap y @ ppointf dup 134 @ = not rot and while x @ y @ psetfc -1 x +! repeat drop x @ 1+ ; BLOCK NUMBER 98 ( PMODE Graphics Word Set - Mode F - 18/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psetfr ( -- xl ) begin x @ dup 127 > not swap y @ ppointf dup 134 @ = not rot and while x @ y @ psetfc 1 x +! repeat drop x @ 1- ; : psetflr ( -- ) 0 wasin ! x @ 1+ psetfl lx ! x ! psetfr dup rx @ swap rx ! pstack rx ! 1+ x ! ; : pmrf ( -- ) begin x @ dup dup 127 > not swap y @ ppointf 134 @ = rot rx @ 1- > not and and while 1 x +! repeat ; : pmrtf ( -- ) 0 wasin ! pmrf x @ dup rx @ 1- > not if lx ! psetfr dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then ; : pmlbf ( -- ) x @ y @ ppointf 134 @ = if pmrtf then ; : pmlaf ( -- ) lx @ x ! pmlbf x @ dup 0< not swap y @ ppointf 134 @ = not and if psetflr then begin x @ rx @ 1- > not while pmrtf repeat ; : pmloopf ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not swap 191 > not and if pmlaf then repeat ; BLOCK NUMBER 99 ( PMODE Graphics Word Set - Mode F - 19/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : ppaintf ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ psetfl lx ! x ! psetfr 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush pmloopf ; 16 base ! : pstorf ( +n -- ) dup dup 3 + swap do i block i 2 pick - 400 * 0BA @ + swap 400 cmove update loop flush drop ; : ploadf ( +n -- ) dup dup 3 + swap do i block i 2 pick - 400 * 0BA @ + 400 cmove loop drop ; decimal BLOCK NUMBER 100 ( PMODE Graphics Word Set - Mode F - 20/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wclrvf ( 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 xclrf ( 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 : pclrf ( xul yul xlr ylr color -- ) wclrvf 0 do xclrf fill loop drop drop drop ; BLOCK NUMBER 101 ( PMODE Graphics Word Set - Mode F - 21/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create dbsrf ( 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 : pmakef ( xul yul xlr ylr -- ) dbsrf create , , allot ; BLOCK NUMBER 102 ( PMODE Graphics Word Set - Mode F - 22/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wconvf ( 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 xcpyf ( 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 : pputf ( xul yul tb -- ) wconvf 0 do xcpyf cmove loop drop drop drop ; : pgetf ( xul yul tb -- ) wconvf 0 do xcpyf swap rot rot cmove loop drop drop drop ; BLOCK NUMBER 103 ( PMODE Graphics Word Set - Mode G - 01/xx ) ( 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! : pmg0 ( -- ) ( 128x192f0 ) FF22 c@ 7 and 0E0 + FF22 c! 0 FFC0 c! 1 FFC3 c! 1 FFC5 c! ; : pmg1 ( -- ) ( 128x192f1 ) FF22 c@ 7 and 0E8 + FF22 c! 0 FFC0 c! 1 FFC3 c! 1 FFC5 c! ; : pclsg0 ( -- ) 0BA @ 1800 0 fill ; : pclsg1 ( -- ) 0BA @ 1800 55 fill ; : pclsg2 ( -- ) 0BA @ 1800 0AA fill ; : pclsg3 ( -- ) 0BA @ 1800 0FF fill ; create pfcolg0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 02AE , A16E , 9112 , decimal BLOCK NUMBER 104 ( PMODE Graphics Word Set - Mode G - 02/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create pfcolg1 ( -- ) here dup 2- ! 3402 , 8601 , 97B2 , 8655 , 97B5 , 3502 , AEA1 , 6E91 , create pfcolg2 ( -- ) here dup 2- ! 3402 , 8602 , 97B2 , 86AA , 97B5 , 3502 , AEA1 , 6E91 , create pfcolg3 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 97B5 , 3502 , AEA1 , 6E91 , create psetg ( x y -- ) here dup 2- ! 3436 , 3706 , 8620 , 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 105 ( PMODE Graphics Word Set - Mode G - 03/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lg1 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lg2 ( -- ) 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 , 8620 , 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 106 ( PMODE Graphics Word Set - Mode G - 04/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lg3 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lg4 ( -- ) 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 , 8620 , 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 107 ( PMODE Graphics Word Set - Mode G - 05/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lg5 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lg6 ( -- ) 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 , 8620 , 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 108 ( PMODE Graphics Word Set - Mode G - 06/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lg7 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 54D3 , D51F , 014F , C603 , D4BE , CB81 , 1F02 , E6A4 , 1F98 , 43A4 , 84D4 , B5D7 , D59A , D5A7 , 8439 , 3536 , AEA1 , 6E91 , create lg8 ( -- ) 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 , 8620 , 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 109 ( PMODE Graphics Word Set - Mode G - 07/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! : lg18 ( -- ) 0CD @ 0> if lg1 else lg8 then ; : lg27 ( -- ) 0CD @ 0> if lg2 else lg7 then ; : lg36 ( -- ) 0CD @ 0> if lg3 else lg6 then ; : lg45 ( -- ) 0CD @ 0> if lg4 else lg5 then ; : lg1845 ( -- ) 0CB @ 0> if lg18 else lg45 then ; : lg2736 ( -- ) 0CB @ 0> if lg27 else lg36 then ; : plineg ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if lg1845 else lg2736 then ; decimal BLOCK NUMBER 110 ( PMODE Graphics Word Set - Mode G - 08/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ppointg ( x y -- c ) here dup 2- ! 3436 , 3706 , 8620 , 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 111 ( PMODE Graphics Word Set - Mode G - 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 112 ( PMODE Graphics Word Set - Mode G - 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 113 ( PMODE Graphics Word Set - Mode G - 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 pckg ( offset-x offset-y -- [ offset-x offset-y true ] or [ false ] ) here dup 2- ! 3406 , EC42 , 2D15 , 1083 , 007F , 2E0F , ECC4 , 2D0B , 1083 , 00BF , 2E05 , CCFF , FF20 , 0533 , 44CC , 0000 , 3606 , 3506 , AEA1 , 6E91 , decimal BLOCK NUMBER 114 ( PMODE Graphics Word Set - Mode G - 12/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqg1 ( -- ) 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 @ + pckg if psetg then then then ; : psqg2 ( -- ) 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 @ + pckg if psetg then then then ; : psqg3 ( -- ) 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 @ - pckg if psetg then then then ; : psqg4 ( -- ) 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 @ - pckg if psetg then then then ; BLOCK NUMBER 115 ( PMODE Graphics Word Set - Mode G - 13/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqg ( -- ) psqg1 psqg2 psqg3 psqg4 ; : 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 116 ( PMODE Graphics Word Set - Mode G - 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 psqg ; : 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 psqg ; : pellipseg ( xc yc ea eb ba qa -- ) setr esu psqg begin dse 2@ 0 0 d< while el1 repeat esu1 psqg begin eq while el2 repeat ; BLOCK NUMBER 117 ( PMODE Graphics Word Set - Mode G - 15/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : pdlineg ( 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 plineg ; : pquitg ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1 65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 ! pfcolg0 ; BLOCK NUMBER 118 ( PMODE Graphics Word Set - Mode G - 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 119 ( PMODE Graphics Word Set - Mode G - 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 ; : psetgc ( current-color# x y -- ) rot 178 c@ = not if psetg -1 wasin ! else drop drop then ; : psetgl ( -- xl ) begin x @ dup 0< not swap y @ ppointg dup 134 @ = not rot and while x @ y @ psetgc -1 x +! repeat drop x @ 1+ ; BLOCK NUMBER 120 ( PMODE Graphics Word Set - Mode G - 18/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psetgr ( -- xl ) begin x @ dup 127 > not swap y @ ppointg dup 134 @ = not rot and while x @ y @ psetgc 1 x +! repeat drop x @ 1- ; : psetglr ( -- ) 0 wasin ! x @ 1+ psetgl lx ! x ! psetgr dup rx @ swap rx ! pstack rx ! 1+ x ! ; : pmrg ( -- ) begin x @ dup dup 127 > not swap y @ ppointg 134 @ = rot rx @ 1- > not and and while 1 x +! repeat ; : pmrtg ( -- ) 0 wasin ! pmrg x @ dup rx @ 1- > not if lx ! psetgr dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then ; : pmlbg ( -- ) x @ y @ ppointg 134 @ = if pmrtg then ; : pmlag ( -- ) lx @ x ! pmlbg x @ dup 0< not swap y @ ppointg 134 @ = not and if psetglr then begin x @ rx @ 1- > not while pmrtg repeat ; : pmloopg ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not swap 191 > not and if pmlag then repeat ; BLOCK NUMBER 121 ( PMODE Graphics Word Set - Mode G - 19/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : ppaintg ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ psetgl lx ! x ! psetgr 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush pmloopg ; 16 base ! : pstorg ( +n -- ) dup dup 6 + swap do i block i 2 pick - 400 * 0BA @ + swap 400 cmove update loop flush drop ; : ploadg ( +n -- ) dup dup 6 + swap do i block i 2 pick - 400 * 0BA @ + 400 cmove loop drop ; decimal BLOCK NUMBER 122 ( PMODE Graphics Word Set - Mode G - 20/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wclrvg ( 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 , 203D , 1F01 , 3706 , 5454 , 3A1F , 10D3 , BA36 , 0635 , 0636 , 0635 , 0636 , 0635 , 0636 , 0635 , 16AE , A16E , 9112 , create xclrg ( sb1 lb code -- sb2 lb code sb1 lb code ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : pclrg ( xul yul xlr ylr color -- ) wclrvg 0 do xclrg fill loop drop drop drop ; BLOCK NUMBER 123 ( PMODE Graphics Word Set - Mode G - 21/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create dbsrg ( 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 : pmakeg ( xul yul xlr ylr -- ) dbsrg create , , allot ; BLOCK NUMBER 124 ( PMODE Graphics Word Set - Mode G - 22/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wconvg ( xul yul tb -- sb tb4 lb nl ) here dup 2- ! 3436 , 3720 , 3706 , 8620 , 3D1F , 0137 , 0654 , 543A , 1F10 , D3BA , 3606 , AEA4 , EC22 , 3124 , 3636 , 3536 , AEA1 , 6E91 , create xcpyg ( sb1 tb1 lb -- sb2 tb2 lb sb1 tb1 lb ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06E3 , 44ED , 46EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : pputg ( xul yul tb -- ) wconvg 0 do xcpyg cmove loop drop drop drop ; : pgetg ( xul yul tb -- ) wconvg 0 do xcpyg swap rot rot cmove loop drop drop drop ; BLOCK NUMBER 125 ( PMODE Graphics Word Set - Mode H - 01/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! ( Set 2-color mask ) 8040 79 ! 2010 7B ! 0804 7D ! 0201 7F ! : pmh0 ( -- ) ( 256x192t0 ) FF22 c@ 7 and 0F0 + FF22 c! 0 FFC0 c! 1 FFC3 c! 1 FFC5 c! ; : pmh1 ( -- ) ( 256x192t1 ) FF22 c@ 7 and 0F8 + FF22 c! 0 FFC0 c! 1 FFC3 c! 1 FFC5 c! ; : pclsh0 ( -- ) 0BA @ 1800 0 fill ; : pclsh1 ( -- ) 0BA @ 1800 0FF fill ; create pfcolh0 ( -- ) here dup 2- ! 3402 , 4F97 , B297 , B535 , 02AE , A16E , 9112 , decimal BLOCK NUMBER 126 ( PMODE Graphics Word Set - Mode H - 02/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create pfcolh1 ( -- ) here dup 2- ! 3402 , 8603 , 97B2 , 86FF , 97B5 , 3502 , AEA1 , 6E91 , create pseth ( x y -- ) here dup 2- ! 3436 , 3706 , 8620 , 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 127 ( PMODE Graphics Word Set - Mode H - 03/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lh1 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 , 07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 , D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , create lh2 ( -- ) 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 , 8620 , 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 128 ( PMODE Graphics Word Set - Mode H - 04/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lh3 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 , 07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 , D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , create lh4 ( -- ) 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 , 8620 , 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 129 ( PMODE Graphics Word Set - Mode H - 05/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lh5 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 , 07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 , D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , create lh6 ( -- ) 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 , 8620 , 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 130 ( PMODE Graphics Word Set - Mode H - 06/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create lh7 ( -- ) 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 , 8620 , 3DD3 , BADD , D5DC , BD54 , 5454 , D3D5 , 1F01 , 4FC6 , 07D4 , BECB , 791F , 02E6 , A41F , 9843 , A484 , D4B5 , D7D5 , 9AD5 , A784 , 3935 , 36AE , A16E , 9112 , create lh8 ( -- ) 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 , 8620 , 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 131 ( PMODE Graphics Word Set - Mode H - 07/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! : lh18 ( -- ) 0CD @ 0> if lh1 else lh8 then ; : lh27 ( -- ) 0CD @ 0> if lh2 else lh7 then ; : lh36 ( -- ) 0CD @ 0> if lh3 else lh6 then ; : lh45 ( -- ) 0CD @ 0> if lh4 else lh5 then ; : lh1845 ( -- ) 0CB @ 0> if lh18 else lh45 then ; : lh2736 ( -- ) 0CB @ 0> if lh27 else lh36 then ; : plineh ( x0 y0 xn yn -- ) 0C5 ! 0C3 ! 0BF ! 0BD ! 0C3 @ 0BD @ - 0CB ! 0C5 @ 0BF @ - 0CD ! 0CB @ abs 0CD @ abs > if lh1845 else lh2736 then ; decimal BLOCK NUMBER 132 ( PMODE Graphics Word Set - Mode H - 08/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create ppointh ( x y -- c ) here dup 2- ! 3436 , 3706 , 8620 , 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 133 ( PMODE Graphics Word Set - Mode H - 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 134 ( PMODE Graphics Word Set - Mode H - 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 135 ( PMODE Graphics Word Set - Mode H - 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 pckh ( offset-x offset-y -- [ offset-x offset-y true ] or [ false ] ) here dup 2- ! 3406 , EC42 , 2D15 , 1083 , 00FF , 2E0F , ECC4 , 2D0B , 1083 , 00BF , 2E05 , CCFF , FF20 , 0533 , 44CC , 0000 , 3606 , 3506 , AEA1 , 6E91 , decimal BLOCK NUMBER 136 ( PMODE Graphics Word Set - Mode H - 12/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqh1 ( -- ) 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 @ + pckh if pseth then then then ; : psqh2 ( -- ) 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 @ + pckh if pseth then then then ; : psqh3 ( -- ) 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 @ - pckh if pseth then then then ; : psqh4 ( -- ) 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 @ - pckh if pseth then then then ; BLOCK NUMBER 137 ( PMODE Graphics Word Set - Mode H - 13/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psqh ( -- ) psqh1 psqh2 psqh3 psqh4 ; : 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 138 ( PMODE Graphics Word Set - Mode H - 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 psqh ; : 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 psqh ; : pellipseh ( xc yc ea eb ba qa -- ) setr esu psqh begin dse 2@ 0 0 d< while el1 repeat esu1 psqh begin eq while el2 repeat ; BLOCK NUMBER 139 ( PMODE Graphics Word Set - Mode H - 15/xx ) ( Copyright [ c ] 1992 by BDS Software ) decimal : pdlineh ( 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 plineh ; : pquith ( -- ) 65314 c@ 7 and 248 + 65314 c! 1 65477 c! 1 65475 c! 0 65472 c! 186 @ 6144 255 fill 0 243 ! 0 245 ! pfcolh0 ; BLOCK NUMBER 140 ( PMODE Graphics Word Set - Mode H - 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 141 ( PMODE Graphics Word Set - Mode H - 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 ; : psethc ( current-color# x y -- ) rot 178 c@ = not if pseth -1 wasin ! else drop drop then ; : psethl ( -- xl ) begin x @ dup 0< not swap y @ ppointh dup 134 @ = not rot and while x @ y @ psethc -1 x +! repeat drop x @ 1+ ; BLOCK NUMBER 142 ( PMODE Graphics Word Set - Mode H - 18/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : psethr ( -- xl ) begin x @ dup 255 > not swap y @ ppointh dup 134 @ = not rot and while x @ y @ psethc 1 x +! repeat drop x @ 1- ; : psethlr ( -- ) 0 wasin ! x @ 1+ psethl lx ! x ! psethr dup rx @ swap rx ! pstack rx ! 1+ x ! ; : pmrh ( -- ) begin x @ dup dup 255 > not swap y @ ppointh 134 @ = rot rx @ 1- > not and and while 1 x +! repeat ; : pmrth ( -- ) 0 wasin ! pmrh x @ dup rx @ 1- > not if lx ! psethr dup rx @ swap rx ! pstack rx ! 1+ x ! else drop then ; : pmlbh ( -- ) x @ y @ ppointh 134 @ = if pmrth then ; : pmlah ( -- ) lx @ x ! pmlbh x @ dup 0< not swap y @ ppointh 134 @ = not and if psethlr then begin x @ rx @ 1- > not while pmrth repeat ; : pmlooph ( -- ) begin 136 @ 65024 < while gpop y @ dup 0< not swap 191 > not and if pmlah then repeat ; BLOCK NUMBER 143 ( PMODE Graphics Word Set - Mode H - 19/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal : ppainth ( x y limit-color# ) 134 ! y ! x ! 65024 136 ! x @ 1+ psethl lx ! x ! psethr 1+ rx ! lx @ rx @ lx @ 1- rx @ 1+ y @ 1+ 1 gpush lx @ rx @ lx @ 1- rx @ 1+ y @ 1- -1 gpush pmlooph ; 16 base ! : pstorh ( +n -- ) dup dup 6 + swap do i block i 2 pick - 400 * 0BA @ + swap 400 cmove update loop flush drop ; : ploadh ( +n -- ) dup dup 6 + swap do i block i 2 pick - 400 * 0BA @ + 400 cmove loop drop ; decimal BLOCK NUMBER 144 ( PMODE Graphics Word Set - Mode H - 20/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wclrvh ( 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 , 8620 , 3D1F , 0137 , 0654 , 5454 , 3A1F , 10D3 , BA36 , 0635 , 0636 , 0635 , 0636 , 0635 , 0636 , 0635 , 16AE , A16E , 9112 , create xclrh ( sb1 lb code -- sb2 lb code sb1 lb code ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : pclrh ( xul yul xlr ylr color -- ) wclrvh 0 do xclrh fill loop drop drop drop ; BLOCK NUMBER 145 ( PMODE Graphics Word Set - Mode H - 21/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create dbsrh ( 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 : pmakeh ( xul yul xlr ylr -- ) dbsrh create , , allot ; BLOCK NUMBER 146 ( PMODE Graphics Word Set - Mode H - 22/22 ) ( Copyright [ c ] 1992 by BDS Software ) decimal 16 base ! create wconvh ( xul yul tb -- sb tb4 lb nl ) here dup 2- ! 3436 , 3720 , 3706 , 8620 , 3D1F , 0137 , 0654 , 5454 , 3A1F , 10D3 , BA36 , 06AE , A4EC , 2231 , 2436 , 3635 , 36AE , A16E , 9112 , create xcpyh ( sb1 tb1 lb -- sb2 tb2 lb sb1 tb1 lb ) here dup 2- ! 3406 , EC44 , 3606 , C300 , 20ED , 46EC , 4436 , 06E3 , 44ED , 46EC , 4436 , 0635 , 06AE , A16E , 9112 , decimal : pputh ( xul yul tb -- ) wconvh 0 do xcpyh cmove loop drop drop drop ; : pgeth ( xul yul tb -- ) wconvh 0 do xcpyh swap rot rot cmove loop drop drop drop ;