697 lines
20 KiB
Tal
697 lines
20 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 )
|
|
( - line numbers in left column (toggle mode?) )
|
|
( - help text )
|
|
( - save file command -> tmp first )
|
|
( - open file command? )
|
|
( - close file command? )
|
|
( - move by word/paragraph )
|
|
( - search )
|
|
( - search&replace )
|
|
( - tab support? )
|
|
( - windows line-ending support (CRLF) )
|
|
|
|
( FIXME: )
|
|
( - stop using bytes for row/col/etc. )
|
|
( - consider storing absolute cursor instead )
|
|
|
|
|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 }
|
|
|
|
%quit! { #01 .System/halt DEO }
|
|
|
|
%height { ;term/rows LDA2 NIP }
|
|
%last-line { ;term/rows LDA2 #0001 SUB2 NIP }
|
|
%pen-line { ;term/rows LDA2 #0002 SUB2 NIP }
|
|
%pen-col { ;term/cols LDA2 #0002 SUB2 NIP }
|
|
|
|
|0100
|
|
;read-filename .Console/vector DEO2
|
|
|
|
( use this if hardcoding to 80x24 )
|
|
( ;setup-80x24 JSR2 )
|
|
|
|
( use this to detect terminal size )
|
|
( ;setup-terminal-size JSR2 )
|
|
BRK
|
|
|
|
( ERROR HANDLING )
|
|
|
|
( using error! will print the given message before causing )
|
|
( the interpreter to halt. )
|
|
@error! ( msg* -> )
|
|
LIT '! emit sp
|
|
&loop LDAk ,&continue JCN ,&done JMP
|
|
&continue LDAk emit INC2 ,&loop JMP
|
|
&done POP2 nl
|
|
dbg BRK
|
|
|
|
( error messages )
|
|
@term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
|
|
@rel-line-error "invalid 20 "relative 20 "line 20 "number 00
|
|
|
|
@open-file ( filename* -> )
|
|
.File/name DEO2
|
|
#8000 .File/length DEO2
|
|
;buffer/data .File/read DEO2
|
|
|
|
.File/success DEI2 #0000 GTH2 ,&ok JCN
|
|
;messages/input-error ;print JSR2 nl quit!
|
|
|
|
( calculate buffer limit address using start + size )
|
|
&ok .File/success DEI2 ;buffer/data ADD2 ;buffer/limit STA2
|
|
JMP2r
|
|
|
|
@setup-terminal-size
|
|
( ;setup-80x24 JSR2 )
|
|
#fe #fe ;term-move-cursor JSR2
|
|
;term-get-cursor-position JSR2
|
|
;tmp/data ;tmp/pos STA2
|
|
;receive-terminal-size .Console/vector DEO2
|
|
JMP2r
|
|
|
|
@receive-terminal-size
|
|
.Console/read DEI ;tmp/pos LDA2 STA
|
|
;tmp/pos LDA2 INC2 ;tmp/pos STA2
|
|
.Console/read DEI LIT 'R EQU ;parse-terminal-size JCN2
|
|
BRK
|
|
|
|
@parse-terminal-size ( -> )
|
|
LIT2r 0000 LIT2r 0000
|
|
;tmp/data LDAk #1b NEQ ,&parse-error JCN ( i ) INC2
|
|
LDAk LIT '[ NEQ ,&parse-error JCN ( i ) INC2
|
|
&loop
|
|
LDAk LIT '; EQU ,&parse-col JCN
|
|
LIT2r 000a MUL2r
|
|
LDAk LIT '0 SUB #00 SWP STH2 ADD2r
|
|
INC2 ,&loop JMP
|
|
&parse-col
|
|
INC2 STH2r #0002 SUB2 ;term/rows STA2
|
|
&loop2
|
|
LDAk LIT 'R EQU ,&done JCN
|
|
LIT2r 000a MUL2r
|
|
LDAk LIT '0 SUB #00 SWP STH2 ADD2r
|
|
INC2 ,&loop2 JMP
|
|
&done
|
|
STH2r ;term/cols STA2 POP2
|
|
;on-key .Console/vector DEO2
|
|
;draw-all JSR2
|
|
BRK
|
|
&parse-error POP2 ;tmp/data LDA2
|
|
;term-size-parse-error ;error! JMP2
|
|
|
|
@setup-linecount ( -> )
|
|
;buffer/data LIT2r 0001
|
|
&loop DUP2 ;buffer/limit LDA2 EQU2 ,&done JCN
|
|
LDAk #00 EQU ,&done JCN
|
|
LDAk #0a NEQ JMP INC2r
|
|
INC2 ,&loop JMP
|
|
&done POP2
|
|
STH2r ;buffer/line-count STA2
|
|
JMP2r
|
|
|
|
@setup-80x24 ( -> )
|
|
#0050 ;term/cols STA2
|
|
#0014 ;term/rows STA2
|
|
;on-key .Console/vector DEO2
|
|
;draw-all JSR2
|
|
JMP2r
|
|
|
|
@read-filename ( -> )
|
|
#12 DEI #0a EQU ,&execute JCN ( did we read \n ? )
|
|
#12 DEI ;tmp/pos LDA2 STA ( no, so save in buffer )
|
|
;tmp/pos LDA2 INC2 ;tmp/pos STA2 ( pos++ )
|
|
BRK ( return )
|
|
|
|
&execute ( we saw a newline, so do something )
|
|
#00 ;tmp/pos LDA2 STA ( null terminate str )
|
|
;tmp/data ;tmp/pos STA2 ( reset pos )
|
|
;tmp/data ;filename ;str-copy JSR2 ( open file )
|
|
;filename ;open-file JSR2 ( open file )
|
|
;setup-linecount JSR2 ( determine # of lines )
|
|
;setup-terminal-size JSR2 ( detect terminal dimensions )
|
|
BRK
|
|
|
|
@bol
|
|
#00 ;cursor/col STA
|
|
;draw-statusbar JSR2
|
|
;draw-cursor JSR2 BRK
|
|
|
|
( FIXME: handle long lines )
|
|
@eol
|
|
;cur-line JSR2 ;line-len JSR2 NIP ;cursor/col STA
|
|
;draw-statusbar JSR2
|
|
;draw-cursor JSR2 BRK
|
|
|
|
( FIXME: handle long lines )
|
|
@forward
|
|
;cur-pos JSR2 ;last-pos JSR2 GTH2 ,&skip JCN
|
|
;cur-col JSR2 ;cur-last JSR2 GTH ,&next-line JCN
|
|
;cur-col JSR2 INC ;cursor/col STA
|
|
;draw-statusbar JSR2 ;draw-cursor JSR2
|
|
,&skip JMP
|
|
&next-line #00 ;cursor/col STA ( TODO: need to ensure cursor is visible )
|
|
;cursor/row LDA INC ;cursor/row STA
|
|
;ensure-visible-cursor JSR2
|
|
;draw-cursor JSR2
|
|
&skip BRK
|
|
|
|
( FIXME: handle long lines )
|
|
@back
|
|
;cur-col JSR2 #01 LTH ,&skip JCN
|
|
;cur-col JSR2 #01 SUB ;cursor/col STA
|
|
;draw-statusbar JSR2
|
|
;draw-cursor JSR2
|
|
&skip BRK
|
|
|
|
@up
|
|
;cur-line-num JSR2 #0000 EQU2 ,&done JCN
|
|
;cursor/row LDA #01 LTH ,&screen-up JCN
|
|
;cursor/row LDA #01 SUB ;cursor/row STA
|
|
;draw-statusbar JSR2
|
|
;draw-cursor JSR2 BRK
|
|
&screen-up
|
|
;cur-line-num JSR2 #0001 SUB2
|
|
;jump-to-line JSR2
|
|
;draw-all JSR2
|
|
&done BRK
|
|
|
|
@down
|
|
;cur-abs-row JSR2 ;last-abs-row JSR2 EQU2 ,&done JCN
|
|
;cursor/row LDA INC ;cursor/row STA
|
|
;ensure-visible-cursor JSR2
|
|
;draw-statusbar JSR2
|
|
;draw-cursor JSR2 BRK
|
|
&done BRK
|
|
|
|
@page-up
|
|
;bof-is-visible JSR2 ,&near-eof JCN
|
|
;buffer/line-offset LDA2
|
|
;term/rows LDA2 SUB2 #0003 ADD2
|
|
DUP2 ;abs-line JSR2 ;buffer/offset STA2
|
|
;buffer/line-offset STA2
|
|
;ensure-visible-cursor JSR2
|
|
;draw-all JSR2 BRK
|
|
&near-eof
|
|
#00 ;cursor/row STA
|
|
#00 ;cursor/col STA
|
|
;draw-cursor JSR2 BRK
|
|
|
|
@page-down
|
|
;eof-is-visible JSR2 ,&near-eof JCN
|
|
;buffer/line-offset LDA2
|
|
;term/rows LDA2 ADD2 #0003 SUB2
|
|
DUP2 ;abs-line JSR2 ;buffer/offset STA2
|
|
;buffer/line-offset STA2
|
|
;ensure-visible-cursor JSR2
|
|
;draw-all JSR2 BRK
|
|
&near-eof
|
|
;buffer/line-count LDA2
|
|
;buffer/line-offset LDA2 INC2
|
|
SUB2 NIP ;cursor/row STA
|
|
;cur-len JSR2 ;cursor/col STA
|
|
;draw-cursor JSR2 BRK
|
|
|
|
@quit quit!
|
|
|
|
@ignore BRK
|
|
|
|
@insert ( c^ -> )
|
|
;cur-pos JSR2 ;shift-right JSR2
|
|
;cur-col JSR2 INC ;cursor/col STA
|
|
;draw-all JSR2
|
|
BRK
|
|
|
|
( TODO: handle last line )
|
|
@newline ( c^ -> )
|
|
#0a ;cur-pos JSR2 ;shift-right JSR2
|
|
#00 ;cursor/col STA
|
|
;cursor/row LDA INC ;cursor/row STA
|
|
;buffer/line-count LDA2k INC2 SWP2 STA2
|
|
;ensure-visible-cursor JSR2
|
|
;draw-all JSR2
|
|
BRK
|
|
|
|
@at-buffer-start ( -> bool^ )
|
|
;cur-pos JSR2 ;buffer/data EQU2 JMP2r
|
|
|
|
@at-line-start ( -> bool^ )
|
|
;cursor/col LDA #00 EQU JMP2r
|
|
|
|
@bof-is-visible ( -> bool^ )
|
|
;buffer/line-offset LDA2 #0000 EQU2 JMP2r
|
|
|
|
@eof-is-visible ( -> bool^ )
|
|
;buffer/line-offset LDA2 ;term/rows LDA2 ADD2 INC2
|
|
;buffer/line-count LDA2
|
|
GTH2 JMP2r
|
|
|
|
@backspace ( -> )
|
|
;at-buffer-start JSR2 ,&skip JCN
|
|
;at-line-start JSR2 ,&prev-line JCN
|
|
;cur-col JSR2 #01 SUB ;cursor/col STA
|
|
,&finish JMP
|
|
&prev-line
|
|
;cur-line-num JSR2 #0001 SUB2
|
|
;jump-to-line JSR2 ( TODO: fix weird eof behavior )
|
|
;cur-len JSR2 NIP ;cursor/col STA
|
|
;buffer/line-count LDA2k #0001 SUB2 SWP2 STA2
|
|
&finish
|
|
;cur-pos JSR2 ;shift-left JSR2
|
|
;draw-all JSR2
|
|
&skip BRK
|
|
|
|
@delete ( -> )
|
|
;last-pos JSR2 #0001 SUB2 ( lst-1 )
|
|
;cur-pos JSR2 LTH2 ,&skip JCN
|
|
;cur-pos JSR2 LDAk STH ( cur [c] )
|
|
;shift-left JSR2 ( [c] )
|
|
STHr #0a NEQ ,¬-newline JCN
|
|
;buffer/line-count LDA2k #0001 SUB2 SWP2 STA2
|
|
¬-newline ;draw-all JSR2
|
|
&skip BRK
|
|
|
|
@escape ( -> )
|
|
#01 ;saw-esc STA BRK
|
|
|
|
@goto-end ( -> )
|
|
;more-than-one-screen JSR2 ,&large JCN
|
|
;buffer/line-count LDA2 NIP #01 SUB ;cursor/row STA
|
|
#0000 ,&continue JMP
|
|
&large
|
|
height #01 SUB ;cursor/row STA
|
|
;buffer/line-count LDA2 ;term/rows LDA2 SUB2
|
|
&continue
|
|
DUP2 ;buffer/line-offset STA2
|
|
;abs-line JSR2 ;buffer/offset STA2
|
|
;cur-len JSR2 NIP ;cursor/col STA
|
|
;draw-all JSR2 BRK
|
|
|
|
@goto-start ( -> )
|
|
;buffer/data ;buffer/offset STA2
|
|
#0000 ;buffer/line-offset STA2
|
|
#00 ;cursor/col STA
|
|
#00 ;cursor/row STA
|
|
;draw-all JSR2
|
|
BRK
|
|
|
|
@goto-line ( -> )
|
|
#0016 ;jump-to-line JSR2
|
|
;draw-all JSR2 BRK
|
|
|
|
@jump-to-line ( n* -> )
|
|
;term/rows LDA2 #0002 DIV2 LTH2k ( n rows/2 n<rows/2? ) ,&early JCN
|
|
OVR2 SWP2 SUB2 ( n n-rows/2 )
|
|
;buffer/line-count LDA2 ( n n-rows/2 lines )
|
|
;term/rows LDA2 SUB2 ( n n-rows/2 lines-rows )
|
|
GTH2k ( n n-rows/2 lines-rows n-rows/2>lines-rows? )
|
|
,&late JCN ( n n-rows/2 lines-rows )
|
|
POP2 ,&finish JMP
|
|
&early ( n rows/2 )
|
|
POP2 #0000 ,&finish JMP ( n 0000 )
|
|
&late ( n n-rows/2 lines-rows )
|
|
NIP2
|
|
&finish ( n o )
|
|
SUB2k STH2 DUP2 ( n o o [n-o] )
|
|
;buffer/line-offset STA2 ( n o [n-o] )
|
|
;abs-line JSR2 ;buffer/offset STA2 ( n [n-o] )
|
|
#00 ;cursor/col STA ( n [n-o] )
|
|
POP2 STH2r NIP ;cursor/row STA ( )
|
|
JMP2r
|
|
|
|
@ensure-visible-cursor
|
|
;cursor/row LDA height LTH ,&noop JCN
|
|
;cur-line-num JSR2 ;jump-to-line JSR2
|
|
;draw-all JSR2
|
|
&noop JMP2r
|
|
|
|
@refresh
|
|
;draw-all JSR2 BRK
|
|
|
|
@debug
|
|
;rel-line-error ;error! JMP2
|
|
( #00 #00 DIV BRK )
|
|
|
|
( 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 ;saw-esc STA
|
|
.Console/read DEI LIT '< EQU ( M-< ) ;goto-start JCN2
|
|
.Console/read DEI LIT '> EQU ( M-> ) ;goto-end JCN2
|
|
.Console/read DEI LIT 'g EQU ( M-g ) ;goto-line JCN2
|
|
.Console/read DEI LIT 'v EQU ( M-v ) ;page-up JCN2
|
|
BRK
|
|
|
|
@move-to-message-line ( -> )
|
|
#02 height #02 ADD ;term-move-cursor JSR2 JMP2r
|
|
|
|
( TODO: filename prmopt )
|
|
@save ( -> )
|
|
;buffer/limit LDA2 ;buffer/data SUB2 STH2 ( [size] )
|
|
;tmp-file-name .File/name DEO2
|
|
STH2kr .File/length DEO2
|
|
;buffer/data .File/write DEO2
|
|
|
|
;move-to-message-line JSR2
|
|
.File/success DEI2 STH2r EQU2 ( ok? ) ,&ok JCN
|
|
;messages/save-failed ,&finish JMP
|
|
&ok ;messages/save-ok
|
|
&finish ;print JSR2 BRK
|
|
|
|
@tmp-file-name "file.tmp 00
|
|
|
|
( TODO: C-g or C-h for help )
|
|
( TODO: C-s for search )
|
|
( TODO: tab input? )
|
|
@on-key
|
|
;saw-esc LDA ;on-key-escaped JCN2
|
|
.Console/read DEI #01 EQU ( C-a ) ;bol JCN2
|
|
.Console/read DEI #02 EQU ( C-b ) ;back JCN2
|
|
.Console/read DEI #04 EQU ( C-d ) ;delete JCN2
|
|
.Console/read DEI #05 EQU ( C-e ) ;eol JCN2
|
|
.Console/read DEI #06 EQU ( C-f ) ;forward JCN2
|
|
.Console/read DEI #0c EQU ( C-l ) ;refresh JCN2
|
|
.Console/read DEI #0d EQU ( \r ) ;newline JCN2
|
|
.Console/read DEI #0e EQU ( C-n ) ;down JCN2
|
|
.Console/read DEI #0f EQU ( C-o ) ;save JCN2
|
|
.Console/read DEI #10 EQU ( C-p ) ;up JCN2
|
|
.Console/read DEI #16 EQU ( C-v ) ;page-down JCN2
|
|
.Console/read DEI #18 EQU ( C-x ) ;quit JCN2
|
|
.Console/read DEI #1a EQU ( C-z ) ;debug JCN2
|
|
.Console/read DEI #1b EQU ( ESC ) ;escape JCN2
|
|
.Console/read DEI #7f EQU ( DEL ) ;backspace JCN2
|
|
.Console/read DEI #20 LTH ;ignore JCN2 ( ignore for now )
|
|
.Console/read DEI #7e GTH ;ignore JCN2 ( ignore for now )
|
|
.Console/read DEI ( printable ASCII ) ;insert JMP2
|
|
BRK
|
|
|
|
@min ( x^ y^ -> min^ )
|
|
LTHk JMP SWP POP JMP2r
|
|
|
|
@min2 ( x* y* -> min* )
|
|
LTH2k JMP SWP2 POP2 JMP2r
|
|
|
|
@term-move-cursor ( col^ row^ -> )
|
|
ansi INC ( row+1 ) ;emit-dec JSR2
|
|
LIT '; emit INC ( col+1 ) ;emit-dec JSR2
|
|
LIT 'H emit JMP2r
|
|
|
|
@term-get-cursor-position
|
|
ansi LIT '6 emit LIT 'n emit JMP2r
|
|
|
|
@term-erase-all
|
|
ansi LIT '2 emit LIT 'J emit JMP2r
|
|
|
|
@draw-cursor
|
|
;cur-col JSR2 ;cur-row JSR2
|
|
;term-move-cursor JSR2 JMP2r
|
|
|
|
@draw-statusbar
|
|
#00 height ;term-move-cursor JSR2
|
|
ansi LIT '7 emit LIT 'm emit
|
|
LIT2r 2018
|
|
;term/cols LDA2 #0000
|
|
&loop GTH2k ,&continue JCN ,&done JMP
|
|
&continue DEOkr INC2 ,&loop JMP
|
|
&done POP2 POP2 POP2r
|
|
|
|
#00 height ;term-move-cursor JSR2
|
|
;messages/saved ;print JSR2
|
|
;filename ;print JSR2
|
|
#20 emit
|
|
LIT '[ emit
|
|
;buffer/limit LDA2 ;buffer/data SUB2 ;emit-dec2 JSR2
|
|
;messages/bytes ;print JSR2
|
|
#20 emit
|
|
;buffer/line-count LDA2 ;emit-dec2 JSR2
|
|
;messages/lines ;print JSR2
|
|
#20 emit
|
|
LIT '( emit
|
|
;cur-col JSR2 INC ;emit-dec JSR2
|
|
LIT ', emit
|
|
;cur-abs-row JSR2 INC2 ;emit-dec2 JSR2
|
|
LIT ') emit
|
|
|
|
ansi LIT '0 emit LIT 'm emit
|
|
JMP2r
|
|
|
|
( @draw-line ( s* -> )
|
|
&loop LDAk #00 EQU ,&done JCN
|
|
LDAk #0a EQU ,&done JCN
|
|
LDAk emit INC2 ,&loop JMP
|
|
&done POP2 JMP2r )
|
|
|
|
@draw-all
|
|
;term-erase-all JSR2
|
|
#00 #00 ;term-move-cursor JSR2
|
|
#01 STH
|
|
;buffer/offset LDA2
|
|
&loop
|
|
LDAk #00 EQU ,&eof JCN
|
|
LDAk #0a EQU ,&eol JCN
|
|
LDAk emit INC2 ,&loop JMP
|
|
&eol INCr STHkr height GTH ,&done JCN
|
|
cr nl INC2 ,&loop JMP
|
|
&eof
|
|
ansi LIT '3 emit LIT '1 emit LIT 'm emit
|
|
&eof-loop
|
|
STHkr height GTH ,&done JCN
|
|
cr nl
|
|
LIT '~ emit INCr
|
|
,&eof-loop JMP
|
|
&done POP2 POPr
|
|
ansi LIT '0 emit LIT 'm emit
|
|
;draw-statusbar JSR2
|
|
;draw-cursor JSR2
|
|
JMP2r
|
|
|
|
@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
|
|
|
|
@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 JSR2 JMP2r
|
|
|
|
@cur-last ( -> n* )
|
|
;cur-line JSR2 ;line-len JSR2 #0001 SUB2 NIP JMP2r
|
|
|
|
@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
|
|
|
|
@abs-line ( y* -> s* )
|
|
#0000 SWP2 SUB2 STH2 ( [-y] )
|
|
;buffer/data ( addr )
|
|
&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 ( addr+1 [-y+1] ) ,&newline JMP
|
|
&done POP2r JMP2r
|
|
¬-found POP2 POP2r #0000 JMP2r
|
|
|
|
( line number relative to the offset, starting at 0 )
|
|
@rel-line ( y^ -> s* )
|
|
#00 SWP SUB STH ( [-y] )
|
|
;buffer/offset LDA2 ( addr* )
|
|
STHkr #00 EQU ,&done JCN ( addr [-y] )
|
|
&newline ( addr [-y] )
|
|
STHkr ,&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 INCr ( addr+1 [-y+1] ) ,&newline JMP
|
|
&done POPr JMP2r
|
|
¬-found ;rel-line-error ;error! JMP2
|
|
|
|
@cur-line ( -> s* )
|
|
;cursor/row LDA ;rel-line JSR2 JMP2r
|
|
|
|
@cur-line-num ( -> n* )
|
|
#00 ;cursor/row LDA ;buffer/line-offset LDA2 ADD2 JMP2r
|
|
|
|
@cur-pos ( -> s* )
|
|
;cur-line JSR2 #00 ;cur-col JSR2 ADD2 JMP2r
|
|
|
|
@cur-abs-row ( -> n* )
|
|
;buffer/line-offset LDA2 #00 ;cursor/row LDA ADD2 JMP2r
|
|
|
|
@last-abs-row ( -> n* )
|
|
;buffer/line-count LDA2 #0001 SUB2 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 STA2 ( )
|
|
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 STA2 ( )
|
|
#00 ;buffer/limit LDA2 STA ( ensure null termination )
|
|
JMP2r
|
|
|
|
( TODO: should be using cur-col and cur-row almost everywhere )
|
|
( otherwise, bugs! )
|
|
|
|
@cur-col
|
|
;cursor/col LDA ;cur-len JSR2 NIP ;min JSR2 JMP2r
|
|
|
|
@cur-row
|
|
;cursor/row LDA JMP2r
|
|
|
|
@last-pos
|
|
;buffer/limit LDA2 #0001 SUB2 JMP2r
|
|
|
|
@more-than-one-screen ( -> bool^ )
|
|
;buffer/line-count LDA2 ;term/rows LDA2 GTH2 JMP2r
|
|
|
|
@fits-in-one-screen ( -> bool^ )
|
|
;buffer/line-count LDA2 ;term/rows LDA2 INC2 LTH2 JMP2r
|
|
|
|
@mod-div ( x^ y^ -> x%d x/y )
|
|
DIVk STHk MUL SUB STHr JMP2r
|
|
|
|
@mod-div2 ( x^ y^ -> x%d x/y )
|
|
DIV2k STH2k MUL2 SUB2 STH2r JMP2r
|
|
|
|
@emit
|
|
( &long SWP2 ,&short JSR )
|
|
&short SWP ,&byte JSR
|
|
&byte DUP #04 SFT ,&char JSR
|
|
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
|
JMP2r
|
|
|
|
@emit-digit ( n^ -> )
|
|
LIT '0 ADD emit JMP2r
|
|
|
|
@emit-dec ( n^ -> )
|
|
DUP #63 GTH ,&do3 JCN
|
|
DUP #09 GTH ,&do2 JCN
|
|
,&do1 JMP
|
|
&do3 #64 ;mod-div JSR2 ;emit-digit JSR2
|
|
&do2 #0a ;mod-div JSR2 ;emit-digit JSR2
|
|
&do1 ;emit-digit JSR2 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 JSR2 JMP2r
|
|
|
|
@messages [ &input-error "input 20 "error 00
|
|
&bytes 20 "bytes, 00
|
|
&save-ok "saved 00
|
|
&save-failed "failed 00
|
|
&lines 20 "lines] 00
|
|
&saved "-- 20 00
|
|
&unsaved "** 20 00 ]
|
|
|
|
@tmp [ &pos :tmp/data
|
|
&data $100 ]
|
|
|
|
@term [ &cols 0050
|
|
&rows 0018 ]
|
|
|
|
@cursor [ &col 00 &row 00 ]
|
|
|
|
( did we just see ESC? )
|
|
@saw-esc 00
|
|
|
|
( )
|
|
@filename $80
|
|
|
|
( |1ffc )
|
|
( offset is address of the first visible line )
|
|
( size is total size of data in bytes )
|
|
@buffer [ &limit 0000
|
|
&offset :buffer/data
|
|
&line-count 0000
|
|
&line-offset 0000
|
|
&data $8000 ]
|