nxu/term.tal

( 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 )
( various:         ESC [ ? ... )

|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 )
    @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 )
    #0cf0 .System/r DEO2
    #0c88 .System/g DEO2
    #0c0f .System/b DEO2

    ( 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

@first-addr ( -> )
    ;screen JMP2r

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

@cur-addr ( -> addr* )
    ;bol-addr JSR2 .cur-x LDZ2 ADD2 JMP2r

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

@last-addr ( -> )
    .cols LDZ2 .rows LDZ2 MUL2 ;screen 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
    ;screen STH2
    #0000 &yloop
        #0000 &xloop
            #20 STH2kr STA INC2r
            INC2 DUP2 .cols LDZ2 LTH2 ,&xloop JCN
        POP2
        INC2 DUP2 .rows LDZ2 LTH2 ,&yloop JCN
    POP2 POP2r
    JMP2r

@redraw
    #41 .tint STZ
    .dirty? LDZ #00 EQU ,&done JCN
    ;screen STH2
    #0000 DUP2 .Screen/y DEO2
    &yloop
        #0000 DUP2 .Screen/x DEO2
        &xloop
            STH2kr LDA ;draw-tile JSR2
            .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
            INC2 INC2r
            DUP2 .cols LDZ2 LTH2 ,&xloop JCN
        POP2
        .Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
        INC2
        DUP2 .rows LDZ2 LTH2 ,&yloop JCN
    POP2 POP2r

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

@hide-cursor
    .tint LDZ
    #41 .tint STZ
    ;draw-cursor JSR2
    .tint STZ JMP2r

@show-cursor
    .tint LDZ
    #44 .tint STZ
    ;draw-cursor JSR2
    .tint STZ JMP2r

@draw-cursor
    .cur-x LDZ2 #30 SFT2 .Screen/x DEO2
    .cur-y LDZ2 #30 SFT2 .Screen/y DEO2
    .cur-y LDZ2 .cols LDZ2 MUL2 .cur-x LDZ2 ADD2 ;screen ADD2 LDA
    ;draw-tile JMP2

@on-button ( -> )
    .lastkey LDZ .Controller/button DEI STHk EOR STHr AND ( new-buttons )
          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 .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-seq ( -> )
    .Console/r DEI
    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-seq ( 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-seq 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-noop JCN2         ( set attr )
    DUP LIT "n EQU ;exec-status JCN2       ( get status )
    DUP LIT "G EQU ;exec-move-col JCN2     ( move cursor to col )
    DUP LIT "H EQU ;exec-move JCN2         ( move cursor )
    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 "J EQU ;exec-erase-screen JCN2 ( erase screen )
    DUP LIT "K EQU ;exec-erase-line JCN2   ( erase line )
    POP BRK

@exec-noop ( c^ -> )
    POP 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 ;last-addr JSR2 ;erase JSR2 BRK
    &erase-to-end
        POP2 ;bol-addr JSR2 ;last-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* -> )
    OVR2 SWP2 SUB2 STH2        ( start* [count=start-end*] )
    #20 ROT ROT                ( 20 start* [count*] )
    &loop                      ( 20 addr* [i*] )
        STAk INC2 INC2r        ( 20 addr+1* [i+1*] )
        ORAkr STHr ,&loop JCN  ( 20 addr* [i+1*] )
    POP2r POP2 POP             ( )
    #01 .dirty? STZ            ( ; FIXME just redraw affected tiles )
    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

@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-seq JCN2
    .Console/r DEI ,debug-esc JSR
    ;on-read .Console/vect DEO2
    ;on-read JMP2

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

@on-read
    .Console/r DEI
    DUP ,&ok JCN POP BRK
    &ok #41 .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
    ;hide-cursor JSR2
    #0001 ;back-n JSR2
    ;show-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
    #20 DUP ;cursor-addr JSR2 STA
    ;draw-tile JSR2
    ;forward JSR2
    INC DUP ,&loop JCN
    POP JMP2r

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

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

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

@read-printable ( c -> )
    DUP ;cursor-addr JSR2 STA
    ;draw-tile JSR2
    ;forward JSR2 BRK

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

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

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

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

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

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

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

@scroll
    ;end-screen STH2
    ;screen .cols LDZ2 ADD2 STH2
    &loop
        STH2kr LDA #20 STH2kr STA
        STH2kr .cols LDZ2 SUB2 STA
        INC2r GTH2kr STHr ,&loop JCN
    POP2r POP2r
    #01 .dirty? STZ
    ;show-cursor JSR2 BRK

@cursor-addr ( -> addr* )
    .cur-y LDZ2 .cols LDZ2 MUL2
    .cur-x LDZ2 ADD2 ;screen ADD2
    JMP2r

( 0 <= c < 256 )
@draw-tile ( c^ -> )
    DUP #80 LTH
    ,draw-7bit JCN
    ,draw-8bit JMP

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

( 0 <= c < 128 )
@draw-7bit ( c^ -> )
    ;load-tile JSR2
    .tint LDZ .Screen/sprite DEO
    JMP2r

( 128 <= c < 256 )
@draw-8bit ( 8bit^ -> )
    #80 SUB ;load-tile JSR2
    .tint LDZ #05 EOR .Screen/sprite DEO
    JMP2r

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

@next-arg ( c^ -> )
    POP
    ( TODO: check if we already have max args )
    ;args/pos LDA2k INC2 INC2 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

( store characters for redraw, etc. )
@screen $0c80 ( 80 x 40 )
@end-screen

( ( store attributes for redraw, etc. )
@attrs $0c80 ( 80 x 40 )
@end-attrs )