fixed a few bugs, diagnosed more
This commit is contained in:
parent
233e8b07f2
commit
46f0f162eb
138
femto.tal
138
femto.tal
|
@ -64,9 +64,10 @@
|
|||
%sp { #2018 DEO }
|
||||
%nl { #0a18 DEO }
|
||||
%cr { #0d18 DEO }
|
||||
%exit { #01 .System/halt DEO BRK }
|
||||
%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 }
|
||||
|
@ -82,13 +83,28 @@
|
|||
( ;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 exit
|
||||
;messages/input-error ;print JSR2 nl quit!
|
||||
|
||||
( calculate buffer limit address using start + size )
|
||||
&ok .File/success DEI2 ;buffer/data ADD2 ;buffer/limit STA2
|
||||
|
@ -130,7 +146,8 @@
|
|||
;on-key .Console/vector DEO2
|
||||
;draw-all JSR2
|
||||
BRK
|
||||
&parse-error LDAk #00 #00 DIV
|
||||
&parse-error POP2 ;tmp/data LDA2
|
||||
;term-size-parse-error ;error! JMP2
|
||||
|
||||
@setup-linecount ( -> )
|
||||
;buffer/data LIT2r 0001
|
||||
|
@ -158,8 +175,7 @@
|
|||
&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 ;open-file JSR2 ( open file ) )
|
||||
;tmp/data ;filename ;str-copy JSR2 ( )
|
||||
;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 )
|
||||
|
@ -211,6 +227,7 @@
|
|||
|
||||
( FIXME: need to handle 'end of buffer' stuff )
|
||||
@down
|
||||
;cur-abs-row JSR2 ;last-abs-row JSR2 EQU2 ,&done JCN
|
||||
;cursor/row LDA pen-line GTH ,&screen-down JCN
|
||||
;cursor/row LDA INC ;cursor/row STA
|
||||
;draw-statusbar JSR2
|
||||
|
@ -220,14 +237,12 @@
|
|||
;buffer/offset LDA2 ADD2 ;buffer/offset STA2
|
||||
;buffer/line-offset LDA2k INC2 SWP2 STA2
|
||||
;draw-all JSR2
|
||||
BRK
|
||||
&done BRK
|
||||
|
||||
@quit exit
|
||||
@quit quit!
|
||||
|
||||
@ignore BRK
|
||||
|
||||
@die #00 #00 DIV
|
||||
|
||||
@insert ( c^ -> )
|
||||
;cursor/col LDA pen-col GTH ,&skip JCN ( FIXME )
|
||||
;cur-pos JSR2 ;shift-right JSR2
|
||||
|
@ -251,13 +266,20 @@
|
|||
;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
|
||||
|
||||
( TODO: handle first line )
|
||||
@backspace ( -> )
|
||||
;cur-pos JSR2 ;buffer/data EQU2 ,&skip JCN
|
||||
;cursor/col LDA #00 EQU ,&prev-line JCN
|
||||
;cursor/col LDA #01 SUB ;cursor/col STA
|
||||
;at-buffer-start JSR2 ,&skip JCN
|
||||
;at-line-start JSR2 ,&prev-line JCN
|
||||
;get-col JSR2 #01 SUB ;cursor/col STA
|
||||
( ;cursor/col LDA #01 SUB ;cursor/col STA )
|
||||
,&finish JMP
|
||||
&prev-line
|
||||
&prev-line ( TODO: what if row=0 but offset>0 ? )
|
||||
;cursor/row LDA #01 SUB ;cursor/row STA
|
||||
;cur-len JSR2 NIP ;cursor/col STA
|
||||
;buffer/line-count LDA2k #0001 SUB2 SWP2 STA2
|
||||
|
@ -266,12 +288,11 @@
|
|||
;draw-all JSR2
|
||||
&skip BRK
|
||||
|
||||
( there's at least one bug -- join lots of lines near start )
|
||||
@delete ( -> )
|
||||
;last-pos JSR2 #0001 SUB2
|
||||
;cur-pos JSR2 LTH2k ,&skip JCN
|
||||
;cur-pos JSR2 LDAk STH
|
||||
;shift-left JSR2
|
||||
;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
|
||||
|
@ -280,15 +301,18 @@
|
|||
@escape ( -> )
|
||||
#01 ;saw-esc STA BRK
|
||||
|
||||
( TODO: small buffers )
|
||||
@goto-end ( -> )
|
||||
;buffer/line-count LDA2 ;term/rows LDA2 ( #00 #00 DIV ) SUB2
|
||||
DUP2 ;buffer/line-offset STA2
|
||||
;abs-line JSR2 ;buffer/offset STA2
|
||||
height #01 SUB ;cursor/row STA
|
||||
;cur-len JSR2 NIP ;cursor/col STA
|
||||
;draw-all JSR2
|
||||
BRK
|
||||
;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
|
||||
|
@ -322,6 +346,13 @@
|
|||
POP2 STH2r NIP ;cursor/row STA
|
||||
JMP2r
|
||||
|
||||
@refresh
|
||||
;draw-all JSR2 BRK
|
||||
|
||||
@debug
|
||||
;rel-line-error ;error! JMP2
|
||||
( #00 #00 DIV BRK )
|
||||
|
||||
( TODO: M-v for page up and M-> for goto end )
|
||||
( M-f and M-b for next/previous word )
|
||||
( M-n and M-p for next/previous paragraph )
|
||||
|
@ -345,10 +376,12 @@
|
|||
.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 #10 EQU ( C-p ) ;up 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 )
|
||||
|
@ -412,15 +445,23 @@
|
|||
@draw-all
|
||||
;term-erase-all JSR2
|
||||
#00 #00 ;term-move-cursor JSR2
|
||||
#00 STH
|
||||
#01 STH
|
||||
;buffer/offset LDA2
|
||||
&loop
|
||||
LDAk #00 EQU ,&eof JCN
|
||||
LDAk #0a EQU ,&eol JCN
|
||||
LDAk emit INC2 ,&loop JMP
|
||||
&eol INCr STHkr last-line ( #17 ) GTH ,&eof JCN
|
||||
cr nl INC2 ,&loop JMP
|
||||
&eof POP2 POPr
|
||||
&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
|
||||
|
@ -465,6 +506,7 @@
|
|||
@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] )
|
||||
|
@ -473,7 +515,7 @@
|
|||
INC2 ,&loop JMP ( addr+1 [-y] )
|
||||
&found INC2 INCr ( addr+1 [-y+1] ) ,&newline JMP
|
||||
&done POPr JMP2r
|
||||
¬-found #00 #00 DIV
|
||||
¬-found ;rel-line-error ;error! JMP2
|
||||
|
||||
@cur-line ( -> s* )
|
||||
;cursor/row LDA ;rel-line JSR2 JMP2r
|
||||
|
@ -484,6 +526,9 @@
|
|||
@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^] )
|
||||
;buffer/limit LDA2 ( addr limit [prev^] )
|
||||
|
@ -499,19 +544,24 @@
|
|||
;buffer/limit STA2 ( )
|
||||
JMP2r
|
||||
|
||||
( TODO: change last/addr order and GTH -> LTH to remove hack )
|
||||
@shift-left ( addr* -> )
|
||||
;buffer/limit LDA2 ( addr limit )
|
||||
#0001 SUB2 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 ( )
|
||||
;buffer/limit LDA2 ( addr limit )
|
||||
#0001 SUB2 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 get-col and get-row almost everywhere )
|
||||
( otherwise, bugs! )
|
||||
|
||||
@get-col
|
||||
;cursor/col LDA ;cur-len JSR2 NIP ;min JSR2 JMP2r
|
||||
|
||||
|
@ -521,6 +571,12 @@
|
|||
@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
|
||||
|
||||
@doc-start ( -> s* ) ;buffer/data JMP2r
|
||||
@doc-limit ( -> s* ) ;buffer/limit LDA2 JMP2r
|
||||
@doc-last ( -> s* ) ;buffer/limit LDA2 #0001 SUB2 JMP2r
|
||||
|
|
Loading…
Reference in New Issue