/support/generic/lineedit.fth

\ ****************************************************************************
\ CamelForth for the Zilog Z80
\ Copyright (c) 1994,1995 Bradford J. Rodriguez
\ With contributions by Douglas Beattie Jr., 1998
\ Widely extended and reorganised by Garry Lancaster, 1999-2011
\ Z88, Sprinter, ZX Spectrum +3/+3e ports by Garry Lancaster, 1999-2011
\
\ This program is free software; you can redistribute it and/or modify
\ it under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 3 of the License, or
\ (at your option) any later version.
\
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU General Public License for more details.
\
\ You should have received a copy of the GNU General Public License
\ along with this program.  If not, see <http://www.gnu.org/licenses/>.
\ ****************************************************************************

CR .( Loading Line Editor...)
\ Fig-Forth style block editor with extra facilities

VARIABLE SCR

: LIST ( U -- )
   DUP SCR ! CR ." Block " DUP . BLOCK
   16 FOR  16 R@ - 
           CR . SPACE 64 2DUP TYPE +
      STEP  DROP ;

VOCABULARY EDITOR
ALSO EDITOR DEFINITIONS ALSO FORTH

64 CONSTANT C/L

VARIABLE CNT    \ length of the string in PAD
VARIABLE R#     \ cursor offset to screen

: TEXT ( CHARACTER -- )
  PAD C/L BLANK PARSE CNT ! PAD CNT @ CMOVE ;

: LINE ( UNSIGNED -- CDATA -> CHARACTER )
  DUP 15 > ABORT" INVALID LINE NUMBER"
  SCR @ BLOCK SWAP C/L * + ;

: -CMOVE ( CDATA -> CHARACTER UNSIGNED -- )
  LINE C/L CMOVE UPDATE ;

: #LOCATE ( -- UNSIGNED UNSIGNED )
  R# @ C/L /MOD ;

: #LEAD ( -- CDATA -> CHARACTER UNSIGNED )
  #LOCATE LINE SWAP ;

: #LAG ( -- CDATA -> CHARACTER UNSIGNED )
  #LEAD SWAP OVER + C/L ROT - ;

: DELETE ( UNSIGNED -- )
  #LEAD ROT MIN >R DROP
  #LAG + R@ -
  #LAG R@ NEGATE R# +! #LEAD + SWAP CMOVE
  R> BLANK UPDATE ;

: H ( UNSIGNED -- )
  LINE PAD C/L CMOVE ;

: E ( UNSIGNED -- )
  LINE C/L BLANK UPDATE ;

: S ( UNSIGNED -- )
  DUP 14 MIN 14 DO I LINE I 1+ -CMOVE -1 +LOOP E ;

: D ( UNSIGNED -- )
  DUP H 15 DUP ROT ?DO I 1+ LINE I -CMOVE LOOP E ;

: R ( UNSIGNED -- )
  PAD SWAP -CMOVE ;

: M ( INTEGER -- )
  CR R# +! #LOCATE 2 .R DROP SPACE
  #LEAD TYPE [CHAR] _ EMIT #LAG TYPE ;

: T ( UNSIGNED -- )
  DUP C/L * R# ! H 0 M ;

: L ( -- )
  SCR @ LIST 0 M ;

: B ( -- )
  CNT @ NEGATE M ;

: P ( UNSIGNED -- )
  0 TEXT R ;

: I ( UNSIGNED -- )
  DUP S R ;

: C ( -- )
  0 TEXT #LAG CNT @ MIN >R
  R@ R# +! DUP #LAG CMOVE>
  PAD SWAP R> CMOVE
  UPDATE 0 M ;

: TOP ( -- )
  0 R# ! ;

: CLEAR ( UNSIGNED -- )
  DUP BLOCK 1024 BLANK UPDATE SCR ! TOP ;

: WIPE
  SCR @ CLEAR L ;

: INIT ( U1 U2 -- )
  TUCK SWAP - 1+ FOR DUP CLEAR 1- STEP DROP ;

: COPY ( UNSIGNED 1ST -- )
  SWAP BLOCK SWAP BUFFER 1024 CMOVE UPDATE ;

: LIST ( UNSIGNED -- )
  TOP LIST ;

: 1LINE ( -- FLAG )
  #LAG PAD CNT @ SEARCH
  IF  NIP #LAG NIP SWAP - CNT @ + R# +! TRUE
  ELSE  2DROP #LAG R# +! DROP FALSE
  THEN ;

: FINDTEXT ( -- )
  BEGIN 1023 R# @ <
    IF TOP TRUE ABORT" NOT FOUND"
    THEN 1LINE
  UNTIL ;

: N ( -- )
  FINDTEXT 0 M ;

: F ( -- )
  0 TEXT N ;

: X ( -- )
  0 TEXT FINDTEXT CNT @ DELETE 0 M ;

: TILL ( -- )
  #LEAD + 0 TEXT 1LINE 0= ABORT" NOT FOUND"
  #LEAD + SWAP - ABS DELETE 0 M ;

: V
  #LOCATE NIP 3 + 15 MIN 5 - 0 MAX DUP 6 + SWAP
  DO  CR I 2 .R SPACE I LINE C/L TYPE  LOOP
  0 M ;

: ED ( UNSIGNED -- )
    DUP H PAD C/L NEGATE ACCEPT DROP R ;

: BINS ( B1 B2 U -- )
    >R BEGIN  DUP DUP R@ + COPY 1- 2DUP U>  UNTIL
    DROP DUP R> FOR  DUP CLEAR 1+  STEP  DROP SCR ! TOP ;

: BDEL ( B1 B2 U -- )
    >R OVER R@ + BEGIN  DUP DUP R@ - COPY 1+ 2DUP U<  UNTIL
    DROP R> FOR  DUP CLEAR 1-  STEP  DROP SCR ! TOP ;

: INDEX ( U1 U2 -- )
    OVER - 1+
    FOR CR DUP 6 .R SPACE DUP BLOCK C/L TYPE 1+ STEP DROP ;

FORTH DEFINITIONS PREVIOUS PREVIOUS