:asm textmode
  MOV AX 0x03 #
  INT 0x10 #
  NEXT

0 var, textpageid
0 var, textpage

: id>page 12 << ;
: page! dup textpageid ! id>page textpage ! ;

:asm showpage
  POP AX
  MOV AH 0x05 #
  INT 0x10 #
  NEXT

:asm movecursor ( xy -- )
  MOV BH textpageid @+
  MOV AH 0x02 #
  POP DX
  INT 0x10 #
  NEXT

:asm cursorshape! ( shape -- )
  POP CX
  MOV AH 0x01 #
  INT 0x10 #
  NEXT

: hidecursor 0x2607 cursorshape! ;
: showcursor 0x0607 cursorshape! ;

0x0f var, textpen

 0 const black  1 const blue      2 const green   3 const cyan
 4 const red    5 const magenta   6 const brown   7 const lgray
 8 const gray   9 const lblue    10 const lgreen 11 const lcyan
12 const lred  13 const lmagenta 14 const yellow 15 const white

: fg! textpen @ 0xf0 & | textpen ! ;
: bg! 4 << textpen @ 0x0f & | textpen ! ;

80 const pagew
25 const pageh

0xb800 const SCREENSEG

{ : PREP-TEXTCOPY
  MOV ES t& SCREENSEG @+
  MOV AH textpen @+
  MOV DI textpage @+ ; }

:asm fill-page ( char -- )
  POP AX
  PREP-TEXTCOPY
  MOV CX pagew pageh * #
  REPZ STOSW
  NEXT

0 var, textpos
: textx textpos @ 2/ pagew % ;
: texty textpos @ 2/ pagew / ;
: textx! texty pagew * + 2* textpos ! ;
: texty! pagew * textx + 2* textpos ! ;
: textxy! pagew * + 2* textpos ! ;
: nextline texty 1+ pagew * 2* textpos ! ;

{ : PREP-TEXTCOPY-XY
    PREP-TEXTCOPY
    ADD DI textpos @+ ; 

  : CORRECT-TEXTPOS
    SUB DI textpage @+
    MOV textpos @+ DI ; }

:asm draw-text ( s -- )
  MOV BX SI
  POP SI
  PREP-TEXTCOPY-XY
0 :>
  LODSB
  OR AL AL
  JZ 0 @>
  STOSW
  JMP 0 <@
0 <:
  CORRECT-TEXTPOS
  MOV SI BX
  NEXT

:asm draw-char ( char -- )
  POP AX
  PREP-TEXTCOPY-XY
  STOSW
  ADD textpos @+ 2 #
  NEXT

:asm draw-hrepeat ( count char -- )
  POP AX
  POP CX
  JCXZ 1 @>
  PREP-TEXTCOPY-XY
  SHL CX 1 #
  ADD textpos @+ CX
  SHR CX 1 #
  REPZ STOSW
1 <:
  NEXT

:asm draw-vrepeat ( count char -- )
  INT 3 #
  POP AX
  POP CX
  JCXZ 1 @>
  PREP-TEXTCOPY-XY
0 :>  
  STOSW
  ADD DI pagew 1- 2* #
  DEC CX
  JNZ 0 <@
  CORRECT-TEXTPOS
1 <:
  NEXT

( box drawing words )
var boxstyle
: hstyle boxstyle @ 0x01 & ;
: hstyle! 1 & boxstyle @ 0xfe & | boxstyle ! ;
: vstyle boxstyle @ 0x02 & 2/ ;
: vstyle! 1 & 2* boxstyle @ 0xfd & | boxstyle ! ;
: boxstyle! dup hstyle! vstyle! ;
: filled? boxstyle @ 0x04 & ;
: filled boxstyle @ 0x04 | boxstyle ! ;
: hollow boxstyle @ 0xfb & boxstyle ! ;

: hchar hstyle if 0xcd else 0xc4 then ;
: vchar vstyle if 0xba else 0xb3 then ;
: hline ( count -- ) hchar draw-hrepeat ;
: vline ( count -- ) vchar draw-vrepeat ;
: .- hchar draw-char ;
: .| vchar draw-char ;

{ : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ;
0xc9 0xd6 0xd5 0xda :corner tl
0xbb 0xb7 0xb8 0xbf :corner tr
0xc8 0xd3 0xd4 0xc0 :corner bl
0xbc 0xbd 0xbe 0xd9 :corner br
0xb9 0xb6 0xb5 0xb4 :corner lT
0xcc 0xc7 0xc6 0xc3 :corner rT
0xca 0xd0 0xcf 0xc1 :corner uT
0xcb 0xd2 0xd1 0xc2 :corner dT
0xce 0xd7 0xd8 0xc5 :corner .+

: boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ;
: boxbottom ( w -- ) bl 2 - hline br ;

: hollow-boxmiddle ( h w -- )
  textpos @ >r
  textx + 1- textx! dup vline
  <r textpos ! vline ;
: filled-boxmiddle ( h w -- ) 
  textx >r
  2 - swap 
  begin dup while 1-
    vchar draw-char over [ key   lit ] draw-hrepeat vchar draw-char
    nextline r@ textx!
  repeat drop drop rdrop ;
: boxmiddle filled? if filled-boxmiddle else hollow-boxmiddle then ;

: draw-box ( w h -- )
  swap dup boxtop ( h w )
  swap 2 - over boxmiddle
  boxbottom ;

:asm segwordmove ( dst src count seg  -- )
  MOV BX DS
  MOV AX SI
  POP ES
  MOV DX ES
  MOV DS DX
  POP CX
  POP SI
  POP DI
  CMP DI SI
  JL 0 @> ( if dst < src, then copy from the top )
  STD
  SHL CX 1 #
  ADD DI CX
  ADD SI CX
  SHR CX 1 #
  CMPSW ( decrement back to the beginning of the copy )
0 <:
  REPZ MOVSW
  CLD
  MOV SI AX
  MOV DS BX
  NEXT

32 const sp

: scrollup ( y ybottom -- )
  >r r@ over - pagew * swap 
  pagew 2* * textpage @ + 
  dup pagew 2* + <rot SCREENSEG segwordmove 
  textpos @ 0 <r textxy! pagew sp draw-hrepeat textpos ! ;

: pagecopy ( dstpage srcpage -- )
  id>page swap id>page swap [ pagew pageh * lit ] SCREENSEG segwordmove ;

: textstate textpen @ textpos @ boxstyle @ ;
: textstate! boxstyle ! textpos ! textpen ! ;