; AEDIT.IPL  4/7/08
; Full-Screen Array Editor for HP-IPL/OS
; Requires extra.ipl, dms.ipl, double.ipl, (hp)screen.ipl
; File editing requires xdos.ipl
; AEDIT MUST BE RUN IN OCTAL MODE (OR STRING ERROR)
;
; Enter moves cursor to next line (or page) column 1.
; Backspace moves cursor to the left and deletes that character.
; All commands given by control keys, listed on the 24th screen line.
; Cursor - Ctrl-Z down, Ctrl-A left, Ctrl-S right, Ctrl-W up
; Pages - Ctrl-C previous page, Ctrl-V next page, Ctrl-P goto page
; Ctrl-I inserts an empty line, Ctrl-D deletes line
; CTRL-F DELETES ENTIRE PAGE AFTER CONFIRM (NOT ON HINT LINE)
; Ctrl-T toggles insert mode (default overwrite mode)
; Ctrl-N selects HP graphics characters
; Ctrl-O selects regular text characters
; Ctrl-Q saves current page and quits.
;
; THIS IS AN AEDIT VERSION FOR ON-LINE WORK
; EXTRA COMMENTS REMOVED, CHANGES IN UPPERCASE
;
;==========================================================================
OCTAL
"Full-screen Array Editor 4/6/08" $PRINT CRLF
"Loading FED and variables..." $PRINT CRLF
; FED chains to the main file editor word.
; To run and forget from DMENU, name this IPL "$ FED"
DEFINE FED
"FEDIT" $DEFADR DUP IFNZ EXECUTE ELSE DROP ENDIF
END
;----------------------------------------------------------
VARIABLE CPAG ;current alt mem "page" being edited
;each page is 1840 decimal bytes (1630 octal 16 bit words)
;42 octal pages per file, numbered 0-41 octal
VARIABLE MPAG ;max page ever edited, 0-41 octal
;byte size to save = (MPAG+1)*3460 octal
;upon file load MPAGE = bytes/3460 - 1
VARIABLE CLIN  ;current screen line 1-23 decimal (27 octal)
VARIABLE CCOL  ;current screen column 1-78 decimal (116 octal)
VARIABLE GCHR  ;set if graphics character
VARIABLE INSM  ;set if insert mode
VARIABLE AMTW  ;alt mem temp word
;----------------------------------------------------------
"Creating PDGC..." $PRINT CRLF
CREATE PDGC
* print double graphics char    MOD 4/1/08 TO ALLOW SEPARATION
* double-char word on stack
       JSB ZSPOP,I      get double-word
       STA WTMP         save to reuse
       JSB PRMSB        PRINT MSB
       LDA WTMP         GET WORD AGAIN
       JSB PRLSB        PRINT LSB
       JMP ZNXT,I       EXIT WORD
PRMSB  NOP              SUB - PRINT MSB OF A
       CLB
       ASR 10           put 1st char in A
       STA WTMP2        save it
       AND B7           mask off just bit 7
       SZA              skip if bit 7 clear
       JMP PDGC1        jump if bit 7 set
       LDA WTMP2        get byte
       JSB ZOUT,I       print it
       JMP PRMSB,I      EXIT SUB
PDGC1  LDA SG
       JSB ZOUT,I       select graphic char set
       LDA WTMP2        get byte
       AND B177         clear bit 7
       JSB ZOUT,I       print it
       LDA ST
       JSB ZOUT,I       select normal text
       JMP PRMSB,I      EXIT SUB
PRLSB  NOP              SUB - PRINT LSB OF A
       AND B377         mask off high word
       STA WTMP2        save it
       AND B7           mask off just bit 7
       SZA              skip if bit 7 clear
       JMP PDGC3        jump if bit 7 set
       LDA WTMP2        get byte
       JSB ZOUT,I       print it
       JMP PRLSB,I      EXIT SUB
PDGC3  LDA SG
       JSB ZOUT,I       select graphic char set
       LDA WTMP2        get byte
       AND B177         clear bit 7
       JSB ZOUT,I       print it
       LDA ST
       JSB ZOUT,I       select normal text
       JMP PRLSB,I      EXIT SUB
WTMP   OCT 0
WTMP2  OCT 0
B177   OCT 177
B377   OCT 377
B7     OCT 200
SG     OCT 16
ST     OCT 17
END
;----------------------------------------------------------
"CREATING PSGC" $PRINT CRLF
CREATE PSGC /K   ;4/1/08
* PRINT SINGLE GRAPHICS CHARACTER FROM BUFFER
* ENTRY ROW COL BUFFADR (TOP) ON STACK
       JSB ZSPOP,I      GET BUFFADR
       STA BFADR        SAVE IT
       JSB ZSPOP,I      GET COLUMN
       STA WTMP         SAVE FOR NOW
       AND B001         KEEP JUST BIT 1
       STA MFLG         FLAG TO DET. WHICH WORD
       LDA WTMP         GET COL
       ADA CM1          DEC A
       ARS              DIVIDE COL BY 2
       STA WTMP         SAVE TEMP
       JSB ZSPOP,I      GET ROW
       ADA CM1          DEC A
       MPY              MULTIPLY
       DEF LNMPY        BY 50 OCTAL
       ADA WTMP         ADD IN COLUMN/2 OFFSET
       ADA BFADR        ADD IN BUFFER ADR
       STA BFADR        SAVE WORD ADDRESS
       LDA BFADR,I      GET WORD CONTAINING CHAR TO PRINT
       LDB MFLG         IF 1 THEN PRINT MSB, OTHERWISE LSB
       SZB              SKIP IF B=0
       JMP CPMSB        JUMP TO CALL PRMSB
       JSB PRLSB        PRINT LSB
       JMP ZNXT,I       EXIT WORD
CPMSB  JSB PRMSB        PRINT MSB
       JMP ZNXT,I       EXIT WORD
LNMPY  OCT 50           LENGTH OF ONE LINE IN MEM
CM1    DEC -1           TO DECREMENT
B001   OCT 1            MASK COL TO MFLG
MFLG   OCT 0            0=DO LSB  1=DO MSB
BFADR  OCT 0            WHERE THE BUFFER IS
END
;----------------------------------------------------------
"CREATING LNLEN" $PRINT CRLF
CREATE LNLEN  ;2/18/08
* ENTRY: MEMADR ON STACK
* EXIT:  LENGTH OF TEXT LINE ON STACK
       JSB ZSPOP,I      GET MEMADR
       ADA C38          ADD 38 DEC (LAST WORD)
       LDB C39          GET 39 DEC (MAX LEN)
       STB LNLEN        SAVE IN LNLEN TO RETURN
LOOP   LDB 0,I          GET WORD POINTED TO BY A
       CPB SPACES       DOUBLE SPACES?
       JMP DECPTR       YES - DECREMENT LEN AND PTR
       JMP RETVAL       NO - RETURN VALUE
DECPTR ADA CM1          SUBTRACT 1 FROM POINTER
       LDB LNLEN        GET LINE LENGTH
       ADB CM1          SUBTRACT 1 FROM LENGTH
       STB LNLEN        SAVE BACK
       SZB              SKIP IF 0 (DONE)
       JMP LOOP
RETVAL LDA LNLEN        GET LEN
       JSB ZSPSH,I      PUSH TO STACK
       JMP ZNXT,I       EXIT WORD
LNLEN  OCT 0            LINE LEN
C38    DEC 38
C39    DEC 39
CM1    DEC -1
SPACES OCT 20040
END
;----------------------------------------------------------
"Loading sub-words..." $PRINT CRLF
DEFINE MVWA
;IPL alt-mem word mover.. uses block 0 as buffer
;usage: source destination size MVWA (size must not be 0)
;cheating, uses locs 170-174 for temps
170 SWAP PUT ;size in loc 170
171 SWAP PUT ;destination in loc 171
172 SWAP PUT ;source in loc 172
173 170 GET 2000 DIV PUT ;number of 1KW blocks in loc 173
174 170 GET 173 GET 2000 MUL SUB PUT ;remaining words in loc 174
172 GET 171 GET SUB IF<0 ;if source < destination
 ;have to copy backwards to avoid overwriting
 172 GET 173 GET 2000 MUL ADD ;push source, start of remainder
 @BLK GET ;push destination, block 0
 174 GET  ;push size of transfer - remaining words
 A>CCOPY  ;copy from alt to block 0
 @BLK GET ;push source, block 0
 171 GET 173 GET 2000 MUL ADD ;push destination
 174 GET C>ACOPY ;copy remainder back to alt, shifted up
 173 GET IFNZ ;if at least 1 1KW block
  -1 >STEP 173 GET #1 +DO ;loop through 1KW block(s) backwards
   INDEX DEC 2000 MUL 172 GET ADD ;push alt source
   @BLK GET 2000 A>CCOPY ;copy 1KW from alt to buffer
   @BLK GET INDEX DEC 2000 MUL 171 GET ADD 2000 C>ACOPY ;and back to alt
  +LOOP
 ENDIF
ELSE
 ;copy steps forwards (but back in memory so doesn't overwrite)
 173 GET IFNZ ;if at least 1 1KW block
  #1 173 GET +DO
   INDEX DEC 2000 MUL 172 GET ADD ;push alt source
   @BLK GET 2000 A>CCOPY ;copy 1KW from alt to buffer
   @BLK GET INDEX DEC 2000 MUL 171 GET ADD 2000 C>ACOPY ;and back to alt
  +LOOP
 ENDIF
 ;copy remaining words...
 172 GET 173 GET 2000 MUL ADD @BLK GET 174 GET A>CCOPY
 @BLK GET 171 GET 173 GET 2000 MUL ADD 174 GET C>ACOPY
ENDIF
END
;----------------------------------------------------------
DEFINE DISL ;display status line
30 #1 POS
"CTRL:ZAWS moves VCP next/prev/pg ID lines T=" $PRINT
INSM GET IFNZ "ins" ELSE "ovr" ENDIF $PRINT " NO " $PRINT
GCHR GET IFNZ "Gr/txt" ELSE "gr/Txt" ENDIF $PRINT
" Q quit Page=" $PRINT
CPAG GET $STR $TAIL $TAIL $DROP PCHR PCHR " of " $PRINT
MPAG GET $STR $TAIL $TAIL $DROP PCHR PCHR
END
;----------------------------------------------------------
DEFINE DIBUF    ;display buffer  2/18/08
CLS
#0 26 +DO ;LINES 0-22
 @BLK GET INDEX 50 MUL ADD ;CALC OFFSET OF LINE
 DUP LNLEN DUP IFZ DROP DROP CRLF ELSE ;IF LEN IS NON-ZERO
  DEC #0 SWAP +DO DUP INDEX ADD GET PDGC +LOOP ;PRINT TEXT
  CRLF DROP
 ENDIF
+LOOP
DISL ;display status line
END
;----------------------------------------------------------
DEFINE GPAGE    ;get page from alt mem
;entry - CPAG
;exit - alt mem copied to block 0 and screen
;if invalid page, make CPAG=0
CPAG GET 42 SUB IF<0 ELSE CPAG #0 PUT ENDIF
CPAG GET ;get current page
1630 MUL ;multiply by page size
2 ADD    ;add offset
@BLK GET 1630 A>CCOPY ;copy to buffer, block #0
;if page isn't in array format, overwrite with spaces and crlf's
; format each line separately...
#0 26 +DO ;loop thru lines
 INDEX 50 MUL @BLK GET ADD ;calc start of line
 DUP 47 ADD GET 6412 SUB IFZ ;if crlf there
  DROP ;do nothing
 ELSE ;format line...
  DUP 47 ADD 6412 PUT ;add crlf
  DUP 46 ADD +DO INDEX 20040 PUT +LOOP ;overwrite line with spaces
 ENDIF
+LOOP
DIBUF ; display buffer
END
;----------------------------------------------------------
DEFINE PPAGE    ;put page into alt mem
;entry - CPAG MPAG
;exit - buffer copied to alt mem, MPAG=max CPAG
;if invalid page, make CPAG=0
CPAG GET 42 SUB IF<0 ELSE CPAG #0 PUT ENDIF
@BLK GET ;start of buffer
CPAG GET ;get current page
1630 MUL ;multiply by page size
2 ADD    ;add offset
1630 C>ACOPY ;copy page to alt memory
;if CPAG > MPAG make MPAG = CPAG
MPAG GET CPAG GET SUB IF<0 MPAG CPAG GET PUT ENDIF
END
;----------------------------------------------------------
DEFINE PBYTE ;put byte into buffer
;entry CLIN CCOL, byte on stack
;exit - writes character to proper byte in buffer
S>Z ;save byte to Z
;calculate offset...
CLIN GET DEC 50 MUL ;50 oct words per line
CCOL GET DEC 2 DIV ADD ;2 bytes per word
@BLK GET ADD ;add to block address
DUP GET ;get word from buffer, leave address on stack
CCOL GET #1 AND IFNZ ;if high byte
 377 AND ;zero high byte
 Z>S 400 MUL ;shift byte high
 OR PUT ;merge with word and store
ELSE
 177400 AND ;zero low byte
 Z>S OR PUT ;merge with word and store
ENDIF
END
;----------------------------------------------------------
DEFINE GBYTE ;get byte from buffer
;entry - CCOL CLIN
;exit - byte from buffer on stack
;calculate offset...
CLIN GET DEC 50 MUL ;50 oct words per line
CCOL GET DEC 2 DIV ADD ;2 bytes per word
@BLK GET ADD ;add to block address
GET ;get word from buffer
CCOL GET #1 AND IFNZ 400 DIV ;if high byte /256
ELSE 377 AND ENDIF ;if low byte zero high byte
END
;----------------------------------------------------------
DEFINE UDCHR ;update character   MOD 4/2/08
;for restoring text after pressing control keys
CLIN GET CCOL GET OVER OVER POS
@BLK GET PSGC ;PRINT SINGLE GRAPHICS CHAR
END
;----------------------------------------------------------
DEFINE UDLIN ;update line
CLIN GET CCOL GET DEC #1 OR POS ;position cursor to word start
CLIN GET DEC 50 MUL @BLK GET ADD ;push start of line
DUP CCOL GET DEC 2 DIV ADD ;push word with current column
SWAP 46 ADD ;push last word in line, drop start
+DO INDEX GET PDGC +LOOP ;print updated line
END
;----------------------------------------------------------
DEFINE AEBS  ;backspace code
DROP ;keystroke
CCOL GET #1 SUB IFNZ ;if not column 1
 CCOL GET DEC ;push column and decrement
 DUP DEC IF<0 DROP ;ignore if column < 1
 ELSE CCOL SWAP PUT ENDIF
 40 PBYTE ;erase char from buffer
 INSM GET IFZ ;if not insert mode
  UDCHR ;update screen
 ELSE
  CCOL GET DUP S>Z ;save current column
  INC ;start column, the one just moved from
  116 +DO ;to last column
   CCOL INDEX PUT GBYTE ;get byte
   CCOL INDEX DEC PUT PBYTE ;put in prev column
  +LOOP
  CCOL 116 PUT 40 PBYTE ;put space in last column
  CCOL Z>S PUT ;restore current column
  UDLIN ;update line
 ENDIF
ENDIF
END
;----------------------------------------------------------
DEFINE STMPAG
MPAG #0 PUT ;start at 1st page
DO ;scan for crlf's
 MPAG GET 42 SUB IFZ ;if past max page
  #1 ;terminate scan
 ELSE
  MPAG GET 1630 MUL 51 ADD  ;point to last word of 1st line in page
  AMTW #1 A>CCOPY AMTW GET 6412 SUB IFNZ ;if not a crlf
   #1 ;terminate scan
  ELSE
   MPAG DUP GET INC PUT ;inc MPAG
   #0 ;keep scanning
  ENDIF
 ENDIF
UNTIL ;terminated
MPAG GET IFNZ ;if non-zero
 MPAG MPAG GET DEC PUT ;decrement for proper count
ENDIF
END
;----------------------------------------------------------
DEFINE TRCAM
;TRUNCATE ALT MEM TO PREVENT FILE GROWTH  2/22/08 MOD 4/6/08
30 DUP #1 POS 116 40 $CREATE $PRINT ;CLEAR STATUS LINE
#1 POS "Scanning... " $PRINT        ;AND PRINT MESSAGE
STMPAG ;SCAN AND SET MPAG
@BLK GET DUP 117 ADD +DO INDEX #0 PUT +LOOP ;ZERO 2 LINES OF BLOCK 0
MPAG GET 1630 MUL 1632 ADD ;POINT TO BEGINNING OF FIRST UNDEFINED LINE
DO ;LOOP UNTIL DONE
 DUP 2 SUB IFZ #1 ELSE ;IF NO MORE TO DO EXIT OTHERWISE
  50 SUB ;PREVIOUS LINE
  DUP @BLK GET 50 A>CCOPY ;COPY LINE TO BUFFER
  @BLK GET 47 ADD GET 6412 SUB IFZ ;IF A FORMATTED LINE
   @BLK GET GET IFNZ ;AND DOESN'T BEGIN WITH 0
    @BLK GET LNLEN ;CALC LENGTH OF LINE
  ELSE #0 ENDIF ELSE #0 ENDIF ;NOT FORMATTED, LENGTH 0
  IFNZ #1 ELSE ;IF NOT EMPTY EXIT OTHERWISE
   @BLK GET 50 ADD OVER 50 C>ACOPY ;COPY ZEROES TO ALTMEM LINE
   #0 ;KEEP GOING
  ENDIF
 ENDIF
UNTIL ;DONE
DROP STMPAG ;DROP PTR AND RESCAN/SET MPAG
"MPAG=" $PRINT MPAG GET $STR $TAIL $TAIL $DROP PCHR PCHR
" (" $PRINT MPAG GET INC 11 MUL 1750 ADD DECIMAL $STR OCTAL
$TAIL $TAIL $TAIL $DROP DUP 60 SUB IFZ DROP ELSE PCHR ENDIF
PCHR 56 PCHR PCHR "KW) " $PRINT
END
;----------------------------------------------------------
"Loading AEDIT..." $PRINT CRLF
DEFINE AEDIT
; alt memory editor...
; upon entry scans alt mem to determine file "size"
; and sets MPAG to last page with crlf in word offset 47
; (up to MPAG=41 octal)
; CPAG left to whatever it was but reset to 0 if > MPAG
; GPAGE used to load/display page CPAG
; prints helpful keystrokes
; CLIN CCOL set to 1,1, GCHR set to 0, let the editing begin
STMPAG ;scan and set MPAG
;make sure CPAG points to valid page
MPAG GET CPAG GET SUB IF<0 CPAG #0 PUT ENDIF
GCHR #0 PUT 17 PCHR ;make sure in text mode
INSM #0 PUT ;start in (much faster) overwrite mode
GPAGE ;load page into buffer and display
CLIN #1 PUT CCOL #1 PUT GCHR #0 PUT
DO ;main edit loop...
 #0  ;exit flag, make 1 to terminate
 CLIN GET CCOL GET POS ;position cursor
 GCHR GET IFNZ 16 PCHR ENDIF ;output ctrl-N if graphics mode
 CHRIN DUP CASE ;select on keystroke...

 = 32 ; ctrl-Z down
  DROP ;keystroke
  UDCHR ;update char
  CLIN GET INC ;push line and increment
  DUP 30 SUB IF<0 CLIN SWAP PUT ;update if line < 30
  ELSE DROP ENDIF ;otherwise ignore

 = 1  ; ctrl-A left
  DROP ;keystroke
  UDCHR ;update char
  CCOL GET DEC ;push column and decrement
  DUP DEC IF<0 DROP ;ignore if column < 1
  ELSE CCOL SWAP PUT ENDIF ;otherwise update

 = 23 ; ctrl-S right
  DROP ;keystroke
  UDCHR ;update char
  CCOL GET INC ;push column and increment
  DUP 117 SUB IF<0 CCOL SWAP PUT ;update if column < 117
  ELSE DROP ENDIF ;otherwise ignore

 = 27 ; ctrl-W up
  DROP ;keystroke
  UDCHR ;update char
  CLIN GET DEC ;push line and decrement
  DUP DEC IF<0 DROP ;ignore if line < 1
  ELSE CLIN SWAP PUT ENDIF

 = 15 ; enter
  DROP ;keystroke
  CLIN GET INC ;push line and increment
  DUP 30 SUB IF<0 ;if line < 30
   CLIN SWAP PUT ;update
  ELSE
   DROP ;discard line increment
   CLIN #1 PUT ;line 1
   CPAG GET INC ;push/inc page
   DUP 42 SUB IF<0 ;if valid page
    PPAGE ;save previous page
    CPAG SWAP PUT ;update current page
    GPAGE ;load and display new page
   ELSE  ;already last page
    DROP ;discard increment
   ENDIF
  ENDIF
  CCOL #1 PUT

 = 12 ; linefeed - ignore
  DROP ;keystroke

 = 10 ; backspace
  AEBS
 = 177 ; backspace
  AEBS

 = 11 ; ctrl-I insert line
  DROP ;keystroke
  UDCHR ;update char
  PPAGE ;save page to altmem
  CPAG GET 1630 MUL ;calc page offset
  CLIN GET DEC 50 MUL ADD ;add in line offset
  2 ADD ;add in alt mem address
  DUP ;save address to clear line
  DUP 50 ADD ;destination 50 words higher
  75062 OVER SUB ;number of words to move
  ;75062 calc'd as 42 pages of 1630 words each + offset 2,
  ;or last address + 1 that can be occupied by a file
  MVWA ;move words in alt mem
  AMTW 20040 PUT ;spaces in alt mem temp word
  ;a.m. address of line on stack, clear line..
  DUP 46 ADD +DO AMTW INDEX #1 C>ACOPY +LOOP
  STMPAG ;scan and reset MPAG
  GPAGE ;get and display page

 = 4  ; ctrl-D delete line
  DROP ;keystroke
  UDCHR ;update char
  PPAGE ;save page to altmem
  CPAG GET 1630 MUL ;calc page offset
  CLIN GET 50 MUL ADD ;add in line offset (of next line)
  2 ADD ;add in alt mem address
  DUP 50 SUB ;destination 50 words less
  75062 OVER SUB ;number of words to move
  MVWA ;move words in alt mem
  ;zero last line moved.. inefficient use of numbers
  ;to permit later encoding lesser move sizes based on MPAG
  ;for now doing all
  AMTW #0 PUT 75062 50 SUB DUP 47 ADD
  +DO AMTW INDEX #1 C>ACOPY +LOOP
  STMPAG ;scan and reset MPAG
  GPAGE ;get and display page

 = 24 ; ctrl-T toggle insert mode
  DROP ;keystroke
  UDCHR ;update char
  ;flip insert mode...
  INSM GET IFNZ INSM #0 PUT ELSE INSM #1 PUT ENDIF
  DISL ;redisplay status line

 = 16 ; ctrl-N graphics
  DROP ;keystroke
  UDCHR ;update char
  GCHR #1 PUT ;signal graphics
  DISL ;redisplay status line

 = 17 ; ctrl-O text
  DROP ;keystroke
  UDCHR ;update char
  GCHR #0 PUT ;signal text
  DISL ;redisplay status line

 = 3  ; ctrl-C previous page
  DROP ;keystroke
  CPAG GET DEC ;get/decrement page
  DUP IF<0 ;if already page 0
   DROP ;ignore
  ELSE
   PPAGE ;save previous page
   CPAG SWAP PUT ;update page
   GPAGE ;load and display new page
   CLIN #1 PUT CCOL #1 PUT ;reset cursor
  ENDIF

 = 26 ; ctrl-V next page
  DROP ;keystroke
  CPAG GET INC ;push/inc page
  DUP 42 SUB IF<0 ;if valid page
   PPAGE ;save previous page
   CPAG SWAP PUT ;update current page
   GPAGE ;load and display new page
   CLIN #1 PUT CCOL #1 PUT ;reset cursor
  ELSE
   DROP ;discard page, don't increment
  ENDIF

 = 20 ; ctrl-P goto page
  DROP ;keystroke
  PPAGE ;save current page
  30 #1 POS "               " $PRINT ;erase part of status line
  30 #1 POS "Goto page: " $PRINT $IN ;prompt for new page
  $TRIM $LEN IFZ $DROP ELSE ;if page entered
   CLS ;clear immediately to help hide scroll from enter
   $VAL DUP IF<0 DROP ELSE ;don't fool with negative page
    MPAG GET OVER SUB IF<0 DROP ELSE ;or pages past MPAG
     CPAG SWAP PUT ;update current page
    ENDIF
   ENDIF
  ENDIF
  GPAGE ;load and display new page
  CLIN #1 PUT CCOL #1 PUT ;reset cursor

 = 6  ; CTRL-F DELETE PAGE   (1/10/08)
  UDCHR ;4/5/08
  DROP 30 #1 POS "DELETE PAGE?   " $PRINT 30 16 POS CHRIN
  131 SUB IFZ
   CPAG GET 1630 MUL 2 ADD ;PUSH CURRENT PAGE OFFSET
   CPAG GET MPAG GET SUB IFZ ;IF ALREADY LAST PAGE
    @BLK GET DUP 1627 ADD +DO INDEX #0 PUT +LOOP ;ZERO BUFFER
    @BLK GET SWAP 1630 C>ACOPY ;OVERWRITE PAGE WITH ZEROS
    CPAG GET IFNZ CPAG CPAG GET DEC PUT MPAG CPAG GET PUT ENDIF
   ELSE ;COPY NEXT PAGE TO END OVER PAGE AND ZERO LAST VACATED PAGE
    DUP 1630 ADD ;PUSH ADDRESS OF NEXT PAGE
    SWAP ;TO PUT DESTINATION ON TOP
    75062 OVER SUB MVWA  ;MOVE THE WORDS
    @BLK GET DUP 1627 ADD +DO INDEX #0 PUT +LOOP ;ZERO BUFFER
    @BLK GET MPAG GET 1630 MUL 2 ADD 1630 C>ACOPY ;ZERO LAST BLOCK
    STMPAG ;RESET MPAG
   ENDIF
   GPAGE ;RELOAD CURRENT PAGE
  ELSE  ;NOT CONFIRMED
   DISL ;REDISPLAY STAT LINE
  ENDIF

 = 21 ; ctrl-Q quit
  DROP ;keystroke
  PPAGE ;put page in alt
  TRCAM ;TRUNCATE ALT MEM (2/22/08)
  DROP #1 ;exit

 < 40 ; anything else less than space
  DROP ;keystroke
  UDCHR ;update char

 DEFAULT ;character to store
  INSM GET IFNZ ;if insert mode
   CCOL GET 116 SUB IF<0 ;if < last column (77 dec or below)
    CCOL GET S>Z ;save current column
    115 CCOL GET -1 >STEP +DO ;loop backwards from lastcol-1 to current
     CCOL INDEX PUT GBYTE     ;get char
     CCOL INDEX INC PUT PBYTE ;put in next col
     ;16 bit storage makes this a difficult task, every byte must swap
    +LOOP
    CCOL Z>S PUT ;restore current column
   ENDIF
  ENDIF
  GCHR GET IFNZ 200 OR ENDIF ;set bit 7 if in graphics mode
  PBYTE ;put byte in buffer
  CCOL GET INC ;push column and increment
  DUP 117 SUB IF<0 CCOL SWAP PUT ;update if column < 117
  ELSE DROP ENDIF ;otherwise ignore
  INSM GET IFNZ ;if insert mode
   UDLIN ;update line
  ENDIF
 ENDCASE
UNTIL
30 #1 POS ;position cursor at end of screen
END
;==========================================================================
;the following words require XDOS
"Loading XDOS-based LDFILE SVFILE FEDIT..." $PRINT CRLF
DEFINE LDFILE  ;load file from disk into altmem  MOD 4/5/08
;usage "FILE" LDFILE
;if file doesn't exist alt mem not changed
;if not an array file prints error message and clears alt mem
$DUP GetFile ;try to load dir entry
IFZ ;if file doesn't exist
 "File doesn't exist" $PRINT $DROP CRLF
ELSE
 DROP DROP ;drop disk location
 ZAM F2AM CRLF ;load into alt mem
 ;check to see if valid array file...
 51 AMTW #1 A>CCOPY ;check alt loc 51
 AMTW GET 6412 SUB  ;PUSH 0 IF CRLF
 IFNZ ;if not valid
  "Not an array file" $PRINT CRLF
  ZAM ;clear alt mem
 ENDIF
 STMPAG ;SCAN AND SET MAX PAGE (1/11/08)
 CPAG #0 PUT ;RESET CURRENT PAGE (1/11/08)
ENDIF
END
;----------------------------------------------------------
DEFINE SVFILE ;save altmem file to disk  3/15/08
;usage "FILE" SVFILE
;check to see if valid array file...
#1 ;valid flag, set to 0 if not valid
51 AMTW #1 A>CCOPY ;check alt loc 51
AMTW GET 6412 SUB IFNZ DROP #0 ENDIF ;must be crlf
121 AMTW #1 A>CCOPY ;check alt loc 121, MUST BE CRLF OR 0
AMTW GET 6412 SUB IFNZ AMTW GET IFNZ DROP #0 ENDIF ENDIF
IFZ ;if not valid
 "AltMem does not contain array data" $PRINT CRLF
 $DROP ;filename
ELSE ;probably valid, save to file...
 DO ;until filename valid or empty
  $DUP GetFile IFZ #1 ELSE ;if file exists
   DROP DROP ;drop disk location
   "File exists, " $PRINT
   $DUP XDEL CRLF ;prompt to delete file
   $DUP GetFile IFZ #1 ELSE ;if deleted exit loop else
    DROP DROP $DROP
    "Filename: " $PRINT $IN $TRIM #0 ;get new name, check again
   ENDIF
  ENDIF
 UNTIL
 $LEN IFZ $DROP ELSE ;if valid filename entered
  STMPAG ;SCAN ALT AND SET MPAG (2/22/08)
  MPAG GET INC 3460 MUL AM2F CRLF ;save to disk
 ENDIF
ENDIF
END
;----------------------------------------------------------
DEFINE FEDIT
;file editor wrapper - prompts for filename(s)  3/15/08
CRLF CRLF
"=== IPL/text Array File Editor ===" $PRINT CRLF
"Filename to edit: " $PRINT $IN $TRIM
ZAM ;zero alt mem
CPAG #0 PUT ;default page 0
$LEN IFNZ ;if name specified
 $DUP LDFILE ;load file
ENDIF
AEDIT ;edit the file
CRLF CRLF
"Filename to save" $PRINT
$LEN IFNZ " (enter for " $PRINT $DUP $PRINT ")" $PRINT ENDIF
": " $PRINT $IN $TRIM
$LEN IFNZ ;if new name specified
 $SWAP $DROP ;drop old name
ELSE
 $DROP ;empty name to use old name
ENDIF
$LEN IFZ ;if name empty
 $DROP ;remove string, don't save
ELSE
 SVFILE ;save file
ENDIF
END
;==========================================================================
CONSOLE
~TERMINATE~