start tok64 d64-m8UAYs 100 REM *** lfs disco *** 110 REM 120 REM 5/31/87 version 130 REM 140 REM copyright, 1987 150 REM louis f. sander 160 REM 153 mayer drive 170 REM pittsburgh, pa 15237 180 REM 190 POKE53280,11:POKE53281,15:PRINTCHR$(142);"{dark gray}" 200 au$="{clear}{reverse on}{space*24}louis f. sander {reverse off} {home}{reverse on} " 210 hx$="0123456789abcdef" 220 ol$="{cm @*40}" 230 sh=653:IFPEEK(65534)=23THENsh=211:REM c128 240 xl$="{down*2}{cm t*16}{up*2} 250 wk$=" {cm @*10}{down}{left*10}{reverse on}working{.*3} 260 PRINTau$;"disco" 270 PRINT"{down} this performs various disk utility 280 PRINT" operations on the c-64 and c-128. 290 PRINT"{down} press the key for your choice: 300 PRINT"{down} 1 - change disk name and/or id 310 PRINT" 2 - lock or unlock an entire disk 320 PRINT" 3 - lock or unlock a file 330 PRINT" 4 - examine a file 340 PRINT" 5 - find addresses for a prg file 350 PRINT" 6 - print a seq file 360 PRINT" 7 - unscratch file(s) 370 PRINT"{down} press any other key to quit. 380 GETa$:IFa$=""THEN380 390 IFVAL(a$)=0ORVAL(a$)>7THEN450 400 ONVAL(a$)GOSUB470,810,1060,1400,1860,2120,2430 410 CLOSE2:CLOSE3:CLOSE15 420 PRINTol$;"{reverse on} press to return to the menu{.*3}{home}"; 430 GETa$:IFa$<>CHR$(13)THEN430 440 RUN 450 END 460 : 470 PRINTau$;"disk name/id changer 480 PRINT"{down} this changes the diskname and/or 490 PRINT" cosmetic id code of any disk. 500 GOSUB2680:REM wait 510 PRINTau$;"disk name/id changer 520 PRINT"{down} press return to keep old name or id{.*3}{down} 530 OPEN15,8,15,"i0":OPEN2,8,2,"#" 540 GOSUB700 550 PRINTTAB(18);xl$ 560 nn$=dn$:INPUT"{space*8}new name";nn$ 570 IFLEN(nn$)>16THENPRINTTAB(14)"{down}{reverse on}too long!":GOTO550 580 nn$=nn$+"{sh space*16}":REM sh spaces 590 PRINTTAB(18)"{down*2}{cm t*2}{up*2}":ni$=ci$ 600 INPUT" new cosmetic id";ni$:PRINT 610 IFLEN(ni$)<>2THEN590 620 REM write new name & id 630 PRINT#15,"b-p:";2;144 640 PRINT#2,LEFT$(nn$,16);CHR$(160);CHR$(160);ni$; 650 PRINT#15,"u2:";2;0;18;0 660 GOSUB700 670 PRINT#15,"i0" 680 RETURN 690 REM read&print diskname&id 700 PRINT#15,"u1:";2;0;18;0 710 PRINT#15,"b-p:";2;144 720 dn$="":FORj=1TO16:GET#2,a$:dn$=dn$+a$:NEXT 730 PRINT"{down}{space*4}disk name is: "dn$ 740 GET#2,a$,a$,a$,b$:ci$=a$+b$ 750 PRINT"{down}{space*2}cosmetic id is: "ci$ 760 PRINT#15,"m-r"CHR$(18)CHR$(0)CHR$(2) 770 GET#15,a$,b$:id$=a$+b$ 780 PRINT"{down}{space*6}real id is: "id$ 790 RETURN 800 : 810 PRINTau$;"disk lock/unlock 820 PRINT"{down} this locks or unlocks an entire disk. 830 GOSUB2680:REM wait 840 OPEN15,8,15,"i0":OPEN2,8,2,"#" 850 REM read diskname 860 PRINT#15,"u1:";2;0;18;0 870 PRINT#15,"b-p:";2;144 880 dn$="":FORj=1TO16:GET#2,a$:dn$=dn$+a$:NEXT 890 REM lock/unlock 900 PRINT#15,"u1:";2;0;18;0 910 PRINT#15,"b-p:";2;2:GET#2,a$:PRINT#15,"b-p:";2;2 920 s1$="unlocked":s3$="{space*2}lock":s4$="locked!" 930 IFa$<>CHR$(65)THENs1$="locked":s3$="unlock":s4$="unlocked!" 940 PRINT"{down*2}{space*3}disk name is: ";dn$ 950 PRINT"{down}{space*9}status: ";s1$ 960 PRINT"{down}{space*6}";s3$;" it{space*2}n{left*3}";:INPUTa$:a$=LEFT$(a$,1):IFa$<>"y"THEN1030 970 IFs1$="unlocked"THENPRINT#2,CHR$(1);:GOSUB2860:GOTO1010 980 PRINT#2,CHR$(65);:GOSUB2860 990 PRINT#15,"m-w";CHR$(1);CHR$(1);CHR$(1);CHR$(65) 1000 PRINT#15,"m-w";CHR$(2);CHR$(7);CHR$(1);CHR$(65) 1010 PRINT#15,"u2:";2;0;18;0:GOSUB2860 1020 PRINT"{down}{space*5}new status: {reverse on}";s4$ 1030 CLOSE2:PRINT#15,"i0" 1040 RETURN 1050 : 1060 PRINTau$;"file lock 1070 PRINT"{down} this can lock or unlock any file." 1080 a$="lock or unlock":GOSUB2750:REM wait 1090 OPEN15,8,15,"i0":OPEN2,8,2,"0:"+f$:GOSUB2860:CLOSE2:OPEN2,8,2,"#" 1100 IFLEN(f$)<16THENf$=f$+CHR$(160):GOTO1100 1110 t=18:s=1:n$=CHR$(0) 1120 PRINT#15,"u1:2 0"t;s:GOSUB2860 1130 PRINT#15,"b-p:2,0":GET#2,t$,s$:tc=t:sc=s:t=ASC(t$+n$):s=ASC(s$+n$) 1140 FORi=0TO7 1150 PRINT#15,"b-p:2"2+i*32 1160 GET#2,a$:ty=ASC(a$+n$):IF(tyAND128)=0THEN1220 1170 GET#2,a$,b$ 1180 d$="":FORj=0TO15:GET#2,c$:IFc$=""THENc$=n$ 1190 d$=d$+c$:NEXT 1200 IFf$<>d$THEN1220 1210 fo=i:i=1000 1220 NEXT 1230 IFi=1001THEN1250 1240 GOTO1120 1250 PRINT"{down}{space*2}file type: "MID$("delseqprgusrrel{?*9}",(tyAND7)*3+1,3); 1260 s1$="unlocked":s2$="":s3$="{space*2}lock":s4$="locked!" 1270 IFtyAND64THENs1$="locked":s2$="<":s3$="unlock":s4$="unlocked!" 1280 PRINTs2$ 1290 PRINT"{down}{space*5}status: "s1$ 1300 PRINT"{down}{space*2}";s3$;" it{space*2}n{left*3}";:INPUTa$:a$=LEFT$(a$,1) 1310 IFa$="n"THEN1370 1320 IFa$<>"y"THEN1300 1330 ty=(tyAND191)OR((255-ty)AND64) 1340 PRINT#15,"b-p:2"2+fo*32:PRINT#2,CHR$(ty); 1350 PRINT#15,"u2:2 0"tc;sc:GOSUB2860 1360 PRINT"{down} new status: {reverse on}";s4$ 1370 PRINT#15,"i0" 1380 RETURN 1390 : 1400 PRINTau$;"file examiner 1410 PRINT"{down} this lets you see the contents of any 1420 PRINT" prg, seq or usr file. 1430 a$="examine":GOSUB2750:REM wait 1440 OPEN15,8,15,"i0":OPEN2,8,2,f$:GOSUB2860 1450 PRINT"{down} you can choose a fast hex dump or a 1460 PRINT" slower byte-by-byte display in hex,":PRINT" decimal and ascii. 1470 INPUT"{down} display (h or b){space*2}h{left*3}";d$:d$=LEFT$(d$,1):IFd$="h"THEN1650 1480 IFd$<>"b"THEN1470 1490 REM byte-by-byte 1500 PRINT"{down} to step through the file, press {up}{cm @*5}{left*5}{down}{reverse on}space{reverse off}." 1510 PRINT"{down} to quit, press any other key." 1520 PRINT"{down}{reverse on}byte#{right}hex{right}chr${right}ascii" 1530 j=j+1 1540 GET#2,a$:a$=LEFT$(a$+CHR$(0),1):a=ASC(a$):b$=a$ 1550 IFa$=CHR$(34)THENb$=CHR$(34)+CHR$(20)+CHR$(34) 1560 IFa$CHR$(127)THENIFa$""THENPRINT:GOTO1830 1720 GET#2,x$:IFx$=""THENx$=CHR$(0) 1730 IF(st)THEN1800 1740 x=ASC(x$):h=INT(x/16):l=x-(h*16) 1750 PRINTMID$(hx$,h+1,1)+MID$(hx$,l+1,1);" "; 1760 NEXT 1770 c=c+10:PRINT 1780 GOTO1680 1790 REM end of file 1800 IFd$="h"THENPRINT 1810 IF(st)AND64THENPRINT" {reverse on}end of file":GOTO1840 1820 PRINT"{reverse on} st=";st;" " 1830 PRINT"{down} aborted!" 1840 RETURN 1850 : 1860 PRINTau$;"address finder 1870 PRINT"{down} this shows the load and end addresses 1880 PRINT" for any {reverse on} prg {reverse off} file. (other file types 1890 PRINT" will give type mismatch errors). 1900 IFsh<>653THENPRINT"{down} it works in c-64 mode only.":RETURN 1910 GOSUB2750 1920 REM * these lines from addr finder. bad on 128 & +/4? 1930 PRINTwk$ 1940 OPEN15,8,15,"i0":OPEN2,8,2,f$+",p,r":GOSUB2860 1950 POKE782,1:SYS65493:ea=PEEK(174)+256*PEEK(175)-1:REM ok on 128/+4? 1960 h=INT(ea/256):l=ea-256*h:GOSUB2080:ea$=h$ 1970 GET#2,l$:l=ASC(l$+n$) 1980 GET#2,h$:h=ASC(h$+n$):GOSUB2080 1990 PRINT"{up*2}{space*11}":PRINT" hex load range: ";h$;" - ";ea$ 2000 PRINT" dec load range: ";h*256+l;"-";ea 2010 pl=ea+1-(h*256+l) 2020 h=INT(pl/256):l=pl-256*h:GOSUB2080 2030 PRINT" program length: ";pl;"bytes (";h$;")" 2040 PRINT"load addr lo/hi: ";l;"/";h 2050 RETURN 2060 : 2070 REM hex conversion 2080 h$="$":n(1)=256*h+l:FORi=2TO6:n(i)=0:NEXT:FORk=1TO4:m=16^(4-k) 2090 h(k)=INT(n(k)/m):n(k+1)=n(k)-h(k)*m:h$=h$+MID$(hx$,h(k)+1,1):NEXT 2100 RETURN 2110 : 2120 PRINTau$;"fileprinter 2130 PRINT"{down} this lists seq files onto the screen 2140 PRINT" or onto your printer. 2150 a$="print":GOSUB2750:REM wait 2160 OPEN15,8,15,"i0":OPEN2,8,2,f$+",s,r":GOSUB2860 2170 INPUT"{down} print to {reverse on}s{reverse off}creen or {reverse on}p{reverse off}rinter{space*2}p{left*3}";a$:a$=LEFT$(a$,1) 2180 IFa$="s"THENdn=3:GOTO2210 2190 IFa$="p"THENdn=4:GOTO2230 2200 GOTO2170 2210 PRINT"{clear}";TAB(17)"{cm @*5}{space*4}{cm @*10} 2220 PRINTCHR$(14);" To pause, press {reverse on}SHIFT{reverse off} or {reverse on}SHIFT LOCK{reverse off}. 2230 OPEN3,dn,7: REM u&lc 2240 IFdn=3THEN2290 2250 OPEN5,4,5:CLOSE5 2260 IFst<>0THENPRINT"{down}{reverse on} printer is off line! program aborted.":GOTO2410 2270 INPUT"{down} left margin (0-20){space*2}9{left*3}";lm:IF(lm<0)OR(lm>20)THEN2270 2280 sp$=LEFT$("{space*20}",lm):PRINT"{down} printing{.*3}{up}"; 2290 PRINT"{down} to abort, press {reverse on}{reverse off}.":IFdn=3THEN PRINT"{up} T 2300 PRINT#3:PRINT#3,sp$; 2310 GETb$:IFb$=CHR$(13)THEN2400 2320 IFPEEK(sh)=1THEN2320:REM shift key 2330 GET#2,a$ 2340 IFstTHEN2380 2350 PRINT#3,a$;:IFa$=CHR$(13)THENl=l+1:PRINT#3,sp$; 2360 IFl=60THENIFdn=4THENl=0:FORj=1TO6:PRINT#3:NEXTj 2370 GOTO2310 2380 PRINT#3:PRINT#3 2390 PRINT#3,"**{space*2}";f$;" - Printed by Louis F. Sander's FILEPRINTER{space*2}**" 2400 PRINT#3 2410 RETURN 2420 : 2430 PRINTau$;"unscratch 2440 PRINT"{down} this can retrieve programs and other 2450 PRINT" files that have been scratched from a 2460 PRINT" diskette. 2470 PRINT"{down} to use it safely,you {up}{cm @*4}{left*4}{down}{reverse on}must{reverse off} be familiar 2480 PRINT" with the instructions. 2490 GOSUB2680:REM wait 2500 PRINTwk$ 2510 DIMbl$(255):tr=18:se=1:OPEN15,8,15,"i0":OPEN1,8,2,"#" 2520 PRINT#15,"u1:2,"8,tr,se:FORp=0TO255:GET#1,bl$(p):NEXTp 2530 nt=ASC(bl$(0)+CHR$(0)):ns=ASC(bl$(1)+CHR$(0)):nm=1:FORfi=2TO255STEP32 2540 FORpn=3TO18:IFbl$(fi+pn)=""THEN2590 2550 FORpn=3TO18:PRINTbl$(fi+pn);:NEXT:PRINT:IFASC(bl$(fi)+CHR$(0))<>0THEN2590 2560 INPUT"unscratch the above file{space*2}n{left*3}";a$:IFLEFT$(a$,1)="n"THEN2590 2570 xs=xs+1:nm=0:PRINT"file types: 1=seq{space*2}2=prg{space*2}3=usr{space*2}4=rel 2580 INPUT"file type{space*3}2{left*3}";ty:bl$(fi)=CHR$(ty+128):IFty>4ORty<1THEN2580 2590 NEXTfi:PRINTwk$:IFnm=1THEN2610 2600 FORp=0TO255:PRINT#15,"b-p:"2,p:PRINT#1,bl$(p);:NEXTp:PRINT#15,"u2:2,"0,tr,se 2610 IFnt=0ANDns=255THEN2630 2620 tr=nt:se=ns:GOTO2520 2630 CLOSE1 2640 IFxs>0THENPRINT"{down} {reverse on}validating disk. please stand by{.*3}":PRINT#15,"v0" 2650 RETURN 2660 : 2670 REM * insert disk, press d 2680 PRINT"{down} to proceed, put the disk in drive #8,":PRINT" then press d. 2690 PRINT"{down} to return to the menu, press . 2700 GETa$:IFa$=CHR$(13)THENRUN 2710 IFa$="d"THENRETURN 2720 GOTO2700 2730 : 2740 REM * insert disk, enter filename 2750 PRINT"{down} to proceed, put the disk in drive #8, 2760 PRINT" then enter the name of the file you 2770 PRINT" want to ";a$;"." 2780 PRINT"{down} to return to the menu, press 2790 PRINT" without entering a filename. 2800 PRINTTAB(13);xl$ 2810 f$="":INPUT"{space*3}filename";f$ 2820 IFf$=""THENRUN 2830 RETURN 2840 : 2850 REM * disk error check 2860 INPUT#15,e,e$:IFe=63THEN2880 2870 IFe>19THENPRINT"{down} ";LEFT$(ol$,LEN(e$)):PRINT" {reverse on}";e$:GOTO410 2880 RETURN stop tok64 (bastext 1.0)