draw line numbers, use color, support tabs

This commit is contained in:
~d6 2022-03-03 21:12:26 -05:00
parent 8acef622f4
commit 52965adb5f
1 changed files with 116 additions and 21 deletions

129
femto.tal
View File

@ -89,7 +89,7 @@
@open-file ( filename* -> )
.File/name DEO2
#8000 .File/length DEO2
#f000 .File/length DEO2
;buffer/data .File/read DEO2
.File/success DEI2 #0000 GTH2 ,&ok JCN
@ -266,6 +266,19 @@
;draw-all JSR2
BRK
@insert-tab ( -> )
;config/insert-tabs LDA ,&use-tabs JCN
#0000 ;config/tab-width LDA2 SUB2
&loop
DUP2 #0000 EQU2 ,&done JCN
#20 ;cur-pos JSR2 ;shift-right JSR2
INC2 ,&loop JMP
&done
;cur-col JSR2 ;config/tab-width LDA2 ADD2 ;cursor/col STA2
;draw-all JSR2 BRK
&use-tabs
#09 ;insert JMP2
( TODO: handle last line )
@newline ( c^ -> )
#0a ;cur-pos JSR2 ;shift-right JSR2
@ -360,7 +373,7 @@
;buffer/line-offset STA2 ( n o [n-o] )
;abs-line JSR2 ;buffer/offset STA2 ( n [n-o] )
#0000 ;cursor/col STA2 ( n [n-o] )
POP2 STH2r ;cursor/row STA2 ( )
POP2 STH2r ;cursor/row STA2
JMP2r
@ensure-visible-cursor
@ -414,6 +427,7 @@
.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 #09 EQU ( \t ) ;insert-tab 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
@ -440,6 +454,9 @@
LIT '; emit INC2 ( col+1 ) ;emit-dec2 JSR2
LIT 'H emit JMP2r
@term-move-right ( n* -> )
ansi ;emit-dec2 JSR2 LIT 'C emit JMP2r
@term-get-cursor-position ( -> )
ansi LIT '6 emit LIT 'n emit JMP2r
@ -447,12 +464,15 @@
ansi LIT '2 emit LIT 'J emit JMP2r
@draw-cursor ( -> )
;cur-col JSR2 ;cur-row JSR2
;cur-w-col JSR2 ;term/lmargin LDA2 ADD2
;cur-row JSR2
;term-move-cursor JSR2 JMP2r
@draw-statusbar ( -> )
#0000 ;term/rows LDA2 ;term-move-cursor JSR2
ansi LIT '7 emit LIT 'm emit
ansi ;config/color LDA2 emit emit
LIT2 '7 '; emit emit
LIT 'm emit ( esc [ 33 ; 7 m )
LIT2r 2018
;term/cols LDA2 #0000
&loop GTH2k ,&continue JCN ,&done JMP
@ -479,25 +499,42 @@
ansi LIT '0 emit LIT 'm emit
JMP2r
@draw-linenum ( n* -> )
ansi ;config/color LDA2 emit emit LIT 'm emit
;emit-dec2-pad JSR2
ansi LIT2 'm '0 emit emit JMP2r
@emit-tab ( -> )
#0000 ;config/tab-width LDA2 SUB2
LIT2r 2018
&loop ORAk ,&next JCN POP2 POP2r JMP2r
&next DEOkr INC2 ,&loop JMP
@draw-all ( -> )
;term-erase-all JSR2
#0000 #0000 ;term-move-cursor JSR2
#0001 STH2
;buffer/line-offset LDA2 STH2 LIT2r 0001 ( [k line-offset] )
ADD2kr STH2r ;draw-linenum JSR2
;buffer/offset LDA2
&loop
LDAk #00 EQU ,&eof JCN
LDAk #0a EQU ,&eol JCN
LDAk #09 EQU ,&do-tab JCN
LDAk emit INC2 ,&loop JMP
&do-tab ;emit-tab JSR2 INC2 ,&loop JMP
&eol INC2r STH2kr ;term/rows LDA2 GTH2 ,&done JCN
cr nl INC2 ,&loop JMP
cr nl INC2
ADD2kr STH2r ;draw-linenum JSR2
,&loop JMP
&eof
ansi LIT '3 emit LIT '1 emit LIT 'm emit
&eof-loop
STH2kr ;term/rows LDA2 GTH2 ,&done JCN
cr nl
;term/lmargin LDA2 ;term-move-right JSR2
LIT '~ emit INC2r
,&eof-loop JMP
&done POP2 POP2r
&done POP2 POP2r POP2r
ansi LIT '0 emit LIT 'm emit
;draw-statusbar JSR2
;draw-cursor JSR2
@ -522,6 +559,12 @@
@cur-last ( -> n* )
;cur-line JSR2 ;line-len JSR2 #0001 SUB2 JMP2r
@cur-width ( -> n* )
;cur-line JSR2 ;line-width JSR2 JMP2r
@cur-w-last ( -> n* )
;cur-line JSR2 ;line-width JSR2 #0001 SUB2 JMP2r
@line-len ( s* -> n* )
#0000 STH2
&loop LDAk #00 EQU ,&end JCN
@ -529,6 +572,15 @@
INC2 INC2r ,&loop JMP
&end POP2 STH2r JMP2r
@line-width ( s* -> n* )
#0000 STH2
&loop LDAk #00 EQU ,&done JCN
LDAk #0a EQU ,&done JCN
LDAk #09 EQU ,&tabs JCN
INC2 INC2r ,&loop JMP
&tabs #0004 ADD2 ,&loop JMP
&done POP2 STH2r JMP2r
@abs-line ( y* -> s* )
#0000 SWP2 SUB2 STH2 ( [-y] )
;buffer/data ( addr )
@ -597,12 +649,17 @@
#00 ;buffer/limit LDA2 STA ( ensure null termination )
JMP2r
( TODO: should be using cur-col and cur-row almost everywhere )
( otherwise, bugs! )
@cur-col ( -> col* )
;cursor/col LDA2 ;cur-len JSR2 ;min2 JSR2 JMP2r
@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 LDA2 STH2 ADD2r ,&loop JMP
@cur-row ( -> row* )
;cursor/row LDA2 JMP2r
@ -621,11 +678,14 @@
@mod-div2 ( x^ y^ -> x%d x/y )
DIV2k STH2k MUL2 SUB2 STH2r JMP2r
( @emit
&short ( s* -> ) SWP ,&byte JSR
&byte ( b^ -> ) DUP #04 SFT ,&nib JSR
&nib ( n^ -> ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
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
@ -650,6 +710,20 @@
&do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2
&do1 NIP ;emit-digit JSR2 JMP2r
@emit-dec2-pad ( n* -> )
LIT2r 2018 ( preload #20 .Console/write into rst )
DUP2 #270f GTH2 ,&do5 JCN DEOkr
DUP2 #03e7 GTH2 ,&do4 JCN DEOkr
DUP2 #0063 GTH2 ,&do3 JCN DEOkr
DUP2 #0009 GTH2 ,&do2 JCN DEOkr
,&do1 JMP
&do5 #2710 ;mod-div2 JSR2 NIP ;emit-digit JSR2
&do4 #03e8 ;mod-div2 JSR2 NIP ;emit-digit JSR2
&do3 #0064 ;mod-div2 JSR2 NIP ;emit-digit JSR2
&do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2
&do1 NIP ;emit-digit JSR2
DEOr JMP2r
@messages [ &input-error "input 20 "error 00
&bytes 20 "bytes, 00
&save-ok "saved 00
@ -662,7 +736,28 @@
&data $100 ]
@term [ &cols 0050
&rows 0018 ]
&rows 0018
&lmargin 0006 ]
( COLORS )
( )
( SHORT STRING NAME )
( 3033 "30" black )
( 3133 "31" red )
( 3233 "32" green )
( 3333 "33" yellow )
( 3433 "34" blue )
( 3533 "35" magenta )
( 3633 "36" cyan )
( 3733 "37" white )
( 3030 "00" default )
( )
( digits are reversed )
( to emit from stack in )
( last-in-first-out order )
@config [ &tab-width 0004
&insert-tabs 01
&color 3333 ]
( relative cursor positions, e.g. 0 to cols-1 )
@cursor [ &col 0000 &row 0000 ]
@ -680,4 +775,4 @@
&offset :buffer/data
&line-count 0000
&line-offset 0000
&data $8000 ]
&data $f000 ]