Listing of file='@TOIMAGE' on disk='vmedia/mvp-cs386-1.30-disk2.wvd.zip'
# Sector 1360, program filename = '@TOIMAGE'
0010 REM %.@TOIMAGE 04/09/90 -- File to disk image utility
0012 PRINT HEX(03);AT(0,17);"*** DISK FILE COPY INTO A DISK IMAGE UTILITY"
0019 DIM I$(16,16)E0
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 PRINTUSING "### ##### #####",VAL(STR(D$(),2)),VAL(STR(D$(),3),2)-1,VAL(ST
R(D$(),5),2)-1
: RETURN
0720 REM %.Copy Image
: GOSUB 800
0730 PRINT AT(22,59,20)
: GOSUB '60("Copy Complete, Please Press Cancel/Edit",23,0,80)
0740 KEYIN K$
: ON POS(HEX(50F0)=K$)+1GOTO 740
: GOSUB '60(" ",23,0,80)
: GOTO 70
0800 REM %^.Logic to copy to a Disk.Image
: GOSUB 810
: REM /.Scan input table
: GOSUB 860
: REM /.Open output file
: GOSUB 985
: REM /.copy data
: RETURN
0809 REM %.<sr> Scan input table
0810 PRINT AT(13,0,80);"Scan files to COPY on disk ";X0$(1);" and calculate sp
ace needed"
0820 A,B,C=0
0830 GOSUB '155
: IF N$=" "THEN RETURN
: GOSUB '154(N$)
0840 IF D1=0THEN 850
: B=B+1
: A=B1-A1+1
: S=S+A
: PRINT AT(15,0,80);B;N$,A1,B1,C1,D1
: GOTO 830
0850 C=C+1
: PRINT AT(16,0,80);C;"files found not active -- Last file =";N$;" is ty
pe ";D1
: GOTO 830
0855 REM %.<sr> Open Disk.Image file
0860 I=INT(E/16)+1
: S=S+I
0870 IF C>0THEN PRINT AT(17,0,80);F-C;"active files found from list"
0880 PRINT AT(13,0,3*80);" File COPY will require on disk ";X0$(2);" a disk IM
AGE file of";S;"sectors."
0890 F1$="f"&X0$(1)
: PRINT AT(12,14,60);"IMAGE file name: ";HEX(0E);F1$;HEX(0F)
0900 PRINT AT(20,59,20);AT(22,59,20);"(None) - Exit";
0910 PRINT AT(12,40,30);
: LINPUT " or"-F1$
0920 IF F1$=" "THEN 982
0925 IF F1$=F$AND X0$(1)=X0$(2)THEN 880
0930 PRINT AT(23,0,40);AT(12,31,50);HEX(0E);F1$;HEX(0F)
0940 LIMITS T#2,F1$,A,B,C,D
: PRINT AT(12,44);
: PRINTUSING "##### #####";A,B
0950 PRINT AT(22,59,20);"CANCEL - Exit";AT(14,0);
0955 IF D<>0THEN 970
: K$="N"
: PRINT "O.K. to open a new file ? N";HEX(08);
: KEYIN K$,,965
: PRINT K$
: $TRAN(K$,"Yy")R
: IF K$<>"Y"THEN 890
: DATA SAVE DC OPEN T#2,(S+2)F1$
: ERRORZ0$=ERR$(ERR)
: GOSUB '60(Z0$,23,0,40)
: GOTO 910
0960 GOTO 940
0965 IF K$=HEX(F0)OR K$=HEX(50)THEN 12
: GOTO 950
0970 IF S>B-A+1THEN DO
: GOSUB '60("Insufficent space in named file",23,0,40)
: GOTO 910
: END DO
: IF D<2THEN DO
: GOSUB '60("This file is not an Active Data file",23,0,40)
: GOTO 910
: END DO
0980 K$="N"
: PRINT "O.K. to write to this file ? N";HEX(08);
: KEYIN K$,,965
: PRINT K$;
: PRINT AT(14,0,80);
: $TRAN(K$,"Yy")R
: IF K$=" "THEN 982
: IF K$<>"Y"THEN 890
: RETURN
0982 RETURN CLEAR
: GOTO 10
0985 REM %.<sr> IMAGE copy
: REM %0 S Sector, I Index ptr, B0 Base of IMAGE
0990 GOSUB '60(" COPY to disk IMAGE file in process",13,0,80)
: PRINT AT(21,59,20);AT(22,59,20);"Cancel - Abort";AT(12,44);
: PRINTUSING "##### #####";A,B
1000 S=A+I
: B2=B
: B0=A+1
1020 REM %.Set index sectors
: MAT REDIM I$(I,16)16
: INIT(00)I$()
: DATA SAVE BMT#2,(A)I$()
: REM /.0 index in case copy is aborted
1030 STR(I$(),,16)=HEX(01)&BIN(I)&BIN(B-B0,2)&BIN(B-B0,2)&"Disk.Image"
: I=1
: A,B,C=0
1035 REM %.Copy thru list
1040 GOSUB '155
: IF N$=" "THEN 1130
1050 $IF OFF /001,1060
: KEYIN K$
: ON POS(HEX(50F0)=K$)+1GOTO 1050
: PRINT AT(13,0,5*80)
: PRINT AT(22,59,20)
: GOSUB '60("Abort by Operator, Please Press Cancel/Edit",23,0,80)
: GOTO 740
1055 REM %.Copy item
1060 GOSUB '154(N$)
1070 IF D1=0THEN 1040
: B=B+1
: C=B1-A1+1
: PRINT AT(15,0,80);B;N$,A1,B1,C1,D1
1080 PRINT "Write ";STR(N$,,8);" to";S
: COPY T#1,(A1,A1+C)TO T#2,(S)
1090 M$=HEX(1000)
: IF ABS(D1)=1THEN STR(M$,2)=HEX(80)
: IF ABS(D1)=3THEN STR(M$,2)=HEX(40)
: IF D1<0THEN ADD(STR(M$,,1),01)
1100 I=I+16
: STR(I$(),I,16)=M$&BIN(S-B0+1,2)&BIN(S+C-B0,2)&HEX(0000)&N$
1110 PRINT AT(12,44);
: PRINTUSING "##### #####";S,B2
1120 S=S+C
: GOTO 1040
1130 LIMITS T#2,F1$,A2,B2,C2,D
1131 DBACKSPACE #2,BEG
: DSKIP #2,B2-A2-1S
: DATA SAVE DC #2,END
1132 PRINT AT(14,0);"Index"
: DATA SAVE BMT#2,(A2)I$()
1134 PRINT AT(14,0);"Verify"
: VERIFY T#2,(A2,B2)
1140 GOSUB '60(" COPY to disk IMAGE file complete",13,0,80)
: PRINT AT(14,0,5*80)
: RETURN