nxu/term.tal

( term.tal )

( TODO: )
( 1. fix bugs )
( 2. need to focus on line wrap )
( 3. need to implement scrolling regions )
( 4. need to be more rigorous about insert vs replace )
( 5. need draw-line word, and need to use it more )
(   a. on delete, CSI-P )
(   b. on insert )
(   c. etc. )
( 6. add more ansi control seqs )
( 7. stop hard coding terminal size in both term.py and term.tal )
( 8. key repeat - not possible in general though )
( 9. support shift+arrow and alt+arrow )
( 10. crawl has screen-clearing issues )
( 11. cursor hiding for cmatrix )
( 12. clean up super ugly selection code )
( 13. hide cursor when not moving for awhile )
( 14. configure terminal dimensions (config file?) )
( 15. blinking text? )

( 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 )
( set insert:           ESC [ 4 h )
( set replace (def):    ESC [ 4 l )
( 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 )
( move forward n tabs   ESC [ $n I )
( )
( 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 )
( )
( insert lines:              ESC [ $n L )
( delete n characters:       ESC [ $n P )
( insert n blank characters: ESC [ $n @ )
( )
( show cursor:                        ESC [ ? 25 h )
( hide cursor:                        ESC [ ? 25 l )
( set bracketed paste mode:           ESC [ ? 2004 h )
( unset bracketed paste mode:         ESC [ ? 2004 l )
( )
( SEMI-SUPPORTED )
( select G0 charset ($c)              ESC lpar $c )
( save cursor                         ESC 7 )
( restore cursor                      ESC 8 )
( )
( NOT SUPPORTED YET: )
( end alt charset                     ESC [ 10 m )
( end alt charset                     ESC [ 11 m )

( ESC [ $top $bot r -> set scrolling region [$top;$bot] )
( ESC [ 7 h/l       -> set/unset auto-wrap mode )
( ESC [ 1 h/l       -> set/unset application cursor keys [up: CSI A vs SS3 A] )
( ESC =             -> application keypad [use SS3 sequences] )
( ESC M             -> set ANSI conformance level 2 )
( ESC >             -> normal keypad [normal sequences] )

( ESC [ ? 1000 h/l -> send mouse X & Y on button press and release (X11 xterm mouse protocol) )
( ESC [ ? 1002 h/l -> use cell motion mouse tracking, xterm )
( ESC [ ? 1006 h/l -> SGR mouse mode, xterm )
( ESC [ ? 1005 h/l -> UTF-8 mouse mode, xterm )
( ESC [ ? 1015 h/l -> urxvt Mouse mode )
( ESC [ ? 1051 l   -> unset sun function key mode )
( ESC [ ? 1052 l   -> unset hp function key mode )
( ESC [ ? 1060 l   -> unset legacy keyboard emulation )
( ESC [ ? 1061 h   -> set VT220 keyboard emulation )

|00 @System     [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ]
|10 @Console    [ &vect $2 &r $1 &exec $2 &mode $1 &dead $1 &exit $1 &w $1 ]
|20 @Screen     [ &vect $2 &w $2 &h $2 &auto  $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
|90 @Mouse      [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ]
|a0 @File1      [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|b0 @File2      [ &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 )
    @col-bytes    $2 ( 2*cols )
    @debug        $1 ( use debug log? )
    @lastmouse-x  $2 ( last mouse x )
    @lastmouse-y  $2 ( last mouse y )
    @lastmouse-st $1 ( last mouse press )
    @is-lit       $1
    @is-lit-flip  $1
    @lit-click-x  $2
    @lit-click-y  $2
    @lit-drag-x   $2
    @lit-drag-y   $2
    @flash        $1

    ( terminal settings )
    @irm          $1 ( 01: insert and move right, 00: replace and overwrite )
    @awm          $1 ( 01: wrap chars at margin, 00: overwrite at margin )
    @tcem         $1 ( 01: cursor is visible, 00: cursor is invisible )
    @paste        $1 ( 01: bracketed paste is on, 00: is off )

    ( user configuration )
    @visual-bell $1

|0100
    ( metadata )
    ;meta .System/metadata DEO2
    ;meta/name .System/title DEO2

    ( 80 cols x 24 rows + 1 col for padding )
    #0018 .rows STZ2
    #0051 .cols STZ2

    ( set col-bytes, frequently needed )
    .cols LDZ2 DUP2 ADD2 .col-bytes 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

    ( start cursor at origin - including border )
    #0008 ( border ) DUP2 .Screen/x DEO2 .Screen/y DEO2

    ( confirm no buttons pressed yet )
    #00 .lastkey STZ

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

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

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

    ( set initial modes )
    #01 .irm STZ      ( insert and move right )
    #01 .awm STZ      ( wrap at margin )
    #01 .tcem STZ     ( show cursor )
    #00 .paste STZ    ( bracketed paste is off )

    ( clear screen for initial draw )
    clear-screen

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

    ( these only work with a patched uxnemu )
    ( on other emulators they should be no-ops )
    ;shell .Console/exec DEO2 ( set up bash subprocess )
    #80 .Console/mode DEO ( start bash subprocess )

    ( user defaults )
    #01 .visual-bell STZ

    ( set to 01 to enable debug log )
    #01 .debug STZ

    .debug LDZ ?&continue BRK &continue
    #99 #010e DEO
    ;debug-log .File1/name DEO2
    #01 .File1/append DEO
    BRK

@shell "bash 00 "-i 00 00

@load-theme ( -> )
    ;&path .File1/name DEO2
    #0002 .File1/len DEO2
    ;&r .File1/r DEO2
    ;&g .File1/r DEO2
    ;&b .File1/r DEO2
    .File1/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* )
    .col-bytes LDZ2 .cur-y LDZ2 MUL2 ;cells ADD2 JMP2r

@cur-addr ( -> addr* )
    .col-bytes LDZ2 .cur-y LDZ2 MUL2 .cur-x LDZ2 DUP2 ADD2 ADD2 ;cells ADD2 JMP2r

@eol-addr ( -> addr* )
    .col-bytes LDZ2 .cur-y LDZ2 INC2 MUL2 ;cells ADD2 JMP2r

@limit-addr ( -> )
    .col-bytes LDZ2 .rows LDZ2 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
    LIT2r =cells                 ( [addr*] )
    #0000 &yloop                 ( y* [addr*] y* )
        #0000 &xloop             ( y* x* [addr*] )
            #0200 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         ( y* x+1* [addr+2*] )
        POP2                     ( y* [addr*] )
        INC2 DUP2 .rows LDZ2     ( y+1* y+1* rows* [addr*] )
        LTH2 ?&yloop             ( y+1* [addr*] )
    POP2 POP2r JMP2r             ( )

@redraw ( -> )
    .dirty LDZ #00 EQU ?&done
    LIT2r =cells ( [addr*] )
    .rows LDZ2 #0000 DUP2 #0008 ( border ) ADD2 .Screen/y DEO2
    &yloop
        .cols LDZ2 #0000 DUP2 #0008 ( border ) ADD2 .Screen/x DEO2
        &xloop
            STH2kr LDA2 ( DUP2 erase-cell ) draw-cell
            #40 .Screen/sprite DEO
            ( FIXME start )
            .Screen/y DEI2k #0004 ADD2 ROT DEO2
            #40 .Screen/sprite DEO
            .Screen/y DEI2k #0004 SUB2 ROT DEO2
            ( FIXME end )
            .Screen/x DEI2k #0008 ( width/2 ) ADD2 ROT DEO2
            INC2 INC2r INC2r
            GTH2k ?&xloop
        POP2 POP2
        .Screen/y DEI2k #000c ( height ) ADD2 ROT DEO2
        INC2
        GTH2k ?&yloop
    POP2 POP2 POP2r
    .is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally
    &flashing .flash LDZ #00 EQU ?&pointer flash-bell draw-cursor BRK
    &pointer draw-pointer
    &finally draw-cursor #00 .dirty STZ
    &done BRK

@flash-bell ( -> )
    .flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
    #0000 DUP2 .lit-click-x STZ2 .lit-click-y STZ2
    .max-x LDZ2 .lit-drag-x STZ2 .max-y LDZ2 .lit-drag-y STZ2
    redraw-selection clear-selection JMP2r

@screen-to-cell ( row* col* -> )
    #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2
    #000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2
    JMP2r

@screen-to-cursor ( -> )
    .cur-y LDZ2 .cur-x LDZ2 !screen-to-cell

@clear-cursor ( -> )
    screen-to-cursor cur-addr LDA2 !draw-cell

@draw-cursor ( -> )
    screen-to-cursor cur-addr LDA2
    .tcem LDZ #00 EQU ?&skip SWP reverse-tint SWP
    &skip !draw-cell

@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 LIT "A arrow
    &no-n DUP #20 AND #00 EQU ?&no-s LIT "B arrow
    &no-s DUP #40 AND #00 EQU ?&no-w LIT "D arrow
    &no-w DUP #80 AND #00 EQU ?&no-e LIT "C arrow
    &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

@paste-from-buf ( size* -> )
    ;paste-buf SWP2 OVR2 ADD2 SWP2 ( limit* start* )
    &loop                          ( limit* pos* )
    LDAk .Console/w DEO INC2       ( limit* pos+1* )
    GTH2k ?&loop POP2 POP2 JMP2r

@bracket-paste ( c^ -> )
    .Console/w STH
    #1b STHkr DEO
    LIT "[ STHkr DEO
    LIT "2 STHkr DEO
    LIT "0 STHkr DEO
    ( c )  STHkr DEO
    LIT "~ STHr  DEO
    JMP2r

@paste-snarf ( -> )
    .paste LDZ #00 EQU ?&start LIT "0 ;bracket-paste JSR2 &start
    ;snarf .File2/name DEO2      ( )
    #0780 .File2/len DEO2        ( )
    &loop                        ( )
        ;paste-buf .File2/r DEO2 ( )
        .File2/ok DEI2           ( size* )
        DUP2 #0000 EQU2 ?&failed ( size* )
        DUP2 paste-from-buf      ( size* )
        #0780 LTH2 ?&done        ( )
        !&loop                   ( )
    &failed POP2
    &done
    .paste LDZ #00 EQU ?&end LIT "1 ;bracket-paste JSR2 &end
    JMP2r

@lit-first-y
    .is-lit-flip LDZ ?&flip .lit-click-y LDZ2 JMP2r &flip .lit-drag-y LDZ2 JMP2r
@lit-first-x
    .is-lit-flip LDZ ?&flip .lit-click-x LDZ2 JMP2r &flip .lit-drag-x LDZ2 JMP2r
@lit-last-y
    .is-lit-flip LDZ ?&flip .lit-drag-y LDZ2 JMP2r &flip .lit-click-y LDZ2 JMP2r
@lit-last-x
    .is-lit-flip LDZ ?&flip .lit-drag-x LDZ2 JMP2r &flip .lit-click-x LDZ2 JMP2r

@redraw-selection ( -> )
    lit-first-y .cols LDZ2 MUL2                 ( y0*cols* )
    lit-first-x ADD2 #0002 MUL2                 ( 2(y0*cols+x0)* )
    ;cells ADD2 STH2                            ( [addr*] )
    lit-last-y INC2 lit-first-y                 ( yn* y0* [addr*] )
    DUP2 lit-first-x STH2k                      ( yn* y0* x0* [addr* x0*] )
    screen-to-cell                              ( yn* y0* [addr* x0*] )
    &yloop                                      ( yn* y* [addr* x*] )
        OVR2 OVR2 INC2 GTH2 STH .cols LDZ2      ( yn* y* cols* [addr* x* last^] )
        lit-last-x INC2                         ( yn* y* cols* xn* [addr* x* last^] )
        STHr JMP SWP2 POP2 STH2r                ( yn* y* xlim* x* [addr*] )
        &xloop                                  ( yn* y* xlim* x* [addr*] )
            STH2kr LDA2 highlight-cell          ( yn* y* xlim* x* [addr*] )
            .Screen/x DEI2k #0008 ADD2 ROT DEO2 ( yn* y* xlim* x* [addr*] )
            INC2 INC2r INC2r                    ( yn* y* xlim* x+1* [addr+2*] )
            GTH2k ?&xloop                       ( yn* y* xlim* x+1* [addr+2*] )
        POP2 POP2                               ( yn* y* [addr+2*] )
        .Screen/y DEI2k #000c ADD2 ROT DEO2     ( yn* y* [addr+2*] )
        #0008 .Screen/x DEO2                    ( yn* y* [addr+2*] )
        LIT2r 0000 INC2 GTH2k ?&yloop           ( yn* y+1* [addr+2* 0*] )
    POP2 POP2 POP2r POP2r                       ( )
    JMP2r                                       ( )

@point-to-coord ( x* y* -> row* col* )
    DUP2 #0008 SUB2 min #000c DIV2 .max-y LDZ2 min SWP2  ( row=(y-8)/12* x* )
    DUP2 #0008 SUB2 min #0008 DIV2 .max-x LDZ2 min JMP2r ( row* col=(x-8)/8* )

@start-selection ( -> )
    #01 .is-lit STZ                         ( )
    .Mouse/x DEI2 .Mouse/y DEI2             ( x* y* )
    #00 .is-lit-flip STZ                    ( x* y* )
    point-to-coord                          ( row* col* )
    DUP2 .lit-click-x STZ2 .lit-drag-x STZ2 ( row* )
    DUP2 .lit-click-y STZ2 .lit-drag-y STZ2 ( )
    redraw-selection !draw-cursor           ( )

@selection-is-empty ( -> bool^ )
    .lit-click-y LDZ2 .lit-drag-y LDZ2 EQU2
    .lit-click-x LDZ2 .lit-drag-x LDZ2 EQU2 AND JMP2r

@find-natural-end ( y* -> xend* )
    DUP2 .cols LDZ2 MUL2             ( y* y*cols* )
    #0002 MUL2 ;cells ADD2 INC2      ( y* edge* )
    DUP2 .max-x LDZ2 #0002 MUL2 ADD2 ( y* edge* start=edge+2cols* )
    &loop                            ( y* edge* addr* )
        LDAk ?&done                  ( y* edge* addr* )
        #0002 SUB2 LTH2k ?&loop      ( y* edge* addr-2* )
    &done                            ( y* edge* addr* )
        SWP2 SUB2 #0002 DIV2         ( y* x* )
        NIP2 JMP2r                   ( x* )

@copy-line ( y* x1* x0* -> y* )
    STH2 STH2 DUP2 find-natural-end    ( y* xend* [x0* x1*] )
    STH2r min                          ( y* xlim=min(xend,x1)* [x0*] )
    OVR2 .cols LDZ2 MUL2               ( y* xlim* y*cols* [x0*] )
    STH2kr ADD2 #0002 MUL2 ;cells ADD2 ( y* xlim* addr* [x0*] )
    INC2 STH2 SWP2r STH2r            ( y* xlim* x0* [addr+1*] )
    SUB2 INC2 #0000 SWP2 SUB2        ( y* -count* [addr+1*] )
    &loop                            ( y* -i* [pos*] )
        LDAkr STHr copy-char         ( y* -i* [pos*] )
        INC2 INC2r INC2r ORAk ?&loop ( y* -i+1* [pos+2*] )
    POP2 POP2r JMP2r                 ( y* )

@copy-char ( c^ -> )
    DUP ?&ok POP #20 ( replace \0 with space )
    &ok STH ;paste-pos LDA2k ( pos* addr* [c^] )
    STH2k STAr INC2 SWP2 STA2 JMP2r  ( )

@copy-selection ( -> )
    ;paste-buf ;paste-pos STA2
    lit-last-y INC2 lit-first-y                 ( ylim* y0* )
    DUP2 lit-first-x STH2k screen-to-cell       ( yn* y0* [x0*] )
    &yloop                                      ( yn* y* [x*] )
        OVR2 OVR2 INC2 GTH2 STH .max-x LDZ2     ( yn* y* maxx* [x* last^] )
        lit-last-x                              ( yn* y* maxx* xlast* [x* last^] )
        STHr JMP SWP2 POP2 STH2r                ( yn* y* x1* x* )
        copy-line                               ( yn* y* )
        LIT2r 0000 INC2 GTH2k ?&next !&done     ( yn* y+1* [0*] )
    &next                                       ( )
        #0a copy-char !&yloop                   ( )
    &done                                       ( )
        POP2 POP2 POP2r                         ( )
        ;snarf .File2/name DEO2                 ( )
        ;paste-pos LDA2 ;paste-buf SUB2         ( len* )
        .File2/len DEO2                         ( )
        ;paste-buf .File2/w DEO2                ( )
        JMP2r                                   ( )

@handle-selection ( -> )
    selection-is-empty ?&skip copy-selection &skip !clear-selection

@clear-selection ( -> )
    #00 .is-lit STZ
    #00 .is-lit-flip STZ
    #01 .dirty STZ
    #0000 DUP2 .lit-click-y STZ2
          DUP2 .lit-click-x STZ2
          DUP2 .lit-drag-y STZ2
               .lit-drag-x STZ2 JMP2r

@update-selection ( -> )
    .Mouse/x DEI2 .Mouse/y DEI2 point-to-coord  ( row* col* )
    OVR2 .lit-drag-y STZ2 DUP2 .lit-drag-x STZ2 ( row* col* )
    OVR2 .lit-click-y LDZ2 LTH2 ?&earlier       ( row* col* )
    DUP2 .lit-click-x LDZ2 LTH2 ?&earlier       ( row* col* )
    #00 !&done &earlier #01                     ( row* col* )
    &done .is-lit-flip STZ POP2 POP2 JMP2r      ( )

@end-selection ( -> )
    update-selection draw-cursor !handle-selection ( )

@on-click-down ( click^ -> )
    DUP #01 AND ?&left-click
    DUP #02 AND ?&middle-click
                !&done
    &left-click POP !start-selection
    &middle-click POP !paste-snarf
    &done POP JMP2r

@on-click-up ( unclick^ -> )
    #01 AND ?&left-click !&done
    &left-click !end-selection
    &done JMP2r

@draw-at ( x* y* addr* -> )
    STH2k .Screen/addr DEO2            ( x* y* [addr*] )
    STH2k .Screen/y DEO2               ( x [addr* y*] )
    .Screen/x DEO2                     ( [addr* y* x*] )
    #43 .Screen/sprite DEOk            ( 43 sprite^ [addr* y* x*] )
    STH2r #0008 ADD2 .Screen/y DEO2    ( 43 sprite^ [addr*] )
    STH2r #0008 ADD2 .Screen/addr DEO2 ( 43 sprite^ )
    DEO JMP2r                          ( )

@draw-pointer ( -> )
    .lastmouse-x LDZ2 .lastmouse-y LDZ2 ( x* y* )
    #01e0 ;cp437 ADD2 !draw-at          ( )

@on-move ( -> )
    .Mouse/x DEI2 .lastmouse-x LDZ2 NEQ2 ?&redraw ( )
    .Mouse/y DEI2 .lastmouse-y LDZ2 NEQ2 ?&redraw ( )
    JMP2r                                         ( )
    &redraw                                       ( )
    .lastmouse-x LDZ2 .lastmouse-y LDZ2           ( lx* ly* )
    #0200 ;cp437 ADD2 draw-at                     ( )
    .is-lit LDZ #00 EQU ?&next
    update-selection ( redraw-selection )
    #01 .dirty STZ
    &next
    .Mouse/x DEI2 .Mouse/y DEI2                   ( x* y* )
    .lastmouse-y STZ2 .lastmouse-x STZ2           ( )
    draw-pointer
    screen-to-cursor                              ( )
    JMP2r                                         ( )

@on-mouse ( -> )
    .lastmouse-st LDZ           ( last )
    .Mouse/state DEI            ( last st )
    STHk OVR EOR STHkr AND      ( last (last^st)&st [st] )
    on-click-down               ( last [st] )
    DUP STHkr EOR AND           ( last&(last^st) [st] )
    on-click-up                 ( [st] )
    STHr .lastmouse-st STZ      ( )
    on-move BRK                 ( )

@on-key ( -> )
    .Controller/key DEI ?&ok !on-button
    &ok alt ?on-alt-key
        ctrl ?on-ctrl-key
    .Controller/key DEI
    DUP #08 NEQ ?&done
    POP #7f ( send DEL instead of BS )
    &done .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 ?on-ctrl-key
    .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
    DUP LIT "` LTH ?&c1
    LIT "` SUB !&done
    &c1 LIT "@ SUB
    &done .Console/w DEO BRK

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

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

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

@on-read-osc ( -> )
    .Console/r DEI
    DUP #07 ( bell  ) EQU ?&end-osc
        #9c ( esc-\ ) EQU ?&end-osc BRK
    &end-osc ;on-read .Console/vect DEO2 BRK

@debug-arg ( n* -> )
    &short SWP debug-arg/byte
    &byte DUP #04 SFT debug-arg/char
    &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD !scratch-write

@debug-args ( -> )
    ;args/pos LDA2 ;args
    &loop
    #20 scratch-write
    LDA2k debug-arg/short INC2 INC2
    LTH2k ?&done !&loop
    &done POP2 POP2 JMP2r

@debug-priv ( c^ -> )
    .debug LDZ ?&continue POP JMP2r &continue
    reset-scratch
    LIT2r =scratch-write
    LIT "1 STH2kr JSR2
    LIT "b STH2kr JSR2
    #20    STH2kr JSR2
    LIT "[ STH2kr JSR2
    #20    STH2kr JSR2
    LIT "? STH2kr JSR2
    debug-args
    #20    STH2kr JSR2
           STH2kr JSR2
    #0a    STH2r  JSR2
    scratch-len .File1/len DEO2
    ;scratch .File1/w DEO2
    JMP2r

@end-arg-priv ( c^ -> )
    ;on-read .Console/vect DEO2
    DUP LIT "h EQU ?exec-priv-set-or-unset
    DUP LIT "l EQU ?exec-priv-set-or-unset
    DUP debug-priv
    ( TODO: handle these )
    POP BRK

@exec-priv-set-or-unset ( c^ -> )
    #0001 read-arg-1 ( c^ n* )
           DUP2 #0019 NEQ2 ?&!25 POP2 .tcem !&change
    &!25   DUP2 #07d4 NEQ2 ?&!2004 POP2 .paste !&change
    &!2004 POP2 debug-priv BRK
    &change SWP LIT "h EQU SWP STZ BRK ( h is set, l is unset )

@debug-read ( c^ -> )
    .debug LDZ ?&continue POP JMP2r &continue
    reset-scratch
    debug-arg/byte
    #0a scratch-write
    scratch-len .File1/len DEO2
    ;scratch .File1/w DEO2
    JMP2r

@debug-csi ( c^ -> )
    .debug LDZ ?&continue POP JMP2r &continue
    reset-scratch
    LIT2r =scratch-write
    LIT "1 STH2kr JSR2
    LIT "b STH2kr JSR2
    #20    STH2kr JSR2
    LIT "[ STH2kr JSR2
    debug-args
    #20    STH2kr JSR2
           STH2kr JSR2
    #0a    STH2r  JSR2
    scratch-len .File1/len DEO2
    ;scratch .File1/w DEO2
    JMP2r

@end-arg ( c^ -> )
    ;on-read .Console/vect DEO2
    DUP debug-csi
    DUP LIT "d EQU ?exec-move-row     ( move cursor to row )
    DUP LIT "h EQU ?exec-set-mode     ( enable line wrap )
    DUP LIT "l EQU ?exec-reset-mode   ( disable line wrap )
    DUP LIT "m EQU ?exec-set-attr     ( set attr )
    DUP LIT "n EQU ?exec-status       ( get status )
    DUP LIT "@ EQU ?exec-insert-blanks ( insert blank characters )
    DUP LIT "A EQU ?exec-up           ( up )
    DUP LIT "B EQU ?exec-down         ( down )
    DUP LIT "C EQU ?exec-forward      ( forward )
    DUP LIT "D EQU ?exec-back         ( back )
    DUP LIT "G EQU ?exec-move-col     ( move cursor to col )
    DUP LIT "H EQU ?exec-move         ( move cursor )
    DUP LIT "I EQU ?exec-forward-tabs ( forward by tab stops )
    DUP LIT "J EQU ?exec-erase-screen ( erase screen )
    DUP LIT "K EQU ?exec-erase-line   ( erase line )
    DUP LIT "L EQU ?exec-insert-lines ( insert blank lines )
    DUP LIT "M EQU ?exec-delete-lines    ( delete n lines )
    DUP LIT "P EQU ?exec-delete-chars    ( delete n chars )
    ( ` - horizontal position absolute )
    ( S - scroll up n lines )
    ( X - erase n chars )
    ( Z - backward n tab stops )
    ( = 0 C - normal cursor )
    ( = 1 C - bold cursor )
    debug-csi BRK

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

( set mode )
( TODO: insert/replace, line wrap, etc. )
@exec-set-mode ( c^ -> )
    POP #0001 read-arg-1
          DUP2 #0004 NEQ2 ?&!irm POP2 .irm !&set
    &!irm DUP2 #0007 NEQ2 ?&!awm POP2 .awm !&set
    &!awm POP2 BRK
    &set #01 SWP STZ BRK

@exec-reset-mode ( c^ -> )
    POP #0001 read-arg-1
          DUP2 #0004 NEQ2 ?&!irm POP2 .irm !&reset
    &!irm DUP2 #0007 NEQ2 ?&!awm POP2 .awm !&reset
    &!awm POP2 BRK
    &reset #00 SWP STZ BRK

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

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

@exec-set-attr ( c^ -> )
    POP
    ;args/pos LDA2 ;args
    &loop
    LDA2k read-attr
    INC2 INC2
    LTH2k ?&done !&loop
    &done
    POP2 POP2 BRK

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

( FIXME: hardcoded terminal size )
@exec-status
    POP #0000 read-arg-1 #0006 NEQ2 ,&done
    #1b .Console/w DEO
    LIT "[ .Console/w DEO
    LIT "2 .Console/w DEO
    LIT "4 .Console/w DEO
    LIT "; .Console/w DEO
    LIT "8 .Console/w DEO
    LIT "0 .Console/w DEO
    LIT "R .Console/w DEO
    &done BRK

@exec-up POP ;up-n !exec1
@exec-down POP ;down-n !exec1
@exec-forward POP ;forward-n !exec1
@exec-back POP ;back-n !exec1
@exec-insert-blanks POP ;insert-n-spaces !exec1
@exec-delete-lines POP ;delete-n-lines !exec1
@exec-delete-chars POP ;delete-n-chars !exec1
@exec-insert-lines POP ;insert-n-lines !exec1
@exec-forward-tabs POP ;forward-n-tabs !exec1

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

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

( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords )
@erase ( start* end* -> )
    EQU2k ?&skip ( start* end* )
    OVR2 SWP2        ( start* start* end* )
    SUB2 STH2 #0200 SWP2  ( 0200 start* [count*] )
    &loop                      ( 0200 addr* [i*] )
        STA2k INC2 INC2 INC2r INC2r  ( 0200 addr+2* [i+1*] )
        ORAkr STHr ?&loop  ( 0200 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 dec-floor ( row )
    .cur-x LDZ2                ( col )
    goto BRK

@exec-move-col ( c^ -> )
    POP
    .cur-y LDZ2                ( row )
    #0001 read-arg-1 dec-floor ( col )
    goto BRK

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

@dec-floor ( x* -> x==0 ? 0* : x-1* )
    ORAk ?&sub JMP2r &sub #0001 SUB2 JMP2r

@debug-esc ( c^ -> )
    .debug LDZ ?&continue POP JMP2r &continue
    LIT2r =scratch
    LIT "1 STH2kr STA INC2r
    LIT "b STH2kr STA INC2r
    #20    STH2kr STA INC2r
           STH2kr STA INC2r
    #0a    STH2r  STA
    #0005 .File1/len DEO2
    ;scratch .File1/w DEO2
    JMP2r

@on-read-esc ( -> )
    .Console/r DEI
    DUP debug-esc
    DUP LIT "[ EQU ?start-csi
    DUP LIT "] EQU ?start-osc
    DUP LIT "( EQU ?start-charset
    DUP LIT ") EQU ?start-charset
    DUP LIT "7 EQU ?&skip ( save cursor )
    DUP LIT "8 EQU ?&skip ( restore cursor )
    debug-esc
    ;on-read .Console/vect DEO2
    !on-read
    &skip POP ;on-read .Console/vect DEO2 BRK

@on-read-skip ( -> )
    ;on-read .Console/vect DEO2
    BRK

( '(' = designate G0 charset )
( ')' = designate G1 charset )
( '*' = designate G2 charset )
( '+' = designate G3 charset )
@start-charset ( c^ -> )
    POP ;on-read-skip .Console/vect DEO2 BRK

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

@start-osc ( c^ -> )
    POP reset-args ;on-read-osc .Console/vect DEO2 BRK

@on-read ( -> )
    .Console/r DEI
    DUP debug-read
    DUP ?&ok POP BRK
    &ok ( #42 .tint STZ )
    !read

@read ( c^ -> )
    DUP #20 LTH ?read-ctrl
    DUP #7f EQU ?read-del
    !read-printable

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

@read-bel ( 07 -> )
    POP .visual-bell LDZ #00 EQU ?&done
    #06 .flash STZ #01 .dirty STZ
    &done BRK

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

@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          ( x* )
    NIP #07 AND #08 SUB  ( i=(xlo&7)-8^ )
    &loop                ( i^ )
    .tint LDZ #20 DUP2   ( i^ cell* cell* )
    cur-addr STA2  ( i^ cell* ; addr<-cell )
    draw-cell      ( i^ )
    forward        ( i^ )
    INC DUP ?&loop   ( i+1^ )
    POP BRK              ( )

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

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

@read-nl ( 0a -> )
    POP clear-cursor
    at-max-y ?scroll down BRK

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

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

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

@forward ( -> )
    #0001 !forward-n

@back-n ( n* -> )
    clear-cursor
    .cur-x LDZ2 GTH2k ?&zero
    SWP2 SUB2 !&done
    &zero POP2 POP2 #0000
    &done .cur-x STZ2 !draw-cursor

@up-n ( n* -> )
    clear-cursor
    .cur-y LDZ2 GTH2k ?&zero
    SWP2 SUB2 !&done
    &zero POP2 POP2 #0000
    &done .cur-y STZ2 !draw-cursor

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

@down ( -> )
    #0001 !down-n

@insert ( c^ -> )
    .attr LDZ SWP !insert-cell

@insert-cell ( cell* -> )
    .irm LDZ #00 EQU ?&replace ( cell* )
    eol-addr #0001 SUB2        ( cell* last=eol-1* )
    cur-addr                   ( cell* last* cur* )
    &loop                      ( cell* last* pos* )
        LDA2k OVR2 INC2 STA2   ( cell* last* pos* ; pos+1<-pos )
        INC2 LTH2k ?&loop      ( cell* last pos+1* )
    POP2 POP2                  ( cell* )
    &replace                   ( cell* )
        cur-addr STA2 JMP2r    ( )

@forward-n-tabs ( n* -> )
    dec-floor #0008 MUL2              ( i=(n-1)8* )
    #0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* )
    ADD2 !forward-n                   ( )

@insert-n-lines ( n* -> )
    .col-bytes LDZ2 MUL2 STH2    ( [i*] )
    bol-addr                     ( bound* [i*] )
    limit-addr STH2kr            ( bound* limit* i* [i*] )
    INC2 INC2 SUB2               ( bound* start=limit-i-2* [i*] )
    &loop                        ( bound* pos* [i*] )
        LDA2k OVR2 STH2kr ADD2   ( bound* pos* x* pos+i* [i*] )
        STA2                     ( bound* pos* [i*] ; pos+i<-x )
        #0200 OVR2 STA2          ( bound* pos* [i*] ; pos<-0200 )
        #0002 SUB2               ( bound* pos-2* [i*] )
        GTH2k #00 EQU ?&loop     ( bound* pos-2* [i*] )
    POP2 POP2 POP2r              ( )
    #01 .dirty STZ JMP2r        ( )

@insert-n-spaces ( n* -> )
    STH2                        ( [n*] )
    .irm LDZ #00 EQU ?&replace  ( [n*] )
    eol-addr #0001 SUB2         ( last* [n*] )
    STH2kr DUP2 ADD2 SUB2       ( start=last-2n* [n*] )
    cur-addr SWP2               ( end* start* [n*] )
    DUP2kr ADD2r                ( end* start* [n* 2n*] )
    &loop                       ( end* pos* [n* 2n*] )
        LDA2k OVR2 STH2kr ADD2  ( end* pos* x* pos+2n* )
        STA2 #0002 SUB2         ( end* pos-2* [n* 2n*] )
        GTH2k #00 EQU ?&loop    ( end* pos-2* [n* 2n*] )
        POP2 POP2 POP2r         ( [n*] )
    &replace                    ( [n*] )
        LIT2r 0000 SWP2r SUB2r  ( [-n*] )
        #0200 cur-addr          ( 0200 cur* [-n*] )
    &loop2                      ( 0200 pos* [-i*] )
        STA2k INC2 INC2 INC2r   ( 0200 pos+2* [-i+1*] )
        ORAkr STHr ?&loop2      ( 0200 pos+2* [-i+1*] )
    POP2 POP2 POP2r             ( )
    #01 .dirty STZ JMP2r       ( )

( starts with cursor pos )
@delete-n-chars ( n* -> )
    DUP2 ADD2 STH2              ( [i=2n*] )
    eol-addr STH2kr SUB2        ( limit=eol-i* [i*] )
    cur-addr                    ( limit* start* [i*] )
    &loop                       ( limit* pos* [n*] )
        DUP2 STH2kr ADD2 LDA2k  ( limit* pos* pos+i* x* [i*] )
        #0200 ROT2 STA2         ( limit* pos* x* [i*] ; pos+i<-0200 )
        OVR2 STA2 INC2 INC2     ( limit* pos+2* [i*]  ; pos<-x )
        GTH2k ?&loop            ( limit* pos+2* [i*] )
    POP2 POP2 POP2r             ( )
    #01 .dirty STZ JMP2r       ( )

( starts below current line )
@delete-n-lines ( n* -> )
    .col-bytes LDZ2 MUL2 STH2   ( [n*] )
    limit-addr STH2kr SUB2      ( limit* [n*] )
    eol-addr                    ( limit* start* [n*] )
    !delete-n-chars/loop

@scroll
    limit-addr STH2
    ;cells .col-bytes LDZ2 ADD2 STH2
    &loop
        STH2kr LDA2 #0200 STH2kr STA2
        STH2kr .col-bytes LDZ2 SUB2 STA2
        INC2r INC2r GTH2kr STHr ?&loop
    POP2r POP2r
    #01 .dirty STZ
    draw-cursor BRK

( ( 0 <= index < 128 )
@load-tile ( index^ -> )
    #00 SWP #30 SFT2 ( size in bytes )
    ;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
    #80 EOR DUP #02 SFT SWP #20 SFT #0c AND ORA
    &ok .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                ( res=40|x>>2|(x&3)<<2 )
    JMP2r              ( res^ )

( to draw a 12 pixel high character we first draw the top )
( 8 pixels and then we draw the bottom 8 pixels; there is )
( an overlap of 4 pixels. we do this to avoid drawing too )
( low which might overwrite characters on the next line. )

( cell* = tint^ c^ )
@draw-cell ( cell* -> )
    SWP STH                             ( c^ [tint^] )
    #00 SWP #40 SFT2 ;cp437 ADD2        ( addr* [tint^] )
    .Screen/addr DEO2k                  ( addr* s^ [tint^] )
    STHkr .Screen/sprite DEO            ( addr* s^ [tint^] )
    .Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] )
    STH #0004 ADD2 STHr DEO2            ( [tint^] )
    STHr .Screen/sprite DEO             ( )
    .Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
    JMP2r                               ( )

@erase-cell ( cell* -> )
    NIP LITr 40                         ( c^ [tint^] )
    #00 SWP #40 SFT2 ;cp437 ADD2        ( addr* [tint^] )
    .Screen/addr DEO2k                  ( addr* s^ [tint^] )
    STHkr .Screen/sprite DEO            ( addr* s^ [tint^] )
    .Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] )
    STH #0004 ADD2 STHr DEO2            ( [tint^] )
    STHr .Screen/sprite DEO             ( )
    .Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
    JMP2r                               ( )

@highlight-cell ( cell* -> )
    NIP LITr 47                         ( c^ [tint^] )
    #00 SWP #40 SFT2 ;cp437 ADD2        ( addr* [tint^] )
    .Screen/addr DEO2k                  ( addr* s^ [tint^] )
    STHkr .Screen/sprite DEO            ( addr* s^ [tint^] )
    .Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] )
    STH #0004 ADD2 STHr DEO2            ( [tint^] )
    STHr .Screen/sprite DEO             ( )
    .Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
    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
@read-arg-2 ( default* -> n* )
    ;args INC2 INC2 LDA2 !max

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

@debug-log "debug_term.log 00
@scratch $40 &pos $2

@scratch-write ( c^ -> )
    ;scratch/pos LDA2 STA
    ;scratch/pos LDA2k INC2 SWP2 STA2 JMP2r
@scratch-len ( -> n* )
    ;scratch/pos LDA2 ;scratch SUB2 JMP2r
@reset-scratch
    ;scratch ;scratch/pos STA2 JMP2r

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

( 256 chars x 2 tiles/char x 8 bytes/tile = 4096 bytes )
( second tile only uses top 50% )
@cp437
    ~cp437.tal

@snarf ".snarf 00

@meta 00
    &name "determ 0a
    &details "ansi 20 "terminal 20 "emulator 0a
    &author "by 20 "d_m 0a
    &date "3 20 "jan 20 2023 00
    01
    ( device mask ) 41 0d07

( paste buffer )
@paste-buf $0780 ( max 80 x 24 characters )
@paste-pos $2

( store tint+char for each screen position )
@cells