hturtle.glo

   1 \\r
   2 \ HTURTLE.F\r
   3 \ Turtle graphics package for hForth\r
   4 \ Words names are in Korean.\r
   5 \\r
   6 \ HTURTLE.EXE\93e HF86EXE.EXE\9fi ���b�e �\81 \94a�q �\85��\9d� ͡�a �a��\97i�i ��\9da��\r
   7 \ �e\97e \88���\93�\94a.\r
   8 \\r
   9 \       << OPTIONAL.F\r
  10 \       << ASM8086.F\r
  11 \       << COREEXT.F\r
  12 \       << MSDOS.F\r
  13 \       BL PARSE MULTI.F    INCLUDED\r
  14 \       BL PARSE HIOMULT2.F INCLUDED\r
  15 \       BL PARSE HTURTLE.F  INCLUDED\r
  16 \       SAVE-SYSTEM-AS HTURTLE.EXE\r
  17 \\r
  18 \ 1996. 2. 21. \ Wonyong Koh\r
  19 \r
  20 BASE @\r
  21 GET-ORDER  GET-CURRENT\r
  22 �e\8bi���\89\9db-WORDLIST GET-ORDER 1 + SET-ORDER\r
  23 \r
  24 MARKER ~TURTLE\r
  25 \r
  26 DECIMAL\r
  27 CREATE sin16384\r
  28      0 ,    286 ,    572 ,    857 ,   1143 ,   1428 ,   1713 ,   1997 ,   2280 ,   2563 ,\r
  29   2845 ,   3126 ,   3406 ,   3686 ,   3964 ,   4240 ,   4516 ,   4790 ,   5063 ,   5334 ,\r
  30   5604 ,   5872 ,   6138 ,   6402 ,   6664 ,   6924 ,   7182 ,   7438 ,   7692 ,   7943 ,\r
  31   8192 ,   8438 ,   8682 ,   8923 ,   9162 ,   9397 ,   9630 ,   9860 ,  10087 ,  10311 ,\r
  32  10531 ,  10749 ,  10963 ,  11174 ,  11381 ,  11585 ,  11786 ,  11982 ,  12176 ,  12365 ,\r
  33  12551 ,  12733 ,  12911 ,  13085 ,  13255 ,  13421 ,  13583 ,  13741 ,  13894 ,  14044 ,\r
  34  14189 ,  14330 ,  14466 ,  14598 ,  14726 ,  14849 ,  14968 ,  15082 ,  15191 ,  15296 ,\r
  35  15396 ,  15491 ,  15582 ,  15668 ,  15749 ,  15826 ,  15897 ,  15964 ,  16026 ,  16083 ,\r
  36  16135 ,  16182 ,  16225 ,  16262 ,  16294 ,  16322 ,  16344 ,  16362 ,  16374 ,  16382 ,\r
  37  16384 ,  16382 ,  16374 ,  16362 ,  16344 ,  16322 ,  16294 ,  16262 ,  16225 ,  16182 ,\r
  38  16135 ,  16083 ,  16026 ,  15964 ,  15897 ,  15826 ,  15749 ,  15668 ,  15582 ,  15491 ,\r
  39  15396 ,  15296 ,  15191 ,  15082 ,  14968 ,  14849 ,  14726 ,  14598 ,  14466 ,  14330 ,\r
  40  14189 ,  14044 ,  13894 ,  13741 ,  13583 ,  13421 ,  13255 ,  13085 ,  12911 ,  12733 ,\r
  41  12551 ,  12365 ,  12176 ,  11982 ,  11786 ,  11585 ,  11381 ,  11174 ,  10963 ,  10749 ,\r
  42  10531 ,  10311 ,  10087 ,   9860 ,   9630 ,   9397 ,   9162 ,   8923 ,   8682 ,   8438 ,\r
  43   8192 ,   7943 ,   7692 ,   7438 ,   7182 ,   6924 ,   6664 ,   6402 ,   6138 ,   5872 ,\r
  44   5604 ,   5334 ,   5063 ,   4790 ,   4516 ,   4240 ,   3964 ,   3686 ,   3406 ,   3126 ,\r
  45   2845 ,   2563 ,   2280 ,   1997 ,   1713 ,   1428 ,   1143 ,    857 ,    572 ,    286 ,\r
  46      0 ,   -286 ,   -572 ,   -857 ,  -1143 ,  -1428 ,  -1713 ,  -1997 ,  -2280 ,  -2563 ,\r
  47  -2845 ,  -3126 ,  -3406 ,  -3686 ,  -3964 ,  -4240 ,  -4516 ,  -4790 ,  -5063 ,  -5334 ,\r
  48  -5604 ,  -5872 ,  -6138 ,  -6402 ,  -6664 ,  -6924 ,  -7182 ,  -7438 ,  -7692 ,  -7943 ,\r
  49  -8192 ,  -8438 ,  -8682 ,  -8923 ,  -9162 ,  -9397 ,  -9630 ,  -9860 , -10087 , -10311 ,\r
  50 -10531 , -10749 , -10963 , -11174 , -11381 , -11585 , -11786 , -11982 , -12176 , -12365 ,\r
  51 -12551 , -12733 , -12911 , -13085 , -13255 , -13421 , -13583 , -13741 , -13894 , -14044 ,\r
  52 -14189 , -14330 , -14466 , -14598 , -14726 , -14849 , -14968 , -15082 , -15191 , -15296 ,\r
  53 -15396 , -15491 , -15582 , -15668 , -15749 , -15826 , -15897 , -15964 , -16026 , -16083 ,\r
  54 -16135 , -16182 , -16225 , -16262 , -16294 , -16322 , -16344 , -16362 , -16374 , -16382 ,\r
  55 -16384 , -16382 , -16374 , -16362 , -16344 , -16322 , -16294 , -16262 , -16225 , -16182 ,\r
  56 -16135 , -16083 , -16026 , -15964 , -15897 , -15826 , -15749 , -15668 , -15582 , -15491 ,\r
  57 -15396 , -15296 , -15191 , -15082 , -14968 , -14849 , -14726 , -14598 , -14466 , -14330 ,\r
  58 -14189 , -14044 , -13894 , -13741 , -13583 , -13421 , -13255 , -13085 , -12911 , -12733 ,\r
  59 -12551 , -12365 , -12176 , -11982 , -11786 , -11585 , -11381 , -11174 , -10963 , -10749 ,\r
  60 -10531 , -10311 , -10087 ,  -9860 ,  -9630 ,  -9397 ,  -9162 ,  -8923 ,  -8682 ,  -8438 ,\r
  61  -8192 ,  -7943 ,  -7692 ,  -7438 ,  -7182 ,  -6924 ,  -6664 ,  -6402 ,  -6138 ,  -5872 ,\r
  62  -5604 ,  -5334 ,  -5063 ,  -4790 ,  -4516 ,  -4240 ,  -3964 ,  -3686 ,  -3406 ,  -3126 ,\r
  63  -2845 ,  -2563 ,  -2280 ,  -1997 ,  -1713 ,  -1428 ,  -1143 ,   -857 ,   -572 ,   -286 ,\r
  64     -0 ,    286 ,    572 ,    857 ,   1143 ,   1428 ,   1713 ,   1997 ,   2280 ,   2563 ,\r
  65   2845 ,   3126 ,   3406 ,   3686 ,   3964 ,   4240 ,   4516 ,   4790 ,   5063 ,   5334 ,\r
  66   5604 ,   5872 ,   6138 ,   6402 ,   6664 ,   6924 ,   7182 ,   7438 ,   7692 ,   7943 ,\r
  67   8192 ,   8438 ,   8682 ,   8923 ,   9162 ,   9397 ,   9630 ,   9860 ,  10087 ,  10311 ,\r
  68  10531 ,  10749 ,  10963 ,  11174 ,  11381 ,  11585 ,  11786 ,  11982 ,  12176 ,  12365 ,\r
  69  12551 ,  12733 ,  12911 ,  13085 ,  13255 ,  13421 ,  13583 ,  13741 ,  13894 ,  14044 ,\r
  70  14189 ,  14330 ,  14466 ,  14598 ,  14726 ,  14849 ,  14968 ,  15082 ,  15191 ,  15296 ,\r
  71  15396 ,  15491 ,  15582 ,  15668 ,  15749 ,  15826 ,  15897 ,  15964 ,  16026 ,  16083 ,\r
  72  16135 ,  16182 ,  16225 ,  16262 ,  16294 ,  16322 ,  16344 ,  16362 ,  16374 ,  16382 ,\r
  73  16384 ,  16382 ,  16374 ,  16362 ,  16344 ,  16322 ,  16294 ,  16262 ,  16225 ,  16182 ,\r
  74  16135 ,  16083 ,  16026 ,  15964 ,  15897 ,  15826 ,  15749 ,  15668 ,  15582 ,  15491 ,\r
  75  15396 ,  15296 ,  15191 ,  15082 ,  14968 ,  14849 ,  14726 ,  14598 ,  14466 ,  14330 ,\r
  76  14189 ,  14044 ,  13894 ,  13741 ,  13583 ,  13421 ,  13255 ,  13085 ,  12911 ,  12733 ,\r
  77  12551 ,  12365 ,  12176 ,  11982 ,  11786 ,  11585 ,  11381 ,  11174 ,  10963 ,  10749 ,\r
  78  10531 ,  10311 ,  10087 ,   9860 ,   9630 ,   9397 ,   9162 ,   8923 ,   8682 ,   8438 ,\r
  79   8192 ,   7943 ,   7692 ,   7438 ,   7182 ,   6924 ,   6664 ,   6402 ,   6138 ,   5872 ,\r
  80   5604 ,   5334 ,   5063 ,   4790 ,   4516 ,   4240 ,   3964 ,   3686 ,   3406 ,   3126 ,\r
  81   2845 ,   2563 ,   2280 ,   1997 ,   1713 ,   1428 ,   1143 ,    857 ,    572 ,    286 ,\r
  82      0 ,   -286 ,   -572 ,   -857 ,  -1143 ,  -1428 ,  -1713 ,  -1997 ,  -2280 ,  -2563 ,\r
  83  -2845 ,  -3126 ,  -3406 ,  -3686 ,  -3964 ,  -4240 ,  -4516 ,  -4790 ,  -5063 ,  -5334 ,\r
  84  -5604 ,  -5872 ,  -6138 ,  -6402 ,  -6664 ,  -6924 ,  -7182 ,  -7438 ,  -7692 ,  -7943 ,\r
  85  -8192 ,  -8438 ,  -8682 ,  -8923 ,  -9162 ,  -9397 ,  -9630 ,  -9860 , -10087 , -10311 ,\r
  86 -10531 , -10749 , -10963 , -11174 , -11381 , -11585 , -11786 , -11982 , -12176 , -12365 ,\r
  87 -12551 , -12733 , -12911 , -13085 , -13255 , -13421 , -13583 , -13741 , -13894 , -14044 ,\r
  88 -14189 , -14330 , -14466 , -14598 , -14726 , -14849 , -14968 , -15082 , -15191 , -15296 ,\r
  89 -15396 , -15491 , -15582 , -15668 , -15749 , -15826 , -15897 , -15964 , -16026 , -16083 ,\r
  90 -16135 , -16182 , -16225 , -16262 , -16294 , -16322 , -16344 , -16362 , -16374 , -16382 ,\r
  91 -16384 , -16382 , -16374 , -16362 , -16344 , -16322 , -16294 , -16262 , -16225 , -16182 ,\r
  92 -16135 , -16083 , -16026 , -15964 , -15897 , -15826 , -15749 , -15668 , -15582 , -15491 ,\r
  93 -15396 , -15296 , -15191 , -15082 , -14968 , -14849 , -14726 , -14598 , -14466 , -14330 ,\r
  94 -14189 , -14044 , -13894 , -13741 , -13583 , -13421 , -13255 , -13085 , -12911 , -12733 ,\r
  95 -12551 , -12365 , -12176 , -11982 , -11786 , -11585 , -11381 , -11174 , -10963 , -10749 ,\r
  96 -10531 , -10311 , -10087 ,  -9860 ,  -9630 ,  -9397 ,  -9162 ,  -8923 ,  -8682 ,  -8438 ,\r
  97  -8192 ,  -7943 ,  -7692 ,  -7438 ,  -7182 ,  -6924 ,  -6664 ,  -6402 ,  -6138 ,  -5872 ,\r
  98  -5604 ,  -5334 ,  -5063 ,  -4790 ,  -4516 ,  -4240 ,  -3964 ,  -3686 ,  -3406 ,  -3126 ,\r
  99  -2845 ,  -2563 ,  -2280 ,  -1997 ,  -1713 ,  -1428 ,  -1143 ,   -857 ,   -572 ,   -286 ,\r
 100     -0 ,    286 ,    572 ,    857 ,   1143 ,   1428 ,   1713 ,   1997 ,   2280 ,   2563 ,\r
 101   2845 ,   3126 ,   3406 ,   3686 ,   3964 ,   4240 ,   4516 ,   4790 ,   5063 ,   5334 ,\r
 102   5604 ,   5872 ,   6138 ,   6402 ,   6664 ,   6924 ,   7182 ,   7438 ,   7692 ,   7943 ,\r
 103   8192 ,   8438 ,   8682 ,   8923 ,   9162 ,   9397 ,   9630 ,   9860 ,  10087 ,  10311 ,\r
 104  10531 ,  10749 ,  10963 ,  11174 ,  11381 ,  11585 ,  11786 ,  11982 ,  12176 ,  12365 ,\r
 105  12551 ,  12733 ,  12911 ,  13085 ,  13255 ,  13421 ,  13583 ,  13741 ,  13894 ,  14044 ,\r
 106  14189 ,  14330 ,  14466 ,  14598 ,  14726 ,  14849 ,  14968 ,  15082 ,  15191 ,  15296 ,\r
 107  15396 ,  15491 ,  15582 ,  15668 ,  15749 ,  15826 ,  15897 ,  15964 ,  16026 ,  16083 ,\r
 108  16135 ,  16182 ,  16225 ,  16262 ,  16294 ,  16322 ,  16344 ,  16362 ,  16374 ,  16382 ,\r
 109 \r
 110 HEX\r
 111 \ : PLOT  ( x y -- )\r
 112 \     Y>SEG SWAP 8 /MOD SWAP >R           \ seg_addr x/8  R: x_mod_8\r
 113 \     2DUP LC@ R> CHARS XMASK + C@ OR ROT ROT LC! ;\r
 114 \r
 115 CODE PLOT  ( x y -- )\r
 116     BX 1 SHL,\r
 117     Y>SegTable ) BX ADD,\r
 118     0 [BX] ES MOV,\r
 119     BX POP,\r
 120     BX CX MOV,\r
 121     BX 1 SHR,\r
 122     BX 1 SHR,\r
 123     BX 1 SHR,\r
 124     ES: 0 [BX] AL MOV,\r
 125     1 # AH MOV,\r
 126     CL NOT,\r
 127     7 # CL AND,\r
 128     AH CL ROL,\r
 129     AH AL OR,\r
 130     ES: AL 0 [BX] MOV,\r
 131     BX POP,\r
 132     NEXT,\r
 133 END-CODE\r
 134 \r
 135 \ : 2ROT\r
 136 \     >R >R 2SWAP R> R> 2SWAP ;\r
 137 \\r
 138 \ : LINE  ( x1 y1 x2 y2--)\r
 139 \     2OVER 2OVER ROT - ABS >R - ABS R> MAX 2 <\r
 140 \     IF 2DROP PLOT EXIT THEN\r
 141 \     2OVER 2OVER ROT + 1+ 2/ >R + 1+ 2/ R>\r
 142 \     2DUP 2ROT RECURSE RECURSE ;\r
 143 \r
 144 VARIABLE Delta\r
 145 VARIABLE Delta/2\r
 146 \r
 147 \ y changing faster than x\r
 148 CODE steep640   \ on entry, ax = delta x, bx = delta y, cx=x1, dx=y1\r
 149     BX BP MOV,                  \ for counter\r
 150     BX 1 SHR,\r
 151     BX Delta/2 ) MOV,           \ halfy\r
 152     BX BX XOR,                  \ clear for cmp\r
 153 6 L:\r
 154     BX PUSH,\r
 155     CX PUSH,            \ x\r
 156     DX BX MOV,\r
 157     BX 1 SHL,\r
 158     Y>SegTable ) BX ADD,\r
 159     0 [BX] ES MOV,\r
 160     CX BX MOV,\r
 161     BX 1 SHR,\r
 162     BX 1 SHR,\r
 163     BX 1 SHR,\r
 164     ES: 0 [BX] AL MOV,\r
 165     1 # AH MOV,\r
 166     CL NOT,\r
 167     7 # CL AND,\r
 168     AH CL ROL,\r
 169     AH AL OR,\r
 170     ES: AL 0 [BX] MOV,\r
 171     CX POP,\r
 172     BX POP,\r
 173     DX INC,                     \ y is always increasing\r
 174     MAX-Y 16* # DX CMP,\r
 175     8 L# JL,\r
 176     DX DX XOR,\r
 177 8 L:\r
 178     Delta ) BX ADD,             \ = bx + delta_y\r
 179     Delta/2 ) BX CMP,           \ bx > halfy ?\r
 180     7 L# JLE,\r
 181     SI BX SUB,                  \ bx - delta_y\r
 182     DI CX ADD,                  \ inc or dec x\r
 183     MAX-X 8 * # CX SUB,\r
 184     7 L# JNS,\r
 185     MAX-X 8 * # CX ADD,\r
 186     7 L# JNS,\r
 187     MAX-X 8 * # CX ADD,\r
 188 7 L:\r
 189     BP DEC,\r
 190     6 L# JGE,\r
 191     BP POP,\r
 192     SI POP,\r
 193     BX POP,\r
 194     NEXT,\r
 195 END-CODE\r
 196 \r
 197 \ on exit, cx=x1, dx=y1, ax=x2, bx=y2\r
 198 CODE line640  ( x1 y1 x2 y2 -- )        \ writes to screen directly\r
 199     AX POP,\r
 200     DX POP,\r
 201     CX POP,\r
 202     SI PUSH,   ( used to hold direction)\r
 203     BP PUSH,   ( used as counter)\r
 204 \ see if we'll inc or dec x, y (draws in any direction)\r
 205     DX BX SUB,                  \ bx <- y2-y1 (delta y)\r
 206     2 L# JGE,\r
 207     BX DX ADD,                  \ dx <- y2\r
 208     BX NEG,                     \ abs(delta y)\r
 209     CX AX XCHG,\r
 210 2 L:\r
 211     BX SI MOV,                  \ delta_y(BX) to SI\r
 212     CX AX SUB,                  \ x2 - x1 = delta_x\r
 213     1 # DI MOV,                 \ di to increment x\r
 214     4 L# JGE,\r
 215     -1 # DI MOV,                \ di to decrement x\r
 216     AX NEG,                     \ abs(delta x)\r
 217 4 L:\r
 218     \ adjust x1(CX), y1(DX) in proper range\r
 219     AX PUSH,\r
 220     DX PUSH,\r
 221     CX AX MOV,\r
 222     CWD,\r
 223     MAX-X 8 * # BP MOV,\r
 224     BP IDIV,\r
 225     DX DX OR,\r
 226     1 L# JNS,\r
 227     BP DX ADD,\r
 228 1 L:\r
 229     DX CX MOV,\r
 230     DX POP,\r
 231     DX AX MOV,\r
 232     CWD,\r
 233     MAX-Y 16* # BP MOV,\r
 234     BP IDIV,\r
 235     DX DX OR,\r
 236     8 L# JNS,\r
 237     BP DX ADD,\r
 238 8 L:\r
 239     AX POP,\r
 240     AX Delta ) MOV,             \ abs(delta x)\r
 241     BX AX CMP,                  \ delta_x - delta_y\r
 242     5 L# JGE,\r
 243     ' steep640 # JMP,           \ y changes faster than x\r
 244 5 L:\r
 245 \ x changing faster than y\r
 246     AX BP MOV,                  \ for counter\r
 247     AX 1 SHR,\r
 248     AX Delta/2 ) MOV,           \ halfx\r
 249     BX BX XOR,                  \ clear for cmp\r
 250 6 L:\r
 251     BX PUSH,\r
 252     CX PUSH,            \ x\r
 253     DX BX MOV,\r
 254     BX 1 SHL,\r
 255     Y>SegTable ) BX ADD,\r
 256     0 [BX] ES MOV,\r
 257     CX BX MOV,\r
 258     BX 1 SHR,\r
 259     BX 1 SHR,\r
 260     BX 1 SHR,\r
 261     ES: 0 [BX] AL MOV,\r
 262     1 # AH MOV,\r
 263     CL NOT,\r
 264     7 # CL AND,\r
 265     AH CL ROL,\r
 266     AH AL OR,\r
 267     ES: AL 0 [BX] MOV,\r
 268     CX POP,\r
 269     BX POP,\r
 270     DI CX ADD,                  \ inc or dec x\r
 271     MAX-X 8 * # CX SUB,\r
 272     9 L# JNS,\r
 273     MAX-X 8 * # CX ADD,\r
 274     9 L# JNS,\r
 275     MAX-X 8 * # CX ADD,\r
 276 9 L:\r
 277     SI BX ADD,                  \ = bx + delta_y\r
 278     Delta/2 ) BX CMP,           \ bx > halfx ?\r
 279     7 L# JLE,\r
 280     Delta ) BX SUB,             \ bx - delta_x\r
 281     DX INC,                     \ y is always increasing\r
 282     MAX-Y 16* # DX CMP,\r
 283     7 L# JL,\r
 284     DX DX XOR,\r
 285 7 L:\r
 286     BP DEC,\r
 287     6 L# JGE,\r
 288     BP POP,\r
 289     SI POP,\r
 290     BX POP,\r
 291     NEXT,\r
 292 END-CODE\r
 293 \r
 294 \ y changing faster than x\r
 295 CODE xsteep640   \ on entry, ax = delta x, bx = delta y, cx=x1, dx=y1\r
 296     BX BP MOV,                  \ for counter\r
 297     BX 1 SHR,\r
 298     BX Delta/2 ) MOV,           \ halfy\r
 299     BX BX XOR,                  \ clear for cmp\r
 300 6 L:\r
 301     BX PUSH,\r
 302     CX PUSH,            \ x\r
 303     DX BX MOV,\r
 304     BX 1 SHL,\r
 305     Y>SegTable ) BX ADD,\r
 306     0 [BX] ES MOV,\r
 307     CX BX MOV,\r
 308     BX 1 SHR,\r
 309     BX 1 SHR,\r
 310     BX 1 SHR,\r
 311     ES: 0 [BX] AL MOV,\r
 312     1 # AH MOV,\r
 313     CL NOT,\r
 314     7 # CL AND,\r
 315     AH CL ROL,\r
 316     AH AL XOR,\r
 317     ES: AL 0 [BX] MOV,\r
 318     CX POP,\r
 319     BX POP,\r
 320     DX INC,                     \ y is always increasing\r
 321     MAX-Y 16* # DX CMP,\r
 322     8 L# JL,\r
 323     DX DX XOR,\r
 324 8 L:\r
 325     Delta ) BX ADD,             \ = bx + delta_y\r
 326     Delta/2 ) BX CMP,           \ bx > halfy ?\r
 327     7 L# JLE,\r
 328     SI BX SUB,                  \ bx - delta_y\r
 329     DI CX ADD,                  \ inc or dec x\r
 330     MAX-X 8 * # CX SUB,\r
 331     7 L# JNS,\r
 332     MAX-X 8 * # CX ADD,\r
 333     7 L# JNS,\r
 334     MAX-X 8 * # CX ADD,\r
 335 7 L:\r
 336     BP DEC,\r
 337     6 L# JGE,\r
 338     BP POP,\r
 339     SI POP,\r
 340     BX POP,\r
 341     NEXT,\r
 342 END-CODE\r
 343 \r
 344 \ on exit, cx=x1, dx=y1, ax=x2, bx=y2\r
 345 CODE xline640  ( x1 y1 x2 y2 -- )        \ writes to screen directly\r
 346     AX POP,\r
 347     DX POP,\r
 348     CX POP,\r
 349     SI PUSH,   ( used to hold direction)\r
 350     BP PUSH,   ( used as counter)\r
 351 \ see if we'll inc or dec x, y (draws in any direction)\r
 352     DX BX SUB,                  \ bx <- y2-y1 (delta y)\r
 353     2 L# JGE,\r
 354     BX DX ADD,                  \ dx <- y2\r
 355     BX NEG,                     \ abs(delta y)\r
 356     CX AX XCHG,\r
 357 2 L:\r
 358     BX SI MOV,                  \ delta_y(BX) to SI\r
 359     CX AX SUB,                  \ x2 - x1 = delta_x\r
 360     1 # DI MOV,                 \ di to increment x\r
 361     4 L# JGE,\r
 362     -1 # DI MOV,                \ di to decrement x\r
 363     AX NEG,                     \ abs(delta x)\r
 364 4 L:\r
 365     \ adjust x1(CX), y1(DX) in proper range\r
 366     MAX-X 8 * # CX SUB,\r
 367     1 L# JNS,\r
 368     MAX-X 8 * # CX ADD,\r
 369     1 L# JNS,\r
 370     MAX-X 8 * # CX ADD,\r
 371 1 L:\r
 372     MAX-Y 16* # DX SUB,\r
 373     8 L# JNS,\r
 374     MAX-Y 16* # DX ADD,\r
 375     8 L# JNS,\r
 376     MAX-Y 16* # DX ADD,\r
 377 8 L:\r
 378     AX Delta ) MOV,             \ abs(delta x)\r
 379     BX AX CMP,                  \ delta_x - delta_y\r
 380     5 L# JGE,\r
 381     ' xsteep640 # JMP,          \ y changes faster than x\r
 382 5 L:\r
 383 \ x changing faster than y\r
 384     AX BP MOV,                  \ for counter\r
 385     AX 1 SHR,\r
 386     AX Delta/2 ) MOV,           \ halfx\r
 387     BX BX XOR,                  \ clear for cmp\r
 388 6 L:\r
 389     BX PUSH,\r
 390     CX PUSH,            \ x\r
 391     DX BX MOV,\r
 392     BX 1 SHL,\r
 393     Y>SegTable ) BX ADD,\r
 394     0 [BX] ES MOV,\r
 395     CX BX MOV,\r
 396     BX 1 SHR,\r
 397     BX 1 SHR,\r
 398     BX 1 SHR,\r
 399     ES: 0 [BX] AL MOV,\r
 400     1 # AH MOV,\r
 401     CL NOT,\r
 402     7 # CL AND,\r
 403     AH CL ROL,\r
 404     AH AL XOR,\r
 405     ES: AL 0 [BX] MOV,\r
 406     CX POP,\r
 407     BX POP,\r
 408     DI CX ADD,                  \ inc or dec x\r
 409     MAX-X 8 * # CX SUB,\r
 410     9 L# JNS,\r
 411     MAX-X 8 * # CX ADD,\r
 412     9 L# JNS,\r
 413     MAX-X 8 * # CX ADD,\r
 414 9 L:\r
 415     SI BX ADD,                  \ = bx + delta_y\r
 416     Delta/2 ) BX CMP,           \ bx > halfx ?\r
 417     7 L# JLE,\r
 418     Delta ) BX SUB,             \ bx - delta_x\r
 419     DX INC,                     \ y is always increasing\r
 420     MAX-Y 16* # DX CMP,\r
 421     7 L# JL,\r
 422     DX DX XOR,\r
 423 7 L:\r
 424     BP DEC,\r
 425     6 L# JGE,\r
 426     BP POP,\r
 427     SI POP,\r
 428     BX POP,\r
 429     NEXT,\r
 430 END-CODE\r
 431 \r
 432 DECIMAL\r
 433 10 CONSTANT scale\r
 434 0 VALUE \90\81\9f��\95?\r
 435 VARIABLE �wз\r
 436 MAX-X 8 * 2/ VALUE xOffset\r
 437 MAX-Y 16 * 2/ VALUE yOffset\r
 438 VARIABLE xCoord  xOffset xCoord !\r
 439 VARIABLE yCoord  yOffset yCoord !\r
 440 \r
 441 : �\95\97i�� ( -- )     FALSE TO \90\81\9f��\95? ;\r
 442 : �\95\90\81\9da ( -- )     TRUE  TO \90\81\9f��\95? ;\r
 443 : �\89���e ( y -- )   MAX-Y SWAP - TO YTop ;\r
 444 : �����e ( -- )     PAGE ;\r
 445 \r
 446 CODE sin* ( \88�\9f� \88b\95� -- \88�\9f�*sin[\88b\95�] )\r
 447 \ : sin*   CELLS sin16384 + @ M* 16384 SM/REM NIP ;\r
 448     BX 1 SHL,\r
 449     sin16384 [BX] BX MOV,\r
 450     AX POP,\r
 451     BX IMUL,\r
 452     BX BX XOR,\r
 453     AX 1 SHL,\r
 454     DX 1 RCL,\r
 455     AX 1 SHL,\r
 456     DX 1 RCL,\r
 457     DX BX ADC,\r
 458     NEXT,\r
 459 END-CODE\r
 460 \r
 461 CODE cos* ( \88�\9f� \88b\95� -- \88�\9f�*cos[\88b\95�] )\r
 462 \ : cos*   90 + CELLS sin16384 + @ M* 16384 SM/REM NIP ;\r
 463     90 # BX ADD,\r
 464     BX 1 SHL,\r
 465     sin16384 [BX] BX MOV,\r
 466     AX POP,\r
 467     BX IMUL,\r
 468     BX BX XOR,\r
 469     AX 1 SHL,\r
 470     DX 1 RCL,\r
 471     AX 1 SHL,\r
 472     DX 1 RCL,\r
 473     DX BX ADC,\r
 474     NEXT,\r
 475 END-CODE\r
 476 \r
 477 : \9d�.\8ba�� ( x y -- )\r
 478     scale / yOffset SWAP -          \ x y1\r
 479     SWAP scale / xOffset + SWAP     \ x1 y1\r
 480     \90\81\9f��\95? IF 2DUP xCoord @ yCoord @ line640 THEN\r
 481     yCoord !  xCoord ! ;\r
 482 \r
 483 : \88�\82���a ( -- )\r
 484     xCoord @  8 �wз @ 270 + sin* +\r
 485     yCoord @  8 �wз @ 270 + cos* -\r
 486     2DUP xCoord @ yCoord @ xline640                 \ x1 y1\r
 487     xCoord @  16 �wз @ sin* +\r
 488     yCoord @  16 �wз @ cos* -                      \ x1 y1 x2 y2\r
 489     2SWAP 2OVER xline640                            \ x2 y2\r
 490     xCoord @  8 �wз @ 90 + sin* +\r
 491     yCoord @  8 �wз @ 90 + cos* -                  \ x2 y2 x3 y3\r
 492     2SWAP 2OVER xline640                            \ x3 y3\r
 493     xCoord @  yCoord @  xline640 ;\r
 494 \r
 495 : ���e���� ( -- )   YTop PAGE 0 OVER AT-XY TO YTop \88�\82���a ;\r
 496 \r
 497 HEX\r
 498 : \88{�e�i ( xt 'name2' -- )\r
 499     DUP xt>name ?DUP 0= IF -12 THROW THEN\r
 500     SWAP head, linkLast\r
 501     C@ DUP\r
 502     040 AND IF IMMEDIATE    THEN\r
 503     020 AND IF COMPILE-ONLY THEN ;\r
 504 \r
 505 DECIMAL\r
 506 ' IMMEDIATE  \88{�e�i  �a\9d�\r
 507 ' RECURSE    \88{�e�i  \96A�\89\9c�\r
 508 ' IF         \88{�e�i  �e\r
 509 ' ELSE       \88{�e�i  �a\93��e\r
 510 ' THEN       \88{�e�i  \9ca\r
 511 ' BEGIN      \88{�e�i  ���A�\81��\r
 512 ' UNTIL      \88{�e�i  \8ca��\r
 513 ' WHILE      \88{�e�i  \95��e\r
 514 ' REPEAT     \88{�e�i  \88�\97s�\81\r
 515 ' DO         \88{�e�i  �\91\r
 516 ' LOOP       \88{�e�i  \95��a\r
 517 ' I          \88{�e�i  \88a\r
 518 ' CONSTANT   \88{�e�i  \8a\88�e\88t\r
 519 ' VARIABLE   \88{�e�i  �\81\9fe\88t\r
 520 ' DUP        \88{�e�i  �A\8da\r
 521 ' OVER       \88{�e�i  \88�\90�\r
 522 ' DROP       \88{�e�i  ��\9da\r
 523 ' SWAP       \88{�e�i  �a\8e�\r
 524 ' ROT        \88{�e�i  \95�\9da\r
 525 ' >R         \88{�e�i  >\96A\r
 526 ' R>         \88{�e�i  \96A>\r
 527 ' R@         \88{�e�i  \96A@\r
 528 ' AND        \88{�e�i  \90{�q\8dA\r
 529 ' OR         \88{�e�i  \90{�a�\89\9c�\r
 530 ' XOR        \88{�e�i  \90{\98a\9d�\r
 531 ' MOD        \88{�e�i  \90a�ỡ\r
 532 ' CR         \88{�e�i  \94a�q�\89\r
 533 ' WORDS      \88{�e�i  �i�a\r
 534 ' .S         \88{�e�i  .\94ᣡ\r
 535 \r
 536 ' THEN       \88{�e�i  ENDIF\r
 537 ' =          \88{�e�i  ==\r
 538 ' BYE        \88{�e�i  \8f{\r
 539 ' BYE        \88{�e�i  EXIT\r
 540 ' BYE        \88{�e�i  exit\r
 541 \r
 542 �\81\9fe\88t \88a\9d���á\r
 543 �\81\9fe\88t �A\9d���á\r
 544 \r
 545 : �A�a\9f�\9d�   ( -- )\r
 546         \88�\82���a\r
 547         0 �wз !\r
 548         0 \88a\9d���á !\r
 549         0 �A\9d���á !\r
 550         0 0 \9d�.\8ba��\r
 551         \88�\82���a ;\r
 552 \r
 553 : ���e����   ( -- )\r
 554         �\95\97i�� �A�a\9f�\9d� ���e���� �\95\90\81\9da ;\r
 555 \r
 556 : ��\88\85���e ( -- )    8 �\89���e  ���e���� ;\r
 557 : �����e   ( -- )    �����e    ���e���� ;\r
 558 \r
 559 : \95�.��\9fe��  ( \88b\95� -- )\r
 560         \88�\82���a\r
 561         �wз @ +\r
 562         �A\8da 0 < �e                  ( \88b\95�\88a 0��\94a �b�a�e)\r
 563                    ���A�\81�� 360 +    ( 0 ���w�� \96I \98\81\8ca�� 360�i \94��q)\r
 564                    �A\8da -1 > \8ca��\r
 565                  �a\93��e 360 \90a�ỡ   ( 0��\94a �a�e 360�a\9d� \90a\92\85 \90a�ỡ\9fi \90q\8b�)\r
 566                  \9ca\r
 567         �wз !\r
 568         \88�\82���a ;\r
 569 \r
 570 : \95�.�E��     -1 * \95�.��\9fe�� ;\r
 571 \r
 572 : �e�q.\88a    ( dx dy -- )\r
 573         \88�\82���a\r
 574         �A\9d���á @ +            ( dx y+dy )\r
 575         �A\8da �A\9d���á !         ( dx y+dy )\r
 576         �a\8e� \88a\9d���á @ +       ( y+dy x+dx )\r
 577         �A\8da \88a\9d���á !         ( y+dy x+dx )\r
 578         �a\8e�                    ( x+dx y+dy )\r
 579         \9d�.\8ba��\r
 580         \88�\82���a ;\r
 581 \r
 582 : �|�a\9d�   ( l -- )\r
 583         �A\8da                    ( l l )\r
 584         �wз @ sin*             ( l dx )\r
 585         �a\8e�                    ( dx l )\r
 586         �wз @ cos*             ( dx dy )\r
 587         �e�q.\88a  ;\r
 588 \r
 589 : \96�\9d�     ( \88�\9f� -- )\r
 590         -1 *  �|�a\9d� ;\r
 591 \r
 592 : __��\9fe��.��\8d�   ( \88�\9f� �U�\81  -- )\r
 593         0 �\91   5 \95�.��\9fe��   �A\8da �|�a\9d�  5 \95�.��\9fe��   \95��a   ��\9da ;\r
 594 \r
 595 : ��\9fe��.��\8d�   ( �e��\9fq \88b\95� -- )\r
 596         �a\8e�  355 2034 */       ( \88b\95� \88�\9f� ) ( ��\8d��i 10\95��� \90a\92\81�� \8ba\9f� )\r
 597                                         ( 2*pi*r*\88b\95�/360*10 = pi*r*\88b\95�/18 )\r
 598                                         ( pi = 355/113 = 3.141593 )\r
 599         �A\8da >\96A                        ( \96A\95��� \94ᣡ�A \88�\9f�\9fi \88i�\81\9f�)\r
 600         \88�\90�  10 /              ( \88b\95� \88�\9f� �U�\81 )\r
 601         __��\9fe��.��\8d�           ( \88b\95� )\r
 602         10 \90a�ỡ               ( \88b\95�_\90a�ỡ )\r
 603         �A\8da \96A>                ( \88b\95�_\90a�ỡ \88b\95�_\90a�ỡ \88�\9f� )\r
 604         ( 10�a\9d� \90a\92\85 \90a�ỡ \88b\95��A �\81\94w�a\93e \88�\9f��e�q �|�a\9d� \88q)\r
 605         *  10 /  �|�a\9d�         ( \88b\95�_\90a�ỡ )\r
 606         \95�.��\9fe��  ;\r
 607 \r
 608 : ��\9fe��.�� ( �e��\9fq -- )   360 ��\9fe��.��\8d� ;\r
 609 \r
 610 : __�E��.��\8d�   ( \88�\9f� �U�\81  -- )\r
 611         0 �\91   5 \95�.�E��   �A\8da �|�a\9d�  5 \95�.�E��   \95��a   ��\9da ;\r
 612 \r
 613 : �E��.��\8d�     ( �e��\9fq \88b\95� -- )\r
 614         �a\8e�  355 2034 */       ( \88b\95� \88�\9f� ) ( ��\8d��i 10\95��� \90a\92\81�� \8ba\9f� )\r
 615                                         ( 2*pi*r*\88b\95�/360*10 = pi*r*\88b\95�/18 )\r
 616         �A\8da >\96A                        ( \96A\95��� \94ᣡ�A \88�\9f�\9fi \88i�\81\9f�)\r
 617         \88�\90�  10 /              ( \88b\95� \88�\9f� �U�\81 )\r
 618         __�E��.��\8d�             ( \88b\95� )\r
 619         10 \90a�ỡ               ( \88b\95�_\90a�ỡ )\r
 620         �A\8da \96A>                ( \88b\95�_\90a�ỡ \88b\95�_\90a�ỡ \88�\9f� )\r
 621              ( 10�a\9d� \90a\92\85 \90a�ỡ \88b\95��A �\81\94w�a\93e \88�\9f��e�q �|�a\9d� \88q)\r
 622         *  10 /  �|�a\9d�         ( \88b\95�_\90a�ỡ )\r
 623         \95�.�E��  ;\r
 624 \r
 625 : �E��.�� ( �e��\9fq -- )   360 �E��.��\8d� ;\r
 626 \r
 627 : \91A��   ( �a\8b� -- )\r
 628         4 0  �\91   �A\8da �|�a\9d�   90 \95�.��\9fe��   \95��a   ��\9da ;\r
 629 \r
 630 : \89så\91A��   ( -- )\r
 631         100 \91A��  200 \91A��  300 \91A��  400 \91A�� ;\r
 632 \r
 633 : \94a���a��\97a   ( -- )\r
 634         45 \95�.��\9fe��\r
 635         4 0 �\91  \89så\91A��  90 \95�.��\9fe��  \95��a ;\r
 636 \r
 637 : \8b��i   ( �a\8b� -- )\r
 638         �A\8da �|�a\9d�  �A\8da \91A��  \96�\9d� ;\r
 639 \r
 640 : �a��\8b��i   ( �a\8b� -- )\r
 641         6 0 �\91  �A\8da \8b��i  60 \95�.��\9fe��  \95��a ;\r
 642 \r
 643 : �a\9cq\88\81��   ( -- )\r
 644         100 �a��\8b��i  400 �a��\8b��i ;\r
 645 \r
 646 : \8d���   ( �a\8b� -- )\r
 647         �A\8da  90 ��\9fe��.��\8d�  90 \95�.��\9fe��\r
 648               90 ��\9fe��.��\8d�  90 \95�.��\9fe�� ;\r
 649 \r
 650 : \8d�     ( �a\8b� -- )\r
 651         8 0 �\91   �A\8da  \8d��� 45 \95�.��\9fe��   \95��a   ��\9da ;\r
 652 \r
 653 : \94a\9fe\8d���   ( �a\8b� -- )\r
 654         �A\8da  60 ��\9fe��.��\8d�  120 \95�.��\9fe��\r
 655               60 ��\9fe��.��\8d�  120 \95�.��\9fe�� ;\r
 656 \r
 657 : \94a\9fe\8d�     ( �a\8b� -- )\r
 658         6 0 �\91   �A\8da  \94a\9fe\8d��� 60 \95�.��\9fe��   \95��a   ��\9da ;\r
 659 \r
 660 : �\95�i   ( �a\8b� -- )\r
 661         �A\8da  90 �E��.��\8d�  �A\8da 90 ��\9fe��.��\8d�\r
 662         �A\8da  90 �E��.��\8d�       90 ��\9fe��.��\8d� ;\r
 663 \r
 664 : �\81     ( �a\8b� -- )\r
 665         9 0 �\91   �A\8da �\95�i  160 \95�.��\9fe��   \95��a  ��\9da ;\r
 666 \r
 667 : \88b�w     ( �a\8b� ����\9f��\81 -- )\r
 668         360 \88�\90� /  �a\8e�        ( �a\8b� \95�_\88b\95� ����\9f��\81 )\r
 669         0 �\91  \88�\90� �|�a\9d�  �A\8da \95�.��\9fe��  \95��a\r
 670         ��\9da ��\9da ;\r
 671 \r
 672 : �i   ( �e�\81_�\81 �y�� -- )\r
 673         \88�\90� \88�\90� *\r
 674         0 �\91  600 �|�a\9d�  \88�\90� \88�\90� 360 * �a\8e� / \95�.��\9fe��  \95��a\r
 675         ��\9da ��\9da ;\r
 676 \r
 677 : \94a\88b�w   ( �a\8b� \88b\95� -- )\r
 678         �wз @ >\96A                    ( \96A\95���\94ᣡ�A ��q �wз�i \88i�\81\9f�)\r
 679         ���A�\81��\r
 680            \88�\90� �|�a\9d� �A\8da \95�.��\9fe��\r
 681         �wз @  \96A@ = \8ca��            ( �wз�� ��q�wз\89� \88{�a�� \98\81\8ca�� \96A�\89��)\r
 682         ��\9da ��\9da  \96A> ��\9da ;         ( \88t\94ᣡ�� \96A\95��� \94ᣡ\9fi ���� )\r
 683 \r
 684 : \94a\88b�w�a\9cw5    5 0 �\91  450  72 \94a\88b�w  72 \95�.��\9fe��  \95��a ;\r
 685 : \94a\88b�w�a\9cw4    4 0 �\91  700 135 \94a\88b�w  90 \95�.��\9fe��  \95��a ;\r
 686 : \94a\88b�w�a\9cw12  12 0 �\91  15 \95�.��\9fe��  �\95\97i��  400 �|�a\9d�  �\95\90\81\9da\r
 687                          200 135 \94a\88b�w  15 \95�.��\9fe��  \95��a ;\r
 688 \r
 689 : \90a�\81   ( \88a��\88b\95� \88a��\8b��� \88a��á\8b��\81 -- )\r
 690         >\96A                             ( \88a��á\8b��\81\9fi \96A\95���\94ᣡ�A \88i�\81\9f�)\r
 691         \96A@ �e                          ( '\96A@ 0 <> �e' \89� \88{�q)\r
 692            \88�\90� \95�.�E��\r
 693            �A\8da 2 * �|�a\9d�\r
 694            \88�\90� \88�\90� \96A@ 1 - \96A�\89\9c�\r
 695            �A\8da 2 * \96�\9d�\r
 696            \88�\90� 2 * \95�.��\9fe��\r
 697            �A\8da �|�a\9d�\r
 698            \88�\90� \88�\90� \96A@ 1 - \96A�\89\9c�\r
 699            \96�\9d�  \95�.�E��\r
 700         �a\93��e  ��\9da ��\9da \9ca\r
 701         \96A> ��\9da ;\r
 702 \r
 703 �\81\9fe\88t ��\93i�a\8b�  20 ��\93i�a\8b� !\r
 704 : �w   ( \90a�� -- )\r
 705         �A\8da  0 = �e  ��\93i�a\8b� @ �|�a\9d�\r
 706               �a\93��e  �A\8da  0 > �e  �A\8da 1 - \96A�\89\9c�     (  \90a��-1 �w )\r
 707                                     90 \95�.��\9fe��\r
 708                                     1 \88�\90� - \96A�\89\9c�     (  1-\90a�� �w )\r
 709                             �a\93��e  -1 \88�\90� - \96A�\89\9c�    ( -1-\90a�� �w )\r
 710                                     90 \95�.�E��\r
 711                                      1 \88�\90� + \96A�\89\9c�    (  1+\90a�� �w )\r
 712               \9ca  \9ca\r
 713         ��\9da ;\r
 714 \r
 715 : ���a�i\r
 716     ��\88\85���e\r
 717     ." '\93i�\91'�a\9d� �e \88�\82\8ba\9f� �a\9d�\8ba\9c\91�i ���b�s\93�\94a."              \94a�q�\89 \94a�q�\89\r
 718     ." ��Ǳ�i\97i�i ��\9da�e             '�i�a'           \9ca\89� á��\89�"  \94a�q�\89\r
 719     ." ��Ǳ�i�i ��\98�\89A �a\93e�� ��\9da�e '\95��\91�i \95��\91�i'  ��\9c� á��\89�"  \94a�q�\89\r
 720     ." DOS\9d� \95��a \88a\9da�e             '\8f{'           ��\9ca\89� á������." \94a�q�\89\r
 721     ." \8ba\9f�\89� \8bi�a\9fi \88{�� ��\9da�e '�����e' \98a\9d� ��\9da�e '��\88\85���e'��\9ca\89� á������"\r
 722     \94a�q�\89\r
 723     �\95\90\81\9da\r
 724     300 \8d�  450 \8d�  600 \8d�\r
 725     �\95\97i��  90 \95�.�E��  2000 �|�a\9d�  �\95\90\81\9da\r
 726     900 \94a\9fe\8d�  700 \94a\9fe\8d�  500 \94a\9fe\8d�\r
 727     �\95\97i��  4000 \96�\9d�  90 \95�.��\9fe��  �\95\90\81\9da\r
 728     300 Ё\r
 729     1 \8bi�A��\9db�w�\81 ! ;       \ �e\8bi��\9db\r
 730 \r
 731 ���a�i\r
 732 \r
 733 : TURTLE-hi\r
 734     DOSCommand>PAD\r
 735     GET-MODE TO OldMode# HGRAPHIC hi\r
 736     ." �\81\89e\89� �A�e\89� ���w�i �a���I wykoh\9d� ��\90\81 �\81������." CR\r
 737     S" BLOCKS.BLK" MAPPED-TO-BLOCK\r
 738     ���a�i  QUIT ;\r
 739 \r
 740 ' TURTLE-hi TO 'boot\r
 741 \r
 742 ( \94a�q�i �a\9d\81\9d� ���a��������. )\r
 743 ( \94a���a��\97a )\r
 744 ( 400 \8b��i  400 �a��\8b��i  �a\9cq\88\81�� )\r
 745 ( 400 3 \88b�w   400 5 \88b�w   400 7 \88b�w )\r
 746 ( 5 2 �i  7 2 �i  7 3 �i  8 3 �i  9 2 �i  9 4 �i  10 3 �i  11 3 �i  11 5 �i )\r
 747 ( \94a\88b�w�a\9cw5 )\r
 748 ( \94a\88b�w�a\9cw5 )\r
 749 ( \94a\88b�w�a\9cw12 )\r
 750 ( 30 400 4 \90a�\81 )\r
 751 ( 20 250 5 \90a�\81 )\r
 752 ( 20 250 6 \90a�\81 )\r
 753 ( 50 ��\93i�a\8b� !   9 �w )\r
 754 ( 20 ��\93i�a\8b� !  12 �w )\r
 755 \r
 756 SET-CURRENT  SET-ORDER\r
 757 BASE !\r