1
50 ONERRORREPORT:PRINT:PROCexit(ERR)
60 A$=FNOS_GetEnv+" ":fs%=FNfs
70 IFFNcl("-?",0):PROCsyntax:PROCexit(0)
80 IFFNcl("-help",0):PROChelp:PROCexit(0)
90 DIMctrl% 31:X%=ctrl%:Y%=X%DIV256
100 IFFNs(A$)="":INPUT"Source drive: "in$:INPUT"Output file: "out$:INPUT"Disk size (K): "sz$:A$=in$+" "+out$+" "+sz$
110 dbug%=FNcl("-d",0):auto%=FNcl("-a",0):verb%=FNcl("-v",0):size%=VALFNcl("-s",1):mix%=FNcl("-m",0)
120 zero%=FNcl("-z",0):inv%=FNcl("-i",0):in$=FNcl("",0):out$=FNcl("",0)
130 IFsize%=0:IFVALA$:size%=VALFNcl("",0)
140 IFsize%<50:size%=size%*100-40*(size%=6)-20*(size%=7ORsize%=3)-40*(size%=14)
150 IFin$>"@":in$=CHR$(ASCin$-17)
160 drive%=VALin$:geom$=A$:IFgeom$="":auto%=TRUE
170 IFdbug%:PRINT"in$ ='"in$"'"'"out$ ='"out$"'"'"geom$='"geom$"'"'"size%=";size%'"auto%=";auto%'"verb%=";verb%'"debug=";dbug%
180 DIMdiskrec% 255:logbps%=0:max%=0:PROCparameters
190 size%=(sides%*tracks%*spt%*2^logbps%)/1024:IFauto%:size%=-1
200 PROCgeom:IFauto%:geom$=""
210 IFdbug%:PRINT" D:S:H:TK:Z:NM:S0"'"G:"geom$
220 IFlogbps%=0:PROCsyntax:PROCexit(220)
240 ONERRORREPORT:OSCLI"FX143,18,"+STR$fs%:PROCClose_All:PROCHour_Glass(-3):PRINT:PROCexit(ERR)
250 out%=OPENOUT(out$):IFout%=0:PRINT"Can't open '"out$"'":PROCexit(192)
260 IFverb%:PRINT"Create ";LEFT$(STR$size%+"K ",size%>0);"image of ";FNgeom
270 PROCFDC_Init(diskrec%,logbps%,spt%,heads%,den%,tracks%,sec0%)
280 bps%=2^logbps%:bsz%=spt%*bps%:DIMdata% bsz%-1
290 drive%=drive%AND3:IFos%<6:IFden%=2:drive%=drive%OR4
300 PROCdiskread:PROCfinish
310 PROCexit(0):END
330 DEFPROCdiskread
340 PTR#out%=0:dstep%=(tracks%>63)+2
350 IFseq%:FORhead%=0TOsides%-1:FORtrack%=0TOtracks%-1:PROCtrack(head%*tracks%*dstep%+track%):NEXTtrack%:NEXThead%:ENDPROC
360 FORtrack%=0TOtracks%-1:FORhead%=0TOsides%-1:PROCtrack(track%*sides%*dstep%+head%):NEXThead%:NEXTtrack%
370 ENDPROC
390 DEFPROCfinish
400 IFverb%:PRINT
410 CLOSE#out%:out%=0
420 OSCLI"SetType "+out$+" "+STR$~FNimgtype(out$):OSCLI"Stamp "+out$
430 PROCexit(0)
440 ENDPROC
460 DEFPROCtrack(offset%)
470 IFverb%:IFPOS=0:PRINT"----";
480 IFverb%:PRINTCHR$8;CHR$8;CHR$8;CHR$8;head%;":";FNd0(track%,2);
490 IFauto%:PROCautoELSEr%=FNdiskop(1,data%,spt%):num%=spt%*bps%
500 IFinv%:FORA%=0TOspt%*bps%-1STEP4:data%!A%=NOTdata%!A%:NEXT
510 PROCgbpb(2,out%,data%,num%,0)
520 ENDPROC
540 DEFPROCauto
550 r%=FNdiskop(1,data%,spt%)
560 IFr%=0:IFspt%*bps%>max%:max%=spt%*bps%:VDU13:PROCdiskread:PROCfinish:ENDPROC
570 IFr%=0:PROCpad:num%=max%:ENDPROC
600 IFverb%:PRINT" Reading sector IDs:";
610 sec0%=0:PROCsense:IFr%:IFverb%:PRINT" Can't sense track."
620 IFr%:num%=max%:ENDPROC
630 logbps%=data%?3+7:sec0%=256:dup%=FALSE:A%=0:REPEAT
640 IFdata%?(A%+2)<sec0%:sec0%=data%?(A%+2)
650 IFA%>4:B%=0:REPEAT:dup%=(data%!B%=data%!A%):B%=B%+4:UNTILA%=B%ORdup%
660 A%=A%+4:UNTILdata%!A%=-1ORdup%
670 IFdata%!(A%-4)=data%!8:A%=A%-4
680 IFdata%!(A%-4)=data%!4:A%=A%-4
690 IFdata%!(A%-4)=data%!0:A%=A%-4
700 spt%=A%DIV4:bps%=2^logbps%:IFmix%:IFspt%>10:spt%=10
710 IFden%=4:IFseq%:seq%=FALSE:heads%=2:max%=0
720 IFverb%:PRINT" den:";den%;" sec0:"FNh0(sec0%,2)" spt:";spt%;" bps:";bps%;" tsz:";max%;
730 IFverb%:PROCgeom:A$=FNgeom:PRINTMID$(A$,INSTR(A$,"(")-1);
740 IFspt%*bps%>max%:max%=spt%*bps%:VDU13:PROCdiskread:PROCfinish:ENDPROC
750 FORA%=0TOmax%-1STEP4:data%!A%=-1:NEXT
760 PROCFDC_Init(diskrec%,logbps%,spt%,heads%,den%,tracks%,sec0%):r%=FNdiskop(1,data%,spt%):PROCpad
770 IFr%:IFverb%:PRINT" Can't read track";
780 IFr%:PROCread
790 IFverb%:PRINT
800 num%=max%
810 ENDPROC
830 DEFPROCread
840 IFverb%:PRINT" Sec: ";
850 FORsec%=0TOspt%-1
860 IFverb%:PRINTSTRING$(5,CHR$8);FNh0(sec0%+sec%,2);
870 r%=FNdiskop(1,data%+bps%*sec%,bps%)
880 IFverb%:PRINT" ";FNh0(r%,2);
890 NEXT
900 ENDPROC
920 DEFPROCpad
930 IFmax%>spt%*bps%:FORA%=spt%*bps%TOmax%-1STEP4:data%?A%=-1:NEXT
940 IFmax%<>2*spt%*bps%:ENDPROC
950 FORB%=spt%-1TO0STEP-1:FORA%=252TO0STEP-4
960 data%!(B%*bps%*2+A%+bps%)=-1:data%!(B%*bps%*2+A%)=data%!(B%*bps%+A%)
970 NEXTA%:NEXTB%
980 ENDPROC
1000 DEFPROCsense
1010 FORA%=0TO255STEP4:data%!A%=-1:NEXT
1020 den%=1:PROCFDC_Init(diskrec%,logbps%,spt%,heads%,den%,tracks%,sec0%):r%=FNdiskop(3,data%,spt%):IFr%=0:ENDPROC
1030 den%=2:PROCFDC_Init(diskrec%,logbps%,spt%,heads%,den%,tracks%,sec0%):r%=FNdiskop(3,data%,spt%):IFr%=0:ENDPROC
1040 den%=4:PROCFDC_Init(diskrec%,logbps%,spt%,heads%,den%,tracks%,sec0%):r%=FNdiskop(3,data%,spt%):IFr%=0:ENDPROC
1050 ENDPROC
1070 DEFPROCparameters
1090 logbps%=10:spt%=16:den%=2:IFHIMEM-LOMEM<20480:logbps%=8:spt%=16:den%=1
1100 dstep%=FALSE:tracks%=80:sec0%=0:sides%=2:heads%=1:seq%=TRUE
1110 IFauto%:IFsize%=0:size%=-1:ENDPROC
1120 auto%=FALSE
1150 IFsize%:A$="G:"+FNsize(size%):IFA$="G:":geom$=""
1160 IFA$=geom$:geom$=""
1170 geom2$=geom$
1190 logbps%=8:spt%=10:den%=1:sides%=1
1200 REPEAT
1220 REPEAT:A$=FNs(A$)
1230 A%=FNp("D"):IFA%<>TRUE:den%=A%
1240 A%=FNp("Q"):IFA%<>TRUE:seq%=A%
1250 A%=FNp("H"):IFA%<>TRUE:sides%=A%
1260 A%=FNp("T"):IFA%<>TRUE:tracks%=A%
1270 A%=FNp("S"):IFA%<>TRUE:logbps%=A%+7
1280 A%=FNp("B"):IFA%<>TRUE:logbps%=(LNA%)/(LN2)
1290 A%=FNp("N"):IFA%<>TRUE:spt%=A%
1300 IFLEFT$(A$,1)="Z"ORLEFT$(A$,1)="z":sec0%=EVAL("&"+MID$(A$,2)):A$=MID$(A$,2+LENSTR$~A%)
1310 IFLEFT$(A$,1)=":":A$=MID$(A$,2)
1320 UNTILINSTR("DdQqHhTtSsBbNnZz",LEFT$(A$,1))=0ORA$=""
1330 IFLEFT$(A$,2)<>"G:"ANDLEFT$(A$,2)<>"g:":PROCgeom:A$="G:"+geom$
1360 IFLEFT$(A$,2)<>"G:":PRINT"Unknown geometry":PROCexit(220):END
1370 den%=VALMID$(A$,3):seq%=VALMID$(A$,5)<>0:sides%=VALMID$(A$,7)
1380 heads%=sides%:tracks%=VALMID$(A$,9):logbps%=7+VALMID$(A$,12):IFlogbps%>14:logbps%=logbps%-7
1390 spt%=VALMID$(A$,14):sec0%=EVAL("&"+MID$(A$,17,2))
1400 A$=geom2$:geom2$="":UNTILA$=""
1410 IFseq%:IFheads%=2:heads%=1
1420 ENDPROC
1440 DEFFNp(B$):IFLEFT$(A$,1)<>B$ANDLEFT$(A$,1)<>CHR$(ASCB$+32):=TRUE
1450 A%=VALMID$(A$,2):A$=MID$(A$,2+LENSTR$A%):=A%
1470 DEFPROCsyntax:PRINT"DiskToImg <src drive> <outfile> (-size <num>) (<geometry>) -a -m -z -v -help":ENDPROC
1490 DEFPROChelp:PROCsyntax:PRINT$(PAGE+17)" (C)J.G.Harston 2008-2014"
1500 PRINT" -auto attempts to autosense source disk layout"
1510 PRINT" -mix mixed-density Slogger disk"
1520 PRINT" -zero track 0 starts with sector 0"
1530 PRINT" -inv invert data"
1540 PRINT" <geometry> is:"
1550 PRINT" G:<den>:<seq>:<heads>:<tracks>:<logsecsize>:<sectors>:<sec0>"
1560 PRINT" or any combination of:"
1580 PRINT" D<den>:Q<seq>:H<heads>:T<tracks>:B<secsize>:N<sectors>:Z<sec0>"
1590 PRINT" known -size options are:"
1600 FORA%=50TO1600STEP10
1610 geom$=FNsize(A%):IFgeom$<>"":PRINT" -size ";A%;"K : ";FNgeom
1620 NEXT:ENDPROC
1640 DEFFNsize(size%)
1660 IFsize%=200:="1:1:1:80:1:10:00"
1670 IFsize%=320:="2:1:1:80:1:16:00"
1680 IFsize%=400:="1:1:2:80:1:10:00"
1690 IFsize%=640:="2:1:2:80:1:16:00"
1700 IFsize%=720:="2:0:2:80:2:09:01"
1710 IFsize%=800:="2:0:2:80:3:05:00"
1720 IFsize%=1440:="4:0:2:80:2:18:01"
1730 IFsize%=1600:="4:0:2:80:3:10:00"
1750 IFsize%=100:="1:1:1:40:1:10:00"
1760 IFsize%=160:="2:1:1:40:1:16:00"
1770 IFsize%=360:="2:0:2:40:2:09:01"
1780 IFsize%=400:="2:1:2:40:2:10:01"
1800 IFsize%=070:="1:1:1:35:0:16:01"
1810 IFsize%=140:="1:1:2:35:0:16:01"
1820 IFsize%=280:="2:1:1:35:1:16:01"
1830 =""
1850 DEFFNgeom
1860 IFgeom$="":="autosensed disk"
1880 IFgeom$="1:1:1:40:1:10:00":="1*40*10*256 FM disk (40T DFS)"
1890 IFgeom$="2:1:1:40:1:16:00":="1*40*16*256 MFM disk (ADFS S)"
1900 IFgeom$="1:1:1:80:1:10:00":="1*80*10*256 FM disk (80T DFS)"
1910 IFgeom$="2:1:1:80:1:16:00":="1*80*16*256 MFM disk (ADFS M)"
1920 IFgeom$="1:1:2:80:1:10:00":="2*80*10*256 FM disk (2xDFS, L2FS, AcornCPM, TorchCPN, HADFS)"
1930 IFgeom$="1:0:2:80:1:10:00":="80*2*10*256 FM disk (interleaved 2xDFS, L2FS, AcornCPM, TorchCPN, HADFS)"
1940 IFgeom$="2:1:2:80:1:16:00":="2*80*16*256 MFM disk (ADFS L, L3FS, Filestore)"
1950 IFgeom$="2:0:2:80:1:16:00":="80*2*16*256 MFM disk (interleaved ADFS L, L3FS, Filestore)"
1960 IFgeom$="2:0:2:80:2:09:01":="80*2*9*512 MFM disk (DOS 720K)"
1970 IFgeom$="2:0:2:80:3:05:00":="80*2*5*1024 MFM disk (MDFS, AcornDOS, ADFS D,E)"
1980 IFgeom$="2:0:2:80:3:05:01":="80*2*5*1024 MFM disk (AcornDOS)"
1990 IFgeom$="4:0:2:80:2:18:01":="80*2*18*512 MFM disk (DOS 1440K)"
2000 IFgeom$="4:0:2:80:3:10:00":="80*2*10*1024 MFM disk (ADFS F)"
2020 IFgeom$="1:1:1:35:0:16:01":="1*35*16*128 FM disk (1xMZ-80K)"
2030 IFgeom$="1:1:2:35:0:16:01":="2*35*16*128 FM disk (2xMZ-80K)"
2040 IFgeom$="2:1:1:35:1:16:01":="1*35*16*256 MFM disk (MZ-80A/B)"
2050 IFgeom$="2:0:2:40:2:09:01":="40*2*9*512 MFM disk (360K DOS)"
2060 IFgeom$="2:1:2:40:2:10:01":="2*40*10*512 MFM disk (MZ-80A/B CPM)"
2080 IFgeom$="2:1:2:80:2:10:00":="2*80*10*512 MFM disk (Slogger DDCPM)"
2090 ="G:"+geom$+" disk"
2110 DEFPROCgeom
2120 geom$=STR$den%+":"+STR$(seq%AND1)+":"+STR$sides%+":"+STR$tracks%+":"+STR$(logbps%-7)+":"+RIGHT$("0"+STR$spt%,2)+":"+RIGHT$("0"+STR$~sec0%,2)
2130 ENDPROC
2150 DEFFNimgtype(in$)
2160 in%=OPENIN(in$):IFin%=0:=-1
2170 PROCgbpb(4,in%,data%,16,0):CLOSE#in%:in%=0
2180 data%?11=13
2190 IF$data%="Slogger CPM":=&1A6
2200 IF$data%="SLOGGER CPM":=&1A6
2210 data%?8=13
2220 IF$data%="Acorn CP":=&1A6
2230 IF$data%="ACORN CP":=&1A6
2240 IF$(data%+5)="DOS":=&FC8
2250 =&B22
2280 DEFPROCFDC_Init(dskrec%,bps%,spt%,hds%,den%,trks%,sec0%)
2290 LOCALi%:IFos%<>6:ENDPROC
2300 dskrec%?0=bps%:dskrec%?1=spt%:dskrec%?2=hds%:dskrec%?3=den%
2310 FORi%=4TO59STEP4:dskrec%!i%=0:NEXT:dskrec%!64=&20000000
2320 dskrec%?8=sec0%:dskrec%!16=trks%*spt%*(2^bps%)*hds%
2330 ENDPROC
2350 DEFFNdiskop(op%,data%,spt%)
2360 IFos%=6:SYS"XADFS_DiscOp",0,op%+64+(diskrec%<<6),offset%*spt%*bps%+(drive%<<29),data%,spt%*bps%TOr%:=r%
2370 IFden%=1:IFop%=1:=FNdisk(data%,&53,drive%+head%*2,track%,sec0%,spt%,den%)
2380 IFden%=1:IFop%=2:=FNdisk(data%,&4B,drive%+head%*2,track%,sec0%,spt%,den%)
2390 IFden%=1:IFop%=3:=FNdisk(data%,&5B,drive%+head%*2,track%,sec0%,spt%,den%)
2400 IFden%=2:IFop%=1:=FNscsi(data%,&008,drive%,track%*16+head%*80,spt%)
2410 IFden%=2:IFop%=2:=FNscsi(data%,&10A,drive%,track%*16+head%*80,spt%)
2420 =-1
2440 DEFPROCClose_All
2450 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
2460 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
2470 ENDPROC
2490 DEFPROCgbpb(A%,chn%,addr%,num%,ptr%)
2500 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:CALL&FFD1:ENDPROC
2520 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
2530 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
2550 DEFPROCHour_Glass(A%):IFos%<>6:ENDPROC
2560 IFA%=-1:SYS"Hourglass_On":ENDPROC
2570 IFA%=-2:SYS"Hourglass_Off":ENDPROC
2580 IFA%=-3:SYS"Hourglass_Smash":ENDPROC
2590 SYS"Hourglass_Percentage",A%
2600 ENDPROC
2620 DEFFNOS_GetEnv:LOCALA$,A%:X%=1:os%=((USR&FFF4)AND&FF00)DIV256:DIMX%-1
2630 IFos%=32:IFPAGE>&FFFF:SYS"GetModuleFileName",0,X%,255:A$=$$X%:run$=A$:=@cmd$
2640 IFos%=32:A$=$&100
2650 IFLENA$=0:IFPAGE>&7FFF:run$=$&8100:SYS"OS_GetEnv"TOA$,,A%:SYS"OS_WriteEnv","",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$
2660 IFLENA$=0:IF?(TOP-3):A$=$&600ELSEIFLENA$=0:A$=$(PAGE-&300)
2670 A%=INSTR(A$+" "," "):run$=LEFT$(A$,A%-1):IFrun$<>"":=MID$(A$,A%+1)
2680 Y%=X%DIV256:A%=9:?X%=0:X%!1=X%+16:X%!16=0:CALL&FFD1:A%=X%+16:IF!A%AND?A%+A%?2<>8:A%?(A%+1)=13:=$(A%+1)
2690 =""
2710 DEFPROCexit(A%):OSCLI"FX1,"+STR$A%:END
2720 ENDPROC
2740 DEFFNcl(l$,n%):IFl$="":A$=FNs(A$):IFASCA$=34:A%=INSTR(A$+" "" ",""" ",2):l$=MID$(A$,2,A%-2):A$=FNs(MID$(A$,A%+1)):=l$
2750 IFl$="":A%=INSTR(A$+" "," "):l$=LEFT$(A$,A%-1):A$=FNs(MID$(A$,A%+1)):=l$
2760 IFn%=0:IFl$<>"":A%=INSTR(A$,l$):IFA%:A$=FNs(LEFT$(A$,A%-1)+MID$(A$,INSTR(A$," ",A%)+1))+" ":=TRUE
2770 IFn%=0:IFl$<>"":=FALSE
2780 A%=INSTR(LEFT$(" ",ASCl$=32)+A$,l$):IFA%=0:=""
2790 A$=LEFT$(A$,A%-1)+FNs(MID$(A$,INSTR(A$," ",A%)+1))
2800 IFASCl$=32:l$=MID$(A$,A%):A$=LEFT$(A$,A%-1):=MID$(l$,1-(ASCl$=34),LENl$+2*(ASCl$=34))
2810 IFASCMID$(A$,A%,1)<>34:l$=MID$(A$,A%,INSTR(A$+" "," ",A%)-A%):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+1):=l$
2820 l$=MID$(A$,A%+1,INSTR(A$+""" ",""" ",A%+1)-A%-1):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+3):=l$
2830 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
2840 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
2850 =A$
2870 DEFFNdisk(addr%,cmd%,drv%,trk%,sec%,num%,den%):LOCALfs%
2880 fs%=FNfs:IFfs%<>4:*FX143,18,4
2890 REPEATX%?0=drv%+den%*24+8:X%!1=addr%:X%?5=3-7*(cmd%>127)
2900 X%?6=cmd%:X%?7=trk%:X%?8=sec%:X%?9=num%OR&20:A%=127:CALL&FFF1
2910 A%=X%?(7+X%?5):UNTILA%<>&10:IFfs%<>4:OSCLI"FX143,18,"+STR$fs%
2920 =A%
2940 DEFFNscsi(addr%,cmd%,drv%,sect%,num%):LOCALfs%
2950 fs%=FNfs:IFfs%<>8:*FADFS
2960 X%?0=0:X%!1=addr%:X%?5=cmd%:X%?6=drv%*32+((sect%AND&1F0000)DIV65536)
2970 X%?7=((sect%AND&FF00)DIV256):X%?8=sect%:X%!9=num%:X%!11=0
2980 A%=&72:CALL&FFF1:A%=?X%:IFfs%<>8:OSCLILEFT$("DISMOUNT",cmd%>255):OSCLI"FX143,18,"+STR$fs%
2990 =A%
3010 DEFFNfs:LOCALA%,E%,Y%:=(USR&FFDA)AND&FF
65449
162 CLGOSCLIPOSPROCATN CIRCLELOADWHEN
PAGEREPORTEVAL TRUEA{ATN RECTANGLELOADLEFT$(
PAGEREPEATEVAL ORLNTRUE CIRCLEATNINSTALLRECTANGLELOADWHEN
PAGEREPEATATNINSTALLRECTANGLELEN"™ g{¢N {L÷ÿQ%=PA.:CH."* BASIC
f{Z{{{ORLENFNLNTRUE RECTANGLEGCOLLNFNLEN`EVALORIGINTRUEPRIVATEELLIPSELNTRUET{ATNPRIVATEELLIPSETAB(ATNT{STEPEXITVDU`WHENOSCLIPLOTFILLLEN `LINEINTORLEN g{,zELLIPSE0 EVALELLIPSEPOSINTERRORLNLOADPOSINTERRORLOGEVAL TRUECLEARQTIMELNLOADPAGERETURNGCOLLOGONDEG{EXITPRINT
352 PTR QUITMOUSEPAGERUNLENELLIPSEeINTLNLEN eLENINTLENCIRCLE QUITMOUSEEVAL ENDPROC{ ENDPROC{TRUECLEARQ2302PAGEPRINTONENDWHILE{EXITMOVELENPTR QUITMOUSELENCIRCLE`