dsforth/main_emit6.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; 6x8 font printing engine
   3 ;; the font was stolen from the
   4 ;; BYTEX font editor, (c) BYTEX Group
   5 ;; all dumb code is mine.
   6 ;; all smart code is taken from
   7 ;; the font editor & slighly tweaked.
   8 ;;                            Ketmar
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 font6x8_data:
  12   incbin "main_font6x8.fnt"
  13
  14 emit6_line_count equ 24  ;; was 22
  15 emit6_line_width equ 42
  16
  17 $FORTH_CONST (E6FONTADDR)   font6x8_addr
  18 font6x8_addr: defw font6x8_data
  19
  20 $FORTH_CONST (E6CURXY)      emit6y
  21 $FORTH_CONST (E6CURX)       emit6x
  22 $FORTH_CONST (E6CURY)       emit6y
  23 $FORTH_CONST (E6WASSCROLL)  emit6wasscrl
  24 $FORTH_CONST CONWIDTH       emit6_line_width
  25
  26 emit6_attrp equ 23693
  27
  28 emit6wasscrl: defb 0
  29 ;; current pos x & y
  30 emit6y: defb 0
  31 emit6x: defb 0
  32
  33   IF USE_PRINT_ATTRS
  34 emit6_allowattr: defb 1
  35
  36 $FORTH_CONST EMIT-ATTRS? 1
  37
  38 $FORTH_CODE_WORD TATTRS
  39 ;; k8
  40 ;; ( flag -- )
  41 ;; allow attr setting
  42   pop   hl
  43   ld    a,h
  44   or    l
  45   jr    z,fword_tattrz_zero
  46   ld    a,1
  47 fword_tattrz_zero:
  48   ld    (emit6_allowattr),a
  49   jp    i_next
  50 $FORTH_END_CODE_WORD TATTRS
  51
  52 $FORTH_CODE_WORD TATTRS?
  53 ;; k8
  54 ;; ( -- flag )
  55   ld    a,(emit6_allowattr)
  56   ld    l,a
  57   ld    h,0
  58   jp    i_pushhl
  59 $FORTH_END_CODE_WORD TATTRS?
  60
  61 ;; scroll up
  62 emit6_do_scroll_subr:
  63   call  #0DFE    ;; CL-SC-ALL
  64   ; set attribute for the lower part
  65   ld    hl,scrattr8x8(0,23)
  66   ld    de,scrattr8x8(1,23)
  67   ld    a,(emit6_attrp)
  68   ld    (hl),a
  69   ld    bc,31
  70   ldir
  71   ret
  72
  73   ELSE
  74 $FORTH_CONST EMIT-ATTRS? 0
  75 emit6_do_scroll_subr equ #0DFE    ;; CL-SC-ALL
  76
  77 $FORTH_CODE_WORD TATTRS
  78 ;; k8
  79 ;; ( flag -- )
  80 ;; allow attr setting
  81   pop   hl
  82   jp    i_next
  83 $FORTH_END_CODE_WORD TATTRS
  84
  85 $FORTH_CODE_WORD TATTRS?
  86 ;; k8
  87 ;; ( -- flag )
  88   ld    hl,0
  89   jp    i_pushhl
  90 $FORTH_END_CODE_WORD TATTRS?
  91
  92   ENDIF
  93
  94 ;; internal EmitChar
  95 ;; in: L=char
  96 emit6_internal:
  97   push  hl
  98
  99 ;; check for the new line
 100   ld    hl,emit6y
 101   ld    a,(emit6x)
 102   cp    emit6_line_width
 103   jr    c,emit6i_0   ;; no new line
 104   xor   a
 105   ld    (emit6x),a
 106   inc   (hl)
 107
 108 emit6i_0:
 109 ;; check for scroll
 110   ld    a,(hl)
 111   cp    emit6_line_count
 112   jr    c,emit6i_1   ;; no scroll
 113
 114 ;; do scroll
 115   ld    (hl),emit6_line_count-1
 116   ld    hl,emit6wasscrl
 117   inc   (hl)
 118   call  emit6_do_scroll_subr
 119
 120 emit6i_1:
 121   pop   hl
 122   push  ix
 123
 124 ;; print char
 125 ;; in: L=code
 126 ;;     E=y
 127 ;;     D=x
 128 ;; draw6InvMask: char inverse mask (norm: #00; inv: #FC)
 129 ;; draw6CharMask: screen AND mask (norm: #03; over: #FF)
 130 ;; draw6PutALU0: OR(#B2)/XOR(#AA) -- curr. XOR
 131 ;; draw6PutALU1: OR(#B3)/XOR(#AB) -- curr. XOR
 132 DrawChar6:
 133   ld    h,0
 134   add   hl,hl
 135   add   hl,hl
 136   add   hl,hl
 137   ld    bc,(font6x8_addr)
 138   add   hl,bc
 139   push  hl
 140   pop   ix
 141
 142 ;; calc screen address
 143   ld    de,(emit6y)
 144   rlc   e
 145   rlc   e
 146   rlc   e
 147   rlc   d
 148   ld    a,d
 149   rlc   d
 150   add   a,d
 151   ld    d,a
 152   ld    a,e
 153   and   a
 154   rra
 155   scf
 156   rra
 157   and   a
 158   rra
 159   xor   e
 160   and   #F8
 161   xor   e
 162   ld    h,a
 163   ld    a,d
 164   rlca
 165   rlca
 166   rlca
 167   xor   e
 168   and   #C7
 169   xor   e
 170   rlca
 171   rlca
 172   ld    l,a
 173   ld    a,d
 174   and   7
 175
 176   IF USE_PRINT_ATTRS
 177   ld    (emit6_scraddr),hl
 178   ld    (emit6_scrofs),a
 179   ENDIF
 180
 181   rra
 182   ld    (Draw6Shift),a                 ;  [#00] [#00]
 183   ld    b,8
 184
 185 Draw6LineLoop:
 186   push  bc
 187   ld    a,(IX+0)
 188 draw6InvMask: equ $+1
 189   xor   #00
 190   ld    d,a
 191   ld    e,0
 192   exx
 193 draw6CharMask: equ $+2
 194   ld    de,#03FF
 195   exx
 196 Draw6Shift: equ $+1
 197   ld    a,#00
 198 ;;
 199   or    a
 200   jr    z,Draw6SkipShift
 201
 202 Draw6ShiftLoop:
 203   or    a
 204   rr    d
 205   rr    e
 206   rr    d
 207   rr    e
 208   exx
 209   scf
 210   rr    d
 211   rr    e
 212   rr    d
 213   rr    e
 214   exx
 215   dec   a
 216   jr    nz,Draw6ShiftLoop
 217
 218 Draw6SkipShift:
 219   ld    a,(hl)
 220   exx
 221   and   d
 222   exx
 223 draw6PutALU0:
 224   xor   d
 225   ld    (hl),a
 226   inc   l
 227   ld    a,l
 228   and   #1F              ;; char byte is zero?
 229   jr    z,Draw6SkipPut
 230   ld    a,(hl)
 231   exx
 232   and   e
 233   exx
 234 draw6PutALU1:
 235   xor   e
 236   ld    (hl),a
 237
 238 Draw6SkipPut:
 239   dec   l
 240   inc   h
 241   inc   ix
 242   pop   bc
 243   djnz  Draw6LineLoop
 244
 245   pop   ix
 246
 247   ld    hl,emit6x
 248   inc   (hl)
 249
 250   IF USE_PRINT_ATTRS
 251   ld    a,(emit6_allowattr)
 252   or    a
 253   ret   z
 254   ; set attr
 255   ld    hl,0
 256 emit6_scraddr equ $-2
 257   ; conver to attribute
 258   ld   a,h
 259   rrca
 260   rrca
 261   rrca
 262   and  #03
 263   or   #58
 264   ld   h,a
 265   ; set
 266   ld    a,(emit6_attrp)
 267   ld    (hl),a
 268   ex    af,af'
 269   ; check shift
 270   ld    a,0
 271 emit6_scrofs equ $-1
 272   cp    3
 273   ret   c
 274   inc   hl
 275   ex    af,af'
 276   ld    (hl),a
 277   ENDIF
 278
 279   ret
 280 ;; end of internal EmitChar
 281
 282
 283 ;; internal CR proc
 284 cr6internal:
 285 ;; check for the new line
 286   xor   a
 287   ld    (emit6x),a
 288
 289 cr6i_0:
 290   ld    hl,emit6y
 291   inc   (hl)
 292
 293 ;; check for scroll
 294   ld    a,(hl)
 295   cp    emit6_line_count
 296   ret   c        ;; no scroll
 297
 298 ;; do scroll
 299   ld    (hl),emit6_line_count-1
 300   ld    hl,emit6wasscrl
 301   inc   (hl)
 302   jp    #0DFE    ;; CL-SC-ALL
 303 ;; end of internal CR proc
 304
 305
 306 ;; draw one char, advance pos, scroll if necessary
 307 $FORTH_CODE_WORD XEMIT
 308 ;; k8
 309 ;; ( c -- )
 310   pop   hl
 311 doxemit6:
 312   push  bc
 313   call  emit6_internal
 314   pop   bc
 315   jp    i_next
 316 $FORTH_END_CODE_WORD XEMIT
 317
 318
 319 ;; clear screen
 320 $FORTH_CODE_WORD CLS
 321 ;; AberSoft, k8
 322 docls6:
 323   ld    hl,0
 324   ld    (emit6y),hl
 325   IF USE_PRINT_ATTRS
 326   ld    (emit8_coordx),hl
 327   ENDIF
 328
 329   push  bc
 330   ld    a,2
 331   call  #1601
 332   call  #0D6B
 333   pop   bc
 334   jp    i_next
 335 $FORTH_END_CODE_WORD CLS
 336
 337
 338 ;; backspace (back one char)
 339 $FORTH_CODE_WORD EMITBS
 340 ;; k8
 341 ;; ( -- )
 342 dobs6:
 343   ld    hl,(emit6y)
 344   ld    a,h
 345   or    l
 346   jp    z,i_next   ;; can't move above the top
 347   ld    a,l
 348   or    a
 349   jr    z,bs6_0    ;; up one line
 350   dec   h          ;; left
 351   ld    (emit6y),hl
 352   jp    i_next
 353 bs6_0:
 354   ld    h,emit6_line_width-1
 355   dec   l
 356   ld    (emit6y),hl
 357   jp    i_next
 358 $FORTH_END_CODE_WORD EMITBS
 359
 360
 361 ;; draw one char, advance pos, scroll if necessary
 362 ;; it understands:
 363 ;;   #05 -- vtab (up)
 364 ;;   #06 -- go right
 365 ;;   #08 -- bs
 366 ;;   #09 -- tab
 367 ;;   #10 -- vtab
 368 ;;   #12 -- cls
 369 ;;   #13 -- cr (no line feed)
 370 $FORTH_CODE_WORD EMIT
 371 ;; k8
 372 ;; ( c -- )
 373   pop   hl
 374   ld    a,l
 375 do_normal_emit_a:
 376   cp    5
 377   jr    nz,emit6_0
 378 ;;vtab (up)
 379   ld    a,(emit6y)
 380   or    a
 381   jp    z,i_next
 382   dec   a
 383   ld    (emit6y),a
 384   jp    i_next
 385 emit6_0:
 386   cp    6
 387   jr    nz,emit6_1
 388 ;;go right
 389   ld    hl,emit6x
 390   inc   (hl)
 391   jp    i_next
 392 emit6_1:
 393   cp    8
 394   jr    z,dobs6
 395   cp    9
 396   jr    z,dohtab6
 397   cp    10
 398   jr    z,dovtab6
 399   cp    12
 400   jr    z,docls6
 401   cp    13
 402   jp    nz,doxemit6
 403   xor   a
 404   ld    (emit6x),a
 405   jp    i_next
 406 $FORTH_END_CODE_WORD EMIT
 407
 408
 409 ;; do CR
 410 $FORTH_CODE_WORD CR
 411 ;; k8
 412 ;; ( -- )
 413 docr6:
 414   push  bc
 415   call  cr6internal
 416   pop   bc
 417   jp    i_next
 418 $FORTH_END_CODE_WORD CR
 419
 420
 421 ;; scroll up
 422 $FORTH_CODE_WORD VSCROLL
 423 ;; k8
 424 ;; ( -- )
 425   push  bc
 426   call  emit6_do_scroll_subr
 427   pop   bc
 428   jp    i_next
 429 $FORTH_END_CODE_WORD VSCROLL
 430
 431
 432 ;; vertical tab (#10)
 433 $FORTH_CODE_WORD VTAB
 434 ;; k8
 435 ;; ( -- )
 436 dovtab6:
 437   push  bc
 438   call  cr6i_0
 439   pop   bc
 440   jp    i_next
 441 $FORTH_END_CODE_WORD VTAB
 442
 443 ;; horizontal tab (#9)
 444 $FORTH_CODE_WORD HTAB
 445 ;; k8
 446 ;; ( -- )
 447 dohtab6:
 448   push  bc
 449
 450   ld    a,(emit6x)
 451   cp    40
 452   jr    c,htab6_0   ;; no new line
 453   push  af
 454   call  cr6internal
 455   pop   af
 456   cp    emit6_line_width
 457   jr    c,htab6_q   ;; there were spaces, so tab is complete %-)
 458
 459 htab6_0:
 460   ld    a,(emit6x)
 461   ld    e,a
 462   or    #07
 463   inc   a
 464   sub   e
 465
 466 htab6_1:
 467   push  af
 468   ld    l,32
 469   call  emit6_internal
 470   pop   af
 471   dec   a
 472   jr    nz,htab6_1
 473
 474 htab6_q:
 475   pop   bc
 476   jp    i_next
 477 $FORTH_END_CODE_WORD HTAB
 478
 479
 480 $FORTH_CODE_WORD WHEREX
 481 ;; k8
 482 ;; ( -- x )
 483   ld    a,(emit6x)
 484 wherexy_common:
 485   ld    l,a
 486   ld    h,0
 487   jp    i_pushhl
 488 $FORTH_END_CODE_WORD WHEREX
 489
 490 $FORTH_CODE_WORD WHEREY
 491 ;; k8
 492 ;; ( -- y )
 493   ld    a,(emit6y)
 494   jr    wherexy_common
 495 $FORTH_END_CODE_WORD WHEREY
 496
 497 $FORTH_CODE_WORD GOTOXY
 498 ;; k8
 499 ;; ( x y -- )
 500   pop   hl  ; l=y
 501   pop   de  ; e=x
 502   ld    h,e
 503   ld    (emit6y),hl
 504   jp    i_next
 505 $FORTH_END_CODE_WORD GOTOXY
 506
 507
 508 $FORTH_CODE_WORD TOVER
 509 ;; k8
 510 ;; ( n -- )
 511   ld    hl,draw6CharMask
 512   ld    (hl),#03
 513   pop   de
 514   ld    a,e
 515   or    a
 516   jr    z,tover0
 517   ld    (hl),#FF
 518   dec   a
 519   jr    z,tover1
 520 ;; mode 2 (OR)
 521   ld    a,#B2
 522   ld    (draw6PutALU0),a
 523   jr    tover2
 524 tover1:
 525 ;; mode 1 (XOR)
 526   ld    a,#AA
 527   ld    (draw6PutALU0),a
 528 tover2:
 529   inc   a
 530   ld    (draw6PutALU1),a
 531 tover0:
 532   jp    i_next
 533 $FORTH_END_CODE_WORD TOVER
 534
 535 $FORTH_CODE_WORD TOVER?
 536 ;; k8
 537 ;; ( n -- )
 538   ld    a,(draw6CharMask)
 539   cp    #FF
 540   ld    hl,1
 541   jr    z,toverq0
 542   dec   l
 543 toverq0:
 544   jp    i_pushhl
 545 $FORTH_END_CODE_WORD TOVER?
 546
 547 $FORTH_CODE_WORD TINV
 548 ;; k8
 549 ;; ( n -- )
 550   pop   de
 551   ld    a,e
 552   or    a
 553   jr    z,tinv0
 554   ld    a,#FC
 555 tinv0:
 556   ld    (draw6InvMask),a
 557   jp    i_next
 558 $FORTH_END_CODE_WORD TINV
 559
 560 $FORTH_CODE_WORD TINV?
 561 ;; k8
 562 ;; ( n -- )
 563   ld    a,(draw6InvMask)
 564   ld    l,a
 565   ld    h,0
 566   or    a
 567   jr    z,tinvq0
 568   inc   l
 569 tinvq0:
 570   jp    i_pushhl
 571 $FORTH_END_CODE_WORD TINV?
 572
 573
 574 $FORTH_CODE_WORD SPACE
 575 ;; k8
 576 ;; ( -- )
 577   ld    l,32
 578   jp    doxemit6
 579 $FORTH_END_CODE_WORD SPACE
 580
 581 $FORTH_CODE_WORD EMITCR
 582 ;; k8
 583 ;; ( -- )
 584   xor   a
 585   ld    (emit6x),a
 586   jp    i_next
 587 $FORTH_END_CODE_WORD EMITCR
 588
 589 $FORTH_CODE_WORD SPACES
 590 ;; k8
 591 ;; ( n -- )
 592   pop   hl
 593   push  bc
 594 spaces0:
 595   ld    a,h
 596   cp    128
 597   jr    nc,spaces1
 598   or    l
 599   jr    z,spaces1
 600   push  hl
 601   ld    l,32
 602   call  emit6_internal
 603   pop   hl
 604   dec   hl
 605   jr    spaces0
 606 spaces1:
 607   pop   bc
 608   jp    i_next
 609 $FORTH_END_CODE_WORD SPACES
 610
 611
 612 $FORTH_WORD TYPE
 613 ;; AberSoft
 614 ;; ( addr len -- )
 615   dup 0 > 0BRANCH type1
 616   OVER + SWAP (DO)
 617 type0:
 618   I C@ EMIT
 619   (LOOP)  type0
 620   BRANCH type2
 621 type1:
 622   2DROP
 623 type2:
 624   ;S
 625 $FORTH_END_WORD TYPE
 626
 627 $FORTH_WORD XTYPE
 628 ;; AberSoft, k8
 629 ;; ( addr len -- )
 630   dup 0 > 0BRANCH xtype1
 631   OVER + SWAP (DO)
 632 xtype0:
 633   I C@ XEMIT
 634   (LOOP)  xtype0
 635   BRANCH xtype2
 636 xtype1:
 637   2DROP
 638 xtype2:
 639   ;S
 640 $FORTH_END_WORD XTYPE
 641
 642
 643   IF USE_PRINT_ATTRS
 644 $FORTH_CONST SV-ATTR_P emit6_attrp
 645
 646
 647 $FORTH_CODE_WORD PAPER
 648 ;; k8
 649 ;; ( -- n )
 650   pop   de
 651   ld    a,e
 652   and   7
 653   rlca
 654   rlca
 655   rlca
 656   ld    e,a
 657   ld    hl,emit6_attrp
 658   ld    a,(hl)
 659   and   0o0307
 660   or    e
 661   ld    (hl),a
 662   jp    i_next
 663 $FORTH_END_CODE_WORD PAPER
 664
 665 $FORTH_CODE_WORD INK
 666 ;; k8
 667 ;; ( -- n )
 668   pop   de
 669   ld    a,e
 670   and   7
 671   ld    e,a
 672   ld    hl,emit6_attrp
 673   ld    a,(hl)
 674   and   0o0370
 675   or    e
 676   ld    (hl),a
 677   jp    i_next
 678 $FORTH_END_CODE_WORD INK
 679
 680 $FORTH_CODE_WORD FLASH
 681 ;; k8
 682 ;; ( -- n )
 683   pop   de
 684   ld    a,e
 685   or    a
 686   jr    z,fword_flash_zero
 687   ld    e,0o0200
 688 fword_flash_zero:
 689   ld    hl,emit6_attrp
 690   ld    a,(hl)
 691   and   0o0177
 692   or    e
 693   ld    (hl),a
 694   jp    i_next
 695 $FORTH_END_CODE_WORD FLASH
 696
 697 $FORTH_CODE_WORD BRIGHT
 698 ;; k8
 699 ;; ( -- n )
 700   pop   de
 701   ld    a,e
 702   or    a
 703   jr    z,fword_bright_zero
 704   ld    e,0o0100
 705 fword_bright_zero:
 706   ld    hl,emit6_attrp
 707   ld    a,(hl)
 708   and   0o0277
 709   or    e
 710   ld    (hl),a
 711   jp    i_next
 712 $FORTH_END_CODE_WORD BRIGHT
 713
 714
 715 emit8_coordx defb 0
 716 emit8_coordy defb 0
 717
 718 $FORTH_CODE_WORD XEMIT8
 719 ;; k8
 720 ;; ( c -- )
 721 fword_xemit8:
 722   ld    hl,(emit8_coordx)
 723   ; check high parts
 724   ld    a,l
 725   cp    32
 726   jr    c,fword_xemit8_xok
 727   ld    l,255
 728   inc   h
 729 fword_xemit8_xok:
 730   inc   l
 731   ld    a,h
 732   cp    24
 733   jr    c,fword_xemit8_yok
 734   ld    h,23
 735   ld    (emit8_coordx),hl
 736   push  bc
 737   call  emit6_do_scroll_subr
 738   pop   bc
 739   ld    hl,(emit8_coordx)
 740 fword_xemit8_yok:
 741   ld    (emit8_coordx),hl
 742   dec   l
 743   ; h: y
 744   ; l: x
 745   ex    de,hl
 746   ld    a,d
 747   and   #18
 748   or    #40
 749   ld    h,a
 750   ld    a,d
 751   rrca
 752   rrca
 753   rrca
 754   and   #E0
 755   or    e
 756   ld    l,a
 757   ; HL: screen address
 758   pop   de
 759   ex    de,hl
 760   res   7,l
 761   add   hl,hl
 762   ld    h,15
 763   add   hl,hl
 764   add   hl,hl
 765   ; draw it
 766   ; HL: char address
 767   ; DE: screen$ address
 768   ld    a,8
 769   push  de
 770 fword_xemit8_loop:
 771   ex    af,af'
 772   ld    a,(hl)
 773   inc   hl
 774   ld    (de),a
 775   inc   d
 776   ex    af,af'
 777   dec   a
 778   jr    nz,fword_xemit8_loop
 779   ; put attribute
 780   pop   hl
 781   ; conver to attribute
 782   ld   a,h
 783   rrca
 784   rrca
 785   rrca
 786   and  #03
 787   or   #58
 788   ld   h,a
 789   ld   a,(emit6_attrp)
 790   ld   (hl),a
 791   jp   i_next
 792 $FORTH_END_CODE_WORD XEMIT8
 793
 794 $FORTH_CODE_WORD EMIT8
 795 ;; k8
 796 ;; ( c -- )
 797   pop   hl
 798   ld    a,l
 799   cp    13
 800   jr    z,fword_emit_cr
 801   cp    10
 802   jr    z,fword_emit_lf
 803   push  hl
 804   jr    fword_xemit8
 805 fword_emit_cr:
 806   xor   a
 807   ld    (emit8_coordx),a
 808   jp    i_next
 809 fword_emit_lf:
 810   ld    a,(emit8_coordy)
 811   inc   a
 812   ld    (emit8_coordy),a
 813   cp    25
 814   jp    c,i_next
 815   ld    a,23
 816   ld    (emit8_coordy),a
 817   push  bc
 818   call  emit6_do_scroll_subr
 819   pop   bc
 820   jp    i_next
 821 $FORTH_END_CODE_WORD EMIT8
 822
 823 $FORTH_CODE_WORD CR8
 824 ;; k8
 825 ;; ( -- )
 826   xor   a
 827   ld    (emit8_coordx),a
 828   jr    fword_emit_lf
 829 $FORTH_END_CODE_WORD CR8
 830
 831 $FORTH_CODE_WORD SPACE8
 832 ;; k8
 833 ;; ( -- )
 834   ld    l,32
 835   push  hl
 836   jp    fword_xemit8
 837 $FORTH_END_CODE_WORD SPACE8
 838
 839 $FORTH_WORD SPACES8
 840 ;; k8
 841 ;; ( n -- )
 842   DUP 1- 0< 0BRANCH fword_spaces8_ok
 843     DROP ;S
 844 fword_spaces8_ok:
 845   0 (DO)
 846 fword_spaces8_loop:
 847     SPACE8
 848   (LOOP) fword_spaces8_loop
 849   ;S
 850 $FORTH_END_WORD SPACES8
 851
 852 $FORTH_WORD TYPE8
 853 ;; AberSoft
 854 ;; ( addr len -- )
 855   dup 0 > 0BRANCH fword_type8_1
 856   OVER + SWAP (DO)
 857 fword_type8_0:
 858   I C@ EMIT8
 859   (LOOP)  fword_type8_0
 860   BRANCH fword_type8_2
 861 fword_type8_1:
 862   2DROP
 863 fword_type8_2:
 864   ;S
 865 $FORTH_END_WORD TYPE8
 866
 867 $FORTH_WORD XTYPE8
 868 ;; AberSoft, k8
 869 ;; ( addr len -- )
 870   dup 0 > 0BRANCH fword_xtype8_1
 871   OVER + SWAP (DO)
 872 fword_xtype8_0:
 873   I C@ XEMIT8
 874   (LOOP)  fword_xtype8_0
 875   BRANCH fword_xtype8_2
 876 fword_xtype8_1:
 877   2DROP
 878 fword_xtype8_2:
 879   ;S
 880 $FORTH_END_WORD XTYPE8
 881
 882 $FORTH_CODE_WORD AT8
 883 ;; k8
 884 ;; ( y x -- )
 885   pop   hl
 886   pop   de
 887   ld    h,e
 888   ld    (emit8_coordx),hl
 889   jp    i_next
 890 $FORTH_END_CODE_WORD AT8
 891
 892 $FORTH_WORD KEY8
 893 ;; k8
 894 ;; ( -- c )
 895   (KEY-SHOW-CURSOR) C@
 896   (KEY-SHOW-CURSOR) 0C!
 897   KEY
 898   SWAP (KEY-SHOW-CURSOR) C!
 899   ;S
 900 $FORTH_END_WORD KEY8
 901
 902 $FORTH_WORD (.8")  ;;"
 903 ;; k8
 904 ;; ( -- )
 905   R> COUNT 2DUP TYPE8 + >R ;S
 906 $FORTH_END_WORD (.8")  ;;"
 907
 908 $FORTH_WORD .8" IMM  ;;"
 909 ;; k8
 910 ;; ( -- )
 911   LIT 34 STATE @ 0BRANCH fword_qs8_0
 912     COMPILE (.8")  ;;"
 913     WORD C@ 1+ ALLOT
 914     ;S
 915 fword_qs8_0:
 916   WORD COUNT TYPE8
 917   ;S
 918 $FORTH_END_WORD .8"  ;;"
 919
 920 $FORTH_WORD D.8R
 921 ;; AberSoft
 922 ;; ( d n -- )
 923   >R SWAP OVER DABS <# #S SIGN #> R> OVER - SPACES8 TYPE8 ;S
 924 $FORTH_END_WORD D.8R
 925
 926 $FORTH_WORD .8R
 927 ;; AberSoft
 928 ;; ( n1 n2 -- )
 929   >R S->D R> D.8R ;S
 930 $FORTH_END_WORD .8R
 931
 932 $FORTH_WORD D.8
 933 ;; AberSoft
 934 ;; ( d -- )
 935   0 D.8R SPACE8 ;S
 936 $FORTH_END_WORD D.8
 937
 938 $FORTH_WORD .8
 939 ;; AberSoft
 940 ;; ( n -- )
 941   S->D D.8 ;S
 942 $FORTH_END_WORD .8
 943
 944 $FORTH_WORD U.8
 945 ;; AberSoft
 946 ;; ( u -- )
 947   0 D.8 ;S
 948 $FORTH_END_WORD U.8
 949
 950 $FORTH_WORD U.8R
 951 ;; AberSoft
 952 ;; ( u n -- )
 953   >R 0 R> D.8R ;S
 954 $FORTH_END_WORD U.8R
 955
 956   ENDIF