From e57df8c5445b7cb1a91f210e7fe3ed7fcc275153 Mon Sep 17 00:00:00 2001
From: d6 <d_m@plastic-idolatry.com>
Date: Sat, 28 Jan 2023 10:40:47 -0500
Subject: [PATCH] wip

---
 BUGS     |  4 ++-
 term.tal | 76 +++++++++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 70 insertions(+), 10 deletions(-)

diff --git a/BUGS b/BUGS
index ad3620c..bed1c04 100644
--- a/BUGS
+++ b/BUGS
@@ -4,5 +4,7 @@
 4. less 'G' has problems
 5. line editing after M-a has issues
 6. log more control codes
-7. shift text to right when inserting
+[x] shift text to right when inserting
 8. when running links (duckduckgo -> varvara), return stack underflow
+9. crash on backspace in femto
+10. M-backspace doesn't redraw properly
diff --git a/term.tal b/term.tal
index c58c41d..1301da8 100644
--- a/term.tal
+++ b/term.tal
@@ -11,6 +11,8 @@
 ( )
 ( set attributes:      ESC [ x ; ... m  ->  0:reset 1:bright 2:dim 7:reverse )
 ( get cursor position: ESC [ 6 n        ->  ESC [ $row ; $col R )
+( set insert:          ESC [ 4 h )
+( set replace (def):   ESC [ 4 l )
 ( enable line wrap:    ESC [ 7 h )
 ( disable line wrap:   ESC [ 7 l )
 ( )
@@ -34,7 +36,7 @@
 ( show cursor:     ESC [ ? 25 h )
 ( hide cursor:     ESC [ ? 25 l )
 ( insert lines:    ESC [ $n L )
-( ESC \) )
+( ESC lpar )
 ( ESC 7 )
 ( )
 ( set bracketed paste mode (xterm):         ESC [ ? 2004 h )
@@ -62,6 +64,10 @@
     @max-x   $2 ( cols-1 )
     @max-y   $2 ( rows-1 )
 
+    ( terminal settings )
+    @irm     $1 ( 01: insert and move right, 00: replace and overwrite )
+    @awm     $1 ( 01: wrap chars at margin, 00: overwrite at margin )
+
 |0100
     ( 80 cols x 24 rows )
     #0028 .rows STZ2
@@ -74,7 +80,7 @@
     ( set initial cursor )
     #0000 .cur-x STZ2
     #0000 .cur-y STZ2
-    
+
     ( confirm no buttons pressed yet )
     #00 .lastkey STZ
 
@@ -92,6 +98,10 @@
     #02 .attr STZ
     ;update-tint JSR2
 
+    ( set initial modes )
+    #01 .irm STZ ( insert and move right )
+    #01 .awm STZ ( wrap at margin )
+
     ( clear screen for initial draw )
     ;clear-screen JSR2
 
@@ -100,8 +110,9 @@
     ;on-key .Controller/vect DEO2 ( set up keyboard )
     ;on-read .Console/vect DEO2   ( set up stdin )
 
-    #99 #010e DEO
-     ( set up debug log )
+    #99
+    ( #010e DEO )
+    ( set up debug log )
     ;debug .File/name DEO2
     #01 .File/append DEO
 
@@ -244,7 +255,7 @@
     BRK
 
 @on-read-csi ( -> )
-    #010e DEO
+(    #010e DEO )
     .Console/r DEI
     DUP LIT "? EQU ;start-priv JCN2
     DUP LIT "; EQU ;next-arg JCN2
@@ -339,6 +350,7 @@
     DUP LIT "l EQU ;exec-reset-mode JCN2   ( disable line wrap )
     DUP LIT "m EQU ;exec-set-attr JCN2     ( set attr )
     DUP LIT "n EQU ;exec-status JCN2       ( get status )
+    DUP LIT "@ EQU ;exec-insert-blanks JCN2 ( insert blank characters )
     DUP LIT "A EQU ;exec-up JCN2           ( up )
     DUP LIT "B EQU ;exec-down JCN2         ( down )
     DUP LIT "C EQU ;exec-forward JCN2      ( forward )
@@ -356,9 +368,18 @@
 ( set mode )
 ( TODO: insert/replace, line wrap, etc. )
 @exec-set-mode ( c^ -> )
-    POP BRK
+    POP #0001 ;read-arg-1 JSR2
+          DUP2 #0004 NEQ2 ,&!irm JCN POP2 .irm ,&set JMP
+    &!irm DUP2 #0007 NEQ2 ,&!awm JCN POP2 .awm ,&set JMP
+    &!awm POP2 BRK
+    &set #01 SWP STZ BRK
+
 @exec-reset-mode ( c^ -> )
-    POP BRK
+    POP #0001 ;read-arg-1 JSR2
+          DUP2 #0004 NEQ2 ,&!irm JCN POP2 .irm ,&reset JMP
+    &!irm DUP2 #0007 NEQ2 ,&!awm JCN POP2 .awm ,&reset JMP
+    &!awm POP2 BRK
+    &reset #00 SWP STZ BRK
 
 @read-attr ( attr* -> )
         DUP2 #0000 NEQ2 ,&!0 JCN #02 .attr STZ ,&done JMP ( reset )
@@ -380,7 +401,7 @@
     INC2 INC2
     LTH2k ,&done JCN ,&loop JMP
     &done
-    POP2 POP2 BRK 
+    POP2 POP2 BRK
 
 @exec1 ( addr* -> )
     STH2 #0001 ;read-arg-1 JSR2 STH2r JSR2 BRK
@@ -401,6 +422,7 @@
 @exec-down POP ;down-n ;exec1 JMP2
 @exec-forward POP ;forward-n ;exec1 JMP2
 @exec-back POP ;back-n ;exec1 JMP2
+@exec-insert-blanks POP ;insert-n-spaces ;exec1 JMP2
 
 @exec-erase-line
     POP  #0000 ;read-arg-1 JSR2
@@ -494,7 +516,7 @@
     ;read JMP2
 
 @read ( c^ -> )
-    DUP #20 LTH ;read-ctrl JCN2    
+    DUP #20 LTH ;read-ctrl JCN2
     DUP #7f EQU ;read-del JCN2
     ;read-printable JMP2
 
@@ -584,6 +606,42 @@
 @down ( -> )
     #0001 ,down-n JMP
 
+@insert ( c^ -> )
+    .attr LDZ SWP ,insert-cell JMP
+
+@insert-cell ( cell* -> )
+    .irm LDZ #00 EQU ,&replace JCN ( cell* )
+    ;eol-addr JSR2 #0001 SUB2      ( cell* last=eol-1* )
+    ;cur-addr JSR2                 ( cell* last* cur* )
+    &loop                          ( cell* last* pos* )
+        LDA2k OVR2 INC2 STA2       ( cell* last* pos* ; pos+1<-pos )
+        INC2 LTH2k ,&loop JCN      ( cell* last pos+1* )
+    POP2 POP2                      ( cell* )
+    &replace                       ( cell* )
+        ;cur-addr JSR2 STA2 JMP2r  ( )
+
+@insert-n-spaces ( n* -> )
+    STH2                            ( [n*] )
+    .irm LDZ #00 EQU ,&replace JCN  ( [n*] )
+    ;eol-addr JSR2 #0001 SUB2       ( last* [n*] )
+    STH2kr DUP2 ADD2 SUB2           ( start=last-2n* [n*] )
+    ;cur-addr JSR2 SWP2             ( end* start* [n*] )
+    DUP2kr ADD2r                    ( end* start* [n* 2n*] )
+    &loop                           ( end* pos* [n* 2n*] )
+        LDA2k OVR2 STH2kr ADD2      ( end* pos* x* pos+2n* )
+        STA2 #0002 SUB2             ( end* pos-2* [n* 2n*] )
+        GTH2k #00 EQU ,&loop JCN    ( end* pos-2* [n* 2n*] )
+        POP2 POP2 POP2r             ( [n*] )
+    &replace                        ( [n*] )
+        LIT2r 0000 SWP2r SUB2r      ( [-n*] )
+        #4220 ;cur-addr JSR2        ( 4220 cur* [-n*] )
+    &loop2                          ( 4220 pos* [-i*] )
+        STA2k INC2 INC2 INC2r       ( 4220 pos+2* [-i+1*] )
+        ORAkr STHr ,&loop2 JCN      ( 4220 pos+2* [-i+1*] )
+    &done
+        POP2 POP2 POP2r             ( )
+        #01 .dirty? STZ JMP2r       ( )
+
 @scroll
     ;limit-addr JSR2 STH2
     ;cells .cols LDZ2 #0002 MUL2 ADD2 STH2