( 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. investigate neauoire mosh flicker. theory: tmux running under non-ansi TERM ) ( 11. crawl has screen-clearing issues ) ( 12. cursor hiding for cmatrix ) ( 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 ) ( 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 ) |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 ) ( set to 01 to enable debug log ) #00 .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*] ) #0220 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 draw-cell .Screen/x DEI2k #0008 ( width ) ADD2 ROT DEO2 INC2 INC2r INC2r GTH2k ?&xloop POP2 POP2 .Screen/y DEI2k #000c ( height ) ADD2 ROT DEO2 INC2 GTH2k ?&yloop POP2 POP2 POP2r draw-cursor #00 .dirty? STZ &done BRK @clear-cursor .cur-x LDZ2 #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2 .cur-y LDZ2 #000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2 cur-addr LDA2 !draw-cell @screen-to-cursor .cur-x LDZ2 #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2 .cur-y LDZ2 #000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2 JMP2r @draw-cursor ( .cur-x LDZ2 #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2 .cur-y LDZ2 #000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2 ) 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 ;&path .File2/name DEO2 ( ) #0100 .File2/len DEO2 ( ) &loop ( ) ;paste-buf .File2/r DEO2 ( ) .File2/ok DEI2 ( size* ) DUP2 #0000 EQU2 ?&failed ( size* ) DUP2 paste-from-buf ( size* ) #0100 LTH2 ?&done ( ) !&loop ( ) &failed POP2 &done .paste LDZ #00 EQU ?&end LIT "1 ;bracket-paste JSR2 &end JMP2r [ &path ".snarf 00 ] @on-click-down ( click^ -> ) #02 AND ?&middle-click !&done &middle-click paste-snarf &done JMP2r @on-click-up ( unclick^ -> ) POP 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 ( ) @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 ( ) .Mouse/x DEI2 .Mouse/y DEI2 ( x* y* ) OVR2 OVR2 #01e0 ;cp437 ADD2 draw-at ( x* y* ) .lastmouse-y STZ2 .lastmouse-x STZ2 ( ) 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 ) 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 #0220 SWP2 ( 4220 start* [count*] ) &loop ( 4220 addr* [i*] ) STA2k INC2 INC2 INC2r INC2r ( 4220 addr+2* [i+1*] ) ORAkr STHr ?&loop ( 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 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 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 ?&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 BRK ( TODO: flash terminal ) @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 ) #0220 OVR2 STA2 ( bound* pos* [i*] ; pos<-4220 ) #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*] ) #0220 cur-addr ( 4220 cur* [-n*] ) &loop2 ( 4220 pos* [-i*] ) STA2k INC2 INC2 INC2r ( 4220 pos+2* [-i+1*] ) ORAkr STHr ?&loop2 ( 4220 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*] ) #0220 ROT2 STA2 ( limit* pos* x* [i*] ; pos+i<-4220 ) 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 #0220 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 ( ) @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 ( paste buffer ) @paste-buf $100 ( 256 chars x 2 tiles/char x 8 bytes/tile = 4096 bytes ) ( second tile only uses top 50% ) @cp437 ~cp437.tal @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 ( store tint+char for each screen position ) @cells