( 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 ) |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 ] |0000 @tint $1 ( draw mode. 01=regular, 04=inverted ) @dirty? $1 ( screen needs redraw? ) @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 ( 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 ) ( return ) BRK @bol-addr ( -> addr* ) .cols LDZ2 .cur-y LDZ2 MUL2 JMP2r @cur-addr ( -> addr* ) ;bol-addr JSR2 .cur-x LDZ2 ADD2 JMP2r @eol-addr ( -> addr* ) .cols LDZ2 .cur-y LDZ2 INC2 MUL2 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-key ( -> ) .Controller/key DEI ,&ok JCN BRK &ok ,alt? JSR ,on-alt-key JCN ,ctrl? JSR ,on-ctrl-key JCN .Controller/key DEI .Console/w DEO BRK @ctrl? ( -> down? ) .Controller/button DEI #01 AND JMP2r @alt? ( -> 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 @end-arg ( c^ -> ) ;on-read .Console/vect DEO2 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-line JCN2 ( erase line ) DUP LIT "K EQU ;exec-noop JCN2 ( erase screen ) 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 ,&erase-to-end JCN DUP2 #0001 ,&erase-from-start JCN ;bol-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK &erase-to-end ;cur-addr JSR2 INC2 ;eol-addr JSR2 ;erase JSR2 BRK &erase-from-start ;bol-addr JSR2 ;cur-addr JSR2 INC2 ;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*] ) #20 ROT ROT ( 20 start* [count*] ) &loop STAk INC2r STH2kr ORA ,&loop JCN POP2r POP2 POP JMP2r @exec-move ( c^ -> ) POP LIT2r ffff #0001 ;read-arg-1 JSR2 STH2kr ADD2 ( row ) #0001 ;read-arg-2 JSR2 STH2r ADD2 ( col ) ;goto JSR2 BRK @on-read-esc ( -> ) .Console/r DEI LIT "[ EQU ;start-seq JCN2 ;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 JSR2 BRK @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 JMP2r ( TODO: flash terminal ) @read-bs ( 08 -> ) POP JMP2r ( POP ;scroll JMP2 ) @read-esc ( 1b -> ) POP ;on-read-esc .Console/vect DEO2 BRK @read-del ( 7f -> ) POP JMP2r ( @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 JMP2r @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 JMP2 @read-printable ( c -> ) DUP ;cursor-addr JSR2 STA ;draw-tile JSR2 ;forward JMP2 @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 ( @back ( -> ) #0001 ,back-n JMP ) @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 ( @up ( -> ) #0001 ,up-n JMP ) @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 JMP2 @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 ( 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 )