1 REM > DiskToImg v0.29
   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  CLGOSCLIPOSPROCATNCIRCLELOADWHEN PAGEREPORTEVALTRUEA{ATNRECTANGLELOADLEFT$( PAGEREPEATEVALORLNTRUECIRCLEATNINSTALLRECTANGLELOADWHEN PAGEREPEATATNINSTALLRECTANGLELEN"  g{N{LQ%=PA.:CH."* BASIC f{Z{{{ORLENFNLNTRUERECTANGLEGCOLLNFNLEN`EVALORIGINTRUEPRIVATEELLIPSELNTRUET{ATNPRIVATEELLIPSETAB(ATNT{STEPEXITVDU`WHENOSCLIPLOTFILLLEN`LINEINTORLEN g{,zELLIPSE0EVALELLIPSEPOSINTERRORLNLOADPOSINTERRORLOGEVALTRUECLEARQTIMELNLOADPAGERETURNGCOLLOGONDEG{EXITPRINT
  352   PTR QUITMOUSEPAGERUNLENELLIPSEeINTLNLENeLENINTLENCIRCLE QUITMOUSEEVAL ENDPROCENDPROC{TRUECLEARQ2302PAGEPRINTONENDWHILE{EXITMOVELENPTR QUITMOUSELENCIRCLE