1369 lines
44 KiB
Tal
1369 lines
44 KiB
Tal
( 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 )
|
|
|
|
|00 @System [
|
|
&vect $2 &expansion $2 &title $2 &metadata $2
|
|
&r $2 &g $2 &b $2 ]
|
|
|
|
|10 @Console [
|
|
&vect $2 &stdin $1 &pad1 $4 &type $1
|
|
&stdout $1 &stderr $1 &proc-put $1 &pad2 $1 ¶m $2 &opts $1 &host-put $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 &pad1 $1
|
|
&pad2 $2 &scrollx $2 &scrolly $2 &pad3 $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 )
|
|
|
|
( user configuration )
|
|
@debug $1 ( use debug log? )
|
|
@show-banner $1 ( show banner on startup? )
|
|
@visual-bell $1 ( flash visual bell? otherwise do nothing )
|
|
@border-pad $2 ( use border? should be 0000 or 0010 )
|
|
|
|
|0100
|
|
( metadata )
|
|
;meta .System/metadata DEO2
|
|
;meta/name .System/title DEO2
|
|
|
|
( user configuration defaults )
|
|
#00 .debug STZ
|
|
#01 .show-banner STZ
|
|
( #0010 .border-pad STZ2 )
|
|
#0000 .border-pad STZ2
|
|
#01 .visual-bell STZ
|
|
|
|
( 80 cols x 24 rows by default )
|
|
#0018 .rows STZ2
|
|
#0050 .cols 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-shell ( 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
|
|
|
|
@env "TERM=ansi 00
|
|
|
|
( these only work with a patched uxnemu )
|
|
( on other emulators they should be no-ops )
|
|
@setup-shell ( -> )
|
|
( setenv 'TERM=ansi' )
|
|
;env .Console/param DEO2
|
|
#11 .Console/host-put DEO
|
|
|
|
( exec 'bash -i' )
|
|
#81 .Console/opts DEO
|
|
;shell .Console/param DEO2
|
|
#01 .Console/host-put DEO
|
|
|
|
( TODO: run stty to communicate terminal size? )
|
|
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 .cur-x STZ2
|
|
#0000 .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 )
|
|
|
|
( prepare for initial draw )
|
|
init-screen
|
|
|
|
( draw border )
|
|
.border-pad LDZ2 ORA ?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 20 "-l 20 "-i 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 ( -> )
|
|
#40 .Screen/sprite DEO ( ; s/s<-40 )
|
|
.Screen/y DEI2k STH2k ( zp^ y* [y*] )
|
|
#0004 ADD2 ROT DEO2 ( [y*] ; s/y<-y+4 )
|
|
#40 .Screen/sprite DEO STH2r ( y* ; s/s<-40 )
|
|
.Screen/y DEO2 JMP2r ( ; s/y<-y )
|
|
|
|
@draw-border ( -> )
|
|
;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/proc-put 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/proc-put DEO INC2 ( limit* pos+1* )
|
|
GTH2k ?&loop POP2 POP2 JMP2r
|
|
|
|
@bracket-paste ( c^ -> )
|
|
.Console/proc-put 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/proc-put 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/proc-put DEO
|
|
ctrl ?on-ctrl-key
|
|
.Controller/key DEI .Console/proc-put 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/proc-put DEO BRK
|
|
|
|
@on-read-priv ( -> BRK )
|
|
.Console/type DEI #21 EQU ?{ BRK }
|
|
.Console/stdin 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/type DEI #21 EQU ?{ BRK }
|
|
.Console/stdin 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/type DEI #21 EQU ?{ BRK }
|
|
.Console/stdin 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 ( insert blank characters )
|
|
DUP LIT "A EQU ?exec-cuu ( up )
|
|
DUP LIT "B EQU ?exec-cud ( down )
|
|
DUP LIT "C EQU ?exec-cuf ( forward )
|
|
DUP LIT "D EQU ?exec-cub ( back )
|
|
DUP LIT "E EQU ?exec-cnl ( next line $n times )
|
|
DUP LIT "F EQU ?exec-cpl ( prev line $n times )
|
|
DUP LIT "G EQU ?exec-cha ( move cursor to col )
|
|
DUP LIT "H EQU ?exec-cup ( move cursor )
|
|
DUP LIT "I EQU ?exec-cht ( forward by tab stops )
|
|
DUP LIT "J EQU ?exec-ed ( erase screen )
|
|
DUP LIT "K EQU ?exec-el ( erase line )
|
|
DUP LIT "L EQU ?exec-il ( insert blank lines )
|
|
DUP LIT "M EQU ?exec-dl ( delete n lines )
|
|
DUP LIT "P EQU ?exec-dch ( delete n chars )
|
|
DUP LIT "S EQU ?exec-su ( scroll up )
|
|
DUP LIT "T EQU ?exec-sd ( scroll down )
|
|
DUP LIT "X EQU ?exec-ech ( erase $n characters )
|
|
DUP LIT "Z EQU ?exec-cbt ( backward by tab stops )
|
|
DUP LIT "` EQU ?exec-hpa ( char pos abs col=$n )
|
|
DUP LIT "a EQU ?exec-hpr ( char pos rel col=$n )
|
|
DUP LIT "d EQU ?exec-vpa ( move cursor to row )
|
|
DUP LIT "e EQU ?exec-vpr ( line pos rel row+=$n )
|
|
DUP LIT "g EQU ?exec-tbc ( clear tab stops )
|
|
DUP LIT "h EQU ?exec-sm ( set mode )
|
|
DUP LIT "l EQU ?exec-rm ( reset mode )
|
|
DUP LIT "m EQU ?exec-sgr ( set graphical rendering )
|
|
DUP LIT "n EQU ?exec-dsr ( device status reports )
|
|
DUP LIT "r EQU ?exec-set-scrolling-region
|
|
DUP LIT "s EQU ?exec-scosc ( saved current cursor position )
|
|
DUP LIT "u EQU ?exec-scorc ( restore saved cursor position )
|
|
( = 0 C - normal cursor )
|
|
( = 1 C - bold cursor )
|
|
debug-csi BRK
|
|
|
|
@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 ?¬-irm POP2 .irm JMP2r
|
|
¬-irm DUP2 #0007 NEQ2 ?¬-awm POP2 .awm JMP2r
|
|
¬-awm 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/proc-put DEO
|
|
LIT "[ .Console/proc-put DEO
|
|
.cur-y LDZ2 INC2 emit-dec2
|
|
LIT "; .Console/proc-put DEO
|
|
.cur-x LDZ2 INC2 emit-dec2
|
|
LIT "R .Console/proc-put 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/type DEI #21 EQU ?{ BRK }
|
|
.Console/stdin DEI
|
|
DUP debug-esc
|
|
DUP LIT "D EQU ?exec-ind
|
|
DUP LIT "E EQU ?exec-nel
|
|
DUP LIT "H EQU ?exec-hts
|
|
DUP LIT "M EQU ?exec-ri
|
|
DUP LIT "P EQU ?exec-dcs
|
|
DUP LIT "[ EQU ?start-csi
|
|
DUP LIT "] EQU ?start-osc
|
|
DUP LIT "c EQU ?exec-ris
|
|
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
|
|
|
|
@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
|
|
|
|
( '(' = designate G0 charset )
|
|
( ')' = designate G1 charset )
|
|
( '*' = designate G2 charset )
|
|
( '+' = designate G3 charset )
|
|
@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
|
|
|
|
@on-read ( -> BRK )
|
|
.Console/type DEI #21 EQU ?{ BRK }
|
|
.Console/stdin DEI read BRK
|
|
|
|
@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 #07 EQU ?read-bel
|
|
DUP #08 EQU ?read-bs
|
|
DUP #09 EQU ?read-tab
|
|
DUP #0a EQU ?read-lf
|
|
DUP #0b EQU ?read-lf
|
|
DUP #0c EQU ?read-lf
|
|
DUP #0d EQU ?read-cr
|
|
DUP #1b EQU ?read-esc
|
|
POP JMP2r
|
|
|
|
@read-bel ( 07 -> )
|
|
POP .visual-bell LDZ #00 EQU ?&done
|
|
#06 .flash STZ #01 .dirty STZ
|
|
&done JMP2r
|
|
|
|
@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
|
|
|
|
@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
|
|
|
|
@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 07 ( 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 LIT "- .Console/proc-put DEO
|
|
&s MUL2 SUB2 ( fall-through to emit-dec2 )
|
|
|
|
( emit an unsigned short as a decimal )
|
|
@emit-dec2 ( n* -> )
|
|
LIT2r ff00 ( n* [ff^ 0^] )
|
|
&read ( ... x* )
|
|
#000a DIV2k STH2k ( x* 10* x/10* [ff^ i^ x/10*] )
|
|
MUL2 SUB2 STH2r ( x%10* x/10* [ff^ i^] )
|
|
INCr ORAk ?&read ( x%10* x/10* [ff^ i+1^] )
|
|
POP2 ( x0* ... xn* [ff^ i+1^] )
|
|
&write
|
|
NIP #30 ADD .Console/proc-put DEO ( x0* ... xn-1* [ff^ j^] )
|
|
OVRr ADDr STHkr ?&write ( x* ... xn-1* [ff^ j-1^] )
|
|
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 "3 20 "jan 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 "2 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 "5 20 "d "e "c 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
|
|
|
|
( store tint+char for each screen position )
|
|
@cells ( width x height x 2 bytes )
|