( TODO: ) ( 1. investigate femto/nano bugs ) ( 2. support attributes (inverse, bold, dim) ) ( 3. add more ansi control seqs ) ( 4. log ESC [ ? x ; ... $c ) ( 5. need draw-line word, and need to use it more ) ( a. on delete, CSI-P ) ( b. on insert ) ( 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 ) ( 1b [ ? 1000 h/l -> send mouse X & Y on button press and release (X11 xterm mouse protocol) ) ( 1b [ ? 1002 h/l -> use cell motion mouse tracking, xterm ) ( 1b [ ? 1006 h/l -> SGR mouse mode, xterm ) ( 1b [ ? 1005 h/l -> UTF-8 mouse mode, xterm ) ( 1b [ ? 1015 h/l -> urxvt Mouse mode ) |00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &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 &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 ) ( TODO: detect when pasting text from varvara if possible ) ( to send CSI 200 ~ on start of paste, and CSI 201 ~ at end of paste ) |0100 ( metadata ) ;meta .System/metadata DEO2 ;meta/name .System/title DEO2 ( 80 cols x 24 rows ) #0028 .rows STZ2 #0050 .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 ( confirm no buttons pressed yet ) #00 .lastkey STZ ( set screen height/width based on rows/cols ) .rows LDZ2 #30 SFT2 #0010 ADD2 .Screen/h DEO2 .cols LDZ2 #30 SFT2 #0010 ADD2 .Screen/w DEO2 ( set colors ) #07bf .System/r DEO2 #07bf .System/g DEO2 #07bf .System/b DEO2 load-theme #0008 DUP2 .Screen/x DEO2 .Screen/y DEO2 ( 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 ) ( 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 @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 ADD2 .Screen/y DEO2 &yloop .cols LDZ2 #0000 DUP2 #0008 ADD2 .Screen/x DEO2 &xloop STH2kr LDA2 draw-cell .Screen/x DEI2k #0008 ADD2 ROT DEO2 INC2 INC2r INC2r GTH2k ?&xloop POP2 POP2 .Screen/y DEI2k #0008 ADD2 ROT DEO2 INC2 GTH2k ?&yloop POP2 POP2 POP2r draw-cursor #00 .dirty? STZ &done BRK @clear-cursor .cur-x LDZ2 #30 SFT2 #0008 ADD2 .Screen/x DEO2 .cur-y LDZ2 #30 SFT2 #0008 ADD2 .Screen/y DEO2 cur-addr LDA2 !draw-cell @draw-cursor .cur-x LDZ2 #30 SFT2 #0008 ADD2 .Screen/x DEO2 .cur-y LDZ2 #30 SFT2 #0008 ADD2 .Screen/y DEO2 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 @on-move .Mouse/x DEI2 .lastmouse-x LDZ2 NEQ2 ?&redraw .Mouse/y DEI2 .lastmouse-y LDZ2 NEQ2 ?&redraw JMP2r &redraw .Mouse/x DEI2 .Screen/x DEO2 .Mouse/y DEI2 .Screen/y DEO2 #02f0 ;ascii ADD2 .Screen/addr DEO2 #43 .Screen/sprite DEO .Mouse/x DEI2 .lastmouse-x STZ2 .Mouse/y DEI2 .lastmouse-y STZ2 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 @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 @exec-status POP #0000 read-arg-1 #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 @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-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-g1-charset ( -> ) ;on-read-skip .Console/vect DEO2 BRK @start-csi ( c^ -> ) POP reset-args ;on-read-csi .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 ;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^ ) ( cell* = tint^ c^ ) @draw-cell ( cell* -> ) SWP STH ( c^ [tint^] ) DUP #80 LTH ?&draw ( c^ [tint^] ) #80 SUB ( c-80^ [tint^] ) &draw load-tile ( [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 @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 ( 128 1-bit 8x8 tiles for ASCII 7-bit characters ) @ascii ~chr/ascii.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 $1900 ( 80 x 40 x 2 )