d6
/
uxn11
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
uxn11/test/term.tal

1376 lines
46 KiB
Tal
Raw Normal View History

wip: make and xclock tests work
2023-12-01 12:19:26 -05:00
( term.tal )
( TODO: )
( 3. need to implement scrolling regions )
( 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 )
( 9. support shift+arrow and alt+arrow )
( 10. crawl has screen-clearing issues )
( 11. cursor hiding for cmatrix )
( 12. clean up super ugly selection code )
( 15. blinking text? )
( 16. status line in femto, etc. is weird *** major bug )
( 17. determ.terminfo )
( 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 )
( special graphics [] changes 95-126 )
|00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ]
|10 @Console [ &vect $2 &stdin $1 &exec $2 &mode $1 &dead $1 &exit $1 &stdout $1 &stderr $1 &child $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 )
@cur-wrap $1 ( did cursor just wrap? )
@max-x $2 ( cols-1 )
@max-y $2 ( rows-1 )
@saved-x $2 ( saved x coordinate )
@saved-y $2 ( saved y coordinate )
@col-bytes $2 ( 2*cols )
@lastmouse-x $2 ( last mouse x )
@lastmouse-y $2 ( last mouse y )
@lastmouse-st $1 ( last mouse press )
@is-lit $1 ( are we selecting an area? )
@is-lit-flip $1 ( is the selection flipped? i.e. drawing left/up )
@lit-click-x $2 ( x coord of starting selection click )
@lit-click-y $2 ( y coord of starting selection click )
@lit-drag-x $2 ( x coord of selection drag )
@lit-drag-y $2 ( y coord of selection drag )
@flash $1 ( visual bell flash timer )
@pointer-ttl $1 ( visible cursor timer )
( terminal settings )
@ignored $1 ( ignored )
@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 )
( margins )
@margin-top $2
@margin-bot $2
( user configuration )
@debug $1 ( use debug log? )
@show-banner $1 ( show banner on startup? )
@visual-bell $1 ( use visual belL? 01: visual bell, 00: do nothing )
@border-pad $2 ( use border? must be either 0000 or 0010 )
|0100
( metadata )
;meta .System/metadata DEO2
;meta/name .System/title DEO2
( user configuration defaults )
#00 .debug STZ
#01 .show-banner STZ
#0000 .border-pad STZ2
#01 .visual-bell STZ
( 80 cols x 24 rows by default )
#0050 .cols STZ2
#0018 DUP .rows STZ2 .margin-bot STZ2
#0000 .margin-top STZ2
( start cursor at origin - including border )
.border-pad LDZ2 .Screen/x DEO2
.border-pad LDZ2 .Screen/y DEO2
( set colors )
#07bf .System/r DEO2
#07bf .System/g DEO2
#07bf .System/b DEO2
load-theme ( optional theme sets colors/dimensions )
;on-redraw .Screen/vect DEO2 ( set up screen callback )
;on-key .Controller/vect DEO2 ( set up keyboard callback )
;on-mouse .Mouse/vect DEO2 ( set up mouse callback )
;on-read .Console/vect DEO2 ( set up stdin callback )
setup-subprocess ( set up experimental subprocess support )
reset-terminal ( initialize terminal state and settings )
setup-debugging ( set up debugging if requested )
draw-banner ( draw banner if requested )
BRK
( these only work with a patched uxnemu )
( on other emulators they should be no-ops )
@setup-subprocess ( -> )
;shell .Console/exec DEO2 ( set up bash subprocess )
#80 .Console/mode DEO ( start bash subprocess )
JMP2r
@setup-debugging ( -> )
.debug LDZ ?&continue JMP2r &continue
;debug-log .File1/name DEO2
#01 .File1/append DEO
JMP2r
@draw-banner ( -> )
redraw ;banner-ascii
&loop LDAk DUP ?&ok POP POP2 JMP2r
&ok read INC2 !&loop
@reset-terminal ( -> )
( set initial cursor )
#0000 DUP2 .cur-x STZ2 .cur-y STZ2
( confirm no buttons pressed yet )
#00 .lastkey STZ
( calculate derived dimensions from cols/rows )
update-dimensions
( set starting tint: reverse=0, bg=0, fg=2 )
#02 .attr STZ update-tint
( set initial modes )
#00 .irm STZ ( insert and move right )
#01 .awm STZ ( wrap at margin )
#01 .tcem STZ ( show cursor )
#00 .paste STZ ( bracketed paste is off )
init-screen ( ; prepare for initial draw )
draw-border ( ; draw border )
JMP2r
@update-dimensions ( -> )
( 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 screen height/width based on rows/cols + border padding )
.border-pad LDZ2 DUP2 ADD2 DUP2
.cols LDZ2 #30 SFT2 ADD2 .Screen/w DEO2
.rows LDZ2 #000c MUL2 ADD2 .Screen/h DEO2
JMP2r
@shell "bash 00 "-i 00 00
@load-theme ( -> )
;&path .File1/name DEO2
#0006 .File1/len DEO2
;&r .File1/r DEO2
.File1/ok DEI2 ORA #01 [ JCN JMP2r ]
,&r LDR2 .System/r DEO2
,&g LDR2 .System/g DEO2
,&b LDR2 .System/b DEO2
#0002 .File1/len DEO2
;&x .File1/r DEO2
.File1/ok DEI2 ORA #01 [ JCN JMP2r ]
#00 ,&x LDR .cols STZ2
#00 ,&y LDR .rows STZ2
JMP2r [ &path ".theme $1 &r $2 &g $2 &b $2 &x $1 &y $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
( signed max )
( #8000 < #8001 < ... < #ffff < #0000 < #0001 < ... < #7fff )
@smax ( x* y* -> min* )
EOR2k POP #80 AND ?min !max
( initialize screen cells and prepare for first draw )
@init-screen ( -> )
first-addr limit-addr #0200 ( fall-through )
@init ( start* limit* cell* -> )
STH2 EQU2k ?&skip ( start* limit* [cell*] )
#01 .dirty STZ OVR2 ( start* limit* start* [cell*] )
#01 SFT2 SWP2 #01 SFT2 SUB2 ( start* -count* [cell*] )
STH2 SWP2r STH2r SWP2 ( cell* start* [-count*] )
&loop ( cell* addr* [-i*] )
STA2k INC2 INC2 INC2r ( cell* addr+2* [-i+1*] )
ORAkr STHr ?&loop ( cell* addr+2* [-i+1*] )
&skip POP2 POP2 POP2r JMP2r ( )
( uses the existing .Screen/x and .Screen/y )
( returns them to their starting values when finished )
@erase-fg-cell ( -> )
;cp437/nul .Screen/addr DEO2 ( ; use nul character to erase )
#43 .Screen/sprite DEO ( ; s/s<-40 )
.Screen/y DEI2k STH2k ( zp^ y* [y*] )
#0004 ADD2 ROT DEO2 ( [y*] ; s/y<-y+4 )
#43 .Screen/sprite DEO STH2r ( y* ; s/s<-40 )
.Screen/y DEO2 JMP2r ( ; s/y<-y )
@draw-border ( -> )
.border-pad LDZ2 ORA ?{ JMP2r }
;cp437/space .Screen/addr DEO2
#04 .Screen/sprite
#0000 draw-border/row
#0008 draw-border/row
.rows LDZ2 #000c MUL2 #0010 ADD2 draw-border/row
.Screen/y DEI2 #0008 ADD2 draw-border/row
#0000 draw-border/col
#0008 draw-border/col
.cols LDZ2 #30 SFT2 #0010 ADD2 draw-border/col
.Screen/x DEI2 #0008 ADD2 draw-border/col
#00 .Screen/auto DEO POP2 !screen-to-cursor
&row ( y* -> )
.Screen/y DEO2
#0000 .Screen/x DEO2
#01 .Screen/auto DEO
#0000 .cols LDZ2 #0004 ADD2 SUB2 STH2
!&loop
&col ( x* -> )
.Screen/x DEO2
#0000 .Screen/y DEO2
#02 .Screen/auto DEO
#0000 .rows LDZ2 #0003 MUL2 INC2 #01 SFT2 #0004 ADD2 SUB2 STH2
!&loop
&loop ( 04 sprite^ [-count] )
DEOk INC2r STH2kr ORA ?&loop POP2r JMP2r
@on-redraw ( -> )
redraw BRK
@redraw ( -> )
.pointer-ttl LDZ #00 EQU ?&pointer-ok ( )
.pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok
#01 .dirty STZ ( redraw without pointer )
&pointer-ok
.dirty LDZ #00 EQU ?&done
LIT2r =cells ( [addr*] )
.rows LDZ2 #0000 DUP2 .border-pad LDZ2 ADD2 .Screen/y DEO2
&yloop
.cols LDZ2 #0000 DUP2 .border-pad LDZ2 ADD2 .Screen/x DEO2
&xloop
STH2kr LDA2 draw-cell erase-fg-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
.is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally
&flashing .flash LDZ #00 EQU ?&pointer flash-bell !draw-cursor
&pointer draw-pointer
&finally draw-cursor #00 .dirty STZ
&done JMP2r
@flash-bell ( -> )
.flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
#0000 DUP2 .lit-click-x STZ2 .lit-click-y STZ2
.max-x LDZ2 .lit-drag-x STZ2 .max-y LDZ2 .lit-drag-y STZ2
redraw-selection !clear-selection
@screen-to-cell ( row* col* -> )
#30 SFT2 ( width ) .border-pad LDZ2 ADD2 .Screen/x DEO2
#000c MUL2 ( height ) .border-pad LDZ2 ADD2 .Screen/y DEO2
JMP2r
@screen-to-cursor ( -> )
.cur-y LDZ2 .cur-x LDZ2 !screen-to-cell
@clear-cursor ( -> )
screen-to-cursor cur-addr LDA2 !draw-cell
@draw-cursor ( -> )
screen-to-cursor cur-addr LDA2
.tcem LDZ #00 EQU ?&skip SWP reverse-tint SWP
&skip !draw-cell
@on-button ( -> BRK )
.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
( TODO: send ESC-$c in VT-52 mode )
( TODO: send ESC-O-$c in "cursor key mode set" )
#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 &start
;snarf .File2/name DEO2 ( )
#0780 .File2/len DEO2 ( )
&loop ( )
;paste-buf .File2/r DEO2 ( )
.File2/ok DEI2 ( size* )
DUP2 #0000 EQU2 ?&failed ( size* )
DUP2 paste-from-buf ( size* )
#0780 LTH2 ?&done ( )
!&loop ( )
&failed POP2
&done
.paste LDZ #00 EQU ?&end LIT "1 bracket-paste &end
JMP2r
@lit-first-y
.is-lit-flip LDZ ?&flip .lit-click-y LDZ2 JMP2r &flip .lit-drag-y LDZ2 JMP2r
@lit-first-x
.is-lit-flip LDZ ?&flip .lit-click-x LDZ2 JMP2r &flip .lit-drag-x LDZ2 JMP2r
@lit-last-y
.is-lit-flip LDZ ?&flip .lit-drag-y LDZ2 JMP2r &flip .lit-click-y LDZ2 JMP2r
@lit-last-x
.is-lit-flip LDZ ?&flip .lit-drag-x LDZ2 JMP2r &flip .lit-click-x LDZ2 JMP2r
@redraw-selection ( -> )
lit-first-y .cols LDZ2 MUL2 ( y0*cols* )
lit-first-x ADD2 DUP2 ADD2 ( 2(y0*cols+x0)* )
;cells ADD2 STH2 ( [addr*] )
lit-last-y INC2 lit-first-y ( yn* y0* [addr*] )
DUP2 lit-first-x STH2k ( yn* y0* x0* [addr* x0*] )
screen-to-cell ( yn* y0* [addr* x0*] )
&yloop ( yn* y* [addr* x*] )
OVR2 OVR2 INC2 GTH2 STH .cols LDZ2 ( yn* y* cols* [addr* x* last^] )
lit-last-x INC2 ( yn* y* cols* xn* [addr* x* last^] )
STHr [ JMP SWP2 ] POP2 STH2r ( yn* y* xlim* x* [addr*] )
&xloop ( yn* y* xlim* x* [addr*] )
STH2kr LDA2 highlight-cell ( yn* y* xlim* x* [addr*] )
.Screen/x DEI2k #0008 ADD2 ROT DEO2 ( yn* y* xlim* x* [addr*] )
INC2 INC2r INC2r ( yn* y* xlim* x+1* [addr+2*] )
GTH2k ?&xloop ( yn* y* xlim* x+1* [addr+2*] )
POP2 POP2 ( yn* y* [addr+2*] )
.Screen/y DEI2k #000c ADD2 ROT DEO2 ( yn* y* [addr+2*] )
.border-pad LDZ2 .Screen/x DEO2 ( yn* y* [addr+2*] )
LIT2r 0000 INC2 GTH2k ?&yloop ( yn* y+1* [addr+2* 0*] )
POP2 POP2 POP2r POP2r ( )
JMP2r ( )
@y-point-to-row ( y* -> row* )
.border-pad LDZ2 LTH2k ?&y0 SUB2 #000c DIV2 .max-y LDZ2 !min &y0 POP2 POP2 #0000 JMP2r
@x-point-to-col ( x* -> col* )
#0004 ADD2 .border-pad LDZ2 LTH2k ?&x0 SUB2 #03 SFT2 .max-x LDZ2 !min &x0 POP2 POP2 #0000 JMP2r
@point-to-coord ( x* y* -> row* col* )
y-point-to-row SWP2 !x-point-to-col
@unset-wrap ( -> )
#00 .cur-wrap STZ JMP2r
@start-selection ( -> )
#01 .is-lit STZ ( )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
#00 .is-lit-flip STZ ( x* y* )
point-to-coord ( row* col* )
DUP2 .lit-click-x STZ2 .lit-drag-x STZ2 ( row* )
DUP2 .lit-click-y STZ2 .lit-drag-y STZ2 ( )
redraw-selection !draw-cursor ( )
@selection-is-empty ( -> bool^ )
.lit-click-y LDZ2 .lit-drag-y LDZ2 EQU2
.lit-click-x LDZ2 .lit-drag-x LDZ2 EQU2 AND JMP2r
@find-natural-end ( y* -> xend* )
DUP2 .cols LDZ2 MUL2 ( y* y*cols* )
DUP2 ADD2 ;cells ADD2 INC2 ( y* edge* )
DUP2 .max-x LDZ2 DUP2 ADD2 ADD2 ( y* edge* start=edge+2cols* )
&loop ( y* edge* addr* )
LDAk ?&done ( y* edge* addr* )
#0002 SUB2 LTH2k ?&loop ( y* edge* addr-2* )
&done ( y* edge* addr* )
SWP2 SUB2 #01 SFT2 ( y* x* )
NIP2 JMP2r ( x* )
@copy-line ( y* x1* x0* -> y* )
STH2 STH2 DUP2 find-natural-end ( y* xend* [x0* x1*] )
STH2r min ( y* xlim=min(xend,x1)* [x0*] )
DUP2 STH2kr GTH2 ?&ok ( y* xlim* [x0*] )
POP2 POP2r JMP2r ( y* ; return if line is empty )
&ok OVR2 .cols LDZ2 MUL2 ( y* xlim* y*cols* [x0*] )
STH2kr ADD2 DUP2 ADD2 ;cells ADD2 ( y* xlim* addr* [x0*] )
INC2 STH2 SWP2r STH2r ( y* xlim* x0* [addr+1*] )
SUB2 INC2 #0000 SWP2 SUB2 ( y* -count* [addr+1*] )
&loop ( y* -i* [pos*] )
LDAkr STHr copy-char ( y* -i* [pos*] )
INC2 INC2r INC2r ORAk ?&loop ( y* -i+1* [pos+2*] )
POP2 POP2r JMP2r ( y* ; done )
@copy-char ( c^ -> )
DUP ?&ok POP #20 ( replace \0 with space )
&ok STH ;paste-pos LDA2k ( pos* addr* [c^] )
STH2k STAr INC2 SWP2 STA2 JMP2r ( )
@copy-selection ( -> )
;paste-buf ;paste-pos STA2
lit-last-y INC2 lit-first-y ( ylim* y0* )
DUP2 lit-first-x STH2k screen-to-cell ( yn* y0* [x0*] )
&yloop ( yn* y* [x*] )
OVR2 OVR2 INC2 GTH2 STH .max-x LDZ2 ( yn* y* maxx* [x* last^] )
lit-last-x ( yn* y* maxx* xlast* [x* last^] )
STHr [ JMP SWP2 ] POP2 STH2r ( yn* y* x1* x* )
copy-line ( yn* y* )
LIT2r 0000 INC2 GTH2k ?&next !&done ( yn* y+1* [0*] )
&next ( )
#0a copy-char !&yloop ( )
&done ( )
POP2 POP2 POP2r ( )
;snarf .File2/name DEO2 ( )
;paste-pos LDA2 ;paste-buf SUB2 ( len* )
.File2/len DEO2 ( )
;paste-buf .File2/w DEO2 ( )
JMP2r ( )
@handle-selection ( -> )
selection-is-empty ?&skip copy-selection
&skip ( fall through to clear-selection )
@clear-selection ( -> )
#00 .is-lit STZ
#00 .is-lit-flip STZ
#01 .dirty STZ
#0000 DUP2 .lit-click-y STZ2
DUP2 .lit-click-x STZ2
DUP2 .lit-drag-y STZ2
.lit-drag-x STZ2 JMP2r
@update-selection ( -> )
.Mouse/x DEI2 .Mouse/y DEI2 point-to-coord ( row* col* )
OVR2 .lit-drag-y STZ2 DUP2 .lit-drag-x STZ2 ( row* col* )
OVR2 .lit-click-y LDZ2 LTH2 ?&earlier ( row* col* )
DUP2 .lit-click-x LDZ2 LTH2 ?&earlier ( row* col* )
#00 !&done &earlier #01 ( row* col* )
&done .is-lit-flip STZ POP2 POP2 JMP2r ( )
@end-selection ( -> )
update-selection draw-cursor !handle-selection ( )
@on-click-down ( click^ -> )
DUP #01 AND ?&left-click
DUP #02 AND ?&middle-click
!&done
&left-click POP !start-selection
&middle-click POP !paste-snarf
&done POP JMP2r
@on-click-up ( unclick^ -> )
#01 AND ?&left-click !&done
&left-click !end-selection
&done 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 ( )
@draw-pointer ( -> )
.lastmouse-x LDZ2 .lastmouse-y LDZ2 ( x* y* )
.pointer-ttl LDZ ?&visible ;cp437/nul !draw-at
&visible ;cp437/rs !draw-at
@on-move ( -> )
#c4 .pointer-ttl STZ ( pointer visible for ~1 second )
.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* )
;cp437/space draw-at ( )
.is-lit LDZ #00 EQU ?&next ( )
update-selection #01 .dirty STZ ( )
&next ( )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
.lastmouse-y STZ2 .lastmouse-x STZ2 ( )
draw-pointer !screen-to-cursor ( )
@on-mouse ( -> BRK )
.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 ( -> BRK )
#00 .pointer-ttl STZ #01 .dirty STZ ( hide pointer )
.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 ( -> BRK )
#1b .Console/w DEO
ctrl ?on-ctrl-key
.Controller/key DEI .Console/w DEO BRK
( control seqs: )
( ctrl-sp -> 00 )
( ctrl-@ -> 00 )
( ctrl-a -> 01 )
( ... )
( ctrl-y -> 19 )
( ctrl-z -> 1a )
( ctrl-[ -> 1b )
( esc -> 1b )
( ctrl-\ -> 1c )
( ctrl-] -> 1d )
( ctrl-^ -> 1e )
( ctrl-/ -> 1f )
( ctrl-_ -> 1f )
( ctrl-$n emits: )
( 0 <= $n < @ -> $n )
( @ <= $n < ` -> $n #40 SUB )
( ` <= $n <= #ff -> $n #60 SUB )
@on-ctrl-key ( -> BRK )
.Controller/key DEI
DUP #20 EQU ?&nul ( space )
DUP #2d EQU ?&us ( '-' i.e. '_' )
DUP #2f EQU ?&nul ( '/' )
DUP #32 EQU ?&nul ( '2' i.e. '@' )
DUP #36 EQU ?&rs ( '6' i.e. '^' )
DUP LIT "@ LTH ?&done
DUP LIT "` LTH ?&c1
LIT "` SUB !&done
&nul #00 !&done
&rs #1e !&done
&us #1f !&done
&c1 LIT "@ SUB
&done .Console/w DEO BRK
@on-read-priv ( -> BRK )
.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 ( -> BRK )
POP ;on-read-priv .Console/vect DEO2 BRK
@on-read-csi ( -> BRK )
.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 ( -> BRK )
.Console/r DEI
DUP #07 ( bell ) EQU ?&end-osc
#9c ( esc-\ ) EQU ?&end-osc BRK
&end-osc ;on-read .Console/vect DEO2 BRK
( TODO: support 7-bit 1b 5c sequence? )
@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^ -> BRK )
;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^ -> BRK )
#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^ -> BRK )
;on-read .Console/vect DEO2
DUP debug-csi
DUP LIT "@ EQU ?exec-ich ( ICH: insert blank characters )
( TODO ($n-sp-@) SL: shift left $n cols )
DUP LIT "A EQU ?exec-cuu ( CUU: up )
( TODO ($n-sp-A) SR: shift right $n cols )
DUP LIT "B EQU ?exec-cud ( CUD: down )
DUP LIT "C EQU ?exec-cuf ( CUF: forward )
DUP LIT "D EQU ?exec-cub ( CUB: back )
DUP LIT "E EQU ?exec-cnl ( CNL: next line $n times )
DUP LIT "F EQU ?exec-cpl ( CPL: prev line $n times )
DUP LIT "G EQU ?exec-cha ( CHA: move cursor to abs col )
DUP LIT "H EQU ?exec-cup ( CUP: move cursor [row;col] )
DUP LIT "I EQU ?exec-cht ( CHT: forward by tab stops )
DUP LIT "J EQU ?exec-ed ( ED: erase display )
DUP LIT "K EQU ?exec-el ( EL: erase line )
DUP LIT "L EQU ?exec-il ( IL: insert $n blank lines )
DUP LIT "M EQU ?exec-dl ( DL: delete $n lines )
DUP LIT "P EQU ?exec-dch ( DCH: delete n chars )
DUP LIT "S EQU ?exec-su ( SU: scroll up )
DUP LIT "T EQU ?exec-sd ( SD: scroll down )
DUP LIT "X EQU ?exec-ech ( ECH: erase $n characters )
DUP LIT "Z EQU ?exec-cbt ( CBT: backward by tab stops )
DUP LIT "` EQU ?exec-hpa ( HPA: char pos abs col=$n )
DUP LIT "a EQU ?exec-hpr ( HPR: char pos rel col=$n )
( TODO: b - REP: repeat previous graphic char $n times )
( TODO: c - DA: send device attributes )
DUP LIT "d EQU ?exec-vpa ( VPA: move cursor to row )
DUP LIT "e EQU ?exec-vpr ( VPR: line pos rel row+=$n )
( TODO: $r;$c f - HVP: horizontal/vertical position )
DUP LIT "g EQU ?exec-tbc ( TBC: clear tab stops )
DUP LIT "h EQU ?exec-sm ( SM: set mode )
( TODO: ?-$n-h - DECSET: set dec options )
DUP LIT "l EQU ?exec-rm ( RM: reset mode )
( TODO: ?-$n-l - DECRST: reset dec options )
DUP LIT "m EQU ?exec-sgr ( SGR: set graphical rendering )
DUP LIT "n EQU ?exec-dsr ( DSR: device status reports )
( TODO: ?-$n-n - dec device status )
( TODO: $n-q - DECLL: load leds )
DUP LIT "r EQU ?exec-set-scrolling-region ( [$top;$bot] DECSTM: set scrolling reg )
DUP LIT "s EQU ?exec-scosc ( SCOSC: saved current cursor position )
DUP LIT "u EQU ?exec-scorc ( SCORC: restore saved cursor position )
( = 0 C - normal cursor )
( = 1 C - bold cursor )
debug-csi BRK
( TODO )
@exec-set-scrolling-region ( c^ -> BRK ) POP BRK
@exec-tbc ( c^ -> BRK ) POP BRK
@exec-scosc ( c^ -> BRK )
POP .cur-x LDZ2 .saved-x STZ2 .cur-y LDZ2 .saved-y STZ2 BRK
@exec-scorc ( c^ -> BRK )
POP clear-cursor
.saved-x LDZ2 .cur-x STZ2 .saved-y LDZ2 .cur-y STZ2
draw-cursor BRK
@mode-addr ( n* -> zp^ )
DUP2 #0004 NEQ2 ?{ POP2 .irm JMP2r } ( TODO: permanently reset )
DUP2 #0007 NEQ2 ?{ POP2 .awm JMP2r } ( TODO: rename to DECAWM )
( TODO: 20 is LNM: line feed/newline mode )
POP2 .ignored JMP2r
@sm ( n* -> ) mode-addr #01 SWP STZ JMP2r
@rm ( n* -> ) mode-addr #00 SWP STZ JMP2r
( other attributes: )
( 10 - primary font )
( 39 - default fg )
( 49 - default bg )
@read-attr ( attr* -> )
DUP2 #0031 GTH2 ?&skip ( attr* ; skip > 49 )
DUP2 ;sgr-fg ADD2 LDA ( attr* code^ )
DUP #40 EQU ?&reset ( attr* code^ )
DUP #80 EQU ?&invert ( attr* code^ )
DUP #ff EQU ?&done ( attr* code^ )
ROT ROT #0027 GTH2 ?&bg
.attr LDZ #fc !&update
&bg #20 SFT .attr LDZ #f3
&update AND ORA .attr STZ !update-tint
&reset #02 .attr STZ !&done
&invert .attr LDZ #80 ORA .attr STZ
&done update-tint POP &skip POP2 JMP2r
@sgr-fg ( 0 1 2 3 4 5 6 7 8 9 a b c d e f )
( 00 ) 40 03 01 ff ff ff ff 80 ff ff ff ff ff ff ff ff
( 10 ) ff ff ff ff ff ff ff ff ff ff ff ff ff ff 00 02
( 20 ) 02 02 02 02 02 03 ff 02 00 01 01 01 01 01 01 03
( 30 ) ff 00
@exec-sgr ( c^ -> BRK )
POP
;args/pos LDA2 ;args
&loop
LDA2k read-attr
INC2 INC2
LTH2k ?&done !&loop
&done
POP2 POP2 BRK
@exec0 ( addr* -> BRK ) STH2 #0000 read-arg-1 STH2r JSR2 BRK
@exec1 ( addr* -> BRK ) STH2 #0001 read-arg-1 STH2r JSR2 BRK
@exec-cuu POP ;cuu !exec1
@exec-cud POP ;cud !exec1
@exec-cuf POP ;cuf !exec1
@exec-cub POP ;cub !exec1
@exec-ich POP ;ich !exec1
@exec-dl POP ;dl !exec1
@exec-dch POP ;dch !exec1
@exec-il POP ;il !exec1
@exec-cht POP ;cht !exec1
@exec-cbt POP ;cbt !exec1
@exec-cnl POP ;cnl !exec1
@exec-cpl POP ;cpl !exec1
@exec-su POP ;su !exec1
@exec-ech POP ;ech !exec1
@exec-hpa POP ;hpa !exec1
@exec-hpr POP ;hpr !exec1
@exec-vpr POP ;vpr !exec1
@exec-sd POP BRK ( TODO )
@exec-vpa POP ;vpa !exec1
@exec-cha POP ;cha !exec1
@exec-el POP ;el !exec0
@exec-ed POP ;ed_ !exec0
@exec-sm POP ;sm !exec1
@exec-rm POP ;rm !exec1
@exec-dsr POP ;dsr !exec1
@dsr ( n* -> )
#0006 NEQ2 ?&done
#1b .Console/w DEO
LIT "[ .Console/w DEO
.cur-y LDZ2 INC2 emit-dec2
LIT "; .Console/w DEO
.cur-x LDZ2 INC2 emit-dec2
LIT "R .Console/w DEO
&done BRK
@cnl ( n* -> ) clear-cursor #0000 .cur-x STZ2 !down-n
@cpl ( n* -> ) clear-cursor #0000 .cur-x STZ2 !up-n
@cub ( n* -> ) clear-cursor !back-n
@cud ( n* -> ) clear-cursor !down-n
@cuf ( n* -> ) clear-cursor !forward-n
@cuu ( n* -> ) clear-cursor !up-n
@hpa ( n* -> ) unset-wrap clear-cursor dec-floor .max-x LDZ2 min .cur-x STZ2 !draw-cursor
@hpr ( n* -> ) clear-cursor !forward-n
@vpr ( n* -> ) clear-cursor !down-n
@vpa ( n* -> ) dec-floor .cur-x LDZ2 !goto
@cha ( n* -> ) dec-floor .cur-y LDZ2 SWP !goto
@su ( n* -> )
#0000 SWP2 SUB2 STH2 clear-cursor ( [-count*] )
&loop scroll INC2r ORAkr STHr ?&loop ( [-i+1*] )
POP2r JMP2r ( )
@ech ( n* -> )
#0000 SWP2 SUB2 STH2 ( [-count*] )
#0200 cur-addr ( 0200 addr* [-count*] )
&loop ( 0200 pos* [-i*] )
STA2k INC2 INC2 ( 0200 pos+2* [-i*] ; pos<-0200 )
INC2r ORAkr STHr ?&loop ( pos+2* [-i+1*] )
POP2 POP2 POP2r ( )
#01 .dirty STZ JMP2r ( )
@el ( n* -> )
DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ?&erase-full
POP2 JMP2r
&erase-full POP2 bol-addr eol-addr !erase
&erase-to-end POP2 cur-addr eol-addr !erase
&erase-from-start POP2 bol-addr cur-addr !erase
@ed_ ( n* -> )
DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ?&erase-full
POP2 JMP2r
&erase-full POP2 first-addr limit-addr !erase
&erase-to-end POP2 bol-addr limit-addr !erase
&erase-from-start POP2 first-addr eol-addr ( fall-through )
@erase ( start* end* -> ) #0200 !init
@exec-cup ( c^ -> BRK )
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* )
#0001 SUB2 #0000 !smax
@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 ( -> BRK )
.Console/r DEI
DUP debug-esc
&after
( TODO: SP-F, SP-G, SP-L, SP-M, SP-N )
( TODO: #-3, #-4, #-5, #-6, #-8 )
( TODO: %-@, %-G )
DUP LIT "D EQU ?exec-ind ( IND: index )
DUP LIT "E EQU ?exec-nel ( NEL: next line )
DUP LIT "H EQU ?exec-hts ( HTS: tab set )
DUP LIT "M EQU ?exec-ri ( RI: reverse index )
DUP LIT "P EQU ?exec-dcs ( DCS: device control string )
DUP LIT "[ EQU ?start-csi ( CSI: control sequence introducer )
DUP LIT "] EQU ?start-osc ( OSC: operating system command )
DUP LIT "c EQU ?exec-ris ( RIS: full reset )
DUP LIT "( EQU ?start-charset
DUP LIT ") EQU ?start-charset
DUP LIT "7 EQU ?&skip ( DECSC: save cursor )
DUP LIT "8 EQU ?&skip ( DECRC: restore cursor )
DUP LIT "> EQU ?&skip ( DECKPNM: normal keypad )
DUP LIT "~ EQU ?&skip ( LS1R: invoke G1 charset as GR )
DUP LIT "# EQU ?&skip ( TODO: DECALN, fill screen with Es )
debug-esc
;on-read .Console/vect DEO2
!on-read
&skip POP ;on-read .Console/vect DEO2 BRK
@exec-ind ( c^ -> ) POP clear-cursor down-or-scroll BRK
@exec-nel ( c^ -> ) POP cr BRK
@exec-hts ( c^ -> ) POP BRK ( TODO )
@exec-ri ( c^ -> ) POP clear-cursor #0001 up-n BRK
@exec-dcs ( c^ -> ) POP BRK ( TODO )
@exec-ris ( c^ -> )
POP first-addr limit-addr erase
reset-terminal BRK
@on-read-skip ( -> BRK )
;on-read .Console/vect DEO2
BRK
( preceeded by '(' [G0] or ')' [G1] )
( "A" -> UK )
( "B" -> USASCII )
( "0" -> DEC special graphics, line drawing )
@start-charset ( c^ -> BRK )
POP ;on-read-skip .Console/vect DEO2 BRK
@start-csi ( c^ -> BRK )
POP reset-args ;on-read-csi .Console/vect DEO2 BRK
@start-osc ( c^ -> BRK )
POP reset-args ;on-read-osc .Console/vect DEO2 BRK
( TODO: 8-bit input not ready for prime time yet )
@on-read ( -> BRK )
.Console/r DEI ( DUP #7f GTH ?read-8bit ) read BRK
@read-8bit ( c^ -> BRK )
DUP debug-esc #80 SUB !on-read-esc/after
@read ( c^ -> )
DUP debug-read
DUP ?&ok POP JMP2r
&ok
DUP #20 LTH ?read-ctrl
DUP #7f EQU ?read-del
( fall through to draw )
@draw ( c^ -> )
.tint LDZ SWP DUP2 insert-cell draw-cell
.cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ
clear-cursor !forward
@read-ctrl ( c^ -> )
DUP #05 EQU ?&skip ( ENQ - return terminal status )
DUP #07 EQU ?read-bel
DUP #08 EQU ?read-bs
DUP #09 EQU ?read-tab ( HT )
DUP #0a EQU ?read-lf ( NL - LF )
DUP #0b EQU ?read-lf ( VT - treated as LF )
DUP #0c EQU ?read-lf ( FF - treated as LF )
DUP #0d EQU ?read-cr ( CR )
( DUP #0e EQU ?&skip ( TODO: SO - shift out; G0 charset ) )
( DUP #0f EQU ?&skip ( TODO: SI - shift in; G1 charset ) )
DUP #1b EQU ?read-esc
&skip POP JMP2r
@read-bel ( 07 -> )
POP .visual-bell LDZ #00 EQU ?&done
#06 .flash STZ #01 .dirty STZ
&done JMP2r
( TODO: handle reverse wrap-around and dec auto-wrap )
@read-bs ( 08 -> )
POP clear-cursor #0001 !back-n
@read-esc ( 1b -> )
POP ;on-read-esc .Console/vect DEO2 JMP2r
@read-del ( 7f -> )
POP JMP2r
( TODO: respect tab stops )
@read-tab ( 09 -> )
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^ )
clear-cursor ( i^ )
forward ( i^ )
INC DUP ?&loop ( i+1^ )
POP JMP2r ( )
@cr ( -> )
clear-cursor #0000 .cur-x STZ2 !draw-cursor
@read-cr ( 0d -> )
POP .cur-wrap LDZ ?&skip cr &skip JMP2r
@at-max-x ( -> true? ) .cur-x LDZ2 .max-x LDZ2 EQU2 JMP2r
@at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
@read-lf ( 0a -> )
POP !lf
( TODO: cur-wrap machinery not vt100 compliant. )
( cursor should stay on previous line normally )
@lf ( -> )
.cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
@goto ( y* x* -> )
unset-wrap
clear-cursor
.max-x LDZ2 min .cur-x STZ2
.max-y LDZ2 min .cur-y STZ2
!draw-cursor
@forward-n ( n* -> )
.cur-x LDZ2 ADD2 .max-x LDZ2 min .cur-x STZ2 !draw-cursor
@back-n ( n* -> )
unset-wrap
.cur-x LDZ2 SWP2 SUB2 #0000 smax .cur-x STZ2 !draw-cursor
@up-n ( n* -> )
.cur-y LDZ2 SWP2 SUB2 #0000 smax .cur-y STZ2 !draw-cursor
@down-n ( n* -> )
.cur-y LDZ2 ADD2 .max-y LDZ2 min .cur-y STZ2 !draw-cursor
@forward ( -> ) #0001 !forward-n
@down ( -> ) #0001 !down-n
@down-or-scroll ( -> ) at-max-y ?&s !down &s !scroll
@maybe-autowrap ( -> )
.cur-wrap LDZ #00 EQU ?&skip
#00 .cur-wrap STZ
clear-cursor
#0000 .cur-x STZ2
at-max-y ?&scrolling
.cur-y LDZ2k INC2 ROT STZ2
screen-to-cursor
&skip JMP2r
&scrolling !scroll
@insert-cell ( cell* -> )
maybe-autowrap ( cell* )
.irm LDZ #00 EQU ?&replace ( cell* )
cur-addr ( cell* lim* )
eol-addr #0002 SUB2 ( cell* lim* last=eol-2* )
&loop ( cell* lim* pos* )
STH2k #0002 SUB2 LDA2k ( cell* lim* pos-2* cell* [pos*] )
STH2r STA2 LTH2k ?&loop ( cell* lim* pos-2* )
POP2 POP2 ( cell* )
&replace ( cell* )
cur-addr STA2 JMP2r ( )
@cht ( n* -> )
clear-cursor
dec-floor #30 SFT2 ( i=(n-1)8* )
#0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* )
ADD2 !forward-n ( )
@cbt ( n* -> )
unset-wrap
clear-cursor
dec-floor #30 SFT2 ( i=(n-1)8* )
.cur-x LDZ2 #0007 AND2 ( i* cur%8* )
ADD2 !back-n ( )
@il ( 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 )
#0200 OVR2 STA2 ( bound* pos* [i*] ; pos<-0200 )
#0002 SUB2 ( bound* pos-2* [i*] )
GTH2k #00 EQU ?&loop ( bound* pos-2* [i*] )
POP2 POP2 POP2r ( )
#01 .dirty STZ JMP2r ( )
@ich ( n* -> )
STH2 ( [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*] )
LIT2r 0000 SWP2r SUB2r ( [-n*] )
#0200 cur-addr ( 0200 cur* [-n*] )
&loop2 ( 0200 pos* [-i*] )
STA2k INC2 INC2 INC2r ( 0200 pos+2* [-i+1*] )
ORAkr STHr ?&loop2 ( 0200 pos+2* [-i+1*] )
POP2 POP2 POP2r ( )
#01 .dirty STZ JMP2r ( )
( starts with cursor pos )
@dch ( 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*] )
#0200 ROT2 STA2 ( limit* pos* x* [i*] ; pos+i<-0200 )
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 )
@dl ( n* -> )
.col-bytes LDZ2 MUL2 STH2 ( [n*] )
limit-addr STH2kr SUB2 ( limit* [n*] )
eol-addr ( limit* start* [n*] )
!dch/loop
@scroll ( -> )
limit-addr STH2 ( [lim*] )
;cells .col-bytes LDZ2 ADD2 STH2 ( [lim* addr*] )
&loop ( [lim* pos*] )
STH2kr LDA2 #0200 STH2kr STA2 ( cell* [lim* pos* cell*] ; pos<-0200 )
STH2kr .col-bytes LDZ2 SUB2 STA2 ( [lim* pos*] ; pos-cb<-cell )
INC2r INC2r GTH2kr STHr ?&loop ( [lim* pos+2*] )
POP2r POP2r ( )
#01 .dirty STZ ( )
!draw-cursor ( )
( 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 ( )
@highlight-cell ( cell* -> )
NIP LITr 47 ( 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^ -> BRK )
POP
( TODO: check if we already have max args )
;args/pos LDA2k INC2 INC2 SWP2 STA2 BRK
@add-to-arg ( c^ -> BRK )
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/arg1 LDA2 !max
@read-arg-2 ( default* -> n* ) ;args/arg2 ( 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
( emit a signed short as a decimal )
@emit-sdec2 ( n* -> )
DUP2k #1f SFT2 EQUk ?&s LIT2 "- 18 DEO
&s MUL2 SUB2 ( fall-through to emit-dec2 )
( emit an unsigned short as a decimal )
@emit-dec2 ( n* -> )
LITr ff00 &read #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&read
POP2 &write NIP #30 ADD #18 DEO OVRr ADDr STHkr ?&write
POP2r 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 )
@args [ &arg1 $2 &arg2 $2 &rest $c &pos $2 ]
( 256 chars x 2 tiles/char x 8 bytes/tile = 4096 bytes )
( second tile only uses top 50% )
@cp437
~cp437.tal
@snarf ".snarf 00
@meta 00 &body
&name "determ 0a
&details "ansi 20 "terminal 20 "emulator 0a
&author "by 20 "d_m 0a
&date "13 20 "nov 20 "2023 00
02
( device mask ) 41 0d07
( 24x24 icon ) 83 =icon-2-bit
@banner-ascii
0d 0a
20 20 c9 cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd bb 0d 0a
20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
20 20 ba 20 20 "d "e "t "e "r "m 20 20 "v "1 "1 20 20 ba 0d 0a
20 20 ba 20 20 20 20 "b "y 20 "d "_ "m 20 20 20 20 20 ba 0d 0a
20 20 ba 20 20 "1 "3 20 "n "o "v 20 "2 "0 "2 "3 20 20 ba 0d 0a
20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
20 20 c8 cd cd cb cd cd cd cd cd cd cd cd cd cb cd cd bc 0d 0a
20 20 c9 cb cb ce cb cb cb cb cb cb cb cb cb ce cb cb bb 0d 0a
20 20 c8 ca ca ca ca ca ca ca ca ca ca ca ca ca ca ca bc 0d 0a
0d 0a 00
@icon-2-bit
00 00 00 1f 3f 38 32 34 00 00 00 00 00 07 0f 0f
00 00 00 ff ff 00 00 00 00 00 00 00 00 ff ff ff
00 00 00 f8 fc 1c 4c 2c 00 00 00 00 00 e0 f0 f0
34 30 30 30 30 30 30 30 0f 0f 0f 0f 0f 0f 0f 0f
00 00 00 00 00 00 00 00 ff ff ff ff ff ff ff ff
2c 0c 0c 0c 0c 0c 0c 0c f0 f0 f0 f0 f0 f0 f0 f0
34 34 32 38 3f 1e 07 00 0f 0f 0f 07 00 03 00 00
00 00 00 00 ff a0 ff 00 ff ff ff ff 00 ff 00 00
2c 2c 4c 1c fc 38 e0 00 f0 f0 f0 e0 00 c0 00 00
( paste buffer )
@paste-buf $0780 ( max 80 x 24 characters )
@paste-pos $2
( TODO: tab stops )
( state )
@setup
&alternate-keypad-mode 00 ( 00 numeric [DECKPNM], 01 application [DECKPAM] )
&ansi-vt52 00 ( DECANM; 00 ansi, 01 vt-52 )
&chars-per-line 00 ( DECCOLM; 00 80, 01 132 )
&cursor-key-modes 00 ( DECCKM )
&new-line 00 ( LNM; 00 return=CR, return=CRLF; ignored by IND/NEL )
&origin-mode 00 ( DECOM; )
&screen 00 ( DECSCNM; 00 normal, 01 reverse video )
&wraparound 00 ( DECAWM; right margin 00 replace, 01 next line/scroll )
&3-shifted "B ( SCS; character set selected; B is ASCII )
( store tint+char for each screen position )
@cells ( width x height x 2 bytes )