more improvements

This commit is contained in:
~d6 2022-04-01 23:47:37 -04:00
parent 5ef9b333c9
commit da49d8bd69
1 changed files with 116 additions and 166 deletions

282
femto.tal
View File

@ -85,6 +85,8 @@
%quit! { #01 .System/halt DEO BRK }
%lmargin { #0006 }
( zero page )
|0000
@ -93,7 +95,7 @@
@term [
&cols $2 ( relative x coordinate of cursor, from 0 )
&rows $2 ( relative y coordinaet of cursor, from 1 )
&lmargin $2 ( left padding needed for line numbers )
( &lmargin $2 ( left padding needed for line numbers ) )
]
@config [
@ -126,6 +128,7 @@
( 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? )
]
@ -163,7 +166,7 @@
@init-zero-page ( -> )
#0050 .term/cols STZ2
#0018 .term/rows STZ2
#0006 .term/lmargin STZ2
( #0006 .term/lmargin STZ2 )
#0004 .config/tab-width STZ2
#00 .config/insert-tabs STZ
@ -269,55 +272,54 @@
;redraw-statusbar-and-cursor JSR2
;return JMP2
( FIXME: handle long lines )
@eol ( -> )
;cur-line JSR2 ;line-len JSR2 .cursor/col STZ2
;cur-len JSR2 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2
;return JMP2
( FIXME: handle long lines )
@forward ( -> )
;cur-pos JSR2 ;last-pos JSR2 GTH2 ,&skip JCN
;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
,&skip JMP
;return JMP2
&normal
;cur-col JSR2 INC2 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2
&skip
;redraw-cursor JSR2
;return JMP2
( FIXME: handle long lines )
@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 JSR2 JMP2r
;cur-col JSR2 #0001 SUB2 .cursor/col STZ2
;redraw-statusbar-and-cursor JMP2
&next-line
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2
.cursor/row LDZ2k #0001 SUB2 ROT STZ2
;cur-len JSR2 .cursor/col STZ2
;ensure-visible-cursor JSR2 ( FIXME )
;redraw-cursor JSR2
JMP2r
;ensure-visible-cursor JSR2
;redraw-statusbar-and-cursor JSR2
&noop JMP2r
@back ( -> )
;go-back JSR2 ;return JMP2
@up ( -> )
;cur-abs-row JSR2 #0000 EQU2 ,&done JCN
.cursor/row LDZ2 #0000 EQU2 ;return JCN2
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2
;ensure-visible-cursor JSR2
;redraw-statusbar JSR2
&done ;redraw-cursor JSR2 ;return JMP2
;redraw-statusbar-and-cursor JSR2
;return JMP2
@last-abs-row ( -> n* )
.buffer/line-count LDZ2 #0001 SUB2 JMP2r
@down ( -> )
;cur-abs-row JSR2 ;last-abs-row JSR2 EQU2 ,&done JCN
.cursor/row LDZ2 ;last-abs-row JSR2 EQU2 ;return JCN2
.cursor/row LDZ2 INC2 .cursor/row STZ2
;ensure-visible-cursor JSR2
;redraw-statusbar JSR2
&done ;redraw-cursor JSR2 ;return JMP2
;redraw-statusbar-and-cursor JSR2
;return JMP2
@center-view
.term/rows LDZ2 INC2 #0002 DIV2 STH2k
@ -358,7 +360,7 @@
.cursor/row LDZ2 STH2r ADD2 .cursor/row STZ2
;redraw-all JSR2 ;return JMP2
&near-eof
.buffer/line-count LDZ2 #0001 SUB2 ;set-abs-row JSR2
.buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
;cur-len JSR2 .cursor/col STZ2
;redraw-cursor JSR2 ;return JMP2
@ -370,19 +372,22 @@
;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
;move-to-message-line JSR2
;messages/unknown-input ;print JSR2
;tmp/data ;print JSR2
;messages/unknown-input ;tmp/data ;send-message JSR2
BRK
@quit-now quit!
@ignore
;draw-cursor JSR2 BRK
( ;draw-cursor JSR2 ) BRK
@insert ( c^ -> )
#01 .state/modified STZ
@ -420,42 +425,30 @@
;ensure-visible-cursor JSR2
;redraw-all JSR2 ;return JMP2
( @at-buffer-start ( -> bool^ )
;cur-pos JSR2 ;data EQU2 JMP2r )
( @at-line-start ( -> bool^ )
.cursor/col LDZ2 #0000 EQU2 JMP2r )
( @bof-is-visible ( -> bool^ )
.buffer/line-offset LDZ2 #0000 EQU2 JMP2r )
@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 ,&skip JCN
;go-back JSR2
;delete JMP2
&skip
;redraw-cursor JSR2 ;return JMP2
;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 )
;redraw-prompt-and-cursor JSR2 ;return JMP2
&skip ;redraw-prompt-and-cursor JSR2 ;return JMP2
@delete ( -> )
#01 .state/modified STZ
;last-pos JSR2 ;cur-pos JSR2 LTH2 ,&skip JCN
;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2
;cur-pos JSR2 LDAk STH ( cur [c] )
;shift-left JSR2 ( [c] )
STHr #0a NEQ ,&not-newline JCN
.buffer/line-count LDZ2k #0001 SUB2 ROT STZ2
&not-newline ;redraw-all JSR2 ;return JMP2
&skip ;redraw-cursor JSR2 ;return JMP2
@escape ( -> )
#01 .state/saw-esc STZ BRK
@ -502,9 +495,7 @@
@do-goto-line
;tmp/data ;parse-decimal-number JSR2
,&ok JCN
;move-to-message-line JSR2
;messages/unknown-input ;print JSR2
;tmp/data ;print JSR2
;messages/unknown-input ;tmp/data ;send-message JSR2
;return JMP2
&ok
#0001 SUB2 ( convert 1-indexing to 0-indexing )
@ -548,7 +539,7 @@
@ensure-visible-cursor
.cursor/row LDZ2 .buffer/line-offset LDZ2
SUB2 .term/rows LDZ2 LTH2 ,&noop JCN
;cur-abs-row JSR2 ;jump-to-line JSR2
.cursor/row LDZ2 ;jump-to-line JSR2
;redraw-all JSR2
&noop JMP2r
@ -573,25 +564,23 @@
( ends prompt without calling vector )
@cancel-prompt ( -> )
.prompt/active LDZ ,&is-active JCN
#0000 DIV
&is-active
#00 .prompt/active STZ
#00 .state/quitting STZ
;redraw-prompt-and-cursor JSR2 ;return JMP2
#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 ( -> )
.prompt/active LDZ ,&is-active JCN
#0000 DIV
&is-active
#00 .prompt/active STZ
;redraw-prompt-and-cursor JSR2
.prompt/vector LDZ2 JMP2
#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
;redraw-prompt-and-cursor JSR2
;return JMP2
@do-save ( -> )
.buffer/limit LDZ2 ;data SUB2 STH2 ( [size] )
@ -599,30 +588,31 @@
STH2kr .File/length DEO2
;data .File/write DEO2
;move-to-message-line JSR2
.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
;messages/save-ok
&finish
;print JSR2 ;tmp/data ;print JSR2
;redraw-all JSR2
;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
;redraw-prompt-and-cursor JSR2
;return JMP2
@do-search ( -> )
#0000 .searching/regex STZ2
;move-to-next-match JSR2 ,&found JCN
;move-to-prev-match JSR2 ,&found JCN
;move-to-message-line JSR2 ;messages/no-matches-found ;print JSR2
;draw-cursor JSR2 BRK
&found #01 .searching/active STZ ;return JMP2
;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
@ -631,10 +621,12 @@
@do-regex-search ( -> )
;tmp/data ;compile .searching/regex STZ2
;move-to-next-regex-match JSR2 ,&found JCN
;move-to-prev-regex-match JSR2 ,&found JCN
;move-to-message-line JSR2 ;messages/no-matches-found ;print JSR2
;draw-cursor JSR2 BRK
&found #01 .searching/active STZ ;return JMP2
;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
@ -705,9 +697,11 @@
ansi emit-2 emit-K JMP2r
@clear-message-line
;move-to-message-line JSR2
;clear-line JSR2
JMP2r
.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
@ -742,7 +736,7 @@
&found
NIP2 ;jump-to-pos JSR2 #01 JMP2r
&fail
;redraw-cursor JSR2 POP2 POP2 #00 JMP2r
POP2 POP2 #00 JMP2r
@move-to-prev-match ( -> ok^ )
;data
@ -755,7 +749,7 @@
&found
NIP2 ;jump-to-pos JSR2 #01 JMP2r
&fail
;redraw-cursor JSR2 POP2 POP2 #00 JMP2r
POP2 POP2 #00 JMP2r
@move-to-next-regex-match ( -> ok^ )
.buffer/limit LDZ2
@ -863,17 +857,28 @@
@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 .term/lmargin LDZ2 ADD2
;cur-rel-row JSR2
;cur-w-col JSR2 ( .term/lmargin LDZ2 ) 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
@ -907,11 +912,10 @@
emit-(
;cur-col JSR2 INC2 ;emit-dec2 JSR2
emit-,
;cur-abs-row JSR2 INC2 ;emit-dec2 JSR2
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2
emit-)
sp
;get-tab-status JSR2 ;print JSR2
sp .counter LDZ2 ;emit-dec2 JSR2 ( FIXME )
;emit-reset JSR2
JMP2r
@ -920,11 +924,13 @@
.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
JMP2r
@draw-linenum ( n* -> )
;emit-reset JSR2
@ -972,7 +978,7 @@
.searching/active LDZ #00 EQU ,&return JCN ( )
;emit-color-reverse JSR2
.term/lmargin LDZ2 ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
( .term/lmargin LDZ2 ) lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
.buffer/offset LDZ2 DUP2
;screen-limit JSR2 SUB2 STH2 ( offset [-count] )
@ -987,7 +993,7 @@
&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] ) ( POP2 POP2 POP2 POP2 ( FIXME ) )
;draw-region JSR2 ( offset [mlim -count] )
STH2r ( offset mlim [-count] )
OVR2 SUB2 ( offset mlim-offset [-count] )
&next ( offset n [-count] )
@ -996,7 +1002,7 @@
ADD2 ADD2r ( offset+n [n-count] )
,&loop JMP
&newline ( offset [-count] )
.term/lmargin LDZ2 ,&x STR2
( .term/lmargin LDZ2 ) lmargin ,&x STR2
,&y LDR2 INC2 ,&y STR2
INC2 INC2r
,&loop JMP
@ -1035,7 +1041,7 @@
.buffer/offset LDZ2
&bol
ADD2kr STH2r ;draw-linenum JSR2
.term/lmargin LDZ2 INC2 ,&x STR2
( .term/lmargin LDZ2 ) lmargin INC2 ,&x STR2
&loop ( offset [k line-offset] )
LDAk #00 EQU ,&eof JCN
LDAk #0a EQU ,&eol JCN
@ -1061,7 +1067,7 @@
&eof-loop
STH2kr .term/rows LDZ2 GTH2 ,&done JCN
cr nl
.term/lmargin LDZ2 ;term-move-right JSR2
( .term/lmargin LDZ2 ) lmargin ;term-move-right JSR2
emit-~ INC2r
,&eof-loop JMP
&done POP2 POP2r POP2r
@ -1140,48 +1146,37 @@
,&row LDR2 ,&col LDR2 JMP2r
[ &row $2 &col $2 ]
@abs-line ( y* -> s* )
#0000 SWP2 SUB2 STH2 ( [-y] )
;data ( addr )
&newline ( addr [-y] )
( 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 ,&not-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
&loop ( addr [-y] )
LDAk #00 EQU ,&not-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
&not-found POP2 POP2r #0000 JMP2r
( line number relative to the offset, starting at 0 )
( 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* )
#0000 SWP2 SUB2 STH2 ( [-y] )
.buffer/offset LDZ2 ( addr* )
STH2kr #0000 EQU2 ,&done JCN ( addr [-y] )
&newline ( addr [-y] )
STH2kr ORA ,&loop JCN ,&done JMP
&loop ( addr [-y] )
LDAk #00 EQU ,&not-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
&not-found ;messages/rel-line-error ;error! JMP2
.buffer/offset LDZ2 SWP2 ;line-to-pos JMP2
@cur-line ( -> s* )
;cur-rel-row JSR2 .term/rows LDZ2 LTH2 ,&safe JCN
.cursor/row LDZ2 ;abs-line JMP2
&safe ;cur-rel-row JSR2 ;rel-line JMP2
.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
@cur-abs-row ( -> n* )
;cur-rel-row JSR2 .buffer/line-offset LDZ2 ADD2 JMP2r
@last-abs-row ( -> n* )
.buffer/line-count LDZ2 #0001 SUB2 JMP2r
@shift-right ( c^ addr* -> )
ROT STH ( addr [prev^] )
;last-pos JSR2 SWP2 ( last addr [prev^] )
@ -1210,70 +1205,25 @@
#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
@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
@cur-rel-row ( -> row* )
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2 JMP2r
@set-abs-row ( n* -> )
.cursor/row STZ2 JMP2r
@zero-row ( -> )
;data .buffer/offset STZ2
#0000 .buffer/line-offset STZ2
#0000 .cursor/row STZ2
JMP2r
( @inc-row ( -> )
.cursor/row LDZ2 INC2 .cursor/row STZ2 JMP2r )
( @dec-row ( -> )
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 JMP2r )
@last-pos ( -> addr* )
.buffer/limit LDZ2 #0001 SUB2 JMP2r
( @more-than-one-screen ( -> bool^ )
.buffer/line-count LDZ2 .term/rows LDZ2 GTH2 JMP2r )
( @fits-in-one-screen ( -> bool^ )
.buffer/line-count LDZ2 .term/rows LDZ2 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
( @base-10-width ( n* -> w* )
LIT2r 0000 ( n [0] )
&loop ( n [w] )
DUP2 #0000 EQU2 ,&done JCN ( n [w] )
#000a DIV2 ( n/10 [w] )
INC2r ,&loop JMP ( n/10 [w+1] )
&done ( 0 [w] )
POP2 STH2r 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 JMP2 )
@emit-dec2 ( n* -> )
DUP2 #270f GTH2 ,&do5 JCN
DUP2 #03e7 GTH2 ,&do4 JCN