HEX CREATE SETUP-LINE ASSEMBLER
  BOT LDA, N STA, BOT 1+ LDA, N 1+ STA,
  BOT 2+ LDY, SCR-LBASES ,Y LDA,
  N 2+ STA, SCR-HBASES ,Y LDA,
  N 3 + STA, SCR-WIDTH 1- # LDY, RTS,
CREATE RAMOFF ASSEMBLER
  0C0D2 LDA, CLI, POPTWO JMP,
CODE LINE! ( LINE ADDR --- )
  SETUP-LINE JSR, BEGIN,
    N 2+ )Y LDA, N )Y STA,
    DEY, 0< UNTIL, RAMOFF JMP, C;
CODE LINE@ ( LINE ADDR --- )
  SETUP-LINE JSR, BEGIN,
    N )Y LDA, N 2+ )Y STA,
    DEY, 0< UNTIL, RAMOFF JMP, C;

CODE INT-OFF
  SEI, NEXT JMP, C;
CREATE RAMINT ASSEMBLER
  45 STA, 3FE ) JMP,  FORTH
CREATE RAMRES ASSEMBLER
  0C0D2 LDA, 804 JMP, FORTH
: INIT-RAM
  0C0D1 DUP TWEAK TWEAK 100 0 DO
    I 0C0D4 C! RAMINT 0FFFE !
    RAMRES 0FFFC ! LOOP 0C0D2 TWEAK ;
HEX 1000 SCR-WIDTH / CONSTANT L/BANK
: LINEADDR ( LINE --- ADDR )
  L/BANK /MOD DUP 2/ 2/
  0C0D4 C! 3 AND ?DUP IF 1000 * 0C0D3
  ELSE 1000 C0DB THEN
  >R 0C000 + SWAP SCR-WIDTH * +
  R> DUP INT-OFF TWEAK TWEAK ;
DECIMAL

0 VARIABLE PARM
0 VARIABLE MULTMODE
: MUST-UPDATE!
  SCROLL-LAG C@  UPDATE-TIMER C! ;
: NORMAL-MODE  0 MULTMODE ! ;
: TDMV0 ( HORIZ --- )
  SCR-WIDTH 1- MIN
  PARM @ SCR-HEIGHT 1- MIN GOTOXY
  NORMAL-MODE ;
: TDQOT ( CHAR --- )
  PUTCHAR NORMAL-MODE ;
: SAVRES ( HI --- LINE ADDR )
  CUR-Y C@  SWAP 128 * PARM @ +
  LINEADDR ;
: TDSAV ( 0 --- )
  SAVRES LINE! NORMAL-MODE ;
: TDRES ( 0 --- )
  SAVRES LINE@ MUST-UPDATE!
  NORMAL-MODE ;

: CUR-OFFSET ( --- OFFSET )
  CUR-Y C@ SCR-WIDTH * CUR-X C@ + ;

: TDILP ( LINES --- )
  CUR-OFFSET DUP SCR-BUFF SWAP
  SCR-WIDTH /MOD 3RD 3RD - DUP
  6 PICK SCR-WIDTH * + SCR-HEIGHT
  4TH - 7 PICK - SCR-WIDTH * 0 MAX
  CMOVE> ROT ROT - ROT SCR-WIDTH *
  ROT SCR-HEIGHT SWAP - SCR-WIDTH * MIN
  BLANK MUST-UPDATE!  NORMAL-MODE ;

: TDDLP ( LINES --- )
  SCR-WIDTH * CUR-OFFSET DUP SCR-BUFF
  SWAP SCR-WIDTH MOD - #SCREEN SCR-BUFF
  OVER 4TH OVER + SWAP 3RD OVER -
  6 PICK - 0 MAX CMOVE DUP ROT - 3RD
  MIN SWAP ROT - SWAP BLANK
  MUST-UPDATE! NORMAL-MODE ;

: TDICP ( CHARS --- )
  CUR-OFFSET DUP SCR-BUFF SWAP
  SCR-WIDTH MOD OVER DUP 5 PICK +
  SCR-WIDTH 4TH - 6 PICK - 0 MAX CMOVE>
  SCR-WIDTH SWAP - ROT MIN BLANK
  MUST-UPDATE! NORMAL-MODE ;

: TDDCP ( CHARS --- )
  CUR-OFFSET DUP SCR-BUFF SWAP
  SCR-WIDTH MOD OVER 4TH OVER + SWAP
  SCR-WIDTH 4TH - 6 PICK - >R R@ 0 MAX
  CMOVE SWAP R> + ROT ROT SCR-WIDTH
  SWAP - MIN BLANK MUST-UPDATE!
  NORMAL-MODE ;

: %TDSAV ( 250: SAVE LINE )
  10 MULTMODE ! ;

: %TDRES ( 251: RESTORE LINE )
  13 MULTMODE ! ;

: %TDMOV ( 200: MOVE CURSOR )
  1 MULTMODE ! ;
: %TDMV1 ( 201: MOVE CURSOR )
  3 MULTMODE ! ;
: %TDEOF ( 202: END OF FRAME )
  CLEOS ;
: %TDEOL ( 203: END OF LINE )
  CLEOL ;
: %TDDLF ( 204: CHAR AFTER CURSOR )
  BL CUR-OFFSET 2DUP SCR-BUFF C!
  SCR-MEM-ADDR C! ;
: %TDMTF ; ( 205: MOTOR OFF )
: %TDMTN ; ( 206: MOTOR ON )
: %TDCRL ( 207: NEW LINE AND CLEAR )
  RETURN DOWN CLEOL ;
: %TDNOP ; ( 210: NOOP )
: %TDBS ( 211: BACKSPACE )
  LEFT ;
: %TDLF ( 212: LINEFEED )
  DOWN ;
: %TDRCR ( 213: CARRIAGE RETURN )
  RETURN ;

: %TDORS ( 214: OUTPUT RESET )
  28 >MODEM 16 >MODEM
  CUR-X C@ >MODEM  CUR-Y C@ >MODEM ;
: %TDQOT ( 215: QUOTE CHARACTER )
  5 MULTMODE ! ;
: %TDFS ( 216: CURSOR FORWARD )
  RIGHT ;
: %TDMV0 ( 217: MOVE CURSOR )
  3 MULTMODE ! ;
: %TDCLR ( 220: CLEAR SCREEN )
  TOP CLEOS ;
: %TDBEL ( 221: BELL )
  BEEP ;
: %TDINI ; ( 222: INITIALIZE )
: %TDILP ( 223: INSERT LINE POSITIONS )
  6 MULTMODE ! ;
: %TDDLP ( 224: DELETE LINE POSITIONS )
  7 MULTMODE ! ;
: %TDICP ( 225: INSERT CHARACTERS )
  8 MULTMODE ! ;
: %TDDCP ( 226: DELETE CHARACTERS )
  9 MULTMODE ! ;

: %TDBOW ( 227: INVERSE VIDEO ON )
  1 INVMODE ! ;
: %TDRST ( 230: INVERSE VIDEO OFF )
  0 INVMODE ! ;
: %TDGRF ; ( 231: GRAPHICS )
: %TDRSU ; ( 232: REGION SCROLL UP )
: %TDRSD ; ( 233: REGION SCROLL DOWN )
: :CASE
  <BUILDS ] DOES> OVER + + @ EXECUTE ;
: CASE;
  [COMPILE] [ ; IMMEDIATE
:CASE DOCMD ( CMD --- )
  %TDMOV %TDMV1 %TDEOF %TDEOL %TDDLF
  %TDMTF %TDMTN %TDCRL %TDNOP %TDBS
  %TDLF  %TDRCR %TDORS %TDQOT %TDFS
  %TDMV0 %TDCLR %TDBEL %TDINI %TDILP
  %TDDLP %TDICP %TDDCP %TDBOW %TDRST
  %TDGRF %TDRSU %TDRSD %TDNOP %TDNOP
  %TDNOP %TDNOP %TDNOP %TDNOP %TDNOP
  %TDNOP %TDNOP %TDNOP %TDNOP %TDNOP
  %TDSAV %TDRES CASE;

: SUPDUP-OUT ( CHAR --- )
  DUP 170 < IF
    DUP 127 > IF
      127 AND DOCMD
    ELSE >SCREEN THEN
  ELSE DROP THEN ;

: GETPARM
  PARM ! 1 MULTMODE +! ;

:CASE OUTMODE ( CHAR MODE --- )
  SUPDUP-OUT
  GETPARM GETPARM GETPARM TDMV0
  TDQOT TDILP TDDLP TDICP TDDCP
  GETPARM GETPARM TDSAV
  GETPARM GETPARM TDRES
  CASE;

: >SUPDUP ( CHAR --- )
  MULTMODE @ OUTMODE ;

VARIABLE DISPING  VARIABLE SUPDUP
: DISP ( CHAR --- CHAR )
  DUP MULTMODE @
  IF INVERSE ." < " . ." >" NORMAL
  ELSE DUP 127 >
    IF DUP 169 >
      IF INVERSE ." < ??? " .
        ." >" NORMAL
      ELSE INVERSE ." < " 127 AND
        2* ['] DOCMD 2+ + @ 2+ NFA ID.
        ." >" NORMAL THEN
    ELSE DUP 32 <
      IF INVERSE 64 + EMIT NORMAL
      ELSE EMIT THEN THEN THEN ;
: >TERM ( CHAR --- )
  DISPING @ IF
    DISP THEN
  >SUPDUP ;