( 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 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 ) ( ) ( ??? ESC [ ... ? ) ( ??? ESC [ ... d ) ( ??? ESC [ ... G ) |00 @System [ &vect $2 &pad $6 &r $2 &g $2 &b $2 ] |10 @Console [ &vect $2 &r $1 &pad $5 &w $1 ] |20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ] |80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ] |a0 @File [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |0000 @tint $1 ( draw mode. 01=regular, 04=inverted ) @dirty? $1 ( screen needs redraw? ) @lastkey $1 ( last button press ) @rows $2 ( height in characters ) @cols $2 ( width in characters ) @cur-x $2 ( cursor x: 0 <= cur-x < cols ) @cur-y $2 ( cursor y: 0 <= cur-y < rows ) @max-x $2 ( cols-1 ) @max-y $2 ( rows-1 ) |0100 ( 80 cols x 24 rows ) #0028 .rows STZ2 #0050 .cols STZ2 ( set max row/col ) .rows LDZ2 #0001 SUB2 .max-y STZ2 .cols LDZ2 #0001 SUB2 .max-x STZ2 ( set initial cursor ) #0000 .cur-x STZ2 #0000 .cur-y STZ2 ( confirm no buttons pressed yet ) #00 .lastkey STZ ( set screen height/width based on rows/cols ) .rows LDZ2 #30 SFT2 .Screen/h DEO2 .cols LDZ2 #30 SFT2 .Screen/w DEO2 ( set colors ) #0cf0 .System/r DEO2 #0c88 .System/g DEO2 #0c0f .System/b DEO2 ( clear screen for initial draw ) ;clear-screen JSR2 ( set up interrupts ) ;redraw .Screen/vect DEO2 ( set up screen ) ;on-key .Controller/vect DEO2 ( set up keyboard ) ;on-read .Console/vect DEO2 ( set up stdin ) ( set up debug log ) ;debug .File/name DEO2 #01 .File/append DEO BRK @first-addr ( -> ) ;screen JMP2r @bol-addr ( -> addr* ) .cols LDZ2 .cur-y LDZ2 MUL2 ;screen ADD2 JMP2r @cur-addr ( -> addr* ) ;bol-addr JSR2 .cur-x LDZ2 ADD2 JMP2r @eol-addr ( -> addr* ) .cols LDZ2 .cur-y LDZ2 INC2 MUL2 ;screen ADD2 JMP2r @last-addr ( -> ) .cols LDZ2 .rows LDZ2 MUL2 ;screen ADD2 JMP2r @min ( x* y* -> min* ) LTH2k JMP SWP2 POP2 JMP2r @max ( x* y* -> max* ) LTH2k JMP SWP2 NIP2 JMP2r @clear-screen #01 .dirty? STZ ;screen STH2 #0000 &yloop #0000 &xloop #20 STH2kr STA INC2r INC2 DUP2 .cols LDZ2 LTH2 ,&xloop JCN POP2 INC2 DUP2 .rows LDZ2 LTH2 ,&yloop JCN POP2 POP2r JMP2r @redraw #41 .tint STZ .dirty? LDZ #00 EQU ,&done JCN ;screen STH2 #0000 DUP2 .Screen/y DEO2 &yloop #0000 DUP2 .Screen/x DEO2 &xloop STH2kr LDA ;draw-tile JSR2 .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2 INC2 INC2r DUP2 .cols LDZ2 LTH2 ,&xloop JCN POP2 .Screen/y DEI2 #0008 ADD2 .Screen/y DEO2 INC2 DUP2 .rows LDZ2 LTH2 ,&yloop JCN POP2 POP2r ;show-cursor JSR2 #00 .dirty? STZ &done BRK @hide-cursor .tint LDZ #41 .tint STZ ;draw-cursor JSR2 .tint STZ JMP2r @show-cursor .tint LDZ #44 .tint STZ ;draw-cursor JSR2 .tint STZ JMP2r @draw-cursor .cur-x LDZ2 #30 SFT2 .Screen/x DEO2 .cur-y LDZ2 #30 SFT2 .Screen/y DEO2 .cur-y LDZ2 .cols LDZ2 MUL2 .cur-x LDZ2 ADD2 ;screen ADD2 LDA ;draw-tile JMP2 @on-button ( -> ) .lastkey LDZ .Controller/button DEI STHk EOR STHr AND ( new-buttons ) DUP #10 AND #00 EQU ,&no-n JCN LIT "A ,arrow JSR &no-n DUP #20 AND #00 EQU ,&no-s JCN LIT "B ,arrow JSR &no-s DUP #40 AND #00 EQU ,&no-w JCN LIT "D ,arrow JSR &no-w DUP #80 AND #00 EQU ,&no-e JCN LIT "C ,arrow JSR &no-e .Controller/button DEI .lastkey STZ BRK ( send ESC [ $c ) @arrow ( c^ -> ) .Console/w STH #1b STHkr DEO LIT "[ STHkr DEO STHr DEO JMP2r @on-key ( -> ) .Controller/key DEI ,&ok JCN ,on-button JMP &ok ,alt? JSR ,on-alt-key JCN ,ctrl? JSR ,on-ctrl-key JCN .Controller/key DEI .Console/w DEO BRK @ctrl? ( -> is-down? ) .Controller/button DEI #01 AND JMP2r @alt? ( -> is-down? ) .Controller/button DEI #02 AND JMP2r ( alt-XYZ emits ESC and then emits XYZ ) @on-alt-key ( -> ) #1b .Console/w DEO ,ctrl? JSR ,on-ctrl-key JCN .Controller/key DEI .Console/w DEO BRK ( ctrl-$n emits: ) ( 0 <= $n < @ -> $n ) ( @ <= $n < ` -> $n #40 SUB ) ( ` <= $n <= #ff -> $n #60 SUB ) @on-ctrl-key ( -> ) .Controller/key DEI DUP LIT "@ LTH ,&done JCN DUP LIT "` LTH ,&c1 JCN LIT "` SUB ,&done JMP &c1 LIT "@ SUB &done .Console/w DEO BRK @on-read-seq ( -> ) .Console/r DEI DUP LIT "; EQU ;next-arg JCN2 DUP LIT "0 LTH ;end-arg JCN2 DUP LIT "9 GTH ;end-arg JCN2 ;add-to-arg JMP2 @debug-seq ( c^ -> ) ;scratch STH2 LIT "1 STH2kr STA INC2r LIT "b STH2kr STA INC2r #20 STH2kr STA INC2r LIT "[ STH2kr STA INC2r #20 STH2kr STA INC2r STH2kr STA INC2r #0a STH2r STA #0007 .File/len DEO2 ;scratch .File/w DEO2 JMP2r @end-arg ( c^ -> ) ;on-read .Console/vect DEO2 DUP ,debug-seq JSR DUP LIT "h EQU ;exec-noop JCN2 ( enable line wrap ) DUP LIT "l EQU ;exec-noop JCN2 ( disable line wrap ) DUP LIT "m EQU ;exec-noop JCN2 ( set attr ) DUP LIT "n EQU ;exec-status JCN2 ( get status ) DUP LIT "H EQU ;exec-move JCN2 ( move cursor ) DUP LIT "A EQU ;exec-up JCN2 ( up ) DUP LIT "B EQU ;exec-down JCN2 ( down ) DUP LIT "C EQU ;exec-forward JCN2 ( forward ) DUP LIT "D EQU ;exec-back JCN2 ( back ) DUP LIT "J EQU ;exec-erase-screen JCN2 ( erase screen ) DUP LIT "K EQU ;exec-erase-line JCN2 ( erase line ) POP BRK @exec-noop ( c^ -> ) POP BRK @exec1 ( addr* -> ) STH2 #0001 ;read-arg-1 JSR2 STH2r JSR2 BRK @exec-status POP #0000 ;read-arg-1 JSR2 #0006 NEQ2 ,&done #1b .Console/w DEO LIT "[ .Console/w DEO LIT "4 .Console/w DEO LIT "0 .Console/w DEO LIT "; .Console/w DEO LIT "7 .Console/w DEO LIT "9 .Console/w DEO LIT "R .Console/w DEO &done BRK @exec-up POP ;up-n ;exec1 JMP2 @exec-down POP ;down-n ;exec1 JMP2 @exec-forward POP ;forward-n ;exec1 JMP2 @exec-back POP ;back-n ;exec1 JMP2 @exec-erase-line POP #0000 ;read-arg-1 JSR2 DUP2 #0000 EQU2 ,&erase-to-end JCN DUP2 #0001 EQU2 ,&erase-from-start JCN DUP2 #0002 EQU2 ,&erase-full JCN POP2 BRK &erase-full POP2 ;bol-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK &erase-to-end POP2 ;cur-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK &erase-from-start POP2 ;bol-addr JSR2 ;cur-addr JSR2 ;erase JSR2 BRK @exec-erase-screen POP #0000 ;read-arg-1 JSR2 DUP2 #0000 EQU2 ,&erase-to-end JCN DUP2 #0001 EQU2 ,&erase-from-start JCN DUP2 #0002 EQU2 ,&erase-full JCN POP2 BRK &erase-full POP2 ;first-addr JSR2 ;last-addr JSR2 ;erase JSR2 BRK &erase-to-end POP2 ;bol-addr JSR2 ;last-addr JSR2 ;erase JSR2 BRK &erase-from-start POP2 ;first-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK ( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords ) @erase ( start* end* -> ) OVR2 SWP2 SUB2 STH2 ( start* [count=start-end*] ) #20 ROT ROT ( 20 start* [count*] ) &loop ( 20 addr* [i*] ) STAk INC2 INC2r ( 20 addr+1* [i+1*] ) ORAkr STHr ,&loop JCN ( 20 addr* [i+1*] ) POP2r POP2 POP ( ) #01 .dirty? STZ ( ; FIXME just redraw affected tiles ) JMP2r ( ) @exec-move ( c^ -> ) POP #0001 ;read-arg-1 JSR2 #0001 SUB2 ( row ) #0001 ;read-arg-2 JSR2 #0001 SUB2 ( col ) ;goto JSR2 BRK @debug-esc ( c^ -> ) ;scratch STH2 LIT "1 STH2kr STA INC2r LIT "b STH2kr STA INC2r #20 STH2kr STA INC2r STH2kr STA INC2r #0a STH2r STA #0005 .File/len DEO2 ;scratch .File/w DEO2 JMP2r @on-read-esc ( -> ) .Console/r DEI LIT "[ EQU ;start-seq JCN2 .Console/r DEI ,debug-esc JSR ;on-read .Console/vect DEO2 ;on-read JMP2 @start-seq ( -> ) ;reset-args JSR2 ;on-read-seq .Console/vect DEO2 BRK @on-read .Console/r DEI DUP ,&ok JCN POP BRK &ok #41 .tint STZ ;read JMP2 @read ( c^ -> ) DUP #20 LTH ;read-ctrl JCN2 DUP #7f EQU ;read-del JCN2 ;read-printable JMP2 @read-ctrl ( c^ -> ) DUP #07 EQU ;read-bel JCN2 DUP #08 EQU ;read-bs JCN2 DUP #09 EQU ;read-tab JCN2 DUP #0a EQU ;read-nl JCN2 DUP #0d EQU ;read-cr JCN2 DUP #1b EQU ;read-esc JCN2 @read-bel ( 07 -> ) POP BRK ( TODO: flash terminal ) @read-bs ( 08 -> ) POP ;hide-cursor JSR2 #0001 ;back-n JSR2 ;show-cursor JSR2 JMP2r @read-esc ( 1b -> ) POP ;on-read-esc .Console/vect DEO2 BRK @read-del ( 7f -> ) POP BRK ( @read-tab POP JMP2r ) @read-tab POP .cur-x LDZ2 NIP #07 AND #08 SUB &loop #20 DUP ;cursor-addr JSR2 STA ;draw-tile JSR2 ;forward JSR2 INC DUP ,&loop JCN POP JMP2r @read-cr ( 0d -> ) POP ;hide-cursor JSR2 #0000 .cur-x STZ2 BRK @at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r @read-nl ( 0a -> ) POP ;hide-cursor JSR2 ,at-max-y JSR ;scroll JCN2 ;down JSR2 BRK @read-printable ( c -> ) DUP ;cursor-addr JSR2 STA ;draw-tile JSR2 ;forward JSR2 BRK @goto ( y* x* -> ) ;hide-cursor JSR2 .max-x LDZ2 ;min JSR2 .cur-x STZ2 .max-y LDZ2 ;min JSR2 .cur-y STZ2 ;show-cursor JMP2 @forward-n ( n* -> ) ;hide-cursor JSR2 .cur-x LDZ2 ADD2 .max-x LDZ2 ;min JSR2 .cur-x STZ2 ;show-cursor JMP2 @forward ( -> ) #0001 ,forward-n JMP @back-n ( n* -> ) ;hide-cursor JSR2 .cur-x LDZ2 GTH2k ,&zero JCN SWP2 SUB2 ,&done JMP &zero POP2 POP2 #0000 &done .cur-x STZ2 ;show-cursor JMP2 @up-n ( n* -> ) ;hide-cursor JSR2 .cur-y LDZ2 GTH2k ,&zero JCN SWP2 SUB2 ,&done JMP &zero POP2 POP2 #0000 &done .cur-y STZ2 ;show-cursor JMP2 @down-n ( n* -> ) ;hide-cursor JSR2 .cur-y LDZ2 ADD2 .max-y LDZ2 ;min JSR2 .cur-y STZ2 ;show-cursor JMP2 @down ( -> ) #0001 ,down-n JMP @scroll ;end-screen STH2 ;screen .cols LDZ2 ADD2 STH2 &loop STH2kr LDA #20 STH2kr STA STH2kr .cols LDZ2 SUB2 STA INC2r GTH2kr STHr ,&loop JCN POP2r POP2r #01 .dirty? STZ ;show-cursor JSR2 BRK @cursor-addr ( -> addr* ) .cur-y LDZ2 .cols LDZ2 MUL2 .cur-x LDZ2 ADD2 ;screen ADD2 JMP2r ( 0 <= c < 256 ) @draw-tile ( c^ -> ) DUP #80 LTH ,draw-7bit JCN ,draw-8bit JMP ( 0 <= index < 128 ) @load-tile ( index^ -> ) #00 SWP #30 SFT2 ;ascii ADD2 .Screen/addr DEO2 JMP2r ( 0 <= c < 128 ) @draw-7bit ( c^ -> ) ;load-tile JSR2 .tint LDZ .Screen/sprite DEO JMP2r ( 128 <= c < 256 ) @draw-8bit ( 8bit^ -> ) #80 SUB ;load-tile JSR2 .tint LDZ #05 EOR .Screen/sprite DEO JMP2r ( 128 1-bit 8x8 tiles for ASCII 7-bit characters ) @ascii ~chr/ascii.tal @next-arg ( c^ -> ) POP ( TODO: check if we already have max args ) ;args/pos LDA2k INC2 INC2 STA2 BRK @add-to-arg ( c^ -> ) LIT "0 SUB LITr 00 STH ( [digit*] ) ;args/pos LDA2 LDA2k ( addr* value* [digit*] ) #000a MUL2 STH2r ADD2 ( addr* value*10+digit ) SWP2 STA2 BRK @read-arg-1 ( default* -> n* ) ;args LDA2 ;max JMP2 @read-arg-2 ( default* -> n* ) ;args INC2 INC2 LDA2 ;max JMP2 @reset-args ( -> ) ;args ;args/pos STA2 #0000 ;args LITr f8 &loop STA2k INC2 INC2 INCr STHkr ,&loop JCN POPr POP2 POP2 JMP2r @debug "debug_term.log 00 @scratch $40 ( store up to 8 arguments for control sequences ) @args $10 &pos $2 ( store characters for redraw, etc. ) @screen $0c80 ( 80 x 40 ) @end-screen ( ( store attributes for redraw, etc. ) @attrs $0c80 ( 80 x 40 ) @end-attrs )