d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

278
femto.tal
View File

@ -85,6 +85,8 @@
%quit! { #01 .System/halt DEO BRK } %quit! { #01 .System/halt DEO BRK }
%lmargin { #0006 }
( zero page ) ( zero page )
|0000 |0000
@ -93,7 +95,7 @@
@term [ @term [
&cols $2 ( relative x coordinate of cursor, from 0 ) &cols $2 ( relative x coordinate of cursor, from 0 )
&rows $2 ( relative y coordinaet of cursor, from 1 ) &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 [ @config [
@ -126,6 +128,7 @@
( 0x04 prompt ) ( 0x04 prompt )
( 0x08 matches ) ( 0x08 matches )
( 0x10 body and everything else ) ( 0x10 body and everything else )
&message $1 ( did we just print a message? )
&modified $1 ( has the buffer been modified? ) &modified $1 ( has the buffer been modified? )
&quitting $1 ( are we in the process of quitting? ) &quitting $1 ( are we in the process of quitting? )
] ]
@ -163,7 +166,7 @@
@init-zero-page ( -> ) @init-zero-page ( -> )
#0050 .term/cols STZ2 #0050 .term/cols STZ2
#0018 .term/rows STZ2 #0018 .term/rows STZ2
#0006 .term/lmargin STZ2 ( #0006 .term/lmargin STZ2 )
#0004 .config/tab-width STZ2 #0004 .config/tab-width STZ2
#00 .config/insert-tabs STZ #00 .config/insert-tabs STZ
@ -269,55 +272,54 @@
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
;return JMP2 ;return JMP2
( FIXME: handle long lines )
@eol ( -> ) @eol ( -> )
;cur-line JSR2 ;line-len JSR2 .cursor/col STZ2 ;cur-len JSR2 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
;return JMP2 ;return JMP2
( FIXME: handle long lines )
@forward ( -> ) @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 ;cur-col JSR2 ;cur-len JSR2 LTH2 ,&normal JCN
#0000 .cursor/col STZ2 #0000 .cursor/col STZ2
.cursor/row LDZ2 INC2 .cursor/row STZ2 .cursor/row LDZ2 INC2 .cursor/row STZ2
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
,&skip JMP ;return JMP2
&normal &normal
;cur-col JSR2 INC2 .cursor/col STZ2 ;cur-col JSR2 INC2 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
&skip
;redraw-cursor JSR2
;return JMP2 ;return JMP2
( FIXME: handle long lines )
@go-back ( -> ) @go-back ( -> )
;cur-pos JSR2 ;data EQU2 ,&noop JCN
;cur-col JSR2 #0001 LTH2 ,&next-line JCN ;cur-col JSR2 #0001 LTH2 ,&next-line JCN
;cur-col JSR2 #0001 SUB2 .cursor/col STZ2 ;cur-col JSR2 #0001 SUB2 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2 JMP2r ;redraw-statusbar-and-cursor JMP2
&next-line &next-line
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 .cursor/row LDZ2k #0001 SUB2 ROT STZ2
;cur-len JSR2 .cursor/col STZ2 ;cur-len JSR2 .cursor/col STZ2
;ensure-visible-cursor JSR2 ( FIXME ) ;ensure-visible-cursor JSR2
;redraw-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
JMP2r &noop JMP2r
@back ( -> ) @back ( -> )
;go-back JSR2 ;return JMP2 ;go-back JSR2 ;return JMP2
@up ( -> ) @up ( -> )
;cur-abs-row JSR2 #0000 EQU2 ,&done JCN .cursor/row LDZ2 #0000 EQU2 ;return JCN2
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 .cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-statusbar JSR2 ;redraw-statusbar-and-cursor JSR2
&done ;redraw-cursor JSR2 ;return JMP2 ;return JMP2
@last-abs-row ( -> n* )
.buffer/line-count LDZ2 #0001 SUB2 JMP2r
@down ( -> ) @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 .cursor/row LDZ2 INC2 .cursor/row STZ2
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-statusbar JSR2 ;redraw-statusbar-and-cursor JSR2
&done ;redraw-cursor JSR2 ;return JMP2 ;return JMP2
@center-view @center-view
.term/rows LDZ2 INC2 #0002 DIV2 STH2k .term/rows LDZ2 INC2 #0002 DIV2 STH2k
@ -358,7 +360,7 @@
.cursor/row LDZ2 STH2r ADD2 .cursor/row STZ2 .cursor/row LDZ2 STH2r ADD2 .cursor/row STZ2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
&near-eof &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 ;cur-len JSR2 .cursor/col STZ2
;redraw-cursor JSR2 ;return JMP2 ;redraw-cursor JSR2 ;return JMP2
@ -370,19 +372,22 @@
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2 ;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;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 @do-quit
.tmp/data LDZ LIT 'n EQU ;quit-now JCN2 .tmp/data LDZ LIT 'n EQU ;quit-now JCN2
.tmp/data LDZ LIT 'y EQU ;save JCN2 .tmp/data LDZ LIT 'y EQU ;save JCN2
#00 .state/quitting STZ #00 .state/quitting STZ
;move-to-message-line JSR2 ;messages/unknown-input ;tmp/data ;send-message JSR2
;messages/unknown-input ;print JSR2
;tmp/data ;print JSR2
BRK BRK
@quit-now quit! @quit-now quit!
@ignore @ignore
;draw-cursor JSR2 BRK ( ;draw-cursor JSR2 ) BRK
@insert ( c^ -> ) @insert ( c^ -> )
#01 .state/modified STZ #01 .state/modified STZ
@ -420,42 +425,30 @@
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-all JSR2 ;return JMP2 ;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^ ) @eof-is-visible ( -> bool^ )
.buffer/line-offset LDZ2 .term/rows LDZ2 ADD2 INC2 .buffer/line-offset LDZ2 .term/rows LDZ2 ADD2 INC2
.buffer/line-count LDZ2 .buffer/line-count LDZ2
GTH2 JMP2r GTH2 JMP2r
@backspace ( -> ) @backspace ( -> )
;cur-pos JSR2 ;data EQU2 ,&skip JCN ;cur-pos JSR2 ;data EQU2 ;return JCN2
;go-back JSR2 ;go-back JSR2 ;delete JMP2
;delete JMP2
&skip
;redraw-cursor JSR2 ;return JMP2
@backspace-prompt ( -> ) @backspace-prompt ( -> )
.tmp/pos LDZ2 ;tmp/data EQU2 ,&skip JCN ( ;return JCN2 )
#00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 ) #00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 )
STH2k STA ( data[pos-1] <- 0 ) STH2k STA ( data[pos-1] <- 0 )
STH2r .tmp/pos STZ2 ( pos <- pos-1 ) STH2r .tmp/pos STZ2 ( pos <- pos-1 )
;redraw-prompt-and-cursor JSR2 ;return JMP2 &skip ;redraw-prompt-and-cursor JSR2 ;return JMP2
@delete ( -> ) @delete ( -> )
#01 .state/modified STZ #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] ) ;cur-pos JSR2 LDAk STH ( cur [c] )
;shift-left JSR2 ( [c] ) ;shift-left JSR2 ( [c] )
STHr #0a NEQ ,&not-newline JCN STHr #0a NEQ ,&not-newline JCN
.buffer/line-count LDZ2k #0001 SUB2 ROT STZ2 .buffer/line-count LDZ2k #0001 SUB2 ROT STZ2
&not-newline ;redraw-all JSR2 ;return JMP2 &not-newline ;redraw-all JSR2 ;return JMP2
&skip ;redraw-cursor JSR2 ;return JMP2
@escape ( -> ) @escape ( -> )
#01 .state/saw-esc STZ BRK #01 .state/saw-esc STZ BRK
@ -502,9 +495,7 @@
@do-goto-line @do-goto-line
;tmp/data ;parse-decimal-number JSR2 ;tmp/data ;parse-decimal-number JSR2
,&ok JCN ,&ok JCN
;move-to-message-line JSR2 ;messages/unknown-input ;tmp/data ;send-message JSR2
;messages/unknown-input ;print JSR2
;tmp/data ;print JSR2
;return JMP2 ;return JMP2
&ok &ok
#0001 SUB2 ( convert 1-indexing to 0-indexing ) #0001 SUB2 ( convert 1-indexing to 0-indexing )
@ -548,7 +539,7 @@
@ensure-visible-cursor @ensure-visible-cursor
.cursor/row LDZ2 .buffer/line-offset LDZ2 .cursor/row LDZ2 .buffer/line-offset LDZ2
SUB2 .term/rows LDZ2 LTH2 ,&noop JCN 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 ;redraw-all JSR2
&noop JMP2r &noop JMP2r
@ -573,25 +564,23 @@
( ends prompt without calling vector ) ( ends prompt without calling vector )
@cancel-prompt ( -> ) @cancel-prompt ( -> )
.prompt/active LDZ ,&is-active JCN #00 .prompt/active STZ
#0000 DIV #00 .state/quitting STZ
&is-active ;clear-message-line JSR2
#00 .prompt/active STZ ;redraw-prompt-and-cursor JSR2
#00 .state/quitting STZ ;return JMP2
;redraw-prompt-and-cursor JSR2 ;return JMP2
( when called vector should end in BRK ) ( when called vector should end in BRK )
@finish-prompt ( -> ) @finish-prompt ( -> )
.prompt/active LDZ ,&is-active JCN #00 .prompt/active STZ
#0000 DIV ;clear-message-line JSR2
&is-active ;redraw-prompt-and-cursor JSR2
#00 .prompt/active STZ .prompt/vector LDZ2 JMP2
;redraw-prompt-and-cursor JSR2
.prompt/vector LDZ2 JMP2
@save @save
;messages/save-prompt ;filename ;do-save ;start-prompt JSR2 ;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 ( -> ) @do-save ( -> )
.buffer/limit LDZ2 ;data SUB2 STH2 ( [size] ) .buffer/limit LDZ2 ;data SUB2 STH2 ( [size] )
@ -599,7 +588,6 @@
STH2kr .File/length DEO2 STH2kr .File/length DEO2
;data .File/write DEO2 ;data .File/write DEO2
;move-to-message-line JSR2
.File/success DEI2 STH2r EQU2 ( ok? ) ,&ok JCN .File/success DEI2 STH2r EQU2 ( ok? ) ,&ok JCN
;messages/save-failed ,&finish JMP ;messages/save-failed ,&finish JMP
&ok &ok
@ -607,22 +595,24 @@
;tmp/data ;filename ;str-copy JSR2 ;tmp/data ;filename ;str-copy JSR2
;messages/save-ok ;messages/save-ok
&finish &finish
;print JSR2 ;tmp/data ;print JSR2 ;tmp/data ;send-message JSR2
;redraw-all JSR2
.state/quitting LDZ ;quit-now JCN2 .state/quitting LDZ ;quit-now JCN2
;return JMP2 ;return JMP2
@search ( -> ) @search ( -> )
;messages/search-prompt ;messages/null ;do-search ;start-prompt JSR2 ;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 ( -> ) @do-search ( -> )
#0000 .searching/regex STZ2 #0000 .searching/regex STZ2
;move-to-next-match JSR2 ,&found JCN ;move-to-next-match JSR2 ,&found JCN
;move-to-prev-match JSR2 ,&found JCN ;move-to-prev-match JSR2 ,&found JCN
;move-to-message-line JSR2 ;messages/no-matches-found ;print JSR2 ;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
;draw-cursor JSR2 BRK &found
&found #01 .searching/active STZ ;return JMP2 #01 .searching/active STZ
;redraw-matches JSR2
;return JMP2
@regex-search ( -> ) @regex-search ( -> )
;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2 ;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2
@ -631,10 +621,12 @@
@do-regex-search ( -> ) @do-regex-search ( -> )
;tmp/data ;compile .searching/regex STZ2 ;tmp/data ;compile .searching/regex STZ2
;move-to-next-regex-match JSR2 ,&found JCN ;move-to-next-regex-match JSR2 ,&found JCN
;move-to-prev-regex-match JSR2 ,&found JCN ;move-to-prev-regex-match JSR2 ,&found JCN
;move-to-message-line JSR2 ;messages/no-matches-found ;print JSR2 ;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
;draw-cursor JSR2 BRK &found
&found #01 .searching/active STZ ;return JMP2 #01 .searching/active STZ
;redraw-matches JSR2
;return JMP2
@toggle-color ( -> ) @toggle-color ( -> )
.config/color LDZ2 #3733 EQU2 ,&wrap-around JCN .config/color LDZ2 #3733 EQU2 ,&wrap-around JCN
@ -705,9 +697,11 @@
ansi emit-2 emit-K JMP2r ansi emit-2 emit-K JMP2r
@clear-message-line @clear-message-line
;move-to-message-line JSR2 .state/message LDZ #00 EQU ,&done JCN
;clear-line JSR2 ;move-to-message-line JSR2
JMP2r ;clear-line JSR2
#00 .state/message STZ
&done JMP2r
@cancel-search @cancel-search
#00 .searching/active STZ #00 .searching/active STZ
@ -742,7 +736,7 @@
&found &found
NIP2 ;jump-to-pos JSR2 #01 JMP2r NIP2 ;jump-to-pos JSR2 #01 JMP2r
&fail &fail
;redraw-cursor JSR2 POP2 POP2 #00 JMP2r POP2 POP2 #00 JMP2r
@move-to-prev-match ( -> ok^ ) @move-to-prev-match ( -> ok^ )
;data ;data
@ -755,7 +749,7 @@
&found &found
NIP2 ;jump-to-pos JSR2 #01 JMP2r NIP2 ;jump-to-pos JSR2 #01 JMP2r
&fail &fail
;redraw-cursor JSR2 POP2 POP2 #00 JMP2r POP2 POP2 #00 JMP2r
@move-to-next-regex-match ( -> ok^ ) @move-to-next-regex-match ( -> ok^ )
.buffer/limit LDZ2 .buffer/limit LDZ2
@ -863,17 +857,28 @@
@redraw-statusbar ( -> ) #02 ;redraw-add JMP2 @redraw-statusbar ( -> ) #02 ;redraw-add JMP2
@redraw-statusbar-and-cursor ( -> ) #03 ;redraw-add JMP2 @redraw-statusbar-and-cursor ( -> ) #03 ;redraw-add JMP2
@redraw-prompt-and-cursor ( -> ) #05 ;redraw-add JMP2 @redraw-prompt-and-cursor ( -> ) #05 ;redraw-add JMP2
@redraw-matches ( -> ) #08 ;redraw-add JMP2
@redraw-all ( -> ) #1f ;redraw-add JMP2 @redraw-all ( -> ) #1f ;redraw-add JMP2
@draw-cursor ( -> ) @draw-cursor ( -> )
.prompt/active LDZ ,&on-prompt JCN .prompt/active LDZ ,&on-prompt JCN
( TODO: handle long lines ) ( TODO: handle long lines )
;cur-w-col JSR2 .term/lmargin LDZ2 ADD2 ;cur-w-col JSR2 ( .term/lmargin LDZ2 ) lmargin ADD2
;cur-rel-row JSR2 .cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
;term-move-cursor JMP2 ;term-move-cursor JMP2
&on-prompt &on-prompt
JMP2r 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 @get-save-status
.state/modified LDZ ,&is-modified JCN .state/modified LDZ ,&is-modified JCN
;messages/saved JMP2r ;messages/saved JMP2r
@ -907,11 +912,10 @@
emit-( emit-(
;cur-col JSR2 INC2 ;emit-dec2 JSR2 ;cur-col JSR2 INC2 ;emit-dec2 JSR2
emit-, emit-,
;cur-abs-row JSR2 INC2 ;emit-dec2 JSR2 .cursor/row LDZ2 INC2 ;emit-dec2 JSR2
emit-) emit-)
sp sp
;get-tab-status JSR2 ;print JSR2 ;get-tab-status JSR2 ;print JSR2
sp .counter LDZ2 ;emit-dec2 JSR2 ( FIXME )
;emit-reset JSR2 ;emit-reset JSR2
JMP2r JMP2r
@ -920,6 +924,8 @@
.prompt/active LDZ ,&is-active JCN .prompt/active LDZ ,&is-active JCN
JMP2r JMP2r
&is-active &is-active
#01 .state/message STZ
;move-to-message-line JSR2
;emit-color-bold JSR2 ;emit-color-bold JSR2
.prompt/string LDZ2 ;print JSR2 .prompt/string LDZ2 ;print JSR2
;emit-reset JSR2 ;emit-reset JSR2
@ -972,7 +978,7 @@
.searching/active LDZ #00 EQU ,&return JCN ( ) .searching/active LDZ #00 EQU ,&return JCN ( )
;emit-color-reverse JSR2 ;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 .buffer/offset LDZ2 DUP2
;screen-limit JSR2 SUB2 STH2 ( offset [-count] ) ;screen-limit JSR2 SUB2 STH2 ( offset [-count] )
@ -987,7 +993,7 @@
&found ( offset mlim [-count] ) &found ( offset mlim [-count] )
STH2k ( offset mlim [mlim -count] ) STH2k ( offset mlim [mlim -count] )
OVR2 SWP2 ,&x LDR2 ,&y LDR2 ( offset offset mlim x y [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] ) STH2r ( offset mlim [-count] )
OVR2 SUB2 ( offset mlim-offset [-count] ) OVR2 SUB2 ( offset mlim-offset [-count] )
&next ( offset n [-count] ) &next ( offset n [-count] )
@ -996,7 +1002,7 @@
ADD2 ADD2r ( offset+n [n-count] ) ADD2 ADD2r ( offset+n [n-count] )
,&loop JMP ,&loop JMP
&newline ( offset [-count] ) &newline ( offset [-count] )
.term/lmargin LDZ2 ,&x STR2 ( .term/lmargin LDZ2 ) lmargin ,&x STR2
,&y LDR2 INC2 ,&y STR2 ,&y LDR2 INC2 ,&y STR2
INC2 INC2r INC2 INC2r
,&loop JMP ,&loop JMP
@ -1035,7 +1041,7 @@
.buffer/offset LDZ2 .buffer/offset LDZ2
&bol &bol
ADD2kr STH2r ;draw-linenum JSR2 ADD2kr STH2r ;draw-linenum JSR2
.term/lmargin LDZ2 INC2 ,&x STR2 ( .term/lmargin LDZ2 ) lmargin INC2 ,&x STR2
&loop ( offset [k line-offset] ) &loop ( offset [k line-offset] )
LDAk #00 EQU ,&eof JCN LDAk #00 EQU ,&eof JCN
LDAk #0a EQU ,&eol JCN LDAk #0a EQU ,&eol JCN
@ -1061,7 +1067,7 @@
&eof-loop &eof-loop
STH2kr .term/rows LDZ2 GTH2 ,&done JCN STH2kr .term/rows LDZ2 GTH2 ,&done JCN
cr nl cr nl
.term/lmargin LDZ2 ;term-move-right JSR2 ( .term/lmargin LDZ2 ) lmargin ;term-move-right JSR2
emit-~ INC2r emit-~ INC2r
,&eof-loop JMP ,&eof-loop JMP
&done POP2 POP2r POP2r &done POP2 POP2r POP2r
@ -1140,48 +1146,37 @@
,&row LDR2 ,&col LDR2 JMP2r ,&row LDR2 ,&col LDR2 JMP2r
[ &row $2 &col $2 ] [ &row $2 &col $2 ]
@abs-line ( y* -> s* ) ( counts y lines forward from the given address )
#0000 SWP2 SUB2 STH2 ( [-y] ) @line-to-pos ( addr* y* -> s* )
;data ( addr ) #0000 SWP2 SUB2 STH2 ( addr [-y] )
&newline ( addr [-y] ) &newline ( addr [-y] )
STH2kr ORA ,&loop JCN ,&done JMP STH2kr ORA ,&loop JCN ,&done JMP
&loop ( addr [-y] ) &loop ( addr [-y] )
LDAk #00 EQU ,&not-found JCN ( addr [-y] ) LDAk #00 EQU ,&not-found JCN ( addr [-y] )
LDAk #0a EQU ,&found JCN ( addr [-y] ) LDAk #0a EQU ,&found JCN ( addr [-y] )
INC2 ,&loop JMP ( addr+1 [-y] ) INC2 ,&loop JMP ( addr+1 [-y] )
&found INC2 INC2r ( addr+1 [-y+1] ) ,&newline JMP &found INC2 INC2r ,&newline JMP
&done POP2r JMP2r &done POP2r JMP2r
&not-found POP2 POP2r #0000 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* ) @rel-line ( y* -> s* )
#0000 SWP2 SUB2 STH2 ( [-y] ) .buffer/offset LDZ2 SWP2 ;line-to-pos JMP2
.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
@cur-line ( -> s* ) @cur-line ( -> s* )
;cur-rel-row JSR2 .term/rows LDZ2 LTH2 ,&safe JCN .cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2k
.cursor/row LDZ2 ;abs-line JMP2 .term/rows LDZ2 LTH2 ,&ok JCN
&safe ;cur-rel-row JSR2 ;rel-line JMP2 POP2 ;abs-line JMP2
&ok
SUB2 ;rel-line JMP2
@cur-pos ( -> s* ) @cur-pos ( -> s* )
;cur-line JSR2 ;cur-col JSR2 ADD2 JMP2r ;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* -> ) @shift-right ( c^ addr* -> )
ROT STH ( addr [prev^] ) ROT STH ( addr [prev^] )
;last-pos JSR2 SWP2 ( last addr [prev^] ) ;last-pos JSR2 SWP2 ( last addr [prev^] )
@ -1210,70 +1205,25 @@
#00 .buffer/limit LDZ2 STA ( ensure null termination ) #00 .buffer/limit LDZ2 STA ( ensure null termination )
JMP2r JMP2r
( current column in terms of bytes in buffer )
@cur-col ( -> col* ) @cur-col ( -> col* )
.cursor/col LDZ2 ;cur-len JSR2 ;min2 JMP2 .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 ( -> ) @zero-row ( -> )
;data .buffer/offset STZ2 ;data .buffer/offset STZ2
#0000 .buffer/line-offset STZ2 #0000 .buffer/line-offset STZ2
#0000 .cursor/row STZ2 #0000 .cursor/row STZ2
JMP2r 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* ) @last-pos ( -> addr* )
.buffer/limit LDZ2 #0001 SUB2 JMP2r .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 ) @mod-div2 ( x^ y^ -> x%d x/y )
DIV2k STH2k MUL2 SUB2 STH2r JMP2r 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^ -> ) @emit-digit ( n^ -> )
LIT '0 ADD emit JMP2r 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* -> ) @emit-dec2 ( n* -> )
DUP2 #270f GTH2 ,&do5 JCN DUP2 #270f GTH2 ,&do5 JCN
DUP2 #03e7 GTH2 ,&do4 JCN DUP2 #03e7 GTH2 ,&do4 JCN