1311 lines
40 KiB
Tal
1311 lines
40 KiB
Tal
( femto.tal )
|
|
( )
|
|
( requires terminal to be in raw mode )
|
|
( see femto launcher script for more details )
|
|
( )
|
|
( ANSI sequences )
|
|
( )
|
|
( goto $row,$col ESC [ $row ; $col H )
|
|
( goto home ESC [ H )
|
|
( go up ESC [ A )
|
|
( go down ESC [ B )
|
|
( go right ESC [ C )
|
|
( go left ESC [ D )
|
|
( )
|
|
( query cursor ESC [ 6 n )
|
|
( )
|
|
( all scroll on ESC [ r )
|
|
( region scroll on ESC [ $y0 ; $y1 r )
|
|
( scroll down ESC D )
|
|
( scroll up ESC M )
|
|
( )
|
|
( erase cur->eol ESC [ K )
|
|
( erase cur->sol ESC [ 1 K )
|
|
( erase line ESC [ 2 K )
|
|
( erase line->bot ESC [ J )
|
|
( erase line->top ESC [ 1 J )
|
|
( erase all ESC [ 2 J )
|
|
( )
|
|
( set attrs ESC [ $at1 ; ... m )
|
|
( reset ESC [ m )
|
|
( 0 reset, 1 bright, 2 dim, )
|
|
( 4 underscore, 5 blink, )
|
|
( 7 reverse, 8 hidden )
|
|
( )
|
|
( fg (30-37), bg (40-47) )
|
|
( black, red, green, yellow, )
|
|
( blue, magenta, cyan, white )
|
|
|
|
( TODO: )
|
|
( - optimize term drawing )
|
|
( - get long line truncation/scrolling working )
|
|
( - allow line numbers to be toggled off )
|
|
( - help text )
|
|
( - open file command? )
|
|
( - close file command? )
|
|
( - move by word/paragraph )
|
|
( - search )
|
|
( - search&replace )
|
|
( - windows line-ending support (CRLF) )
|
|
|
|
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|
|
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|
|
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
|
|
|
|
%dbg { #ff .System/debug DEO }
|
|
%emit { .Console/write DEO }
|
|
%sp { #2018 DEO }
|
|
%nl { #0a18 DEO }
|
|
%cr { #0d18 DEO }
|
|
%ansi { #1b18 DEO #5b18 DEO }
|
|
|
|
( emit macros )
|
|
( )
|
|
( these save one byte and are easier to read. )
|
|
%emit-! { LIT2 '! 18 DEO }
|
|
%emit-$ { LIT2 '$ 18 DEO }
|
|
%emit-( { LIT2 '( 18 DEO }
|
|
%emit-) { LIT2 ') 18 DEO }
|
|
%emit-, { LIT2 ', 18 DEO }
|
|
%emit-0 { LIT2 '0 18 DEO }
|
|
%emit-1 { LIT2 '1 18 DEO }
|
|
%emit-2 { LIT2 '2 18 DEO }
|
|
%emit-3 { LIT2 '3 18 DEO }
|
|
%emit-6 { LIT2 '6 18 DEO }
|
|
%emit-7 { LIT2 '7 18 DEO }
|
|
%emit-; { LIT2 '; 18 DEO }
|
|
%emit-C { LIT2 'C 18 DEO }
|
|
%emit-H { LIT2 'H 18 DEO }
|
|
%emit-J { LIT2 'J 18 DEO }
|
|
%emit-K { LIT2 'K 18 DEO }
|
|
%emit-[ { LIT2 '[ 18 DEO }
|
|
%emit-m { LIT2 'm 18 DEO }
|
|
%emit-n { LIT2 'n 18 DEO }
|
|
%emit-~ { LIT2 '~ 18 DEO }
|
|
|
|
%quit! { #01 .System/halt DEO BRK }
|
|
|
|
%lmargin { #0006 }
|
|
|
|
( zero page )
|
|
|0000
|
|
|
|
@counter $2
|
|
|
|
@term [
|
|
&cols $2 ( relative x coordinate of cursor, from 0 )
|
|
&rows $2 ( relative y coordinate of cursor, from 1 )
|
|
]
|
|
|
|
@config [
|
|
&tab-width $2 ( how many spaces to display tab chars )
|
|
&insert-tabs $1 ( tab key inserts tabs when true )
|
|
&color $2 ( digits of highlight color in reverse order )
|
|
]
|
|
|
|
@buffer [
|
|
&limit $2 ( last byte of actual data (not including \0) + 1 )
|
|
&offset $2 ( first byte of data visible in terminal )
|
|
&line-count $2 ( total number of lines in file )
|
|
&line-offset $2 ( first line of text visible in terminal )
|
|
]
|
|
|
|
( relative cursor positions, e.g. 0 to cols-1 )
|
|
@cursor [
|
|
&col $2 ( current column value 0-n (may exceed lenght of row) )
|
|
&row $2 ( current relative row value, 0-(height-1) )
|
|
]
|
|
|
|
@state [
|
|
&key $1 ( last key read )
|
|
&saw-esc $1 ( did we just see ESC? )
|
|
&saw-xterm $1 ( did we just see an ESC [ xterm sequence? )
|
|
&saw-vt $1 ( did we just see an ESC [ $N vt sequence? )
|
|
&redraw $1 ( redrawing: bits determine which parts )
|
|
( 0x01 cursor )
|
|
( 0x02 statusbar )
|
|
( 0x04 prompt )
|
|
( 0x08 matches )
|
|
( 0x10 body and everything else )
|
|
&message $1 ( did we just print a message? )
|
|
&modified $1 ( has the buffer been modified? )
|
|
&quitting $1 ( are we in the process of quitting? )
|
|
]
|
|
|
|
( prompt uses .tmp/pos and .tmp/data to track user input )
|
|
@prompt [
|
|
&active $1 ( is prompt currently active? )
|
|
&vector $2 ( what code to run when user responds )
|
|
&string $2 ( string to print for the prompt )
|
|
]
|
|
|
|
@tmp [
|
|
&pos $2 ( temporary pointer to address when reading data )
|
|
&data $40 ( small scratch pad when reading data )
|
|
]
|
|
|
|
( search uses .tmp/pos and .tmp/data to track query string )
|
|
@searching [
|
|
&active $1 ( are we displaying search results? )
|
|
&orig-row $2 ( row we began the search at )
|
|
&orig-col $2 ( col we began the search at )
|
|
®ex $2 ( regex to be stored if any )
|
|
&start $2 ( absolute start pos of match )
|
|
&end $2 ( absolute limit pos of match )
|
|
]
|
|
|
|
( startup )
|
|
|0100
|
|
;init-zero-page JSR2
|
|
;startup JMP2
|
|
|
|
~regex.tal
|
|
|
|
( intialize zero page variables )
|
|
( )
|
|
( everything not specified starts as zero )
|
|
@init-zero-page ( -> )
|
|
#0050 .term/cols STZ2
|
|
#0018 .term/rows STZ2
|
|
|
|
#0004 .config/tab-width STZ2
|
|
#00 .config/insert-tabs STZ
|
|
#3333 .config/color STZ2
|
|
|
|
;data .buffer/offset STZ2
|
|
JMP2r
|
|
|
|
( code to run on startup )
|
|
@startup
|
|
;filename .tmp/pos STZ2
|
|
;read-filename .Console/vector DEO2
|
|
BRK
|
|
|
|
( ERROR HANDLING )
|
|
|
|
( using error! will print the given message before causing )
|
|
( the interpreter to halt. )
|
|
@error! ( msg* -> )
|
|
emit-! sp
|
|
&loop LDAk ,&continue JCN ,&done JMP
|
|
&continue LDAk emit INC2 ,&loop JMP
|
|
&done POP2 nl
|
|
dbg BRK
|
|
|
|
@open-file ( filename* -> )
|
|
.File/name DEO2
|
|
#f000 .File/length DEO2
|
|
;data .File/read DEO2
|
|
|
|
.File/success DEI2 #0000 GTH2 ,&ok JCN
|
|
;messages/input-error ;print JSR2
|
|
;filename ;print JSR2 nl quit!
|
|
|
|
( calculate buffer limit address using start + size )
|
|
&ok .File/success DEI2 ;data ADD2 .buffer/limit STZ2
|
|
JMP2r
|
|
|
|
@setup-terminal-size ( -> )
|
|
#03e7 DUP2 ;term-move-cursor JSR2
|
|
;term-get-cursor-position JSR2
|
|
;tmp/data .tmp/pos STZ2
|
|
;receive-terminal-size .Console/vector DEO2
|
|
JMP2r
|
|
|
|
@receive-terminal-size ( -> )
|
|
.Console/read DEI .state/key STZ
|
|
.state/key LDZ .tmp/pos LDZ2 STA
|
|
.tmp/pos LDZ2 INC2 .tmp/pos STZ2
|
|
.state/key LDZ LIT 'R EQU ;parse-terminal-size JCN2
|
|
BRK
|
|
|
|
@parse-terminal-size ( -> )
|
|
LIT2r 0000 LIT2r 0000
|
|
.tmp/data LDZk #1b NEQ ,&parse-error JCN ( i ) INC
|
|
LDZk LIT '[ NEQ ,&parse-error JCN ( i ) INC
|
|
&loop
|
|
LDZk LIT '; EQU ,&parse-col JCN
|
|
LIT2r 000a MUL2r
|
|
LDZk LIT '0 SUB #00 SWP STH2 ADD2r
|
|
INC ,&loop JMP
|
|
&parse-col
|
|
INC STH2r #0002 SUB2 .term/rows STZ2
|
|
&loop2
|
|
LDZk LIT 'R EQU ,&done JCN
|
|
LIT2r 000a MUL2r
|
|
LDZk LIT '0 SUB #00 SWP STH2 ADD2r
|
|
INC ,&loop2 JMP
|
|
&done
|
|
STH2r .term/cols STZ2 POP
|
|
;on-key .Console/vector DEO2
|
|
;draw-all JSR2
|
|
BRK
|
|
&parse-error POP .tmp/data LDZ2
|
|
;messages/term-size-parse-error ;error! JMP2
|
|
|
|
@setup-linecount ( -> )
|
|
;data LIT2r 0001
|
|
&loop DUP2 .buffer/limit LDZ2 EQU2 ,&done JCN
|
|
LDAk #00 EQU ,&done JCN
|
|
LDAk #09 NEQ ,&next JCN #01 .config/insert-tabs STZ
|
|
&next LDAk #0a NEQ JMP INC2r
|
|
INC2 ,&loop JMP
|
|
&done POP2
|
|
STH2r .buffer/line-count STZ2
|
|
JMP2r
|
|
|
|
@read-filename ( -> )
|
|
#12 DEI #0a EQU ,&execute JCN ( did we read \n ? )
|
|
#12 DEI .tmp/pos LDZ2 STA ( no, so save in buffer )
|
|
.tmp/pos LDZ2 INC2 .tmp/pos STZ2 ( pos++ )
|
|
BRK ( return )
|
|
|
|
&execute ( we saw a newline, so do something )
|
|
#00 .tmp/pos LDZ2 STA ( null terminate str )
|
|
;filename ;open-file JSR2 ( open file )
|
|
;setup-linecount JSR2 ( determine # of lines )
|
|
;setup-terminal-size JSR2 ( detect terminal dimensions )
|
|
BRK
|
|
|
|
@bol ( -> )
|
|
#0000 .cursor/col STZ2
|
|
;redraw-statusbar-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
@eol ( -> )
|
|
;cur-len JSR2 .cursor/col STZ2
|
|
;redraw-statusbar-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
@forward ( -> )
|
|
;cur-pos JSR2 ;last-pos JSR2 GTH2 ;return JCN2
|
|
;cur-col JSR2 ;cur-len JSR2 LTH2 ,&normal JCN
|
|
#0000 .cursor/col STZ2
|
|
.cursor/row LDZ2 INC2 .cursor/row STZ2
|
|
;ensure-visible-cursor JSR2
|
|
;return JMP2
|
|
&normal
|
|
;cur-col JSR2 INC2 .cursor/col STZ2
|
|
;redraw-statusbar-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
@go-back ( -> )
|
|
;cur-pos JSR2 ;data EQU2 ,&noop JCN
|
|
;cur-col JSR2 #0001 LTH2 ,&next-line JCN
|
|
;cur-col JSR2 #0001 SUB2 .cursor/col STZ2
|
|
;redraw-statusbar-and-cursor JMP2
|
|
&next-line
|
|
.cursor/row LDZ2k #0001 SUB2 ROT STZ2
|
|
;cur-len JSR2 .cursor/col STZ2
|
|
;ensure-visible-cursor JSR2
|
|
;redraw-statusbar-and-cursor JSR2
|
|
&noop JMP2r
|
|
|
|
@back ( -> )
|
|
;go-back JSR2 ;return JMP2
|
|
|
|
@up ( -> )
|
|
.cursor/row LDZ2 #0000 EQU2 ;return JCN2
|
|
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2
|
|
;ensure-visible-cursor JSR2
|
|
;redraw-statusbar-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
@last-abs-row ( -> n* )
|
|
.buffer/line-count LDZ2 #0001 SUB2 JMP2r
|
|
|
|
@down ( -> )
|
|
.cursor/row LDZ2 ;last-abs-row JSR2 EQU2 ;return JCN2
|
|
.cursor/row LDZ2 INC2 .cursor/row STZ2
|
|
;ensure-visible-cursor JSR2
|
|
;redraw-statusbar-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
@center-view
|
|
.term/rows LDZ2 INC2 #0002 DIV2 STH2k
|
|
.cursor/row LDZ2 LTH2 ,&standard JCN
|
|
POP2r
|
|
#0000 .buffer/line-offset STZ2
|
|
;data .buffer/offset STZ2
|
|
,&done JMP
|
|
&standard
|
|
.cursor/row LDZ2 STH2r SUB2
|
|
DUP2 .buffer/line-offset STZ2
|
|
;abs-line JSR2 .buffer/offset STZ2
|
|
&done
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
@page-up ( -> )
|
|
.term/rows LDZ2 #0002 SUB2 STH2k
|
|
.buffer/line-offset LDZ2 LTH2 ,&move-full JCN
|
|
POP2r
|
|
;zero-row JSR2
|
|
#0000 .cursor/col STZ2
|
|
,&done JMP
|
|
&move-full
|
|
.cursor/row LDZ2 STH2kr SUB2 .cursor/row STZ2
|
|
.buffer/line-offset LDZ2 STH2r SUB2
|
|
DUP2 .buffer/line-offset STZ2
|
|
;abs-line JSR2 .buffer/offset STZ2
|
|
&done
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
|
|
@page-down
|
|
;eof-is-visible JSR2 ,&near-eof JCN
|
|
.term/rows LDZ2 #0002 SUB2 STH2k
|
|
.buffer/line-offset LDZ2 ADD2
|
|
DUP2 .buffer/line-offset STZ2
|
|
;abs-line JSR2 .buffer/offset STZ2
|
|
.cursor/row LDZ2 STH2r ADD2 .cursor/row STZ2
|
|
;redraw-all JSR2 ;return JMP2
|
|
&near-eof
|
|
.buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
|
|
;cur-len JSR2 .cursor/col STZ2
|
|
;redraw-cursor JSR2 ;return JMP2
|
|
|
|
@quit
|
|
#01 .state/quitting STZ
|
|
.state/modified LDZ ,&is-modified JCN
|
|
quit!
|
|
&is-modified
|
|
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
|
|
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
|
|
|
@send-message ( s1* s2* -> )
|
|
#01 .state/message STZ
|
|
;move-to-message-line JSR2
|
|
SWP2 ;print JSR2 ;print JMP2
|
|
|
|
@do-quit
|
|
.tmp/data LDZ LIT 'n EQU ;quit-now JCN2
|
|
.tmp/data LDZ LIT 'y EQU ;save JCN2
|
|
#00 .state/quitting STZ
|
|
;messages/unknown-input ;tmp/data ;send-message JSR2
|
|
BRK
|
|
|
|
@quit-now quit!
|
|
|
|
@ignore
|
|
( ;draw-cursor JSR2 ) BRK
|
|
|
|
@insert ( c^ -> )
|
|
#01 .state/modified STZ
|
|
;cur-pos JSR2 ;shift-right JSR2
|
|
;cur-col JSR2 INC2 .cursor/col STZ2
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
@insert-prompt ( c^ -> )
|
|
.tmp/pos LDZ2 STH2k STA ( data[pos] <- c )
|
|
INC2r #00 STH2kr STA ( data[pos+1] <- 0 )
|
|
STH2r .tmp/pos STZ2 ( pos <- pos+1 )
|
|
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
|
|
|
@insert-tab ( -> )
|
|
#01 .state/modified STZ
|
|
.config/insert-tabs LDZ ,&use-tabs JCN
|
|
#0000 .config/tab-width LDZ2 SUB2
|
|
&loop
|
|
DUP2 #0000 EQU2 ,&done JCN
|
|
#20 ;cur-pos JSR2 ;shift-right JSR2
|
|
INC2 ,&loop JMP
|
|
&done
|
|
;cur-col JSR2 .config/tab-width LDZ2 ADD2 .cursor/col STZ2
|
|
;redraw-all JSR2 ;return JMP2
|
|
&use-tabs
|
|
#09 ;insert JMP2
|
|
|
|
( TODO: handle last line )
|
|
@newline ( c^ -> )
|
|
#01 .state/modified STZ
|
|
#0a ;cur-pos JSR2 ;shift-right JSR2
|
|
#0000 .cursor/col STZ2
|
|
.cursor/row LDZ2 INC2 .cursor/row STZ2
|
|
.buffer/line-count LDZ2k INC2 ROT STZ2
|
|
;ensure-visible-cursor JSR2
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
@eof-is-visible ( -> bool^ )
|
|
.buffer/line-offset LDZ2 .term/rows LDZ2 ADD2 INC2
|
|
.buffer/line-count LDZ2
|
|
GTH2 JMP2r
|
|
|
|
@backspace ( -> )
|
|
;cur-pos JSR2 ;data EQU2 ;return JCN2
|
|
;go-back JSR2 ;delete JMP2
|
|
|
|
@backspace-prompt ( -> )
|
|
.tmp/pos LDZ2 ;tmp/data EQU2 ,&skip JCN ( ;return JCN2 )
|
|
#00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 )
|
|
STH2k STA ( data[pos-1] <- 0 )
|
|
STH2r .tmp/pos STZ2 ( pos <- pos-1 )
|
|
&skip ;redraw-prompt-and-cursor JSR2 ;return JMP2
|
|
|
|
@delete ( -> )
|
|
#01 .state/modified STZ
|
|
;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2
|
|
;cur-pos JSR2 LDAk STH ( cur [c] )
|
|
;shift-left JSR2 ( [c] )
|
|
STHr #0a NEQ ,¬-newline JCN
|
|
.buffer/line-count LDZ2k #0001 SUB2 ROT STZ2
|
|
¬-newline ;redraw-all JSR2 ;return JMP2
|
|
|
|
@escape ( -> )
|
|
#01 .state/saw-esc STZ BRK
|
|
|
|
@goto-end ( -> )
|
|
.buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
|
|
.buffer/line-count LDZ2 .term/rows LDZ2 LTH2k ,&use-zero JCN
|
|
SUB2 #0002 ADD2 ,&continue JMP
|
|
&use-zero
|
|
POP2 POP2 #0000
|
|
&continue
|
|
DUP2 .buffer/line-offset STZ2
|
|
;abs-line JSR2 .buffer/offset STZ2
|
|
;cur-len JSR2 .cursor/col STZ2
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
@goto-start ( -> )
|
|
;zero-row JSR2
|
|
#0000 .cursor/col STZ2
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
@goto-line ( -> )
|
|
;messages/goto-line ;messages/null ;do-goto-line ;start-prompt JSR2
|
|
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
|
|
|
@parse-decimal-number ( addr* -> n* ok^ )
|
|
LDAk ,&non-empty JCN
|
|
#00 JMP2r
|
|
&non-empty
|
|
LIT2r 0000
|
|
&loop
|
|
LDAk ,&continue JCN
|
|
POP2 STH2r #01 JMP2r
|
|
&continue
|
|
LDAk LIT '0 LTH ,&fail JCN
|
|
LDAk LIT '9 GTH ,&fail JCN
|
|
LIT2r 000a MUL2r
|
|
LDAk LIT '0 SUB #00 SWP STH2 ADD2r
|
|
INC2 ,&loop JMP
|
|
&fail
|
|
POP2r #00 JMP2r
|
|
|
|
|
|
@do-goto-line
|
|
;tmp/data ;parse-decimal-number JSR2
|
|
,&ok JCN
|
|
;messages/unknown-input ;tmp/data ;send-message JSR2
|
|
;return JMP2
|
|
&ok
|
|
#0001 SUB2 ( convert 1-indexing to 0-indexing )
|
|
DUP2 .buffer/line-count LDZ2 LTH2 ,&within JCN
|
|
POP2 ;goto-end JMP2
|
|
&within
|
|
;jump-to-line JSR2
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
@move-to-coord ( col* row* -> )
|
|
DUP2 ;line-is-visible JSR2 ;jump-to-coord/short JCN2
|
|
;jump-to-coord JMP2
|
|
|
|
@jump-to-coord ( x* y* -> )
|
|
.term/rows LDZ2 INC2 #0002 DIV2 LTH2k ( x y rows/2 y<rows/2? ) ,&early JCN
|
|
OVR2 SWP2 SUB2 ( x y y-rows/2 )
|
|
.buffer/line-count LDZ2 ( x y y-rows/2 lines )
|
|
.term/rows LDZ2 SUB2 ( x y y-rows/2 lines-rows )
|
|
GTH2k ( x y y-rows/2 lines-rows y-rows/2>lines-rows? )
|
|
,&late JCN ( x y y-rows/2 lines-rows )
|
|
POP2 ,&finish JMP
|
|
&early ( x y rows/2 )
|
|
POP2 #0000 ,&finish JMP ( x y 0000 )
|
|
&late ( x y y-rows/2 lines-rows )
|
|
NIP2
|
|
&finish ( x y o )
|
|
;redraw-all JSR2
|
|
SUB2k STH2 DUP2 ( x y o o [y-o] )
|
|
.buffer/line-offset STZ2 ( x y o [y-o] )
|
|
;abs-line JSR2 .buffer/offset STZ2 ( x y [y-o] )
|
|
POP2r
|
|
&short
|
|
;redraw-statusbar-and-cursor JSR2
|
|
.cursor/row STZ2 ( x )
|
|
.cursor/col STZ2
|
|
JMP2r
|
|
|
|
@jump-to-line ( n* -> )
|
|
#0000 SWP2 ;jump-to-coord JMP2
|
|
|
|
@ensure-visible-cursor
|
|
.cursor/row LDZ2 .buffer/line-offset LDZ2
|
|
SUB2 .term/rows LDZ2 LTH2 ,&noop JCN
|
|
.cursor/row LDZ2 ;jump-to-line JSR2
|
|
;redraw-all JSR2
|
|
&noop JMP2r
|
|
|
|
@debug
|
|
;messages/rel-line-error ;error! JMP2
|
|
|
|
@move-to-message-line ( -> )
|
|
#0000 .term/rows LDZ2 #0002 ADD2 ;term-move-cursor JMP2
|
|
|
|
( when called vector should end in BRK )
|
|
@start-prompt ( prompt* default* vector* -> )
|
|
.prompt/active LDZ ,&is-active JCN
|
|
#01 .prompt/active STZ ( prompt/active <- 1 )
|
|
.prompt/vector STZ2 ( prompt/vector <- vector )
|
|
DUP2 ;tmp/data ;str-copy JSR2 ( tmp/data <- default )
|
|
;str-len JSR2 ;tmp/data ADD2 ( len(default)+data )
|
|
.tmp/pos STZ2 ( tmp/pos <- len(default)+data )
|
|
.prompt/string STZ2 ( prompt/string <- prompt )
|
|
JMP2r
|
|
&is-active
|
|
#0000 DIV
|
|
|
|
( ends prompt without calling vector )
|
|
@cancel-prompt ( -> )
|
|
#00 .prompt/active STZ
|
|
#00 .state/quitting STZ
|
|
;clear-message-line JSR2
|
|
;redraw-prompt-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
( when called vector should end in BRK )
|
|
@finish-prompt ( -> )
|
|
#00 .prompt/active STZ
|
|
;clear-message-line JSR2
|
|
;redraw-prompt-and-cursor JSR2
|
|
.prompt/vector LDZ2 JMP2
|
|
|
|
@save
|
|
;messages/save-prompt ;filename ;do-save ;start-prompt JSR2
|
|
;redraw-prompt-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
@do-save ( -> )
|
|
.buffer/limit LDZ2 ;data SUB2 STH2 ( [size] )
|
|
;tmp/data .File/name DEO2
|
|
STH2kr .File/length DEO2
|
|
;data .File/write DEO2
|
|
|
|
.File/success DEI2 STH2r EQU2 ( ok? ) ,&ok JCN
|
|
;messages/save-failed ,&finish JMP
|
|
&ok
|
|
#00 .state/modified STZ
|
|
;tmp/data ;filename ;str-copy JSR2
|
|
;messages/save-ok
|
|
&finish
|
|
;tmp/data ;send-message JSR2
|
|
.state/quitting LDZ ;quit-now JCN2
|
|
;return JMP2
|
|
|
|
@search ( -> )
|
|
;messages/search-prompt ;messages/null ;do-search ;start-prompt JSR2
|
|
;redraw-prompt-and-cursor JSR2
|
|
;return JMP2
|
|
|
|
@do-search ( -> )
|
|
.cursor/row LDZ2 .searching/orig-row STZ2
|
|
.cursor/col LDZ2 .searching/orig-col STZ2
|
|
#0000 .searching/regex STZ2
|
|
;move-to-next-match JSR2 ,&found JCN
|
|
;move-to-prev-match JSR2 ,&found JCN
|
|
;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
|
|
&found
|
|
#01 .searching/active STZ
|
|
;redraw-matches JSR2
|
|
;return JMP2
|
|
|
|
@regex-search ( -> )
|
|
;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2
|
|
;redraw-prompt-and-cursor JSR2 ;return JMP2
|
|
|
|
@do-regex-search ( -> )
|
|
;cur-pos JSR2 DUP2 .searching/start STZ2 .searching/end STZ2
|
|
.cursor/row LDZ2 .searching/orig-row STZ2
|
|
.cursor/col LDZ2 .searching/orig-col STZ2
|
|
;tmp/data ;compile JSR2 .searching/regex STZ2
|
|
;move-to-next-regex-match JSR2 ,&found JCN
|
|
;move-to-prev-regex-match JSR2 ,&found JCN
|
|
;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
|
|
&found
|
|
#01 .searching/active STZ
|
|
;redraw-matches JSR2
|
|
;return JMP2
|
|
|
|
@toggle-color ( -> )
|
|
.config/color LDZ2 #3733 EQU2 ,&wrap-around JCN
|
|
.config/color LDZ2 #0100 ADD2 .config/color STZ2 ,&done JMP
|
|
&wrap-around #3033 .config/color STZ2
|
|
&done ;redraw-all JSR2 ;return JMP2
|
|
|
|
@toggle-tabs ( -> )
|
|
.config/insert-tabs LDZk #01 EOR SWP STZ
|
|
;redraw-statusbar-and-cursor JSR2 ;return JMP2
|
|
|
|
( TODO: M-f and M-b for next/previous word )
|
|
( M-n and M-p for next/previous paragraph )
|
|
( maybe M-% for search&replace )
|
|
@on-key-escaped ( -> )
|
|
#00 .state/saw-esc STZ
|
|
.state/key LDZ LIT '< EQU ( M-< ) ;goto-start JCN2
|
|
.state/key LDZ LIT '> EQU ( M-> ) ;goto-end JCN2
|
|
.state/key LDZ LIT 'c EQU ( M-c ) ;toggle-color JCN2
|
|
.state/key LDZ LIT 'g EQU ( M-g ) ;goto-line JCN2
|
|
.state/key LDZ LIT 's EQU ( M-s ) ;regex-search JCN2
|
|
.state/key LDZ LIT 't EQU ( M-t ) ;toggle-tabs JCN2
|
|
.state/key LDZ LIT 'v EQU ( M-v ) ;page-up JCN2
|
|
.state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2
|
|
BRK
|
|
|
|
@xterm
|
|
#01 .state/saw-xterm STZ BRK
|
|
|
|
@on-key-vt ( -> )
|
|
.state/saw-vt LDZk STH #00 SWP STZ
|
|
.state/key LDZ LIT '~ EQU ,&ok JCN
|
|
POPr BRK
|
|
&ok
|
|
STHr DUP LIT '1 NEQ ,¬-1 JCN
|
|
( ^[[1~ -> home ) POP ;bol JMP2
|
|
¬-1 DUP LIT '2 NEQ ,¬-2 JCN
|
|
( ^[[2~ -> insert ) POP BRK
|
|
¬-2 DUP LIT '3 NEQ ,¬-3 JCN
|
|
( ^[[3~ -> delete ) POP ;delete JMP2
|
|
¬-3 DUP LIT '4 NEQ ,¬-4 JCN
|
|
( ^[[4~ -> end ) POP ;eol JMP2
|
|
¬-4 DUP LIT '5 NEQ ,¬-5 JCN
|
|
( ^[[5~ -> page up ) POP ;page-up JMP2
|
|
¬-5 DUP LIT '6 NEQ ,¬-6 JCN
|
|
( ^[[6~ -> page down ) POP ;page-down JMP2
|
|
¬-6 DUP LIT '7 NEQ ,¬-7 JCN
|
|
( ^[[7~ -> home ) POP ;bol JMP2
|
|
¬-7 DUP LIT '8 NEQ ,¬-8 JCN
|
|
( ^[[8~ -> end ) POP ;eol JMP2
|
|
¬-8
|
|
( ??? ) POP BRK
|
|
|
|
@on-key-xterm ( -> )
|
|
#00 .state/saw-xterm STZ
|
|
.state/key LDZ LIT 'A EQU ( ^[[A -> up ) ;up JCN2
|
|
.state/key LDZ LIT 'B EQU ( ^[[B -> down ) ;down JCN2
|
|
.state/key LDZ LIT 'C EQU ( ^[[C -> right ) ;forward JCN2
|
|
.state/key LDZ LIT 'D EQU ( ^[[D -> left ) ;back JCN2
|
|
.state/key LDZ LIT 'F EQU ( ^[[F -> end ) ;eol JCN2
|
|
.state/key LDZ LIT 'H EQU ( ^[[H -> home ) ;bol JCN2
|
|
.state/key LDZ LIT '0 LTH ;ignore JCN2
|
|
.state/key LDZ LIT '8 GTH ;ignore JCN2
|
|
.state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 )
|
|
BRK
|
|
|
|
@clear-line ( -> )
|
|
ansi emit-2 emit-K JMP2r
|
|
|
|
@clear-message-line
|
|
.state/message LDZ #00 EQU ,&done JCN
|
|
;move-to-message-line JSR2
|
|
;clear-line JSR2
|
|
#00 .state/message STZ
|
|
&done JMP2r
|
|
|
|
@cancel-search
|
|
#00 .searching/active STZ
|
|
.searching/orig-row LDZ2 ;jump-to-line JSR2
|
|
.searching/orig-col LDZ2 .cursor/col STZ2
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
@finish-search
|
|
#00 .searching/active STZ
|
|
;redraw-all JSR2 ;return JMP2
|
|
|
|
( TODO: i haven't decided how to solve the problem of )
|
|
( overlapping matches yet. i don't really want to maintain )
|
|
( a global list of all matches, which means that currently )
|
|
( it can change in response to e.g. cursor position when )
|
|
( matches overlap. )
|
|
|
|
@jump-to-next-match ( -> )
|
|
.searching/regex LDZ2 ORA ,&is-regex JCN
|
|
;move-to-next-match JSR2 POP ;return JMP2
|
|
&is-regex
|
|
;move-to-next-regex-match JSR2 POP ;return JMP2
|
|
|
|
@jump-to-prev-match ( -> )
|
|
.searching/regex LDZ2 ORA ,&is-regex JCN
|
|
;move-to-prev-match JSR2 POP ;return JMP2
|
|
&is-regex
|
|
;move-to-prev-regex-match JSR2 POP ;return JMP2
|
|
|
|
@move-to-next-match ( -> ok^ )
|
|
.buffer/limit LDZ2
|
|
;cur-pos JSR2 INC2
|
|
&loop
|
|
GTH2k #00 EQU ,&fail JCN
|
|
DUP2 ;matches-at JSR2
|
|
ORA ,&found JCN
|
|
INC2 ,&loop JMP
|
|
&found
|
|
NIP2 ;jump-to-pos JSR2 #01 JMP2r
|
|
&fail
|
|
POP2 POP2 #00 JMP2r
|
|
|
|
@move-to-prev-match ( -> ok^ )
|
|
;data
|
|
;cur-pos JSR2 #0001 SUB2
|
|
&loop
|
|
GTH2k ,&fail JCN
|
|
DUP2 ;matches-at JSR2
|
|
ORA ,&found JCN
|
|
#0001 SUB2 ,&loop JMP
|
|
&found
|
|
NIP2 ;jump-to-pos JSR2 #01 JMP2r
|
|
&fail
|
|
POP2 POP2 #00 JMP2r
|
|
|
|
@move-to-next-regex-match ( -> ok^ )
|
|
.searching/end LDZ2 .buffer/limit LDZ2 OVR2
|
|
GTH2 ,&ok JCN
|
|
POP2 #00 JMP2r
|
|
&ok
|
|
.searching/regex LDZ2 ;rx-search JSR2 ,&found JCN
|
|
#00 JMP2r
|
|
&found
|
|
;search-end LDA2 .searching/end STZ2
|
|
;search-start LDA2 DUP2 .searching/start STZ2
|
|
;jump-to-pos JSR2 #01 JMP2r
|
|
|
|
( compared to move-to-next-regex-match this is kind of inefficient. )
|
|
( that's because we have no easy way to search backwards from a point. )
|
|
( )
|
|
( we could do some kind of fancy thing where we search the previous )
|
|
( N bytes, then the 2N bytes before that, etc. )
|
|
( )
|
|
( however, 64K is small enough that just searching from the beginning )
|
|
( and then taking the last match before the cursor works. )
|
|
@move-to-prev-regex-match ( -> ok^ )
|
|
LITr 00
|
|
;cur-pos JSR2 ;data ( limit pos [res] )
|
|
&loop ( limit pos [res] )
|
|
GTH2k #00 EQU ,&done JCN ( limit pos )
|
|
DUP2 .searching/regex LDZ2 ;rx-search JSR2 ( limit pos match? )
|
|
#00 EQU ,&done JCN ( limit pos )
|
|
OVR2 ;search-end LDA2 LTH2 ,&done JCN
|
|
POP2 POPr LITr 01
|
|
;search-start LDA2 .searching/start STZ2
|
|
;search-end LDA2 DUP2 .searching/end STZ2
|
|
,&loop JMP
|
|
&done
|
|
POP2 POP2 STHr DUP #00 EQU ,&fail JCN
|
|
.searching/start LDZ2 ;jump-to-pos JSR2
|
|
&fail
|
|
JMP2r
|
|
|
|
@on-key-searching
|
|
.state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2
|
|
.state/key LDZ #0d EQU ( \r ) ;finish-search JCN2
|
|
.state/key LDZ #12 EQU ( C-r ) ;jump-to-prev-match JCN2
|
|
.state/key LDZ #13 EQU ( C-s ) ;jump-to-next-match JCN2
|
|
.state/key LDZ #6e EQU ( n ) ;jump-to-next-match JCN2
|
|
.state/key LDZ #70 EQU ( p ) ;jump-to-prev-match JCN2
|
|
;ignore JMP2
|
|
|
|
@on-key-prompt
|
|
.state/key LDZ #07 EQU ( C-g ) ;cancel-prompt JCN2
|
|
.state/key LDZ #0d EQU ( \r ) ;finish-prompt JCN2
|
|
.state/key LDZ #7f EQU ( DEL ) ;backspace-prompt JCN2
|
|
.state/key LDZ #20 LTH ;ignore JCN2 ( ignore for now )
|
|
.state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now )
|
|
.state/key LDZ ( printable ASCII ) ;insert-prompt JMP2
|
|
BRK
|
|
|
|
( TODO: C-h for help )
|
|
@on-key
|
|
.Console/read DEI .state/key STZ
|
|
;clear-message-line JSR2
|
|
.searching/active LDZ ;on-key-searching JCN2
|
|
.prompt/active LDZ ;on-key-prompt JCN2
|
|
.state/saw-vt LDZ ;on-key-vt JCN2
|
|
.state/saw-xterm LDZ ;on-key-xterm JCN2
|
|
.state/saw-esc LDZ ;on-key-escaped JCN2
|
|
.state/key LDZ #01 EQU ( C-a ) ;bol JCN2
|
|
.state/key LDZ #02 EQU ( C-b ) ;back JCN2
|
|
.state/key LDZ #04 EQU ( C-d ) ;delete JCN2
|
|
.state/key LDZ #05 EQU ( C-e ) ;eol JCN2
|
|
.state/key LDZ #06 EQU ( C-f ) ;forward JCN2
|
|
.state/key LDZ #09 EQU ( \t ) ;insert-tab JCN2
|
|
.state/key LDZ #0c EQU ( C-l ) ;center-view JCN2
|
|
.state/key LDZ #0d EQU ( \r ) ;newline JCN2
|
|
.state/key LDZ #0e EQU ( C-n ) ;down JCN2
|
|
.state/key LDZ #0f EQU ( C-o ) ;save JCN2
|
|
.state/key LDZ #10 EQU ( C-p ) ;up JCN2
|
|
.state/key LDZ #13 EQU ( C-s ) ;search JCN2
|
|
.state/key LDZ #16 EQU ( C-v ) ;page-down JCN2
|
|
.state/key LDZ #18 EQU ( C-x ) ;quit JCN2
|
|
.state/key LDZ #1a EQU ( C-z ) ;debug JCN2
|
|
.state/key LDZ #1b EQU ( ESC ) ;escape JCN2
|
|
.state/key LDZ #7f EQU ( DEL ) ;backspace JCN2
|
|
.state/key LDZ #20 LTH ;ignore JCN2 ( ignore for now )
|
|
.state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now )
|
|
.state/key LDZ ( printable ASCII ) ;insert JMP2
|
|
|
|
@min2 ( x* y* -> min* )
|
|
LTH2k JMP SWP2 POP2 JMP2r
|
|
|
|
@term-move-cursor ( col* row* -> )
|
|
ansi INC2 ( row+1 ) ;emit-dec2 JSR2
|
|
emit-; INC2 ( col+1 ) ;emit-dec2 JSR2
|
|
emit-H JMP2r
|
|
|
|
@term-move-right ( n* -> )
|
|
ansi ;emit-dec2 JSR2 emit-C JMP2r
|
|
|
|
@term-get-cursor-position ( -> )
|
|
ansi emit-6 emit-n JMP2r
|
|
|
|
@term-erase-all ( -> )
|
|
ansi emit-2 emit-J JMP2r
|
|
|
|
@redraw-add ( n^ -> )
|
|
.state/redraw LDZk ROT ORA SWP STZ JMP2r
|
|
|
|
@redraw-cursor ( -> ) #01 ;redraw-add JMP2
|
|
@redraw-statusbar ( -> ) #02 ;redraw-add JMP2
|
|
@redraw-statusbar-and-cursor ( -> ) #03 ;redraw-add JMP2
|
|
@redraw-prompt-and-cursor ( -> ) #05 ;redraw-add JMP2
|
|
@redraw-matches ( -> ) #08 ;redraw-add JMP2
|
|
@redraw-all ( -> ) #1f ;redraw-add JMP2
|
|
|
|
@draw-cursor ( -> )
|
|
.prompt/active LDZ ,&on-prompt JCN
|
|
( TODO: handle long lines )
|
|
;cur-w-col JSR2 lmargin ADD2
|
|
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
|
|
;term-move-cursor JMP2
|
|
&on-prompt
|
|
JMP2r
|
|
|
|
( current column in terms of display width )
|
|
( this is different due to tabs )
|
|
@cur-w-col ( -> col* )
|
|
LIT2r 0000 ( [0] )
|
|
;cur-line JSR2 DUP2 ;cur-col JSR2 ADD2 SWP2 ( lim s [0] )
|
|
&loop GTH2k ,&next JCN
|
|
POP2 POP2 STH2r JMP2r
|
|
&next LDAk #09 EQU ,&tabs JCN INC2 INC2r ,&loop JMP
|
|
&tabs INC2 .config/tab-width LDZ2 STH2 ADD2r ,&loop JMP
|
|
|
|
@get-save-status
|
|
.state/modified LDZ ,&is-modified JCN
|
|
;messages/saved JMP2r
|
|
&is-modified ;messages/unsaved JMP2r
|
|
|
|
@get-tab-status
|
|
.config/insert-tabs LDZ ,&tabs JCN
|
|
;messages/st-spaces JMP2r
|
|
&tabs ;messages/st-tabs JMP2r
|
|
|
|
@draw-statusbar ( -> )
|
|
#0000 .term/rows LDZ2 ;term-move-cursor JSR2
|
|
;emit-color-reverse JSR2
|
|
LIT2r 2018
|
|
.term/cols LDZ2 #0000
|
|
&loop GTH2k ,&continue JCN ,&done JMP
|
|
&continue DEOkr INC2 ,&loop JMP
|
|
&done POP2 POP2 POP2r
|
|
|
|
#0000 .term/rows LDZ2 ;term-move-cursor JSR2
|
|
;get-save-status JSR2 ;print JSR2
|
|
;filename ;print JSR2
|
|
sp
|
|
emit-[
|
|
.buffer/limit LDZ2 ;data SUB2 ;emit-dec2 JSR2
|
|
;messages/bytes ;print JSR2
|
|
sp
|
|
.buffer/line-count LDZ2 ;emit-dec2 JSR2
|
|
;messages/lines ;print JSR2
|
|
sp
|
|
emit-(
|
|
;cur-col JSR2 INC2 ;emit-dec2 JSR2
|
|
emit-,
|
|
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2
|
|
emit-)
|
|
sp
|
|
;get-tab-status JSR2 ;print JSR2
|
|
;emit-reset JSR2
|
|
JMP2r
|
|
|
|
@draw-prompt ( -> )
|
|
;clear-message-line JSR2
|
|
.prompt/active LDZ ,&is-active JCN
|
|
JMP2r
|
|
&is-active
|
|
#01 .state/message STZ
|
|
;move-to-message-line JSR2
|
|
;emit-color-bold JSR2
|
|
.prompt/string LDZ2 ;print JSR2
|
|
;emit-reset JSR2
|
|
;tmp/data ;print JSR2
|
|
JMP2r
|
|
|
|
@draw-linenum ( n* -> )
|
|
;emit-reset JSR2
|
|
ansi .config/color LDZ2 emit emit emit-m
|
|
;emit-dec2-pad JSR2
|
|
ansi emit-0 emit-m JMP2r
|
|
|
|
@matches-at ( s* -> limit* )
|
|
LIT2r :tmp/data
|
|
&loop
|
|
LDAkr STHr ,&non-zero JCN ,&done JMP
|
|
&non-zero
|
|
LDAk LDAkr STHr NEQ ,&fail JCN
|
|
INC2 INC2r ,&loop JMP
|
|
&done
|
|
POP2r JMP2r
|
|
&fail
|
|
POP2r POP2 #0000 JMP2r
|
|
|
|
@draw-region ( offset* limit* col* row* -> )
|
|
OVR2 ( offset limit col row col )
|
|
.term/cols LDZ2 SWP2 SUB2 STH2 ( offset limit col row [cols-col] )
|
|
;term-move-cursor JSR2 ( offset limit [cols-col] )
|
|
OVR2 STH2r ADD2 ( offset limit offset+cols-col )
|
|
;min2 JSR2 STH2 ( offset [cutoff] )
|
|
&loop ( i [cutoff] )
|
|
DUP2 STH2kr LTH2 ,&continue JCN ,&done JMP
|
|
&continue ( i [cutoff] )
|
|
LDAk #00 EQU ,&done JCN
|
|
LDAk #18 DEO INC2 ,&loop JMP
|
|
&done
|
|
POP2 POP2r JMP2r
|
|
|
|
@screen-limit ( -> sc-limit* )
|
|
.term/rows LDZ2 .buffer/line-offset LDZ2 ADD2 ( row0+rows )
|
|
DUP2 .buffer/line-count LDZ2 LTH2 ,¬-end JCN
|
|
POP2 .buffer/limit LDZ2 JMP2r
|
|
¬-end
|
|
;abs-line JMP2
|
|
|
|
@draw-regex-matches ( -> )
|
|
;emit-color-reverse JSR2 ( )
|
|
;screen-limit JSR2 .buffer/offset LDZ2 ( limit pos )
|
|
&loop ( limit pos )
|
|
GTH2k #00 EQU ( limit pos limit>pos=0? )
|
|
,&done JCN ( limit pos )
|
|
DUP2 .searching/regex LDZ2 ( limit pos pos rx )
|
|
;rx-search JSR2 #00 EQU ( limit pos found=0? )
|
|
,&done JCN ( limit pos )
|
|
POP2 ;search-start LDA2 ( limit start )
|
|
GTH2k #00 EQU ( limit start limit>start=0? )
|
|
,&done JCN ( limit start )
|
|
;search-end LDA2 OVR2 ( limit start end start )
|
|
;pos-to-row-col JSR2 ( limit start end row col )
|
|
lmargin ADD2 ( limit start end row col+lm )
|
|
SWP2 .buffer/line-offset LDZ2 SUB2 ( limit start end col+lm row-lo )
|
|
;draw-region JSR2 ( limit )
|
|
;search-end LDA2 ( limit end ) ,&loop JMP
|
|
&done ( limit pos )
|
|
POP2 POP2 JMP2r
|
|
|
|
@draw-matches ( -> )
|
|
( return if not searching )
|
|
.searching/active LDZ #00 EQU ,&return JCN ( )
|
|
.searching/regex LDZ2 ORA ;draw-regex-matches JCN2
|
|
;emit-color-reverse JSR2
|
|
lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
|
|
.buffer/offset LDZ2 DUP2
|
|
;screen-limit JSR2 SUB2 STH2 ( offset [-count] )
|
|
|
|
&loop ( offset [-count] )
|
|
STH2kr #0000 EQU2 ,&done JCN
|
|
DUP2 ;matches-at JSR2 ( offset mlim [-count] )
|
|
DUP2 ORA ,&found JCN
|
|
POP2 ( offset [-count] )
|
|
LDAk #0a EQU ,&newline JCN
|
|
#0001 ,&next JMP ( offset n [-count] )
|
|
&found ( offset mlim [-count] )
|
|
STH2k ( offset mlim [mlim -count] )
|
|
OVR2 SWP2 ,&x LDR2 ,&y LDR2 ( offset offset mlim x y [mlim -count] )
|
|
;draw-region JSR2 ( offset [mlim -count] )
|
|
STH2r ( offset mlim [-count] )
|
|
OVR2 SUB2 ( offset mlim-offset [-count] )
|
|
&next ( offset n [-count] )
|
|
DUP2 ,&x LDR2 ADD2 ,&x STR2 ( offset n [-count )
|
|
STH2k ( offset n [n -count] )
|
|
ADD2 ADD2r ( offset+n [n-count] )
|
|
,&loop JMP
|
|
&newline ( offset [-count] )
|
|
lmargin ,&x STR2
|
|
,&y LDR2 INC2 ,&y STR2
|
|
INC2 INC2r
|
|
,&loop JMP
|
|
&done
|
|
POP2 POP2r
|
|
;emit-reset JSR2
|
|
&return
|
|
JMP2r
|
|
[ &x $2 &y $2 ]
|
|
|
|
@emit-tab ( -> )
|
|
#0000 .config/tab-width LDZ2 SUB2
|
|
LIT2r 2018
|
|
&loop ORAk ,&next JCN POP2 POP2r JMP2r
|
|
&next DEOkr INC2 ,&loop JMP
|
|
|
|
@emit-red ( -> )
|
|
ansi emit-3 emit-1 emit-m JMP2r
|
|
|
|
@emit-reset ( -> )
|
|
ansi emit-0 emit-m JMP2r
|
|
|
|
@emit-red-dollar ( -> )
|
|
;emit-red JSR2 emit-$ ;emit-reset JMP2
|
|
|
|
@emit-color-reverse ( -> )
|
|
ansi .config/color LDZ2 emit emit emit-; emit-7 emit-m JMP2r
|
|
|
|
@emit-color-bold ( -> )
|
|
ansi .config/color LDZ2 emit emit emit-; emit-1 emit-m JMP2r
|
|
|
|
@draw-all ( -> )
|
|
;term-erase-all JSR2
|
|
#0000 #0000 ;term-move-cursor JSR2
|
|
.buffer/line-offset LDZ2 STH2 LIT2r 0001 ( [k line-offset] )
|
|
.buffer/offset LDZ2
|
|
&bol
|
|
ADD2kr STH2r ;draw-linenum JSR2
|
|
lmargin INC2 ,&x STR2
|
|
&loop ( offset [k line-offset] )
|
|
LDAk #00 EQU ,&eof JCN
|
|
LDAk #0a EQU ,&eol JCN
|
|
,&x LDR2 .term/cols LDZ2
|
|
LTH2k ,&ok JCN
|
|
GTH2 ,&skip JCN
|
|
;emit-red-dollar JSR2 ,&x LDR2 INC2 ,&x STR2
|
|
&skip INC2
|
|
,&loop JMP
|
|
&ok POP2 POP2
|
|
LDAk #09 EQU ,&do-tab JCN
|
|
LDAk emit INC2 ,&x LDR2 INC2 ,&x STR2
|
|
,&loop JMP
|
|
&eol INC2r
|
|
STH2kr .term/rows LDZ2 GTH2 ,&done JCN
|
|
cr nl INC2 ,&bol JMP
|
|
&do-tab ;emit-tab JSR2 INC2
|
|
.config/tab-width LDZ2 ,&x LDR2 ADD2 ,&x STR2
|
|
,&loop JMP
|
|
[ &x $2 ]
|
|
&eof
|
|
;emit-red JSR2
|
|
&eof-loop
|
|
STH2kr .term/rows LDZ2 GTH2 ,&done JCN
|
|
cr nl
|
|
lmargin ;term-move-right JSR2
|
|
emit-~ INC2r
|
|
,&eof-loop JMP
|
|
&done POP2 POP2r POP2r
|
|
;emit-reset JSR2
|
|
;draw-matches JSR2
|
|
;draw-statusbar JSR2
|
|
;draw-prompt JSR2
|
|
;draw-cursor JSR2
|
|
JMP2r
|
|
|
|
( handler completion code to do necessary drawing and BRK )
|
|
@return ( -> )
|
|
.state/redraw LDZ
|
|
DUP #10 AND ,&draw-all JCN
|
|
DUP #08 AND ,&do-8 JCN ,&skip-8 JMP &do-8 ;draw-matches JSR2
|
|
&skip-8 DUP #04 AND ,&do-4 JCN ,&skip-4 JMP &do-4 ;draw-prompt JSR2
|
|
&skip-4 DUP #02 AND ,&do-2 JCN ,&skip-2 JMP &do-2 ;draw-statusbar JSR2
|
|
&skip-2 DUP #01 AND ,&do-1 JCN ,&finish JMP &do-1 ;draw-cursor JSR2 ,&finish JMP
|
|
&draw-all .counter LDZ2k INC2 ROT STZ2 ;draw-all JSR2
|
|
&finish POP #00 .state/redraw STZ BRK
|
|
|
|
@str-copy ( src* dst* -> )
|
|
STH2 ( src [dst] )
|
|
&loop LDAk #00 EQU ,&done JCN
|
|
LDAk STH2kr STA
|
|
INC2 INC2r ,&loop JMP
|
|
&done POP2 #00 STH2r STA
|
|
JMP2r
|
|
|
|
@str-len ( s* -> n* )
|
|
LIT2r 0000
|
|
&loop LDAk #00 EQU ,&done JCN
|
|
INC2 INC2r ,&loop JMP
|
|
&done POP2 STH2r
|
|
JMP2r
|
|
|
|
@print ( s* -> )
|
|
&loop LDAk #00 EQU ,&eof JCN
|
|
LDAk #18 DEO INC2 ,&loop JMP
|
|
&eof POP2 JMP2r
|
|
|
|
@cur-len ( -> n* )
|
|
;cur-line JSR2 ;line-len JMP2
|
|
|
|
@line-len ( s* -> n* )
|
|
#0000 STH2
|
|
&loop LDAk #00 EQU ,&end JCN
|
|
LDAk #0a EQU ,&end JCN
|
|
INC2 INC2r ,&loop JMP
|
|
&end POP2 STH2r JMP2r
|
|
|
|
@line-is-visible ( n* -> bool^ )
|
|
.buffer/line-offset LDZ2 LTH2k ,&no JCN
|
|
.term/rows LDZ2 ADD2 LTH2 JMP2r
|
|
&no POP2 POP2 #00 JMP2r
|
|
|
|
@jump-to-pos ( s* -> )
|
|
;pos-to-row-col JSR2 SWP2 ;move-to-coord JMP2
|
|
|
|
@pos-to-row-col ( s* -> row* col* )
|
|
#0000 ,&row STR2
|
|
#0000 ,&col STR2
|
|
;data
|
|
&loop ( s pos )
|
|
GTH2k ,&next JCN ,&done JMP
|
|
&next
|
|
LDAk #0a EQU ,&newline JCN
|
|
,&col LDR2 INC2 ,&col STR2
|
|
INC2 ,&loop JMP
|
|
&newline
|
|
#0000 ,&col STR2
|
|
,&row LDR2 INC2 ,&row STR2
|
|
INC2 ,&loop JMP
|
|
&done
|
|
POP2 POP2
|
|
,&row LDR2 ,&col LDR2 JMP2r
|
|
[ &row $2 &col $2 ]
|
|
|
|
( counts y lines forward from the given address )
|
|
@line-to-pos ( addr* y* -> s* )
|
|
#0000 SWP2 SUB2 STH2 ( addr [-y] )
|
|
&newline ( addr [-y] )
|
|
STH2kr ORA ,&loop JCN ,&done JMP
|
|
&loop ( addr [-y] )
|
|
LDAk #00 EQU ,¬-found JCN ( addr [-y] )
|
|
LDAk #0a EQU ,&found JCN ( addr [-y] )
|
|
INC2 ,&loop JMP ( addr+1 [-y] )
|
|
&found INC2 INC2r ,&newline JMP
|
|
&done POP2r JMP2r
|
|
¬-found POP2 POP2r #0000 JMP2r
|
|
|
|
( find string pointer for absolute y coordinate )
|
|
@abs-line ( y* -> s* )
|
|
;data SWP2 ;line-to-pos JMP2
|
|
|
|
( find string pointer for absolute y coordinate )
|
|
@rel-line ( y* -> s* )
|
|
.buffer/offset LDZ2 SWP2 ;line-to-pos JMP2
|
|
|
|
@cur-line ( -> s* )
|
|
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2k
|
|
.term/rows LDZ2 LTH2 ,&ok JCN
|
|
POP2 ;abs-line JMP2
|
|
&ok
|
|
SUB2 ;rel-line JMP2
|
|
|
|
@cur-pos ( -> s* )
|
|
;cur-line JSR2 ;cur-col JSR2 ADD2 JMP2r
|
|
|
|
@shift-right ( c^ addr* -> )
|
|
ROT STH ( addr [prev^] )
|
|
;last-pos JSR2 SWP2 ( last addr [prev^] )
|
|
&loop LTH2k ,&done JCN ( last addr [prev^] )
|
|
LDAk STH SWPr ( last addr [prev^ curr^] )
|
|
DUP2 STHr ( last addr addr prev^ [curr^] )
|
|
ROT ROT STA ( last addr [curr^] )
|
|
INC2 ,&loop JMP ( last addr+1 [curr^] )
|
|
&done NIP2 DUP2 ( addr addr [prev^] )
|
|
STHr ROT ROT ( addr prev^ addr )
|
|
STA INC2 ( addr+1 )
|
|
.buffer/limit STZ2 ( )
|
|
JMP2r
|
|
|
|
( TODO: change last/addr order and GTH -> LTH to remove hack )
|
|
@shift-left ( addr* -> )
|
|
;last-pos JSR2 SWP2 ( last addr )
|
|
&loop GTH2k ,&next JCN ( last addr )
|
|
,&done JMP ( last addr )
|
|
&next DUP2 INC2 LDAk ( last addr addr+1 c1^ )
|
|
STH SWP2 STHr ( last addr+1 addr c1^ )
|
|
ROT ROT ( last addr+1 c1^ addr )
|
|
STA ,&loop JMP ( last addr+1 )
|
|
&done POP2 ( last )
|
|
.buffer/limit STZ2 ( )
|
|
#00 .buffer/limit LDZ2 STA ( ensure null termination )
|
|
JMP2r
|
|
|
|
( current column in terms of bytes in buffer )
|
|
@cur-col ( -> col* )
|
|
.cursor/col LDZ2 ;cur-len JSR2 ;min2 JMP2
|
|
|
|
@zero-row ( -> )
|
|
;data .buffer/offset STZ2
|
|
#0000 .buffer/line-offset STZ2
|
|
#0000 .cursor/row STZ2
|
|
JMP2r
|
|
|
|
@last-pos ( -> addr* )
|
|
.buffer/limit LDZ2 #0001 SUB2 JMP2r
|
|
|
|
@mod-div2 ( x^ y^ -> x%d x/y )
|
|
DIV2k STH2k MUL2 SUB2 STH2r JMP2r
|
|
|
|
@emit-digit ( n^ -> )
|
|
LIT '0 ADD emit JMP2r
|
|
|
|
@emit-dec2 ( n* -> )
|
|
DUP2 #270f GTH2 ,&do5 JCN
|
|
DUP2 #03e7 GTH2 ,&do4 JCN
|
|
DUP2 #0063 GTH2 ,&do3 JCN
|
|
DUP2 #0009 GTH2 ,&do2 JCN
|
|
,&do1 JMP
|
|
&do5 #2710 ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do4 #03e8 ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do3 #0064 ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do1 NIP ;emit-digit JMP2
|
|
|
|
@emit-dec2-pad ( n* -> )
|
|
LIT2r 2018 ( preload #20 .Console/write into rst )
|
|
DUP2 #270f GTH2 ,&do5 JCN DEOkr
|
|
DUP2 #03e7 GTH2 ,&do4 JCN DEOkr
|
|
DUP2 #0063 GTH2 ,&do3 JCN DEOkr
|
|
DUP2 #0009 GTH2 ,&do2 JCN DEOkr
|
|
,&do1 JMP
|
|
&do5 #2710 ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do4 #03e8 ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do3 #0064 ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
|
&do1 NIP ;emit-digit JSR2
|
|
DEOr JMP2r
|
|
|
|
( various string constants used as messages for the user )
|
|
@messages [ &null 00
|
|
&input-error "input 20 "error: 20 00
|
|
&bytes 20 "bytes, 00
|
|
&save-ok "Successfully 20 "saved 20 00
|
|
&save-failed "Failed 20 "to 20 "save 20 00
|
|
&lines 20 "lines] 00
|
|
&goto-line "Go 20 "to 20 "line: 20 00
|
|
&save-prompt "File 20 "Name 20 "to 20 "Write: 20 00
|
|
&search-prompt "Text 20 "to 20 "Search 20 "for: 20 00
|
|
®ex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 00
|
|
&quit-prompt "Save 20 "modified 20 "file 20 "(y/n)? 20 00
|
|
&unknown-input "Unknown 20 "input: 20 00
|
|
&no-matches-found "No 20 "matches 20 "found: 20 00
|
|
&saved "-- 20 00
|
|
&unsaved "** 20 00
|
|
&term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
|
|
&rel-line-error "invalid 20 "relative 20 "line 20 "number 00
|
|
&st-tabs "[t] 00
|
|
&st-spaces "[s] 00
|
|
]
|
|
|
|
@filename $80 ( path to file being edited )
|
|
|
|
@data $f000 ( actual file data to be edited )
|