more improvements
This commit is contained in:
parent
5ef9b333c9
commit
da49d8bd69
282
femto.tal
282
femto.tal
|
|
@ -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 ,¬-newline JCN
|
||||
.buffer/line-count LDZ2k #0001 SUB2 ROT STZ2
|
||||
¬-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 ,¬-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 ,¬-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
|
||||
|
||||
( 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 ,¬-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 ;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
|
||||
|
|
|
|||
Loading…
Reference in New Issue