( TODO: ) ( 1. investigate femto/nano bugs ) ( 2. support attributes (inverse, bold, dim) ) ( 3. add more ansi control seqs ) ( 4. log ESC [ ? x ; ... $c ) ( ANSI sequences ) ( ) ( set attributes: ESC [ x ; ... m -> 0:reset 1:bright 2:dim 7:reverse ) ( get cursor position: ESC [ 6 n -> ESC [ $row ; $col R ) ( enable line wrap: ESC [ 7 h ) ( disable line wrap: ESC [ 7 l ) ( ) ( move cursor home: ESC [ H ) ( move cursor: ESC [ $row ; $col H ) ( move to column: ESC [ $n G ) ( move to row: ESC [ $n d ) ( move up: ESC [ $n A ) ( move down: ESC [ $n B ) ( move forward: ESC [ $n C ) ( move back: ESC [ $n D ) ( ) ( erase from cursor to end of line: ESC [ K ) ( erase from start of line to cursor: ESC [ 1 K ) ( erase line: ESC [ 2 K ) ( erase from current line to bottom: ESC [ J ) ( erase from current line to top: ESC [ 1 J ) ( erase screen: ESC [ 2 J ) ( ) ( NOT SUPPORTED YET: ) ( show cursor: ESC [ ? 25 h ) ( hide cursor: ESC [ ? 25 l ) ( insert lines: ESC [ $n L ) ( ) ( set bracketed paste mode (xterm): ESC [ ? 2004 h ) |00 @System [ &vect $2 &pad $6 &r $2 &g $2 &b $2 ] |10 @Console [ &vect $2 &r $1 &pad $5 &w $1 ] |20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ] |80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ] |a0 @File [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |0000 @tint $1 ( draw mode. 01=regular, 04=inverted ) @attr $1 ( 5 bits: RxxxBBFF ) @dirty? $1 ( screen needs redraw? ) @lastkey $1 ( last button press ) @rows $2 ( height in characters ) @cols $2 ( width in characters ) @cur-x $2 ( cursor x: 0 <= cur-x < cols ) @cur-y $2 ( cursor y: 0 <= cur-y < rows ) @max-x $2 ( cols-1 ) @max-y $2 ( rows-1 ) |0100 ( 80 cols x 24 rows ) #0028 .rows STZ2 #0050 .cols STZ2 ( set max row/col ) .rows LDZ2 #0001 SUB2 .max-y STZ2 .cols LDZ2 #0001 SUB2 .max-x STZ2 ( set initial cursor ) #0000 .cur-x STZ2 #0000 .cur-y STZ2 ( confirm no buttons pressed yet ) #00 .lastkey STZ ( set screen height/width based on rows/cols ) .rows LDZ2 #30 SFT2 .Screen/h DEO2 .cols LDZ2 #30 SFT2 .Screen/w DEO2 ( set colors ) #07bf .System/r DEO2 #07bf .System/g DEO2 #07bf .System/b DEO2 ;load-theme JSR2 ( set starting tint: reverse=0, bg=0, fg=2 ) #02 .attr STZ ;update-tint JSR2 ( clear screen for initial draw ) ;clear-screen JSR2 ( set up interrupts ) ;redraw .Screen/vect DEO2 ( set up screen ) ;on-key .Controller/vect DEO2 ( set up keyboard ) ;on-read .Console/vect DEO2 ( set up stdin ) ( ( set up debug log ) ;debug .File/name DEO2 #01 .File/append DEO ) BRK @load-theme ( -> ) ;&path .File/name DEO2 #0002 .File/len DEO2 ;&r .File/r DEO2 ;&g .File/r DEO2 ;&b .File/r DEO2 .File/ok DEI2 ORA #01 JCN JMP2r LIT2 &r $2 .System/r DEO2 LIT2 &g $2 .System/g DEO2 LIT2 &b $2 .System/b DEO2 JMP2r [ &path ".theme $1 ] @first-addr ( -> ) ;cells JMP2r @bol-addr ( -> addr* ) .cols LDZ2 .cur-y LDZ2 MUL2 #0002 MUL2 ;cells ADD2 JMP2r @cur-addr ( -> addr* ) .cols LDZ2 .cur-y LDZ2 MUL2 .cur-x LDZ2 ADD2 #0002 MUL2 ;cells ADD2 JMP2r @eol-addr ( -> addr* ) .cols LDZ2 .cur-y LDZ2 INC2 MUL2 #0002 MUL2 ;cells ADD2 JMP2r @limit-addr ( -> ) .cols LDZ2 .rows LDZ2 MUL2 #0002 MUL2 ;cells ADD2 JMP2r @min ( x* y* -> min* ) LTH2k JMP SWP2 POP2 JMP2r @max ( x* y* -> max* ) LTH2k JMP SWP2 NIP2 JMP2r @clear-screen #01 .dirty? STZ ;cells STH2 ( [addr*] ) #0000 &yloop ( y* [addr*] y* ) #0000 &xloop ( y* x* [addr*] ) #4220 STH2kr STA2 ( y* x* [addr*] ) INC2r INC2r ( y* x* [addr+2*] ) INC2 DUP2 .cols LDZ2 ( y* x+1* x+1* cols* [addr+2*] ) LTH2 ,&xloop JCN ( y* x+1* [addr+2*] ) POP2 ( y* [addr*] ) INC2 DUP2 .rows LDZ2 ( y+1* y+1* rows* [addr*] ) LTH2 ,&yloop JCN ( y+1* [addr*] ) POP2 POP2r JMP2r ( ) @redraw .dirty? LDZ #00 EQU ,&done JCN ;cells STH2 ( [addr*] ) #0000 DUP2 .Screen/y DEO2 &yloop #0000 DUP2 .Screen/x DEO2 &xloop STH2kr LDA2 ;draw-cell JSR2 .Screen/x DEI2k #0008 ADD2 ROT DEO2 INC2 INC2r INC2r DUP2 .cols LDZ2 LTH2 ,&xloop JCN POP2 .Screen/y DEI2k #0008 ADD2 ROT DEO2 INC2 DUP2 .rows LDZ2 LTH2 ,&yloop JCN POP2 POP2r ;draw-cursor JSR2 #00 .dirty? STZ &done BRK @clear-cursor .cur-x LDZ2 #30 SFT2 .Screen/x DEO2 .cur-y LDZ2 #30 SFT2 .Screen/y DEO2 ;cur-addr JSR2 LDA2 ;draw-cell JMP2 @draw-cursor .cur-x LDZ2 #30 SFT2 .Screen/x DEO2 .cur-y LDZ2 #30 SFT2 .Screen/y DEO2 ;cur-addr JSR2 LDA2 SWP ;reverse-tint JSR2 SWP ;draw-cell JMP2 @on-button ( -> ) .lastkey LDZ ( last^ ) .Controller/button DEI ( last^ button^ ) STHk EOR ( last-xor-button^ [button^] ) STHr AND ( last-xor-button&button^ ) DUP #10 AND #00 EQU ,&no-n JCN LIT "A ,arrow JSR &no-n DUP #20 AND #00 EQU ,&no-s JCN LIT "B ,arrow JSR &no-s DUP #40 AND #00 EQU ,&no-w JCN LIT "D ,arrow JSR &no-w DUP #80 AND #00 EQU ,&no-e JCN LIT "C ,arrow JSR &no-e POP .Controller/button DEI .lastkey STZ BRK ( send ESC [ $c ) @arrow ( c^ -> ) .Console/w STH #1b STHkr DEO LIT "[ STHkr DEO STHr DEO JMP2r @on-key ( -> ) .Controller/key DEI ,&ok JCN ,on-button JMP &ok ,alt? JSR ,on-alt-key JCN ,ctrl? JSR ,on-ctrl-key JCN .Controller/key DEI .Console/w DEO BRK @ctrl? ( -> is-down? ) .Controller/button DEI #01 AND JMP2r @alt? ( -> is-down? ) .Controller/button DEI #02 AND JMP2r ( alt-XYZ emits ESC and then emits XYZ ) @on-alt-key ( -> ) #1b .Console/w DEO ,ctrl? JSR ,on-ctrl-key JCN .Controller/key DEI .Console/w DEO BRK ( ctrl-$n emits: ) ( 0 <= $n < @ -> $n ) ( @ <= $n < ` -> $n #40 SUB ) ( ` <= $n <= #ff -> $n #60 SUB ) @on-ctrl-key ( -> ) .Controller/key DEI DUP LIT "@ LTH ,&done JCN DUP LIT "` LTH ,&c1 JCN LIT "` SUB ,&done JMP &c1 LIT "@ SUB &done .Console/w DEO BRK @on-read-priv .Console/r DEI DUP LIT "; EQU ;next-arg JCN2 DUP LIT "0 LTH ;end-arg-priv JCN2 DUP LIT "9 GTH ;end-arg-priv JCN2 ;add-to-arg JMP2 @start-priv ;on-read-priv .Console/vect DEO2 BRK @on-read-csi ( -> ) .Console/r DEI DUP LIT "? EQU ;start-priv JCN2 DUP LIT "; EQU ;next-arg JCN2 DUP LIT "0 LTH ;end-arg JCN2 DUP LIT "9 GTH ;end-arg JCN2 ;add-to-arg JMP2 @debug-priv ( c^ -> ) ;scratch STH2 LIT "1 STH2kr STA INC2r LIT "b STH2kr STA INC2r #20 STH2kr STA INC2r LIT "[ STH2kr STA INC2r #20 STH2kr STA INC2r LIT "? STH2kr STA INC2r #20 STH2kr STA INC2r ( TODO: numeric args ) STH2kr STA INC2r #0a STH2r STA #0009 .File/len DEO2 ;scratch .File/w DEO2 JMP2r @end-arg-priv ( c^ -> ) ;on-read .Console/vect DEO2 ( DUP ,debug-priv JSR ) ( TODO: handle these ) POP BRK @debug-csi ( c^ -> ) ;scratch STH2 LIT "1 STH2kr STA INC2r LIT "b STH2kr STA INC2r #20 STH2kr STA INC2r LIT "[ STH2kr STA INC2r #20 STH2kr STA INC2r STH2kr STA INC2r #0a STH2r STA #0007 .File/len DEO2 ;scratch .File/w DEO2 JMP2r @end-arg ( c^ -> ) ;on-read .Console/vect DEO2 ( DUP ,debug-csi JSR ) DUP LIT "d EQU ;exec-move-row JCN2 ( move cursor to row ) DUP LIT "h EQU ;exec-noop JCN2 ( enable line wrap ) DUP LIT "l EQU ;exec-noop JCN2 ( disable line wrap ) DUP LIT "m EQU ;exec-set-attr JCN2 ( set attr ) DUP LIT "n EQU ;exec-status JCN2 ( get status ) DUP LIT "A EQU ;exec-up JCN2 ( up ) DUP LIT "B EQU ;exec-down JCN2 ( down ) DUP LIT "C EQU ;exec-forward JCN2 ( forward ) DUP LIT "D EQU ;exec-back JCN2 ( back ) DUP LIT "G EQU ;exec-move-col JCN2 ( move cursor to col ) DUP LIT "H EQU ;exec-move JCN2 ( move cursor ) DUP LIT "J EQU ;exec-erase-screen JCN2 ( erase screen ) DUP LIT "K EQU ;exec-erase-line JCN2 ( erase line ) DUP LIT "L EQU ;exec-insert-lines JCN2 ( insert blank lines ) POP BRK @exec-noop ( c^ -> ) POP BRK @read-attr ( attr* -> ) DUP2 #0000 NEQ2 ,&!0 JCN #02 .attr STZ ,&done JMP ( reset ) &!0 DUP2 #0001 NEQ2 ,&!1 JCN #03 ,&set-fg JMP ( bright ) &!1 DUP2 #0002 NEQ2 ,&!2 JCN #01 ,&set-fg JMP ( dim ) &!2 DUP2 #0007 NEQ2 ,&!7 JCN .attr LDZk #80 ORA SWP STZ ,&done JMP ( reverse ) &!7 ,&ignored JMP &set-fg .attr LDZ #fc AND ORA .attr STZ &done ;update-tint JSR2 &ignored POP2 JMP2r @exec-set-attr ( c^ -> ) POP ( BRK ( FIXME: gaining 4 bytes per ls -F ) ) ;args/pos LDA2 ;args &loop LDA2k ;read-attr JSR2 INC2 INC2 LTH2k ,&done JCN ,&loop JMP &done POP2 POP2 BRK @exec1 ( addr* -> ) STH2 #0001 ;read-arg-1 JSR2 STH2r JSR2 BRK @exec-status POP #0000 ;read-arg-1 JSR2 #0006 NEQ2 ,&done #1b .Console/w DEO LIT "[ .Console/w DEO LIT "4 .Console/w DEO LIT "0 .Console/w DEO LIT "; .Console/w DEO LIT "7 .Console/w DEO LIT "9 .Console/w DEO LIT "R .Console/w DEO &done BRK @exec-up POP ;up-n ;exec1 JMP2 @exec-down POP ;down-n ;exec1 JMP2 @exec-forward POP ;forward-n ;exec1 JMP2 @exec-back POP ;back-n ;exec1 JMP2 @exec-erase-line POP #0000 ;read-arg-1 JSR2 DUP2 #0000 EQU2 ,&erase-to-end JCN DUP2 #0001 EQU2 ,&erase-from-start JCN DUP2 #0002 EQU2 ,&erase-full JCN POP2 BRK &erase-full POP2 ;bol-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK &erase-to-end POP2 ;cur-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK &erase-from-start POP2 ;bol-addr JSR2 ;cur-addr JSR2 ;erase JSR2 BRK @exec-erase-screen POP #0000 ;read-arg-1 JSR2 DUP2 #0000 EQU2 ,&erase-to-end JCN DUP2 #0001 EQU2 ,&erase-from-start JCN DUP2 #0002 EQU2 ,&erase-full JCN POP2 BRK &erase-full POP2 ;first-addr JSR2 ;limit-addr JSR2 ;erase JSR2 BRK &erase-to-end POP2 ;bol-addr JSR2 ;limit-addr JSR2 ;erase JSR2 BRK &erase-from-start POP2 ;first-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK ( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords ) @erase ( start* end* -> ) EQU2k ,&skip JCN ( start* end* ) OVR2 SWP2 ( start* start* end* ) SUB2 STH2 #4220 SWP2 ( 4220 start* [count*] ) &loop ( 4220 addr* [i*] ) STA2k INC2 INC2 INC2r INC2r ( 4220 addr+2* [i+1*] ) ORAkr STHr ,&loop JCN ( 4220 addr+2* [i+2*] ) POP2r POP2 POP2 ( ) #01 .dirty? STZ ( ; FIXME just redraw affected tiles ) JMP2r ( ) &skip POP2 POP2 JMP2r ( ) @exec-move-row ( c^ -> ) POP #0001 ;read-arg-1 JSR2 #0001 SUB2 ( row ) .cur-x LDZ2 ( col ) ;goto JSR2 BRK @exec-move-col ( c^ -> ) POP .cur-y LDZ2 ( row ) #0001 ;read-arg-2 JSR2 #0001 SUB2 ( col ) ;goto JSR2 BRK @exec-move ( c^ -> ) POP #0001 ;read-arg-1 JSR2 #0001 SUB2 ( row ) #0001 ;read-arg-2 JSR2 #0001 SUB2 ( col ) ;goto JSR2 BRK @exec-insert-lines ( c^ -> ) POP #0001 ;read-arg-1 JSR2 ( n ) POP2 ( TODO: shift ;screen from bol forward by n*cols bytes ) BRK @debug-esc ( c^ -> ) ;scratch STH2 LIT "1 STH2kr STA INC2r LIT "b STH2kr STA INC2r #20 STH2kr STA INC2r STH2kr STA INC2r #0a STH2r STA #0005 .File/len DEO2 ;scratch .File/w DEO2 JMP2r @on-read-esc ( -> ) .Console/r DEI LIT "[ EQU ;start-csi JCN2 ( .Console/r DEI ,debug-esc JSR ) ;on-read .Console/vect DEO2 ;on-read JMP2 @start-csi ( -> ) ;reset-args JSR2 ;on-read-csi .Console/vect DEO2 BRK @on-read .Console/r DEI DUP ,&ok JCN POP BRK &ok ( #42 .tint STZ ) ;read JMP2 @read ( c^ -> ) DUP #20 LTH ;read-ctrl JCN2 DUP #7f EQU ;read-del JCN2 ;read-printable JMP2 @read-ctrl ( c^ -> ) DUP #07 EQU ;read-bel JCN2 DUP #08 EQU ;read-bs JCN2 DUP #09 EQU ;read-tab JCN2 DUP #0a EQU ;read-nl JCN2 DUP #0d EQU ;read-cr JCN2 DUP #1b EQU ;read-esc JCN2 @read-bel ( 07 -> ) POP BRK ( TODO: flash terminal ) @read-bs ( 08 -> ) POP ;clear-cursor JSR2 #0001 ;back-n JSR2 ;draw-cursor JSR2 JMP2r @read-esc ( 1b -> ) POP ;on-read-esc .Console/vect DEO2 BRK @read-del ( 7f -> ) POP BRK ( @read-tab POP JMP2r ) @read-tab POP .cur-x LDZ2 NIP #07 AND #08 SUB &loop .tint LDZ #20 DUP ;cur-addr JSR2 STA2 ;draw-cell JSR2 ;forward JSR2 INC DUP ,&loop JCN POP JMP2r @read-cr ( 0d -> ) POP ;clear-cursor JSR2 #0000 .cur-x STZ2 BRK @at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r @read-nl ( 0a -> ) POP ;clear-cursor JSR2 ,at-max-y JSR ;scroll JCN2 ;down JSR2 BRK @read-printable ( c -> ) .tint LDZ SWP DUP2 ;cur-addr JSR2 STA2 ;draw-cell JSR2 ;forward JSR2 BRK @goto ( y* x* -> ) ;clear-cursor JSR2 .max-x LDZ2 ;min JSR2 .cur-x STZ2 .max-y LDZ2 ;min JSR2 .cur-y STZ2 ;draw-cursor JMP2 @forward-n ( n* -> ) ;clear-cursor JSR2 .cur-x LDZ2 ADD2 .max-x LDZ2 ;min JSR2 .cur-x STZ2 ;draw-cursor JMP2 @forward ( -> ) #0001 ,forward-n JMP @back-n ( n* -> ) ;clear-cursor JSR2 .cur-x LDZ2 GTH2k ,&zero JCN SWP2 SUB2 ,&done JMP &zero POP2 POP2 #0000 &done .cur-x STZ2 ;draw-cursor JMP2 @up-n ( n* -> ) ;clear-cursor JSR2 .cur-y LDZ2 GTH2k ,&zero JCN SWP2 SUB2 ,&done JMP &zero POP2 POP2 #0000 &done .cur-y STZ2 ;draw-cursor JMP2 @down-n ( n* -> ) ;clear-cursor JSR2 .cur-y LDZ2 ADD2 .max-y LDZ2 ;min JSR2 .cur-y STZ2 ;draw-cursor JMP2 @down ( -> ) #0001 ,down-n JMP @scroll ;limit-addr JSR2 STH2 ;cells .cols LDZ2 #0002 MUL2 ADD2 STH2 &loop STH2kr LDA2 #4220 STH2kr STA2 STH2kr .cols LDZ2 #0002 MUL2 SUB2 STA2 INC2r INC2r GTH2kr STHr ,&loop JCN POP2r POP2r #01 .dirty? STZ ;draw-cursor JSR2 BRK ( 0 <= index < 128 ) @load-tile ( index^ -> ) #00 SWP #30 SFT2 ;ascii ADD2 .Screen/addr DEO2 JMP2r ( bits: Rx xx FF BB ) ( - R: reversed [0=normal, 1=reversed] ) ( - F: foreground [0:black, 1:dim, 2:normal, 3:bright] ) ( - B: background [0:black, 1:dim, 2:normal, 3:bright] ) @update-tint ( -> ) .attr LDZ DUP #80 LTH ,&ok JCN #80 EOR DUP #02 SFT SWP #20 SFT #0c AND ORA &ok #40 ORA .tint STZ JMP2r @reverse-tint ( tint^ -> tint^ ) #0f AND ( x=tint&0f ) DUP #02 SFT SWP ( x>>2 x ) #03 AND #20 SFT ( x>>2 (x&3)<<2 ) ORA #40 ORA ( res=40|x>>2|(x&3)<<2 ) JMP2r ( res^ ) ( cell* = tint^ c^ ) @draw-cell ( cell* -> ) SWP STH ( c^ [tint^] ) DUP #80 LTH ,&draw JCN ( c^ [tint^] ) #80 SUB ( c-80^ [tint^] ) &draw ;load-tile JSR2 ( [tint^] ) STHr .Screen/sprite DEO ( ) JMP2r ( ) @next-arg ( c^ -> ) POP ( TODO: check if we already have max args ) ;args/pos LDA2k INC2 INC2 SWP2 STA2 BRK @add-to-arg ( c^ -> ) LIT "0 SUB LITr 00 STH ( [digit*] ) ;args/pos LDA2 LDA2k ( addr* value* [digit*] ) #000a MUL2 STH2r ADD2 ( addr* value*10+digit ) SWP2 STA2 BRK @read-arg-1 ( default* -> n* ) ;args LDA2 ;max JMP2 @read-arg-2 ( default* -> n* ) ;args INC2 INC2 LDA2 ;max JMP2 @reset-args ( -> ) ;args ;args/pos STA2 #0000 ;args LITr f8 &loop STA2k INC2 INC2 INCr STHkr ,&loop JCN POPr POP2 POP2 JMP2r @debug "debug_term.log 00 @scratch $40 ( store up to 8 arguments for control sequences ) @args $10 &pos $2 ( 128 1-bit 8x8 tiles for ASCII 7-bit characters ) @ascii ~chr/ascii.tal ( store tint+char for each screen position ) @cells $1900 ( 80 x 40 x 2 )