VE: add support for tight screens

blk/125

@@ -1,2 +1,2 @@
 -20 LOAD+ ( B105, block editor )
-1 6 LOADR+
+1 7 LOADR+

blk/126

@@ -1,16 +1,16 @@
 CREATE CMD 2 C, '$' C, 0 C,
-CREATE PREVPOS 0 , CREATE PREVBLK 0 ,
+CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
 : MIN ( n n - n ) 2DUP > IF SWAP THEN DROP ;
 : MAX ( n n - n ) 2DUP < IF SWAP THEN DROP ;
 : large? COLS 67 > ; : col- 67 COLS MIN -^ ;
-: acc@ ACC @ 1 MAX ;
+: width large? IF 64 ELSE COLS THEN ;
+: acc@ ACC @ 1 MAX ; : pos@ ( x y -- ) EDPOS @ 64 /MOD ;
 : num ACC @ SWAP _pdacc IF ACC ! ELSE DROP THEN ;
 : nspcs ( n -- , spit n space ) 0 DO SPC LOOP ;
 : aty 0 SWAP AT-XY ;
 : clrscr LINES 0 DO I aty COLS nspcs LOOP ;
 : gutter ( ln n ) OVER + SWAP DO 67 I AT-XY '|' EMIT LOOP ;
 : status 0 aty ." BLK" SPC BLK> ? SPC ACC ?
-    SPC EDPOS @ 64 /MOD . ',' EMIT . SPC
+    SPC pos@ . ',' EMIT . xoff @ IF '>' EMIT THEN SPC
-    BLKDTY @ IF '*' EMIT THEN 10 nspcs ;
+    BLKDTY @ IF '*' EMIT THEN 4 nspcs ;
 : nums 17 1 DO 2 I + aty I . SPC SPC LOOP ;
-: mode! ( c -- ) 4 col- 0 AT-XY ;

blk/127

@@ -1,16 +1,16 @@
-: contents 16 0 DO large? IF 3 ELSE 0 THEN I 3 + AT-XY
+: mode! ( c -- ) 4 col- 0 AT-XY ;
-    64 I * BLK( + DUP 3 col- + SWAP DO
+: contents
-        I C@ 0x20 MAX EMIT LOOP LOOP
+    16 0 DO
+        large? IF 3 ELSE 0 THEN I 3 + AT-XY
+        64 I * BLK( + ( lineaddr ) xoff @ + DUP width + SWAP
+        DO I C@ 0x20 MAX EMIT LOOP LOOP
     large? IF 3 16 gutter THEN ;
 : selblk BLK> @ PREVBLK ! BLK@ contents ;
 : pos! ( newpos -- ) EDPOS @ PREVPOS !
     DUP 0< IF DROP 0 THEN 1023 MIN EDPOS ! ;
-: setpos ( -- ) EDPOS @ 64 /MOD
+: xoff? pos@ DROP ( x )
-    3 + ( header ) SWAP large? IF 3 + ( gutter ) THEN
+    xoff @ ?DUP IF < IF 0 xoff ! contents THEN ELSE
-    SWAP AT-XY ;
+        width >= IF 64 COLS - xoff ! contents THEN THEN ;
+: setpos ( -- ) pos@ 3 + ( header ) SWAP ( y x ) xoff @ -
+    large? IF 3 + ( gutter ) THEN SWAP AT-XY ;
 : cmv ( n -- , char movement ) acc@ * EDPOS @ + pos! ;
-: buftype ( buf ln -- )
-    3 OVER AT-XY KEY DUP EMIT
-    DUP 0x20 < IF 2DROP DROP EXIT THEN
-    ( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c )
-    SWAP C!+ IN( _zbuf (rdln) IN( SWAP 63 MOVE ;

blk/128

@@ -1,14 +1,6 @@
-: $G ACC @ selblk ;
+: buftype ( buf ln -- )
-: $[ BLK> @ acc@ - selblk ;
+    3 OVER AT-XY KEY DUP EMIT
-: $] BLK> @ acc@ + selblk ;
+    DUP 0x20 < IF 2DROP DROP EXIT THEN
-: $t PREVBLK @ selblk ;   
+    ( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c )
-: $I mode! 'I' EMIT IBUF 1 buftype _i contents mode! SPC ;
+    SWAP C!+ IN( _zbuf (rdln) IN( SWAP 63 MOVE ;
-: $F mode! 'F' EMIT FBUF 2 buftype _F setpos mode! SPC ;
+
-: $Y Y ;
-: $E _E contents ;
-: $X acc@ _X contents ;
-: $h -1 cmv ; : $l 1 cmv ; : $k -64 cmv ; : $j 64 cmv ;
-: $H EDPOS @ 0x3c0 AND pos! ;
-: $L EDPOS @ 0x3f OR pos! ;
-: $g ACC @ 1 MAX 1- 64 * pos! ;
-: $@ BLK> @ BLK@* @ EXECUTE 0 BLKDTY ! contents ;

blk/129

@@ -1,12 +1,14 @@
-: $w EDPOS @ BLK( + acc@ 0 DO
+: $G ACC @ selblk ;
-    BEGIN C@+ WS? UNTIL BEGIN C@+ WS? NOT UNTIL LOOP
+: $[ BLK> @ acc@ - selblk ;
-    1- BLK( - pos! ;
+: $] BLK> @ acc@ + selblk ;
-: $W EDPOS @ BLK( + acc@ 0 DO
+: $t PREVBLK @ selblk ;   
-    1+ BEGIN C@+ WS? NOT UNTIL BEGIN C@+ WS? UNTIL LOOP
+: $I mode! 'I' EMIT IBUF 1 buftype _i contents mode! SPC ;
-    2- BLK( - pos! ;
+: $F mode! 'F' EMIT FBUF 2 buftype _F setpos mode! SPC ;
-: $b EDPOS @ BLK( + acc@ 0 DO
+: $Y Y ;
-    1- BEGIN C@- WS? NOT UNTIL BEGIN C@- WS? UNTIL LOOP
+: $E _E contents ;
-    2+ BLK( - pos! ;
+: $X acc@ _X contents ;
-: $B EDPOS @ BLK( + acc@ 0 DO
+: $h -1 cmv ; : $l 1 cmv ; : $k -64 cmv ; : $j 64 cmv ;
-    BEGIN C@- WS? UNTIL BEGIN C@- WS? NOT UNTIL LOOP
+: $H EDPOS @ 0x3c0 AND pos! ;
-    1+ BLK( - pos! ;
+: $L EDPOS @ 0x3f OR pos! ;
+: $g ACC @ 1 MAX 1- 64 * pos! ;
+: $@ BLK> @ BLK@* @ EXECUTE 0 BLKDTY ! contents ;

blk/130

@@ -1,15 +1,12 @@
-: $f EDPOS @ PREVPOS @ 2DUP = IF 2DROP EXIT THEN
+: $w EDPOS @ BLK( + acc@ 0 DO
-    2DUP > IF DUP pos! SWAP THEN
+    BEGIN C@+ WS? UNTIL BEGIN C@+ WS? NOT UNTIL LOOP
-    ( p1 p2, p1 < p2 ) OVER - 64 MIN ( pos len ) FBUF _zbuf
+    1- BLK( - pos! ;
-    SWAP _cpos FBUF ( len src dst ) ROT MOVE ;
+: $W EDPOS @ BLK( + acc@ 0 DO
-: $R ( replace mode )
+    1+ BEGIN C@+ WS? NOT UNTIL BEGIN C@+ WS? UNTIL LOOP
-    mode! 'R' EMIT
+    2- BLK( - pos! ;
-    BEGIN setpos KEY DUP BS? IF -1 EDPOS +! DROP 0 THEN
+: $b EDPOS @ BLK( + acc@ 0 DO
-        DUP 0x20 >= IF
+    1- BEGIN C@- WS? NOT UNTIL BEGIN C@- WS? UNTIL LOOP
-        DUP EMIT EDPOS @ _cpos C! 1 EDPOS +! BLK!! 0
+    2+ BLK( - pos! ;
-    THEN UNTIL mode! SPC contents ;
+: $B EDPOS @ BLK( + acc@ 0 DO
-: $O _U EDPOS @ 0x3c0 AND DUP pos! _cpos _zbuf BLK!! contents ;
+    BEGIN C@- WS? UNTIL BEGIN C@- WS? NOT UNTIL LOOP
-: $o EDPOS @ 0x3c0 < IF EDPOS @ 64 + EDPOS ! $O THEN ;
+    1+ BLK( - pos! ;
-: $D $H 64 icpy
-    acc@ 0 DO 16 EDPOS @ 64 / DO I _mvln- LOOP LOOP
-    BLK!! contents ;

blk/131

@@ -1,15 +1,15 @@
-: UPPER DUP 'a' 'z' =><= IF 32 - THEN ;
+: $f EDPOS @ PREVPOS @ 2DUP = IF 2DROP EXIT THEN
-: handle ( c -- f )
+    2DUP > IF DUP pos! SWAP THEN
-    DUP '0' '9' =><= IF num 0 EXIT THEN
+    ( p1 p2, p1 < p2 ) OVER - 64 MIN ( pos len ) FBUF _zbuf
-    DUP CMD 2+ C! CMD FIND IF EXECUTE ELSE DROP THEN
+    SWAP _cpos FBUF ( len src dst ) ROT MOVE ;
-    0 ACC ! UPPER 'Q' = ;
+: $R ( replace mode )
-: bufp ( buf -- )
+    mode! 'R' EMIT
-    DUP 3 col- + SWAP DO I C@ 0x20 MAX EMIT LOOP ;
+    BEGIN setpos KEY DUP BS? IF -1 EDPOS +! DROP 0 THEN
-: bufs
+        DUP 0x20 >= IF
-    1 aty ." I: " IBUF bufp
+        DUP EMIT EDPOS @ _cpos C! 1 EDPOS +! BLK!! 0
-    2 aty ." F: " FBUF bufp
+    THEN UNTIL mode! SPC contents ;
-    large? IF 0 3 gutter THEN ;
+: $O _U EDPOS @ 0x3c0 AND DUP pos! _cpos _zbuf BLK!! contents ;
-: VE
+: $o EDPOS @ 0x3c0 < IF EDPOS @ 64 + EDPOS ! $O THEN ;
-    clrscr 0 ACC ! 0 PREVPOS ! nums contents
+: $D $H 64 icpy
-    BEGIN status bufs setpos KEY handle UNTIL
+    acc@ 0 DO 16 EDPOS @ 64 / DO I _mvln- LOOP LOOP
-    19 aty (infl) ;
+    BLK!! contents ;

blk/132

@@ -0,0 +1,15 @@
+: UPPER DUP 'a' 'z' =><= IF 32 - THEN ;
+: handle ( c -- f )
+    DUP '0' '9' =><= IF num 0 EXIT THEN
+    DUP CMD 2+ C! CMD FIND IF EXECUTE ELSE DROP THEN
+    0 ACC ! UPPER 'Q' = ;
+: bufp ( buf -- )
+    DUP 3 col- + SWAP DO I C@ 0x20 MAX EMIT LOOP ;
+: bufs
+    1 aty ." I: " IBUF bufp
+    2 aty ." F: " FBUF bufp
+    large? IF 0 3 gutter THEN ;
+: VE
+    clrscr 0 ACC ! 0 PREVPOS ! nums contents
+    BEGIN xoff? status bufs setpos KEY handle UNTIL
+    19 aty (infl) ;

doc/ed.txt

@@ -80,8 +80,7 @@ E: Run X with n = length of FBUF.
 # Visual editor
 
 This editor, unlike the Block Editor, is grid-based instead of
-being command-based. It requires the AT-XY, COLS and LINES words
+being command-based. It requires the Grid subsystem (B401).
-to be implemented.
 
 It is loaded with "125 LOAD" and invoked with "VE". Note that
 this also fully loads the Block Editor.
@@ -141,3 +140,23 @@ cursor. Press return to return to normal mode.
 
 '@' re-reads current block even if it's dirty, thus undoing     
 recent changes.
+
+# Tight screens
+
+Blocks being 64 characters wide, using the Visual editor on a
+screen that is not 64 characters wide is a bit less convenient,
+but very possible.
+
+When VE is in a "tight screen" situation, it behaves different-
+ly: no gutter, no line number. It displays as much of the "left"
+part of the block as it can, but truncate every line.
+
+The right part is still accessible, however. If the cursor moves
+to a part of the block that is invisible, VE will "slide" right
+so that the cursor is shown. It will indicate it "slid" mode by
+adding a ">" next to the cursor address in the status bar.
+
+To slide back left, simply move the cursor to the invisible part
+of the left half of the block.
+
+Other than that, VE works the same.