image of READY prompt

Wang2200.org

Listing of file='TBO.E1' on disk='vmedia/toolbox.wvd.zip'

# Sector 233, program filename = 'TBO.E1'
0025 REM SCREEN  EDITOR 08/10/82 AT 5 PM
0020 COM A$(K)80
   : DIM S$(4)62,B1$(1)1,Q$(2)2
   : X=1
0030 DEFFN'0
   : SELECT PRINT 005(80)
   : GOSUB '61
   : PRINT "  D a t a    e n t r y   ";A1$(1);"   (records in edit ";L1;
     "   max. ";K;"records)"
   : INIT(2D)C$()
   : $GIO#5,(A200,B$)C$()
   : PRINT
   : B=12
   : C=43
   : PRINT TAB(B-3);"\C6\CE\A0\CB\C5\D9";TAB(C-3);"\C6\CE\A0\CB\C5\D9"
   : PRINT TAB(B);"00   Menu";TAB(C);"16   Format"
0040 PRINT TAB(B);"01   List";TAB(C);"17   Hardcopy"
   : PRINT TAB(B);"02   Load";TAB(C);"21   Next     15 records"
   : PRINT TAB(B);"03   Save";TAB(C);"22   Previous 15 records"
   : PRINT TAB(B);"04   Edit last record";TAB(C);"23   Home"
0050 PRINT TAB(B);"05   Cursor down";TAB(C);"24   Erase    80 char"
   : PRINT TAB(B);"06   Cursor up";TAB(C);"25   Delete   80 char"
   : PRINT TAB(B);"07   Begin";TAB(C);"26   Insert   80 char"
   : PRINT TAB(B);"08   Erase";TAB(C);"27   Copy records"
0060 PRINT TAB(B);"09   Delete";TAB(C);"28   Ascii <===> Ebcdic"
   : PRINT TAB(B);"10   Insert";TAB(C);"29   Hex Edit"
   : PRINT TAB(B);"11=>14 Edit";TAB(C);"30   Delete/number records"
   : PRINT TAB(B);"15   \C4\C1\D4\C1\A0\C5\CE\D4\D2\D9";TAB(C);"31 or 'CLEAR'
     Clear memory"
0070 PRINT
   : PRINT "FORMAT LINE  "
   : $GIO#5(A200400D400A,B$)F0$()
0080 PRINT "         1    1    2    2    3    3    4    4    5    5    6    6
        7    7    8"
   : PRINT "    5    0    5    0    5    0    5    0    5    0    5    0    5
        0    5    0"
   : SELECT PRINT 005(K9)
   : PRINT AT(23,0);"For instructions load file : 'Ewritup'";AT(20,0);
0090 $GIO/001(C660,B$)B$(1)
   : IF STR(B$,8,1)<>" "THEN 110
   : B$()=STR(B$,6,1)
   : GOTO 100
0100 ON VAL(B$(1))+1GOTO 30,780,840,890,410,90,90,90,90,90,90,90,90,90,90,760,
     970,800,90,90,90,90,90,90,90,90,90,90,990,1100,1010,120
   : IF B$()=HEX(F0)THEN LOAD RUN T"START"
   : GOTO 90
0110 IF B$(1)<>HEX(81)THEN 90
0120 PRINT
   : INPUT "OK TO CLEAR EDIT FILE ",B$(1)
   : IF B$(1)="Y" THEN 420
   : GOTO 30
0130 DEFFN'7
   : X=1
   : L=0
   : GOSUB '40(0)
   : GOTO 190
0140 DEFFN'37(M,N)
   : IF N=0THEN RETURN
   : IF A1$(1)="EBCDIC"THEN $TRAN(C$(),Y2$())
   : $TRAN(C$(),Z1$())R
   : PRINT STR(C$(),M,N);
   : RETURN
0150 DEFFN'40(A)
   : REM DISPLAY SCREEN
   : PRINT
   : $GIO#5(4003,B$)
   : T=A
0160 GOSUB '62(1+T*K9)
   : T=T+1
   : IF T>=K7+1THEN 170
   : IF T>=A+L9THEN 170
   : $GIO#5(400A,B$)
   : GOTO 160
0170 $GIO#5(4001,B$)
   : X=1
   : RETURN
0180 DEFFN'50(A)
   : REM CUR POS
   : A1=INT((A-1)/K9)
   : $GIO#5("@\A2",B$)I$()<25-A1,A-(K9-1)*A1-1>
   : RETURN
0189 $GIO/001(C660,B$)B$(1)
   : IF STR(B$,8,1)<>" "THEN 220
   : B$()=STR(B$,6,1)
   : GOTO 440
0190 REM %MAINLOOP
   : KEYIN B$(),220,440
   : $GIO("qu@")
   : $IF ON /001,190
0200 REM DISP OF CUR POS
   : IF X<81AND X>72THEN 510
   : $GIO#5("@@@@@@")
   : A$=" "
   : CONVERT X-K9*INT((X-1)/K9)TO STR(A$,6,2),(##)
   : CONVERT 1+L+INT((X-1)/K9)TO STR(A$,2,3),(###)
   : GOSUB '50(73)
   : $GIO#5("\A0@@@@@")A$<,8>
0210 REM RESTORE CURSOR
   : GOSUB '50(X)
   : $GIO#5("@@@")
   : GOTO 189
0220 $TRAN(B$(),T$())R
   : ON 1+VAL(B$(1))GOTO 190,260,230,490,230,230,120,190,430,980,240
0230 REM CHAR
   : IF X=1920THEN SELECT PRINT 005
   : PRINT B$(1);
   : IF A1$(1)="EBCDIC"THEN $TRAN(B$(),Y1$())
   : MAT COPY B$()TO A$()<X+L*K9,1>
   : IF INT(X/K9)=X/K9THEN 270
   : X=X+1
   : ON X-K4 GOTO 250
   : GOTO 190
0240 REM UNDERSC
   : IF A1$(1)="EBCDIC"THEN 190
   : OR (STR(A$(),X+L*K9,1),80)
   : PRINT STR(A$(),X+L*K9,1);
   : X=X+1
   : ON X-K4GOTO 250
   : GOTO 190
0250 X=K3+1
   : IF L=K7+1-24THEN 290
   : L=L+1
   : GOSUB '62((L+23)*K9+1)
   : GOTO 190
0260 REM RET
   : ON X2GOTO 660
0270 GOSUB 280
   : GOTO 190
0280 SELECT PRINT 005
   : IF INT((X-1)/K9)+L<K-1THEN  X=K9+1+K9*INT((X-1)/K9)
   : IF X<>K4+1THEN 290
   : X=K3+1
   : IF L>=K7+1-L9 THEN 290
   : L=L+1
   : PRINT
   : GOSUB '62((L+L9-1)*K9+1)
0290 GOSUB '50(X)
   : RETURN
0300 PRINT ""
   : GOSUB '61
   : IF L1=0THEN RETURN
   : X,I=1
   : L=0
   : PRINT "";
   : SELECT PRINT 005
   : GOSUB '40(L)
0310 KEYIN B$(1),320,340
   : GOTO 330
0320 KEYIN B$(1)
   : IF B$(1)=" "THEN 330
   : GOTO 340
0330 GOSUB 360
   : I=I+1
   : IF I>=L1THEN 340
   : GOTO 310
0340 RETURN CLEAR
   : GOTO 190
0350 DEFFN'60
   : PRINT "\D4\C8\C5\D2\C5\A0\C1\D2\C5\A0";
   : GOSUB '61
   : PRINT L1;"\A0\D2\C5\C3\CF\D2\C4\D3\A0\C9\CE\A0\C5\C4\C9\D4"
   : $GIO("qu\FAu\FAu\FA")
   : RETURN
0360 REM LINE DOWN
   : IF X>K3THEN 370
   : X=X+K9
   : GOSUB '50(X)
   : RETURN
0370 SELECT PRINT 005
   : X=K9+1+K9*INT((X-1)/K9)
   : IF X<>K4+1THEN 380
   : X=K3+1
   : IF L>=K7+1-L9 THEN 380
   : L=L+1
   : PRINT
   : GOSUB '62((L+L9-1)*K9+1)
0380 GOSUB '50(X)
   : RETURN
0390 DEFFN'61
   : REM DEFINE LAST LINE
   : L1=1+ INT((POS(-A$()<>S1$(1))-1)/K9)
   : RETURN
0400 DEFFN'62(D)
   : MAT COPY A$()<D,K9>TO W$()
   : IF A1$(1)="EBCDIC"THEN $TRAN(W$(),Y2$())
   : $TRAN(W$(),Z1$())R
   : $GIO#5(A000400D,B$)W$()<1,K9>
   : RETURN
0410 GOSUB '60
   : PRINT "";
   : IF L1>15THEN L=L1-15
   : IF L<0THEN L=0
   : GOSUB '40(L)
   : IF L1>15THEN X=K9*14+1
   : GOSUB '50(X)
   : GOTO 190
0420 REM CLEAR
   : L=0
   : X=1
   : INIT(S1$(1))A$()
   : GOSUB '40(L)
   : GOTO 190
0430 REM BACKSP
   : ON X-K9*INT((K9-1)/K9)GOTO 190
   : B$(1)=S1$(1)
   : MAT COPY B$()TO A$()<X+K9*L-1,1>
   : $GIO#5(40084020,B$)
   : GOTO 550
0440 REM SF KEY
   : IF B$()=HEX(7E)OR B$()=HEX(7F)THEN 980
   : IF B$()=HEX(F0)OR B$()=HEX(50)THEN 30
0450 ON VAL(B$())+1GOTO 30,780,190,190,410,470,480,580,490,500,520,530,540,550
     ,570,760,30,800,190,190,410,720,740,590,750,600,610,630,540,1100,1010,120
     ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,740,720,,470,480,,490,500,520,,540,550
     ,,,,,740,720,,720,740,,,600,610
0460 GOTO 190
0470 REM LINE DOWN
   : IF X>K3OR INT((X-1)/K9)+L>=K-1THEN 270
   : X=X+K9
   : GOSUB '50(X)
   : GOTO 190
0480 REM LINE UP
   : IF X<=K9THEN 190
   : X=X-K9
   : GOSUB '50(X)
   : GOTO 190
0490 REM ERASE
   : Z=X-K9*INT((X-1)/K9)
   : INIT(S1$(1))W$()
   : MAT COPY W$()<1,K9+1-Z>TO A$()<L*K9+X,K9+1-Z>
   : GOTO 510
0500 REM DEL
   : Z=X-K9*INT((X-1)/K9)
   : MAT COPY A$()<X+L*K9+1,K9-Z>TO A$()<X+L*K9,K9-Z>
   : B$(1)=S1$(1)
   : MAT COPY B$()TO A$()<K9+L*K9+K9*INT((X-1)/K9),1>
0510 $GIO#5(400D4006)
   : GOSUB '62(1+(L+INT((X-1)/K9))*K9)
   : GOSUB '50(X)
   : $GIO#5(4005)
   : GOTO 190
0520 REM INS
   : Z=X-K9*INT((X-1)/K9)
   : MAT COPY -A$()<X+L*K9,K9-Z>TO -A$()<1+X+L*K9,K9-Z>
   : B$(1)=S1$(1)
   : MAT COPY B$()TO A$()<X+L*K9,1>
   : GOTO 510
0530 REM ----->
   : Z=X-K9*INT((X-1)/K9)
   : Z1=5-(INT(Z/(K9-4))*(Z-K9+5))
   : ON Z1+1GOTO 190
   : MAT COPY A$()<X+K9*L,5>TO C$()<1,5>
   : X=X+Z1
   : GOSUB '37(1,Z1)
   : GOTO 190
0540 REM ->
   : MAT COPY A$()<X+K9*L,1>TO B$()
   : ON K9+1-(X-K9*INT((X-1)/K9))GOTO 190
   : X=X+1
   : IF A1$(1)="EBCDIC"THEN $TRAN(B$(),Y2$())
   : $TRAN(B$(),Z1$())R
   : PRINT B$(1);
   : GOTO 190
0550 REM <-
   : Z=X-K9*INT((X-1)/K9)
   : ON ZGOTO 190
   : Z=Z-1
   : X=X-1
0560 ON Z+1GOTO 190
   : SELECT PRINT 005
   : $GIO#5(400D,B$)
   : ON ZGOTO 190
   : MAT COPY A$()<1+K9*(L+INT((X-1)/K9)),Z-1>TO W$()<1,Z-1>
   : IF A1$(1)="EBCDIC"THEN $TRAN(W$(),Y2$())
   : $TRAN(W$(),Z1$())R
   : PRINT STR(W$(),1,Z-1);
   : GOTO 190
0570 REM <-----
   : Z=X-K9*INT((X-1)/K9)
   : Z1=Z-1-(Z-6)*SGN(INT(Z/6))
   : Z=Z-Z1
   : X=X-Z1
   : GOTO 560
0580 REM BEGIN
   : X=K9*INT((X-1)/K9)+1
   : GOSUB '50(X)
   : SELECT PRINT 005
   : GOTO 190
0590 REM HOME
   : X=X-K9*INT(X-1)/K9
   : GOSUB '50(X)
   : GOTO 190
0600 REM DEL LINE
   : Z=X-K9*INT(X-1)/K9
   : IF Z<>1THEN 190
   : INIT(S1$(1))W$()
   : MAT COPY A$()<K9+X+K9*L,1+K7 *K9-X-K9*L>TO A$()<X+K9*L,1+K7*K9-X-K9*L>
   : MAT COPY W$()TO A$()<1+K7*K9,K9>
   : GOTO 620
0610 REM INS LINE
   : Z=X-K9*INT(X-1)/K9
   : Z2=X+K9*L
   : IF INT((X-1)/K9)+L>=K-1OR Z<>1THEN 190
   : INIT(S1$(1))W$()
   : MAT COPY -A$()<Z2,K7 *K9-Z2+1>TO -A$()<K9+Z2,K7 *K9-Z2+1>
   : MAT COPY W$()TO A$()<Z2,K9>
0620 Z=X
   : GOSUB '40(L)
   : X=Z
   : GOSUB '50(X)
   : GOTO 190
0630 X=K9*INT((X-1)/K9)+1
   : X1=X+L*K9
   : X2=1
   : GOSUB '50(X)
   : PRINT "";
   : SELECT PRINT 005
   : GOSUB '62(X+L*K9)
   : PRINT "";
   : SELECT PRINT 005
0640 KEYIN B$()
   : IF B$(1)=HEX(05)OR B$(1)=HEX(45)THEN GOSUB 700
   : IF B$(1)=HEX(06)OR B$(1)=HEX(46)THEN GOSUB 690
   : IF B$(1)=HEX(F0)THEN 680
   : IF B$(1)=HEX(0D)THEN 650
   : GOTO 640
0650 X3=X+L*K9-X1+K9
   : X=1
   : L=0
   : GOSUB '40(0)
   : SELECT PRINT 005
   : GOSUB '50(1904)
   : PRINT " Copy to where ? ";
   : SELECT PRINT 005
   : GOTO 190
0660 REM COPY IT X3=# OF BYTES TO INSERT
   : X2=0
   : X=K9*INT((X-1)/K9)+1
   : GOSUB '61
   : $GIO#5(4003)
   : IF L1+X3/K9>K7THEN PRINT "MEMORY OVERRUN"
   : IF X+L*K9> X1AND X+L*K9< X1+X3THEN STOP "INVALID COPY AREA"
   : IF X+L*K9<X1THEN 710
0670 MAT COPY -A$()<X+L*K9,(K7+1)*K9-X-L*K9-X3>TO -A$()<X+L*K9+X3,(K7+1)*K9-X-
     L*K9-X3>
   : MAT COPY A$()<X1,X3>TO A$()<X+L*K9,X3>
   : X=1
   : L=0
   : GOSUB '40(0)
   : GOTO 190
0680 REM CANCEL COPY
   : X1,X2=0
   : GOTO 760
0690 REM LINE UP
   : IF X<=X1THEN 640
   : $GIO#5(400D)
   : GOSUB '62(X+L*K9)
   : $GIO#5(400C,B$)
   : X=X-K9
   : RETURN
0700 REM PRINT NEXT LINE IN REV.VIDEO
   : PRINT "";
   : SELECT PRINT 005
   : GOSUB 280
   : GOSUB '62(X+L*K9)
   : PRINT "";
   : SELECT PRINT 005
   : RETURN
0710 X1=X1+X3
   : GOTO 670
0720 REM NEXT PAGE
   : IF L>=K7-23 THEN 190
   : L=L+15
   : IF L<K7-23THEN 730
   : L=K7-23
0730 GOSUB '40(L)
   : GOTO 210
0740 REM PREV PAGE
   : ON L+1GOTO 190
   : L=L-15
   : IF L>=0THEN 730
   : L=0
   : GOTO 730
0750 REM ERASE 1 LINE
   : INIT(S1$(1))W$()
   : X=K9*INT((X-1)/K9)+1
   : MAT COPY W$()TO A$()<X+K9*L,K9>
   : INIT(20)W$()
   : $GIO#5(400DA200400D,B$)W$()
   : SELECT PRINT 005
   : GOTO 190
0760 REM RECALL BEGIN
   : X=1
   : L=0
   : GOSUB '40(0)
   : GOTO 190
0770 GOSUB '60
0780 PRINT "";
   : SELECT PRINT 005
   : GOSUB 300
   : L8=23
   : L=L1-L8
   : IF L=K7-22THEN L=L-1
   : IF L>0THEN 790
   : L=0
   : L8=L1
0790 X=K9*L8+1
   : GOTO 190
0800 REM %HARDCOPY
   : SELECT PRINT 005
   : PRINT "";
   : GOSUB '60
   : B$="215"
   : PRINT AT(10,10);"PRINTER ADDRESS <DEFAULT = 215 >";
   : LINPUT -STR(B$,1,3)
   : SELECT #4<STR(B$,1,3)>
   : $GIO#4(400C)
0810 FOR T=1TO L1
   : INIT(S1$(1))Y$()
   : D=1
   : MAT COPY A$()<1+(T-1)*K9,K9>TO Y$()<1,K9>
   : IF A1$(1)="EBCDIC"THEN $TRAN(Y$(),Y2$())
   : IF A1$(1)="EBCDIC"THEN 820
   : Y$()=Y$()AND ALL(80)
   : MAT SEARCHY$()<1,K9>,=HEX(80)TO Q$()
   : IF STR(Q$(),1,2)<>HEX(0000)THEN D=2
   : INIT(20)Y$()
   : MAT COPY A$()<1+(T-1)*K9,K9>TO Y$()<1,K9>
0820 Y$()=AND ALL(7F)
   : $TRAN(Y$(),Z1$())R
   : $TRAN(Y$(),".................  ")R
   : ON DGOTO 830
   : $GIO#4(A200,B$)Y$()<1,132>
   : INIT(20)Y$()
   : MAT COPY A$()<1+(T-1)*K9,K9>TO Y$()<1,K9>
   : Y$()=Y$()AND ALL(80)
   : $TRAN(Y$()<1,132>,HEX(20005F802020))R
0830 $GIO#4(A200400D,B$)Y$()<1,LEN(Y$())>
   : NEXT T
   : $GIO#4(400C)
   : GOTO 760
0840 REM %LOAD
   : PRINT AT(21,0);
   : IF D$="   "THEN D$="310"
   : LINPUT "LOAD FROM ",-D$
   : SELECT #2<D$>
0850 PRINT AT(21,40);
   : LINPUT "FILE ",-F$
   : PRINT "SKIP # OF RECORDS IN FILE <DEFAULT=0> ";
   : S1=0
   : INPUT S1
   : S2=S1
   : INIT(S1$(1))A$()
   : Z=1
   : LIMITS T#2,F$,P9,P9,P9,P9
   : IF P9<>2THEN 850
   : DATA LOAD DC OPEN T#2,F$
0860 DATA LOAD DC #2,S$()
   : IF END THEN 770
   : A6=VAL(STR(S$(1),2,1))
   : A5=3
0870 MAT COPY S$()<A5,1>TO B1$()
   : IF S1=0THEN MAT COPY S$()<A5+1,VAL(B1$(1))>TO A$()<Z,VAL(B1$(1))>
   : IF S1=0THEN Z=Z+K9
   : IF S1<>0THEN S1=S1-1
   : IF Z<K9*(1+K7)THEN 880
   : PRINT "Memory overrun  record ";S2+1;"to record ";S2+K;" are loaded."
   : STOP
0880 A5=A5+VAL(B1$(1))+1
   : IF A5<A6THEN 870
   : IF STR(S$(1),1,1)<>HEX(F0)THEN 860
   : GOTO 770
0890 REM %SAVE
   : PRINT
   : IF D$="   "THEN D$="310"
   : LINPUT "SAVE ON ",-D$
   : SELECT #3<D$>
   : S=0
   : B$="N"
   : PRINT ,,"CREATE A ";A1$(2);" FILE <DEFAULT = N>";
   : INPUT B$
   : IF B$<>"Y"THEN 900
   : IF A1$(1)="EBCDIC"THEN S=2
   : ELSE S=1
0900 LINPUT "FILE ",-F$
   : GOSUB '60
   : B$(1)="N"
   : LIMITS T#3,F$,S1,S2,S3,P9
   : IF P9=2THEN 910
   : IF P9<>0THEN 900
   : PRINT "A NEW FILE HAS TO BE CREATED"
   : INPUT "HOW MANY EMPTY RECORDS TO ADD",L2
   : DATA SAVE DC OPEN T#3,((L1+L2)/3+3),F$
   : GOTO 920
0910 DATA LOAD DC OPEN T#3,F$
   : B$(1)="N"
   : LINPUT "Add records to existing file ",B$(1)
   : IF B$(1)<>"Y"AND B$(1)<>"y"THEN 920
   : IF S2-S1-S3<L1/3THEN STOP "NOT ENOUGH SPACE IN THIS FILE"
   : DSKIP #3,END
   : DBACKSPACE #3,1
   : DATA LOAD DC #3,S$()
   : STR(S$(1),1,1)=HEX(00)
   : DBACKSPACE #3,1
   : DATA SAVE DC #3,S$()
0920 INIT (00)S$()
   : Z=1
   : A5=3
0930 A=LEN(A$(Z))
   : IF S=1OR A1$(1)="EBCDIC"THEN A=K9
   : ON F+1 GOTO 940
   : IF A>=K9 THEN 940
   : A=K9
0940 F=0
   : BIN(B1$(1))=A
   : IF A+A5<248THEN 950
   : DATA SAVE DC #3,S$()
   : INIT(00)S$()
   : A5=3
0950 MAT COPY B1$()TO S$()<A5,1>
   : MAT COPY A$()<(Z-1)*K9+1,A>TO S$()<A5+1,A>
   : IF S=1THEN $TRAN(S$()<A5+1,A>,Y1$())
   : IF S=2THEN $TRAN(S$()<A5+1,A>,Y2$())
   : A5=A5+1+A
   : BIN(STR(S$(1),2,1))=A5
   : Z=Z+1
   : IF Z<=L1 THEN 930
0960 STR(S$(1),1,1)=HEX(F0)
   : DATA SAVE DC #3,S$()
   : DATA SAVE DC #3,END
   : GOTO 30
970REM %FORMAT LINE:PRINT "";AT(17,79);:LINPUT F0$():$TRAN(F0$(),"\80-\80   ")R:F0$()=F0$()OR ALL(7F):$TRAN(F0$(),HEX(2DFF547F2020))R:X=1:$GIO#5("@@@@@@@\A0@
@
")F0$():GOTO 90
0971 PRINT HEX(03);
   : INPUT "Number records beginning with ",N1
   : IF N1<=0THEN 971
   : INPUT "At position (- for right alignment) ",N2
   : N4=ABS(SGN(N2)-1)/2
   : N2=ABS(N2)
   : IF N2>80THEN 971
   : GOSUB '60
0972 FOR T=1TO L1
   : CONVERT T+N1-1TO B$,(########)
   : N3=POS(STR(B$,1,8)<>"0")
   : IF A1$(1)="EBCDIC"THEN $TRAN(B$,Y1$())
   : MAT COPY B$<N3,9-N3>TO A$()<K9*(T-1)+N2+N4*(N3-8),9-N3>
   : NEXT T
   : GOTO 760
0980 REM TAB
   : Z=X-K9*INT((X-1)/K9)
   : MAT SEARCHF0$()<Z+1,K9-Z>,<>"-"TO Q$()
   : Z1=VAL(STR(Q$(1),2,1))
   : ON Z1+1GOTO 270
   : MAT COPY A$()<X+K9*L,Z1>TO C$()<1,Z1>
   : X=X+Z1
   : GOSUB '37(1,Z1)
   : GOTO 190
0990 REM SWITCH ASCII <==> EBCDIC
   : GOSUB '61
   : IF A1$(1)="ASCII"THEN 1000
   : A1$()="ASCII           EBCDIC"
   : S1$()=" "
   : GOTO 1001
1000 A1$()="EBCDIC          ASCII"
   : S1$(1)="@"
1001 IF L1=0THEN INIT(S1$())A$()
   : GOTO 30
1010 REM DELETE RECORDS
   : GOSUB '61
   : T=1
   : PRINT "Delete empty records (1)";AT(2,0);"Delete records      (2) ";AT(4
     ,0);"Number records      (3)";
   : INPUT T
   : IF T>3OR T<1THEN 1010
   : ON T-1GOTO 1030,971
1020 PRINT "Deleting . . .";
   : ON L1+1GOTO 760
   : INIT(S1$(1))W$()
   : FOR T=L1TO 1STEP -1
   : IF STR(A$(),K9*(T-1)+1,K9)<>STR(W$(),1,K9)THEN 1021
   : MAT COPY A$()<T*K9+1,>TO A$()<(T-1)*K9+1,>
   : INIT(S1$())STR(A$(),(K-1)*K9+1)
1021 NEXT T
   : GOSUB '60
   : GOTO 760
1030PRINT "
Start deleting at record # ";:ON L1+1GOTO 30:INPUT T1:IF T1<1OR T1>L1THEN 1030
1040 PRINT AT(2,0,80);"Delete ending record     # ";
   : T2=T1
   : INPUT T2
   : IF T2<T1OR T2>L1THEN 1040
   : MAT COPY A$()<T2*K9+1,>TO A$()<(T1-1)*K9+1,>
   : INIT(S1$(1))STR(A$(),1+K9*(K-(T2-T1+1)))
   : GOSUB '60
   : GOTO 760
1050 REM POSITION HEX
   : PRINT AT(11,34);T5;AT(13+INT((T5-1)/20),3*(T5-1-20*INT((T5-1)/20)));
   : RETURN
1060 REM POSITION ASCII
   : PRINT AT(13+INT((T5-1)/20),59+T5-20*INT((T5-1)/20));
   : HEXPACKSTR(W$(),T5,1)FROMSTR(Y$(),1+2*(T5-1),2)
   : IF A1$(1)="EBCDIC"THEN $TRAN(W$(),Y2$())
   : $TRAN(W$(),Z1$())R
   : $GIO#5(A200,L$)W$()<T5,1>
   : RETURN
1070 SELECT PRINT 005(80)
   : PRINT "     ";BOX(3,60);AT(0,15);"-  -  -   H E X     E D I T O R
       -  -  -   ";AT(2,40);"sf 01 = Goto Record # ";AT(2,10);"sf 00 = Ex
     it";
   : FOR T=1TO 3
   : PRINT AT(4+(T-1)*7,5);"Record # ";AT(4+(T-1)*7,60);A1$(1);"  Translation"
     ;
   : NEXT T
   : RETURN
1080 DEFFN'63(T3)
   : IF T4+T3=2OR T4+T3>=K7+4THEN RETURN
   : PRINT AT((T3-1)*7+4,14);T4+T3-2;
   : HEXUNPACKSTR(A$(),(T4+T3-3)*K9+1,K9)TO STR(Y$(),1,160)
   : MAT COPY A$()<(T4+T3-3)*K9+1,K9>TO W$()<1,K9>
   : IF A1$(1)="EBCDIC"THEN $TRAN(W$(),Y2$())
   : $TRAN(W$(),Z1$())R
1090 FOR T=0TO 3
   : PRINT AT((T3-1)*7+6+T,0);
   : FOR T1=1TO 40STEP 2
   : $GIO#5(A2004020,L$)Y$()<T1+40*T,2>
   : NEXT T1
   : $GIO#5(A000400D,L$)W$()<T*20+1,20>
   : NEXT T
   : RETURN
1100 REM %^HEX EDIT
   : GOSUB 1070
1110 IF X=0THEN X=1
   : L=L+INT((X-1)/K9)
   : T5=X-K9*INT((X-1)/K9)
   : X=1
   : T4=L+1
1120 PRINT AT(11,25);"Position ";
   : GOSUB '63(1)
   : GOSUB '63(3)
   : GOSUB '63(2)
   : PRINT AT(13,0);BOX(0,80);AT(13,59);BOX(4,0);AT(17,0);BOX(0,80);AT(13,0);
   : REM  T5=1
   : T6=0
   : GOSUB 1050
1130 KEYIN B$(),1140,1150
   : GOTO 1130
1140 REM CHAR
   : IF B$(1)=HEX(0D)THEN 1220
   : IF B$(1)=HEX(E5)THEN 1210
   : IF B$(1)=" "THEN 1310
   : IF B$(1)=HEX(08)THEN 1350
   : L$=B$()
   : $TRAN(L$,"000102030405060708090A0B0C0D0E0F")R
   : IF STR(L$,1,1)<>"0"THEN 1130
   : STR(Y$(),1+2*(T5-1)+T6,1)=B$(1)
   : $GIO#5(A000,L$)B$()<1,1>
   : T6=1-T6
   : GOSUB 1060
   : GOSUB 1050
   : IF T6=1THEN $GIO#5(4009)
   : IF T6=0THEN 1310
   : GOTO 1130
1150 REM SF
   : ON VAL(B$(1))+1 GOTO 1180,1160,,,1200,1290,1300,1190,1210,1240,1250,1280,
     1310,1320,1330,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1290
     ,1300,,1210,1240,1250,,1310,1320,,,,,,,,1290,1300,,,1240,1250,,1310,1320
   : IF B$(1)=HEX(7E)OR B$(1)=HEX(7F)THEN 1340
   : GOTO 1130
1160 REM ENTER #
   : GOSUB 1230
1170 GOSUB 1070
   : PRINT AT(2,60);
   : INPUT T4
   : IF T4<1OR T4>K7+1THEN 1170
   : L=T4-1
   : X=1
   : GOTO 1120
1180 REM EXIT
   : GOSUB 1230
   : GOSUB '40(L)
   : X=T5
   : SELECT PRINT 005
   : GOSUB '62(L*K9+1)
   : IF T5<>1THEN PRINT STR(W$(),1,T5-1);
   : GOTO 190
1190 REM BEGIN
   : T5=1
   : GOTO 1270
1200 REM END
   : T5=K9
   : GOTO 1270
1210 REM ERASE
   : GOSUB 1230
   : INIT(S1$())STR(A$(),(T4-1)*K9+T5,K9-T5+1)
   : GOSUB '63(2)
   : GOTO 1270
1220 REM RET
   : GOSUB 1230
   : L=L+1
   : IF L=K7+1THEN L=K7
   : T6=0
   : GOTO 1110
1230 HEXPACKSTR(A$(),1+(T4-1)*K9,K9)FROMSTR(Y$(),1,160)
   : RETURN
1240 REM DEL
   : GOSUB 1230
   : MAT COPY A$()<(T4-1)*K9+T5+1,K9-T5>TO A$()<(T4-1)*K9+T5,K9-T5>
   : STR(A$(),T4*K9,1)=S1$(1)
   : GOTO 1260
1250 REM INS
   : GOSUB 1230
   : MAT COPY -A$()<(T4-1)*K9+T5,K9-T5>TO -A$()<(T4-1)*K9+T5+1,K9-T5>
   : STR(A$(),(T4-1)*K9+T5,1)=S1$(1)
1260 GOSUB '63(2)
1270 GOSUB 1050
   : T6=0
   : GOTO 1130
1280 REM =====>
   : T5=T5+5
   : IF T5>K9THEN T5=K9
   : GOTO 1270
1290 REM DOWN
   : IF T5>60THEN 1220
   : T5=T5+20
   : GOTO 1270
1300 REM UP
   : IF T5<21THEN 1301
   : T5=T5-20
   : GOTO 1270
1301 ON L+1GOTO 1130
   : L=L-1
   : GOSUB 1230
   : T6=0
   : GOTO 1110
1310 REM =>
   : IF T5=K9THEN 1130
   : T5=T5+1
   : GOTO 1270
1320 REM <=
   : ON T5GOTO 1130
   : T5=T5-1
   : GOTO 1270
1330 REM <=====
   : T5=T5-5
   : IF T5<1THEN T5=1
   : GOTO 1270
1340 REM TAB
   : IF T5=K9THEN 1130
   : MAT SEARCHF0$()<T5+1-INT(T5/K9),K9-(T5-INT(T5/K9))>,<>"-"TO Q$()
   : Z1=VAL(STR(Q$(1),2,1))
   : ON Z1+1GOTO 1290
   : T5=T5+Z1
   : GOTO 1270
1350 REM BS
   : ON T5GOTO 1130
   : T5=T5-1
   : STR(W$(),T5,1)=S1$(1)
   : HEXUNPACKS1$(1)TO STR(Y$(),1+(T5-1)*2,2)
   : GOSUB 1050
   : SELECT PRINT 005
   : HEXPRINT S1$();
   : GOTO 1270
9999 DEFFN'31
   : F$=HEX(020400020E450F)
   : SCRATCH TF$
   : SAVE T()F$
   :        F$=HEX(020400020E45430F)
   : SCRATCH TF$
   : SAVE <SR>T()     F$
   :                     STOP "E SAVED"