nxu/term.tal

( TODO: )
( 1. investigate femto/nano bugs )
( 2. support attributes (inverse, bold, dim) )
( 3. add more ansi control seqs )
( 4. log ESC [ ? x ; ... $c )

( ANSI sequences )
( )
( set attributes:      ESC [ x ; ... m  ->  0:reset 1:bright 2:dim 7:reverse )
( get cursor position: ESC [ 6 n        ->  ESC [ $row ; $col R )
( enable line wrap:    ESC [ 7 h )
( disable line wrap:   ESC [ 7 l )
( )
( move cursor home: ESC [ H )
( move cursor:      ESC [ $row ; $col H )
( move to column:   ESC [ $n G )
( move to row:      ESC [ $n d )
( move up:          ESC [ $n A )
( move down:        ESC [ $n B )
( move forward:     ESC [ $n C )
( move back:        ESC [ $n D )
( )
( erase from cursor to end of line:   ESC [ K )
( erase from start of line to cursor: ESC [ 1 K )
( erase line:                         ESC [ 2 K )
( erase from current line to bottom:  ESC [ J )
( erase from current line to top:     ESC [ 1 J )
( erase screen:                       ESC [ 2 J )
( )
( NOT SUPPORTED YET: )
( show cursor:     ESC [ ? 25 h )
( hide cursor:     ESC [ ? 25 l )
( insert lines:    ESC [ $n L )
( )
( set bracketed paste mode (xterm):         ESC [ ? 2004 h )

|00 @System     [ &vect $2 &pad $6 &r $2 &g $2 &b $2 ]
|10 @Console    [ &vect $2 &r $1 &pad $5 &w $1 ]
|20 @Screen     [ &vect $2 &w $2 &h $2 &auto  $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
|a0 @File       [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]

|0000
    @tint    $1 ( draw mode. 01=regular, 04=inverted )
    @attr    $1 ( 5 bits: RxxxBBFF )
    @dirty?  $1 ( screen needs redraw? )
    @lastkey $1 ( last button press )
    @rows    $2 ( height in characters )
    @cols    $2 ( width in characters )
    @cur-x   $2 ( cursor x: 0 <= cur-x < cols )
    @cur-y   $2 ( cursor y: 0 <= cur-y < rows )
    @max-x   $2 ( cols-1 )
    @max-y   $2 ( rows-1 )

|0100
    ( 80 cols x 24 rows )
    #0028 .rows STZ2
    #0050 .cols STZ2

    ( set max row/col )
    .rows LDZ2 #0001 SUB2 .max-y STZ2
    .cols LDZ2 #0001 SUB2 .max-x STZ2

    ( set initial cursor )
    #0000 .cur-x STZ2
    #0000 .cur-y STZ2
    
    ( confirm no buttons pressed yet )
    #00 .lastkey STZ

    ( set screen height/width based on rows/cols )
    .rows LDZ2 #30 SFT2 .Screen/h DEO2
    .cols LDZ2 #30 SFT2 .Screen/w DEO2

    ( set colors )
    #07bf .System/r DEO2
    #07bf .System/g DEO2
    #07bf .System/b DEO2
    ;load-theme JSR2

    ( set starting tint: reverse=0, bg=0, fg=2 )
    #02 .attr STZ
    ;update-tint JSR2

    ( clear screen for initial draw )
    ;clear-screen JSR2

    ( set up interrupts )
    ;redraw .Screen/vect DEO2     ( set up screen )
    ;on-key .Controller/vect DEO2 ( set up keyboard )
    ;on-read .Console/vect DEO2   ( set up stdin )

(     ( set up debug log )
    ;debug .File/name DEO2
    #01 .File/append DEO )

    BRK

@load-theme ( -> )
    ;&path .File/name DEO2
    #0002 .File/len DEO2
    ;&r .File/r DEO2
    ;&g .File/r DEO2
    ;&b .File/r DEO2
    .File/ok DEI2 ORA #01 JCN JMP2r
    LIT2 &r $2 .System/r DEO2
    LIT2 &g $2 .System/g DEO2
    LIT2 &b $2 .System/b DEO2
    JMP2r [ &path ".theme $1 ]

@first-addr ( -> )
    ;cells JMP2r

@bol-addr ( -> addr* )
    .cols LDZ2 .cur-y LDZ2 MUL2 #0002 MUL2 ;cells ADD2 JMP2r

@cur-addr ( -> addr* )
    .cols LDZ2 .cur-y LDZ2 MUL2 .cur-x LDZ2 ADD2 #0002 MUL2 ;cells ADD2 JMP2r

@eol-addr ( -> addr* )
    .cols LDZ2 .cur-y LDZ2 INC2 MUL2 #0002 MUL2 ;cells ADD2 JMP2r

@limit-addr ( -> )
    .cols LDZ2 .rows LDZ2 MUL2 #0002 MUL2 ;cells ADD2 JMP2r

@min ( x* y* -> min* )
    LTH2k JMP SWP2 POP2 JMP2r

@max ( x* y* -> max* )
    LTH2k JMP SWP2 NIP2 JMP2r

@clear-screen
    #01 .dirty? STZ
    ;cells STH2 ( [addr*] )
    #0000 &yloop ( y* [addr*] y* )
        #0000 &xloop ( y* x* [addr*] )
            #4220 STH2kr STA2 ( y* x* [addr*] )
            INC2r INC2r ( y* x* [addr+2*] )
            INC2 DUP2 .cols LDZ2 ( y* x+1* x+1* cols* [addr+2*] )
            LTH2 ,&xloop JCN ( y* x+1* [addr+2*] )
        POP2 ( y* [addr*] )
        INC2 DUP2 .rows LDZ2 ( y+1* y+1* rows* [addr*] )
        LTH2 ,&yloop JCN ( y+1* [addr*] )
    POP2 POP2r JMP2r ( )

@redraw
    .dirty? LDZ #00 EQU ,&done JCN
    ;cells STH2 ( [addr*] )
    #0000 DUP2 .Screen/y DEO2
    &yloop
        #0000 DUP2 .Screen/x DEO2
        &xloop
            STH2kr LDA2 ;draw-cell JSR2
            .Screen/x DEI2k #0008 ADD2 ROT DEO2
            INC2 INC2r INC2r
            DUP2 .cols LDZ2 LTH2 ,&xloop JCN
        POP2
        .Screen/y DEI2k #0008 ADD2 ROT DEO2
        INC2
        DUP2 .rows LDZ2 LTH2 ,&yloop JCN
    POP2 POP2r

    ;draw-cursor JSR2
    #00 .dirty? STZ
    &done BRK

@clear-cursor
    .cur-x LDZ2 #30 SFT2 .Screen/x DEO2
    .cur-y LDZ2 #30 SFT2 .Screen/y DEO2
    ;cur-addr JSR2 LDA2
    ;draw-cell JMP2

@draw-cursor
    .cur-x LDZ2 #30 SFT2 .Screen/x DEO2
    .cur-y LDZ2 #30 SFT2 .Screen/y DEO2
    ;cur-addr JSR2 LDA2
    SWP ;reverse-tint JSR2 SWP
    ;draw-cell JMP2

@on-button ( -> )
    .lastkey LDZ ( last^ )
    .Controller/button DEI ( last^ button^ )
    STHk EOR ( last-xor-button^ [button^] )
    STHr AND ( last-xor-button&button^ )
          DUP #10 AND #00 EQU ,&no-n JCN LIT "A ,arrow JSR
    &no-n DUP #20 AND #00 EQU ,&no-s JCN LIT "B ,arrow JSR
    &no-s DUP #40 AND #00 EQU ,&no-w JCN LIT "D ,arrow JSR
    &no-w DUP #80 AND #00 EQU ,&no-e JCN LIT "C ,arrow JSR
    &no-e POP .Controller/button DEI .lastkey STZ BRK

( send ESC [ $c )
@arrow ( c^ -> )
    .Console/w STH
    #1b STHkr DEO LIT "[ STHkr DEO STHr DEO
    JMP2r

@on-key ( -> )
    .Controller/key DEI ,&ok JCN ,on-button JMP
    &ok ,alt? JSR ,on-alt-key JCN
        ,ctrl? JSR ,on-ctrl-key JCN
        .Controller/key DEI .Console/w DEO BRK

@ctrl? ( -> is-down? ) .Controller/button DEI #01 AND JMP2r
@alt?  ( -> is-down? ) .Controller/button DEI #02 AND JMP2r

( alt-XYZ emits ESC and then emits XYZ )
@on-alt-key ( -> )
    #1b .Console/w DEO
    ,ctrl? JSR ,on-ctrl-key JCN
    .Controller/key DEI .Console/w DEO BRK

( ctrl-$n emits: )
(   0 <= $n < @     ->   $n         )
(   @ <= $n < `     ->   $n #40 SUB )
(   ` <= $n <= #ff  ->   $n #60 SUB )
@on-ctrl-key ( -> )
    .Controller/key DEI
    DUP LIT "@ LTH ,&done JCN
    DUP LIT "` LTH ,&c1 JCN
    LIT "` SUB ,&done JMP
    &c1 LIT "@ SUB
    &done .Console/w DEO BRK

@on-read-priv
    .Console/r DEI
    DUP LIT "; EQU ;next-arg JCN2
    DUP LIT "0 LTH ;end-arg-priv JCN2
    DUP LIT "9 GTH ;end-arg-priv JCN2
    ;add-to-arg JMP2

@start-priv
    ;on-read-priv .Console/vect DEO2
    BRK

@on-read-csi ( -> )
    .Console/r DEI
    DUP LIT "? EQU ;start-priv JCN2
    DUP LIT "; EQU ;next-arg JCN2
    DUP LIT "0 LTH ;end-arg JCN2
    DUP LIT "9 GTH ;end-arg JCN2
    ;add-to-arg JMP2

@debug-priv ( c^ -> )
    ;scratch STH2
    LIT "1 STH2kr STA INC2r
    LIT "b STH2kr STA INC2r
    #20    STH2kr STA INC2r
    LIT "[ STH2kr STA INC2r
    #20    STH2kr STA INC2r
    LIT "? STH2kr STA INC2r
    #20    STH2kr STA INC2r
    ( TODO: numeric args )
           STH2kr STA INC2r
    #0a    STH2r  STA
    #0009 .File/len DEO2
    ;scratch .File/w DEO2
    JMP2r

@end-arg-priv ( c^ -> )
    ;on-read .Console/vect DEO2
(    DUP ,debug-priv JSR )
    ( TODO: handle these )
    POP BRK

@debug-csi ( c^ -> )
    ;scratch STH2
    LIT "1 STH2kr STA INC2r
    LIT "b STH2kr STA INC2r
    #20    STH2kr STA INC2r
    LIT "[ STH2kr STA INC2r
    #20    STH2kr STA INC2r
           STH2kr STA INC2r
    #0a    STH2r  STA
    #0007 .File/len DEO2
    ;scratch .File/w DEO2
    JMP2r

@end-arg ( c^ -> )
    ;on-read .Console/vect DEO2
(    DUP ,debug-csi JSR )
    DUP LIT "d EQU ;exec-move-row JCN2     ( move cursor to row )
    DUP LIT "h EQU ;exec-noop JCN2         ( enable line wrap )
    DUP LIT "l EQU ;exec-noop JCN2         ( disable line wrap )
    DUP LIT "m EQU ;exec-set-attr JCN2     ( set attr )
    DUP LIT "n EQU ;exec-status JCN2       ( get status )
    DUP LIT "A EQU ;exec-up JCN2           ( up )
    DUP LIT "B EQU ;exec-down JCN2         ( down )
    DUP LIT "C EQU ;exec-forward JCN2      ( forward )
    DUP LIT "D EQU ;exec-back JCN2         ( back )
    DUP LIT "G EQU ;exec-move-col JCN2     ( move cursor to col )
    DUP LIT "H EQU ;exec-move JCN2         ( move cursor )
    DUP LIT "J EQU ;exec-erase-screen JCN2 ( erase screen )
    DUP LIT "K EQU ;exec-erase-line JCN2   ( erase line )
    DUP LIT "L EQU ;exec-insert-lines JCN2 ( insert blank lines )
    POP BRK

@exec-noop ( c^ -> )
    POP BRK

@read-attr ( attr* -> )
        DUP2 #0000 NEQ2 ,&!0 JCN #02 .attr STZ ,&done JMP ( reset )
    &!0 DUP2 #0001 NEQ2 ,&!1 JCN #03 ,&set-fg JMP ( bright )
    &!1 DUP2 #0002 NEQ2 ,&!2 JCN #01 ,&set-fg JMP ( dim )
    &!2 DUP2 #0007 NEQ2 ,&!7 JCN .attr LDZk #80 ORA SWP STZ ,&done JMP ( reverse )
    &!7 ,&ignored JMP

    &set-fg .attr LDZ #fc AND ORA .attr STZ
    &done ;update-tint JSR2
    &ignored POP2 JMP2r

@exec-set-attr ( c^ -> )
    POP
    ( BRK ( FIXME: gaining 4 bytes per ls -F ) )
    ;args/pos LDA2 ;args
    &loop
    LDA2k ;read-attr JSR2
    INC2 INC2
    LTH2k ,&done JCN ,&loop JMP
    &done
    POP2 POP2 BRK 

@exec1 ( addr* -> )
    STH2 #0001 ;read-arg-1 JSR2 STH2r JSR2 BRK

@exec-status
    POP #0000 ;read-arg-1 JSR2 #0006 NEQ2 ,&done
    #1b .Console/w DEO
    LIT "[ .Console/w DEO
    LIT "4 .Console/w DEO
    LIT "0 .Console/w DEO
    LIT "; .Console/w DEO
    LIT "7 .Console/w DEO
    LIT "9 .Console/w DEO
    LIT "R .Console/w DEO
    &done BRK

@exec-up POP ;up-n ;exec1 JMP2
@exec-down POP ;down-n ;exec1 JMP2
@exec-forward POP ;forward-n ;exec1 JMP2
@exec-back POP ;back-n ;exec1 JMP2

@exec-erase-line
    POP  #0000 ;read-arg-1 JSR2
    DUP2 #0000 EQU2 ,&erase-to-end JCN
    DUP2 #0001 EQU2 ,&erase-from-start JCN
    DUP2 #0002 EQU2 ,&erase-full JCN
    POP2 BRK
    &erase-full
        POP2 ;bol-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK
    &erase-to-end
        POP2 ;cur-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK
    &erase-from-start
        POP2 ;bol-addr JSR2 ;cur-addr JSR2 ;erase JSR2 BRK

@exec-erase-screen
    POP  #0000 ;read-arg-1 JSR2
    DUP2 #0000 EQU2 ,&erase-to-end JCN
    DUP2 #0001 EQU2 ,&erase-from-start JCN
    DUP2 #0002 EQU2 ,&erase-full JCN
    POP2 BRK
    &erase-full
        POP2 ;first-addr JSR2 ;limit-addr JSR2 ;erase JSR2 BRK
    &erase-to-end
        POP2 ;bol-addr JSR2 ;limit-addr JSR2 ;erase JSR2 BRK
    &erase-from-start
        POP2 ;first-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK

( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords )
@erase ( start* end* -> )
    EQU2k ,&skip JCN ( start* end* )
    OVR2 SWP2        ( start* start* end* )
    SUB2 STH2 #4220 SWP2  ( 4220 start* [count*] )
    &loop                      ( 4220 addr* [i*] )
        STA2k INC2 INC2 INC2r INC2r  ( 4220 addr+2* [i+1*] )
        ORAkr STHr ,&loop JCN  ( 4220 addr+2* [i+2*] )
    POP2r POP2 POP2            ( )
    #01 .dirty? STZ            ( ; FIXME just redraw affected tiles )
    JMP2r                      ( )
    &skip POP2 POP2 JMP2r      ( )

@exec-move-row ( c^ -> )
    POP
    #0001 ;read-arg-1 JSR2 #0001 SUB2 ( row )
    .cur-x LDZ2                       ( col )
    ;goto JSR2 BRK

@exec-move-col ( c^ -> )
    POP
    .cur-y LDZ2                       ( row )
    #0001 ;read-arg-2 JSR2 #0001 SUB2 ( col )
    ;goto JSR2 BRK

@exec-move ( c^ -> )
    POP
    #0001 ;read-arg-1 JSR2 #0001 SUB2 ( row )
    #0001 ;read-arg-2 JSR2 #0001 SUB2 ( col )
    ;goto JSR2 BRK

@exec-insert-lines ( c^ -> )
    POP
    #0001 ;read-arg-1 JSR2 ( n )
    POP2 ( TODO: shift ;screen from bol forward by n*cols bytes )
    BRK

@debug-esc ( c^ -> )
    ;scratch STH2
    LIT "1 STH2kr STA INC2r
    LIT "b STH2kr STA INC2r
    #20    STH2kr STA INC2r
           STH2kr STA INC2r
    #0a    STH2r  STA
    #0005 .File/len DEO2
    ;scratch .File/w DEO2
    JMP2r

@on-read-esc ( -> )
    .Console/r DEI LIT "[ EQU ;start-csi JCN2
(    .Console/r DEI ,debug-esc JSR )
    ;on-read .Console/vect DEO2
    ;on-read JMP2

@start-csi ( -> )
    ;reset-args JSR2
    ;on-read-csi .Console/vect DEO2
    BRK

@on-read
    .Console/r DEI
    DUP ,&ok JCN POP BRK
    &ok ( #42 .tint STZ )
    ;read JMP2

@read ( c^ -> )
    DUP #20 LTH ;read-ctrl JCN2    
    DUP #7f EQU ;read-del JCN2
    ;read-printable JMP2

@read-ctrl ( c^ -> )
    DUP #07 EQU ;read-bel JCN2
    DUP #08 EQU ;read-bs JCN2
    DUP #09 EQU ;read-tab JCN2
    DUP #0a EQU ;read-nl JCN2
    DUP #0d EQU ;read-cr JCN2
    DUP #1b EQU ;read-esc JCN2

@read-bel ( 07 -> )
    POP BRK ( TODO: flash terminal )

@read-bs ( 08 -> )
    POP
    ;clear-cursor JSR2
    #0001 ;back-n JSR2
    ;draw-cursor JSR2
    JMP2r

@read-esc ( 1b -> )
    POP ;on-read-esc .Console/vect DEO2 BRK

@read-del ( 7f -> )
    POP BRK

( @read-tab POP JMP2r )
@read-tab
    POP
    .cur-x LDZ2 NIP #07 AND #08 SUB
    &loop
    .tint LDZ #20 DUP ;cur-addr JSR2 STA2
    ;draw-cell JSR2
    ;forward JSR2
    INC DUP ,&loop JCN
    POP JMP2r

@read-cr ( 0d -> )
    POP ;clear-cursor JSR2 #0000 .cur-x STZ2 BRK

@at-max-y ( -> true? )
    .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r

@read-nl ( 0a -> )
    POP ;clear-cursor JSR2
    ,at-max-y JSR ;scroll JCN2 ;down JSR2 BRK

@read-printable ( c -> )
    .tint LDZ SWP DUP2 ;cur-addr JSR2 STA2
    ;draw-cell JSR2
    ;forward JSR2 BRK

@goto ( y* x* -> )
    ;clear-cursor JSR2
    .max-x LDZ2 ;min JSR2 .cur-x STZ2
    .max-y LDZ2 ;min JSR2 .cur-y STZ2
    ;draw-cursor JMP2

@forward-n ( n* -> )
    ;clear-cursor JSR2
    .cur-x LDZ2 ADD2 .max-x LDZ2 ;min JSR2 .cur-x STZ2
    ;draw-cursor JMP2

@forward ( -> )
    #0001 ,forward-n JMP

@back-n ( n* -> )
    ;clear-cursor JSR2
    .cur-x LDZ2 GTH2k ,&zero JCN
    SWP2 SUB2 ,&done JMP
    &zero POP2 POP2 #0000
    &done .cur-x STZ2 ;draw-cursor JMP2

@up-n ( n* -> )
    ;clear-cursor JSR2
    .cur-y LDZ2 GTH2k ,&zero JCN
    SWP2 SUB2 ,&done JMP
    &zero POP2 POP2 #0000
    &done .cur-y STZ2 ;draw-cursor JMP2

@down-n ( n* -> )
    ;clear-cursor JSR2
    .cur-y LDZ2 ADD2 .max-y LDZ2 ;min JSR2 .cur-y STZ2
    ;draw-cursor JMP2

@down ( -> )
    #0001 ,down-n JMP

@scroll
    ;limit-addr JSR2 STH2
    ;cells .cols LDZ2 #0002 MUL2 ADD2 STH2
    &loop
        STH2kr LDA2 #4220 STH2kr STA2
        STH2kr .cols LDZ2 #0002 MUL2 SUB2 STA2
        INC2r INC2r GTH2kr STHr ,&loop JCN
    POP2r POP2r
    #01 .dirty? STZ
    ;draw-cursor JSR2 BRK

( 0 <= index < 128 )
@load-tile ( index^ -> )
    #00 SWP #30 SFT2
    ;ascii ADD2 .Screen/addr DEO2
    JMP2r

( bits: Rx xx FF BB )
(  - R: reversed   [0=normal, 1=reversed] )
(  - F: foreground [0:black, 1:dim, 2:normal, 3:bright] )
(  - B: background [0:black, 1:dim, 2:normal, 3:bright] )
@update-tint ( -> )
    .attr LDZ
    DUP #80 LTH ,&ok JCN
    #80 EOR DUP #02 SFT SWP #20 SFT #0c AND ORA
    &ok #40 ORA
    .tint STZ JMP2r

@reverse-tint ( tint^ -> tint^ )
    #0f AND            ( x=tint&0f )
    DUP #02 SFT SWP    ( x>>2 x )
    #03 AND #20 SFT    ( x>>2 (x&3)<<2 )
    ORA #40 ORA        ( res=40|x>>2|(x&3)<<2 )
    JMP2r              ( res^ )

( cell* = tint^ c^ )
@draw-cell ( cell* -> )
    SWP STH                 ( c^ [tint^] )
    DUP #80 LTH ,&draw JCN  ( c^ [tint^] )
    #80 SUB                 ( c-80^ [tint^] )
    &draw ;load-tile JSR2   ( [tint^] )
    STHr .Screen/sprite DEO ( )
    JMP2r                   ( )

@next-arg ( c^ -> )
    POP
    ( TODO: check if we already have max args )
    ;args/pos LDA2k INC2 INC2 SWP2 STA2 BRK

@add-to-arg ( c^ -> )
    LIT "0 SUB LITr 00 STH ( [digit*] )
    ;args/pos LDA2 LDA2k   ( addr* value* [digit*] )
    #000a MUL2 STH2r ADD2  ( addr* value*10+digit )
    SWP2 STA2 BRK

@read-arg-1 ( default* -> n* )
    ;args LDA2 ;max JMP2
@read-arg-2 ( default* -> n* )
    ;args INC2 INC2 LDA2 ;max JMP2

@reset-args ( -> )
    ;args ;args/pos STA2
    #0000 ;args LITr f8
    &loop STA2k INC2 INC2
    INCr STHkr ,&loop JCN
    POPr POP2 POP2 JMP2r

@debug "debug_term.log 00
@scratch $40

( store up to 8 arguments for control sequences )
@args $10 &pos $2

( 128 1-bit 8x8 tiles for ASCII 7-bit characters )
@ascii
    ~chr/ascii.tal

( store tint+char for each screen position )
@cells $1900 ( 80 x 40 x 2 )