Listing of file='@TO.DISK' on disk='vmedia/mvp-cs386-1.30-disk2.wvd.zip'
# Sector 790, program filename = '@TO.DISK'
0010 REM %.@TO.DISK 04/09/90-- Disk to Disk --
0012 PRINT HEX(03);AT(0,26);"*** DISK FILE COPY UTILITY ***"
0020 DIM T1$(250)1,S0$(8)124,X0$3,X0$(2)3,Z0$80,X0,Z1$8,K$1,M$2
0030 DIM D8$80,N$8,N1$80,D$(16)16,S$3,Q$1,F1$8,A$80,B$1,Z9$(16)16
0035 REM .Create Ref file leaves E=#items, D$=Source disk, N$(E names)
0040 S8,D9=0
: F=E
: Z0$=" "
0045 IF D0<3THEN 56
: Z0$="From Disk.Image = "&F$
: SELECT #2<D$>
: LIMITS T#2,F$,S8,A,A,A
0050 DATA LOAD BA T#2,(S8)D$()
: AND (STR(D$(),2,1),7F)
: E9=VAL(STR(D$(),2,1))
0056 PRINT AT(1,40-LEN(Z0$)/2);Z0$;AT(2,35);F;"files"
: X0$(1)=D$
0063 REM X0 contains processing mode
: REM X0=1 => Copy Only
: REM X0=2 => Copy & Verify
0070 REM Print Menu
: REM Reset Restore Flag
: Z1$="JUNK0000"
: S,X1,N=0
: GOSUB '50(S9$," ")
0080 ON R1+2GOTO 100,100,112
0100 REM Cancel; SHIFT Cancel
: GOSUB '60("(terminated)",23,0,80)
0105 LOAD RUN T"START"
: ERRORGOSUB '60(" ",23,0,80)
: GOTO 70
0112 IF X0$(1)<>" "THEN 113
: REM no origin platter selected
: S9$=HEX(F218010132F902)
: GOTO 120
0113 IF X0$(2)<>" "THEN 130
: REM no destination platter selected
: S9$=HEX(F218010132F903)
0120 PRINT HEX(07);
: GOSUB '60("Information Required",23,0,80)
: GOTO 70
0130 GOSUB '100(X0$(1))
: X0$(1)=S$
: IF Q$=" "THEN 150
0140 PRINT HEX(07);
: GOSUB '60("Invalid Device Address",23,0,80)
: S9$=HEX(F218010132F902)
: GOTO 70
0150 GOSUB '100(X0$(2))
: X0$(2)=S$
: IF Q$=" "THEN 163
0160 PRINT HEX(07);
: GOSUB '60("Invalid Device Address",23,0,80)
: S9$=HEX(F218010132F903)
: GOTO 70
0163 IF X0$(1)<>X0$(2)THEN 165
: IF D0>1THEN 165
: PRINT HEX(07);
: GOSUB '60("Duplicate Device Address",23,0,80)
: S9$=HEX(F218010132F902)
: GOTO 70
0165 REM #1 => Origin
: SELECT #1<X0$(1)>
: $OPEN #1
: ERRORGOTO 140
0166 REM #2 => Destination
: $CLOSE#1
: SELECT #2<X0$(2)>
: $OPEN #2
: ERRORGOTO 160
0167 $CLOSE#2
0168 PRINT AT(9,40);" Cat. Cur. Max."
: PRINT AT(10,40);
: DATA LOAD BA T#1,(S8,A)D$()
: ERRORINIT(00)D$()
0170 IF STR(D$(),,2)=HEX(0000)THEN 182
: GOSUB 190
: GOSUB 180
: GOTO 720
0180 PRINT AT(11,40);
: DATA LOAD BA T#2,(0,A)D$()
: ERRORINIT(00)D$()
0182 IF STR(D$(),,2)>HEX(0000)THEN 190
: PRINT HEX(06);"DISK ERROR: Unformatted or no catalog"
: PRINT AT(20,62,17);"RUN - Retry"
0185 KEYIN K$
: ON POS(HEX(50F0820D)=K$)+1GOTO 185
: PRINT AT(10,40,40)
: PRINT AT(11,40,40)
: GOTO 70
0190 IF STR(D$(),,1)=HEX(02)THEN PRINTUSING "#### ######## ########",VAL(STR(D
$(),3)),VAL(STR(D$(),4),3)-1,VAL(STR(D$(),7),3)-1
: ELSE PRINTUSING "#### ######## ########",VAL(STR(D$(),2)),VAL(STR(D$(),3)
,2)-1,VAL(STR(D$(),5),2)-1
: RETURN
0720 REM
0730 GOSUB '60(" ",20,1,60)
: GOSUB '60(" ",21,0,80+50)
: GOSUB '60("Start Copy ?",23,0,80)
0740 KEYIN K$
: ON POS(HEX(8250F0)=K$)+1GOTO 740,2010
: GOSUB '60(" ",23,0,80)
: GOTO 70
1990 REM %^.Disk to Disk (file by file)
2000 %Processing File ### : ######## Sectors = ####
2010 REM Begin Installation
2020 GOSUB '60(" ",20,0,4*80)
2030 PRINT HEX(06);AT(18,1,80);
: PRINTUSING 2000;
: PRINT HEX(05);
2040 GOSUB '155
: IF N$=" "THEN 2090
2050 GOSUB '154(N$)
2070 PRINT AT(22,0,80)
: PRINT AT(23,0,80)
: N=N+1
: PRINT AT(18,0);HEX(020402000E06);
: PRINTUSING 2000,N,N$,B1-A1+1
: PRINT HEX(0F);AT(19,0,80);STR(N1$,10)
: GOSUB 2120
2075 IF D1<>3THEN 2080
: GOSUB '229(2,N$)
: IF STR(Z9$(Z6),2,1)<>HEX(80)THEN 2080
: REM .Adj.AP' index
: STR(Z9$(Z6),2,1)=HEX(40)
: DATA SAVE BA T#2,(Z3,Z9)Z9$()
2080 GOSUB 180
: GOTO 2040
2090 GOSUB '60("Disk File Copy Complete, Please Press Cancel/Edit",23,0,80)
2100 KEYIN K$
: ON POS(HEX(50F0)=K$)+1GOTO 2100
: GOSUB '60(" ",18,0,60)
: GOSUB '60(" ",23,0,80)
: GOTO 70
2120 IF D0<>1THEN 2410
: MOVE T#1,N$TO T#2,
: ERRORX9=ERR
: GOTO 2170
2130 IF X0=1THEN RETURN
2140 LIMITS T#2,N$,A,B,C,D
: ERRORX9=ERR
: GOTO 2170
2150 VERIFY T#2,(A,B)E1
: ERRORX9=ERR
: GOTO 2170
2160 IF E1=0THEN RETURN
: GOTO 2320
2170 REM .Interrograte error on initial attempt to move file
: ON X9-80GOTO 2240,2210,2180
: REM .81=Already catalogued 82=not on source 83=no room on platter
: GOTO 2300
2180 REM already catalogued
: SCRATCH T#2,N$
: ERRORX9=ERR
: GOTO 2300
2190 PRINT AT(18,0,10);"Replacing"
: MOVE T#1,N$TO T#2,()
: ERRORX9=ERR
: IF X9=81THEN 2270
: IF X9=82THEN 2210
: GOTO 2300
2200 GOTO 2130
2210 REM not at origin
: PRINT HEX(07);
: GOSUB '60("File not found on origin platter",22,0,80)
: GOTO 2245
2240 REM no room on destination platter
: PRINT HEX(07);
: GOSUB '60("No room on destination platter",22,0,80)
2245 GOSUB '60("Load new disk and press RUN or Cancel/Edit to Abort",23,0,80)
2250 KEYIN K$
: ON POS(HEX(8250F0)=K$)+1GOTO 2250,2260
: GOTO 2340
2260 GOSUB '60(" ",22,0,80*2)
: GOTO 2120
2270 REM insufficient room in old file space
: SAVE T#2,(N$)Z1$0,0
: ERRORX9=ERR
: IF X9<>83THEN 2300
: CONVERT STR(Z1$,5)TO E1
: CONVERT E1+1TO STR(Z1$,5),(####)
: IF E1>9999THEN 2300
: GOTO 2270
2280 SCRATCH T#2,Z1$
: ERRORX9=ERR
: GOTO 2300
2290 GOTO 2120
2300 N=N-1
: RETURN CLEAR
: PRINT HEX(07);
: GOSUB '60("DISK ERROR -",22,0,80)
: Z0$=ERR$(X9)
: PRINT HEX(0E);X9;Z0$;HEX(0F);
: GOSUB '60("RUN - Retry CANCEL - Exit",23,0,80)
2310 KEYIN K$
: ON POS(HEX(8250F0)=K$)+1GOTO 2310,2050
: PRINT AT(18,0,6*80)
: GOTO 70
2320 RETURN CLEAR
: PRINT HEX(07);
: GOSUB '60("MOVE FILE ABORTED, PLEASE CANCEL - VERIFY ERROR SECTOR",23,0,8
0)
: PRINT HEX(0E);E1;HEX(0F);
2330 KEYIN K$
: ON POS(HEX(50F0)=K$)+1GOTO 2310
2340 GOSUB '60(" ",18,0,80)
: GOSUB '60(" ",22,0,2*80)
: GOTO 70
2400 REM %^.Img to Disk (file by file)
: REM .MOVE T #1, TO T#2
2410 REM .#1 N$ LIMITS in A1,B1,C1,D1
: REM %0 C #1 sectors
: C=B1-A1+1
2420 LIMITS T#2,N$,A,B,D,D
: ERRORX9=ERR
: GOTO 2300
2430 IF D<>0THEN 2460
2440 REM .None on destination -- Make one
: DATA SAVE DC OPEN T#2,(C)N$
: ERRORX9=ERR
: GOTO 2170
2450 GOTO 2420
2460 REM .Is there room enuf?
: IF C>B-A+1THEN 2270
: REM /.no
2480 REM %.Move file
: PRINT AT(18,0,10);"Replacing"
: COPY T#1,(A1,A1+C)TO T#2,(A)
2490 REM .Make index item
: K$=HEX(00)
: IF D1=1THEN K$=HEX(80)
: IF D1=3THEN K$=HEX(40)
: I$=HEX(10)&K$&BIN(A,2)&BIN(A+C-1,2)&HEX(0000)&N$
2500 GOSUB '229(2,N$)
: Z9$(Z6)=I$
: DATA SAVE BA T#2,(Z3,Z9)Z9$()
: D1=0
: RETURN
3000 REM %^.@TO.SUBS 04/09/90 @TO.DISK & @TOIMAGE overlay
3005 REM %.'60 Display Highlighted
3010 DEFFN'60(Z0$,R,C,E1)
: REM Prints a message highlighted
: PRINT HEX(020402000E06);AT(R,C,E1);STR(Z0$,,LEN(Z0$));HEX(0F);
: RETURN
3020 REM %.'154 Get LIMITS of file N$
3030 DEFFN'154(N$)
: ON D0GOTO 3040,3040,3070,3070
: STOP "D0 must be 1-4 "#
3040 GOSUB '229(1,N$)
: IF Z6=0THEN 3075
: A$=Z9$(Z6)
: A1=VAL(STR(A$,3),2)
: B1=VAL(STR(A$,5),2)
: D1=POS(HEX(800040)=STR(A$,2))
3050 IF D1<>1THEN RETURN
: DATA LOAD BA T#1,(A1,Z)D$()
: K$=STR(D$(),,1)AND HEX(F0)
: IF K$=HEX(60)OR K$=HEX(70)THEN D1=3
: RETURN
3060 REM .Get from Disk.image
3070 FOR X=S8TO (S8+E9-1)
: Z=9
: IF X=S8THEN Z=25
: DATA LOAD BA T#1,(X,X9)D$()
: MAT SEARCHSTR(D$(),Z),=STR(N$,,8)TO M$STEP 16
: IF M$>HEX(0000)THEN 3080
: NEXT X
3075 Z0$=N$&" not found"
: GOSUB '60(Z0$,23,0,80)
: RETURN
3080 Z0$=STR(D$(),VAL(M$,2)+Z-9,16)
: A1=VAL(STR(Z0$,3),2)+S8
: B1=VAL(STR(Z0$,5),2)+S8
: D1=POS(HEX(1011)=STR(Z0$,,1))
: IF D1>0THEN D1=POS(HEX(800040)=STR(Z0$,2))
: IF STR(Z0$,,1)=HEX(11)THEN D1=-D1
: X=S8+E9
: NEXT X
: RETURN
3130 REM %.'155 Get a file name
3140 DEFFN'155
: X1=X1+1
: IF X1>FTHEN N1$=" "
: ELSE N1$=N$(X1)
: N$=N1$
: IF N$=" "THEN X1=0
: RETURN
3800 REM %^ -- SE.SUBS, RELEASE 6.03, (05/10/82) SCREEN SUBROUTINES --
3801 DIM T1(8),S1$,S4$80,T1$1,T2$80,T3$1,T$(10)1,T4$3,S2$124
3802 REM %ACCEPT REPEATING FIELD
3803 DEFFN'136(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),S0$,S2$,T
2,T9,T$(),S9)
: I=20
: GOSUB 3863
: T2,T5=MIN(MAX(1,T2),T1(6))
: $TRAN(T$(),HEX(202E))R
: T$(5)="5"
: R1=1
3804 IF S9>1THEN 3810
3805 IF T9<0THEN 3806
: T$(5)="5"
: T3$=S2$
: GOSUB 3831
: S2$=T3$
: IF T9=0THEN 3808
: T2=T5
3806 GOSUB 3835
: GOSUB '130(T0,T1,T1(3),S2$,T1$(T2),S0$," ",T$(),T0$)
: T1$(T2)=S4$
: IF R1<5OR R1=11OR R1=14THEN 3808
3807 IF R1=5THEN T2=T2+1
: IF R1=6THEN T2=T2-1
: IF T2>=1AND T2<=T1(6)THEN 3806
3808 RETURN
3809 REM %^PICKTYPE (S9 =2/P1; =3/PM)
3810 SELECT PRINT 205(80)
: PRINT HEX(0202020F);
: $TRAN(S2$,HEX(8520))R
: IF T9<0THEN 3814
: T5=T2
: FOR T2=1TO T1(6)
: IF S9=2THEN 3811
: T4$=STR(S2$,T2,1)&HEX(0F09)
: GOTO 3812
3811 IF T2=T5THEN T4$=HEX(8B0E09)
: ELSE T4$=HEX(900F09)
3812 GOSUB 3835
: GOSUB 3824
3813 NEXT T2
: T2=T5
: IF T9=0THEN 3825
3814 IF S9=3THEN S0$=S0$&"DI"
: GOSUB 3835
: PRINT HEX(06);AT(T0-1,T1-1);
: T9=1
: GOSUB 3840
: IF S9=2AND R1<11OR R1<7THEN 3825
: IF S9=2THEN 3818
: ON R1-8GOTO 3815,3816
: GOTO 3819
3815 STR(S2$,T2,1)=HEX(85)
: GOTO 3817
3816 STR(S2$,T2,1)=HEX(8B)
3817 T4$=STR(S2$,T2,1)&HEX(0F09)
: GOSUB 3824
: I=1
: GOTO 3822
3818 T4$=HEX(900F09)
: GOSUB 3824
3819 ON POS(HEX(2008)=T1$)GOTO 3820,3821
: GOSUB 3826
: GOTO 3823
3820 I=1
: GOTO 3822
3821 I=-1
3822 T2=T2+I
: T2=MOD(T2,T1(6))
: IF T2=0THEN T2=T1(6)
: IF T1$(T2)=" "THEN 3822
3823 IF S9=3THEN T4$=STR(S2$,T2,1)&HEX(0F09)
: ELSE T4$=HEX(8B0E09)
: GOSUB 3835
: GOSUB 3824
: GOTO 3814
3824 PRINT HEX(06);AT(T0-1,T1-1);
: IF T1$(T2)>" "THEN PRINT HEX(0E);T4$;STR(T1$(T2));
: ELSE PRINT TAB(T1-1+2);STR(T1$(T2));
: RETURN
3825 $TRAN(S2$,HEX(2085))R
: T0=T2
: PRINT HEX(0F0202000F);
: IF S2=2THEN RETURN
: MAT REDIM T1$(T1(6))1
: T1$()=S2$
: SELECT PRINT 005(80)
: RETURN
3826 T1$=OR HEX(20)
: S=-1
: IF T2=T1(6)THEN 3827
: FOR I=T2+1TO T1(6)
: T3$=STR(T1$(I),1,1)OR HEX(20)
: IF T3$<>T1$THEN NEXT I
: ELSE S=I
3827 IF T2=1OR S>0THEN 3828
: FOR I=1TO T2-1
: T3$=STR(T1$(I),1,1)OR HEX(20)
: IF T3$<>T1$THEN NEXT I
: ELSE S=I
3828 IF S>-1THEN T2=S
: RETURN
3829 REM %^DISPLAY REPEATING FIELD
3830 DEFFN'137(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),T$())
: MAT REDIM T1$(T1(6))T1(3)
: $TRAN(T$(),HEX(202E))R
3831 SELECT PRINT 405(80)
: IF T$(7)=" "THEN PRINT HEX(020402000E06);
: ELSE PRINT HEX(0F06)
: FOR T2=1TO T1(6)
: GOSUB 3835
: S2$=T1$(T2)
: IF T$(3)=" "OR S2$=" "THEN 3832
: STR(S2$,,LEN(S2$))=ALL(8B)
3832 IF T$(5)>" "THEN $TRAN(S2$,HEX(8520))R
: PRINT AT(T0-1,T1-1);STR(S2$,,T1(3));
: NEXT T2
3833 SELECT PRINT 005(80)
: RETURN
3834 REM %^GLOBAL ROUTINES
3835 IF T$(4)>" "THEN T0=INT((T2-1)/T1(8))*T1(7)+T1(1)
: ELSE T0=MOD((T2-1),T1(4))*T1(7)+T1(1)
: IF T$(4)>" "THEN T1=MOD((T2-1),T1(8))*T1(5)+T1(2)
: ELSE T1=INT((T2-1)/T1(4))*T1(5)+T1(2)
: RETURN
3837 IF T0$<>" "THEN GOSUB 3859
: IF T>0THEN GOSUB 3861
: RETURN
3838 REM %keystroke eval
3839 T=1
: PRINT HEX(06070E);AT(23,0,40);" Invalid key ignored";AT(T0-1,T1-2+T9);
3840 R1=99
: IF T$(9)=" "THEN PRINT HEX(02050F);
: KEYIN T1$,,3844
: IF T1$>HEX(82)THEN 3840
: IF T$(9)>" "THEN IF POS(S0$=T1$)=0OR T1$=" "THEN 3839
: GOSUB 3837
: ON POS(HEX(81820D)=T1$)GOTO 3841,3842,3843
: RETURN
3841 R1=0
: RETURN
3842 R1=1
: RETURN
3843 R1=5
: RETURN
3844 GOSUB 3837
: IF T1$>HEX(1F)THEN 3845
: IF POS(S0$=T1$)=0THEN 3845
: R1=4
: S0=VAL(T1$)
: RETURN
3845 ON POS(HEX(F01F507E7F)=T1$)GOTO 3846,3846,3847,3848,3849
: GOTO 3850
3846 R1=0
: RETURN
3847 R1=-1
: RETURN
3848 R1=5
: RETURN
3849 R1=6
: RETURN
3850 T1$=AND HEX(0F)
: IF POS(HEX(0203050608090A0C0D)=T1$)>0THEN 3851
: GOTO 3839
3851 $TRAN(T1$,HEX(0B060E05))R
: R1=VAL(T1$)
: T2$="1PN4567EDIuewd56"
: IF POS(S0$=STR(T2$,R1,1))>0THEN RETURN
: GOTO 3839
3852 ON POS(HEX(2008)=T1$)GOTO 3853,3854
: GOTO 3855
3853 IF T$(4)>" "THEN R1=12
: ELSE R1=14
: GOTO 3855
3854 IF T$(4)>" "THEN R1=13
: ELSE R1=11
3855 I=T1(6)
: IF T$(4)=" "THEN 3856
: IF R1=14THEN T2=MOD(T2+T1(8),I)
: IF R1=11THEN T2=MOD(T2-T1(8),I)
: GOTO 3857
3856 IF R1=14THEN T2=MOD(T2+1,I)
: IF R1=11THEN T2=MOD(T2-1,I)
3857 IF T2=0THEN T2=T1(6)
: IF T2>T1(6)THEN 3852
: RETURN
3858 %erase window
3859 FOR I=1TO VAL(STR(T0$,3))
: PRINT HEX(06);AT(VAL(STR(T0$,1))-2+I,VAL(STR(T0$,2)),VAL(STR(T0$,4)));
: NEXT I
: T0$=" "
3860 %erase errmsg
3861 PRINT HEX(06);AT(23,0,79);
: T=0
: GOSUB 3898
: RETURN
3862 REM %set disp attr
3863 S1$=HEX(0204)&BIN(I/10)&BIN(MOD(I,10))&HEX(0E)
: PRINT STR(S1$,,5);
: RETURN
3864 REM %.DISPLAY MSG
3865 DEFFN'128(S2$,T0,T1,I)
: SELECT PRINT 005(80)
: IF T0=99THEN PRINT HEX(07);
: IF T1=99THEN T1=40-(LEN(S2$)/2)
: T0=MIN(24,T0)
: T1=MAX(1,T1)
: GOSUB 3863
: I=1
: STR(S2$,LEN(S2$)+1,1)=HEX(AF)
: T=POS(S2$=HEX(AF))
3866 PRINT HEX(06);AT(T0-1,T1-1);STR(S2$,I,T-1);
: I=I+T
: T=POS(STR(S2$,I)=HEX(AF))
: T0=T0+1
: IF T>0THEN 3866
: PRINT HEX(020402000F06);
: RETURN
3867 REM %^DISPLAY SCR TEXT
3868 DEFFN'129
: SELECT PRINT 205(80)
3869 READ T0,T1,I,S4$
: ERRORR1=-2
: RETURN
3870 IF T0=0THEN RETURN
: IF I=99THEN 3871
: IF I=0THEN PRINT HEX(0F);
: ELSE GOSUB 3863
: PRINT HEX(06);AT(T0-1,T1-1);STR(S4$,,LEN(S4$));
: GOTO 3869
3871 PRINT HEX(06);AT(T0-1,T1-1);BOX(VAL(S4$),VAL(STR(S4$,2)))
: GOTO 3869
3872 REM %^TEXT ENTRY
3873 DEFFN'130(T0,T1,T5,S2$,S4$,S0$,T2$,T$(),T0$)
: SELECT PRINT 405(80)
: PRINT HEX(0202000F020402000E);
: $TRAN(T$(),HEX(202E))R
: IF T2$>" "THEN PRINT HEX(060F);AT(T0-1,T1-2-LEN(T2$));T2$;HEX(0E);
: S2$=ALL(S2$)
: T6=POS("H#X"=S2$)
: PRINT HEX(0202020F);
3874 IF T$(3)>" "AND S4$>" "THEN T9=LEN(S4$)+1
: ELSE T9=1
: IF T$(9)=" "THEN GOSUB 3897
: IF S0$<>" "THEN S0$=S0$&"IDEew"
: ELSE S0$="IDEew"
3875 GOSUB 3840
: IF T$(9)>" "THEN 3906
: IF R1<7THEN 3900
: IF R1=11AND POS(S0$="U")>0THEN 3900
: IF R1=14AND POS(S0$="D")>0THEN 3900
: IF R1<99AND T$(3)>" "THEN 3893
: ON R1-7GOTO 3879,3884,3881,3875,3886,3890,3875
: IF T1$=HEX(08)THEN 3890
: IF T9<=T5THEN 3877
: PRINT HEX(07);
: GOTO 3875
3876 REM %char
3877 STR(S4$,T9,1)=T1$
: $TRAN(T1$,HEX(8020))R
: IF T$(3)=" "THEN PRINT HEX(0E);T1$;
: ELSE PRINT HEX(0E8B);
: GOTO 3887
3878 REM %erase
3879 IF T5<T9THEN 3875
: STR(S4$,T9)=" "
: GOSUB 3897
: GOTO 3875
3880 REM %insrt
3881 IF T5<T9THEN 3875
: MAT COPY -S4$<T9,T5-T9>TO -S4$<T9+1,T5-T9>
: STR(S4$,T9,1)=" "
: GOSUB 3897
: GOTO 3875
3882 REM %del
3884 IF T5<T9THEN 3875
: MAT COPY S4$<T9+1,T5-T9>TO S4$<T9,T5-T9>
: STR(S4$,T5,1)=" "
: GOSUB 3897
: GOTO 3875
3885 REM %incrm
3886 IF T9<T5+1THEN PRINT HEX(09);
3887 IF T9<>T5THEN 3888
: IF T$(1)=" "THEN 3888
: R1=5
: GOTO 3900
3888 T9=MIN(T5+1,T9+1)
: GOTO 3875
3889 REM %decrm
3890 IF T9>1THEN 3891
: IF T$(2)=" "THEN 3875
: R1=6
: GOTO 3900
3891 PRINT HEX(08);
: T9=T9-1
: IF T1$<>HEX(08)THEN 3875
: STR(S4$,T9,1)=" "
: PRINT HEX(8508);
: GOTO 3875
3892 PRINT HEX(06070E);AT(23,0,50);T2$;
: T=1
: GOSUB 3898
: GOTO 3875
3893 T2$=" Invalid key ignored"
: GOTO 3892
3894 T2$=" Information required, please enter"
: GOTO 3892
3895 T2$=" Invalid characters in field"
: GOTO 3892
3896 REM %print field
3897 PRINT HEX(06);AT(T0-1,T1-1);
: T2$=S4$
: IF T$(3)>" "AND T2$>" "THEN STR(T2$,,LEN(T2$))=ALL(8B)
: $TRAN(T2$,HEX(8520))R
: PRINT STR(T2$,,T5);
3898 PRINT HEX(06);AT(T0-1,T1-2+T9);
: RETURN
3900 IF T$(7)=" "OR T$(3)>" "THEN 3901
: PRINT HEX(0F);
: GOSUB 3897
3901 $TRAN(S4$,HEX(20802085))R
: IF R1<1THEN 3903
: IF S4$=" "AND T$(6)>" "THEN 3894
3902 REM %validation
3903 ON T6GOTO 3905,3904,3906
: GOTO 3905
3904 IF NUM(S4$)<T1(3)THEN 3895
: GOTO 3906
3905 IF S4$=" "THEN 3906
: I=LEN(S4$)
: IF VER(STR(S4$,,I),S2$)<ITHEN GOTO 3895
3906 SELECT PRINT 005(80)
: PRINT HEX(0F0202000F);
: RETURN
5000 DEFFN'50(S9$,S0$)
: REM Display and Accept ISNy0701 (VER 6.03)
5001 S4=1
: S3=3
: S2=0
: S1=0
: T0$=" "
5002 IF POS(S9$=F2)>0THEN T0$=STR(S9$,POS(S9$=F2)+1,4)
5003 RESTORE LINE5028
: GOSUB '129
5004 T9=0
: FOR T4=1TO 3
5005 ON T4GOSUB 5012,5017,5022
5006 NEXT T4
5007 T9=-1
: IF POS(S9$=F9)>0THEN T3=VAL(STR(S9$,POS(S9$=F9)+1))
: ELSE T3=S4
5008 ON T3GOSUB 5012,5017,5022
5009 ON R1GOTO ,,,,5010,5011
: RETURN
5010 T3=MOD(T3+1,S3+1)
: IF T3=0THEN T3=S4
: GOTO 5008
5011 T3=MOD(T3-1,S3+1)
: IF T3<S4THEN GOTO 5011
: GOTO 5008
5012 MAT REDIM T1$(2)15
: RESTORE LINE5012
: FOR I=1TO 2
: READ T1$(I)
: NEXT I
: GOSUB '136(7,9,1,2,1,2,1,1,T1$(),S0$," ",X0,T9," ",2)
: X0=T0
: RETURN
5013 DATA "Copy Only","Copy and Verify"
5017 IF D0>2THEN 5018
: MAT REDIM T1$(1)3
: GOSUB '136(11,32,3,1,4,1,1,1,X0$(1),S0$,"H",1,T9,"1",1)
: X0$(1)=T1$()
: RETURN
5018 X0$(1)=D$
: PRINT AT(10,31);D$
: RETURN
5022 MAT REDIM T1$(1)3
: GOSUB '136(12,32,3,1,4,1,1,1,X0$(2),S0$,"H",1,T9," ",1)
: X0$(2)=T1$()
: RETURN
5028 DATA 5,2,0,"Select Mode:"
5029 DATA 11,2,0,"Origin platter address:"
5030 DATA 12,2,0,"Destination platter address:"
5032 DATA 21,60,0," RUN - Accept?"
5033 DATA 22,60,0,"RETURN - Proceed"
5034 DATA 23,60,0,"CANCEL - Exit"
5036 DATA 22,1,0,"(c) Copyright Wang Laboratories, Inc. 1988"
5037 DATA 23,5,0,"All rights reserved"
5100 DATA 0,0,0," "
5200 REM %.Validate disk addr
5210 DEFFN'100(S$)
: IF S$="340"THEN 5230
: $TRAN(S$,"AaBbCcDdEeFf")R
: IF POS("DB3"=S$)>0AND POS("123567"=STR(S$,2))>0AND VER(STR(S$,3),"H")>0TH
EN 5220
: Q$="I"
: RETURN
5220 IF POS("3B"=S$)=0OR POS("123"=STR(S$,2))=0OR STR(S$,3)<>"0"THEN 5230
: IF STR(S$,,1)="3"THEN STR(S$,3)="1"
: STR(S$,,1)="D"
5230 Q$=" "
: RETURN
6490 REM %.Find index item
6500 DEFFN'229(Z9,STR(A$,1,8))
: DATA LOAD BA T#Z9,(0,Z3)Z9$()
: Z4=VAL(STR(Z9$(),2,1))
: STR(A$,9,8)=STR(A$,,8)
: ON POS(HEX(0001)=STR(Z9$(),,1))GOSUB 6770,6800
: Z5=Z3
: IF Z3=0THEN 6630
6620 DATA LOAD BA T#Z9,(Z3,Z8)Z9$()
6630 Z6=0
: FOR Z7=1TO 16
: IF Z3<>0THEN 6680
: IF Z7=1THEN Z7=2
6680 B$=STR(Z9$(Z7),,2)
: ON POS(HEX(001011)=B$)GOTO 6740,6720,6720
: GOTO 6750
6720 IF STR(Z9$(Z7),9,8)<>STR(A$,,8)THEN 6750
: Z6=Z7
6740 Z7=16
6750 NEXT Z7
: IF B$=HEX(00)THEN RETURN
: IF Z6<>0THEN RETURN
: B$=HEX(00)
: IF V9<>0THEN 6760
: Z3=Z3-1
: IF Z3=Z5THEN RETURN
: IF Z3<0THEN Z3=Z4-1
: GOTO 6620
6760 Z3=MOD(Z3+1,Z4)
: IF Z3<>Z5THEN 6620
: RETURN
6770 XOR (STR(A$,10,7),STR(A$,9,8))
: B$=STR(A$,16,1)
: STR(A$,18,2)=HEX(0000)
: ADDC(STR(A$,18,2),B$)
: ADDC(STR(A$,18,2),B$)
: ADDC(STR(A$,18,2),B$)
: ADD(STR(A$,18,1),STR(A$,19,1))
: Z3=VAL(STR(A$,18,2))
: Z3=Z3-INT(Z3/Z4)*Z4
: RETURN
6800 STR(A$,18,1)=HEX(00)
: FOR Z5=9TO 16
: IF MOD(Z5,2)>0THEN ROTATE(STR(A$,Z5,1),4)
: STR(A$,18,1)=STR(A$,18,1)ADDSTR(A$,Z5,1)
: NEXT Z5
: Z3=MOD(VAL(STR(A$,18,1)),Z4)
: RETURN