From da49d8bd69dc39d332a8605339c9f51e13bf4624 Mon Sep 17 00:00:00 2001 From: d6 Date: Fri, 1 Apr 2022 23:47:37 -0400 Subject: [PATCH] more improvements --- femto.tal | 282 ++++++++++++++++++++++-------------------------------- 1 file changed, 116 insertions(+), 166 deletions(-) diff --git a/femto.tal b/femto.tal index b345ba6..c190e7d 100644 --- a/femto.tal +++ b/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