jshackney/c64-diskfmt
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Minor updates

Browse source
This commit is contained in:
jshackney 2026-09-19 20:28:00 -04:00
parent 91965273ae
commit 7d17685973
1 changed files with 119 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

192
src/fmt3.bas
View file

@ -32,70 +32,90 @@
31 rem 31 rem
32 rem --- constants --- 32 rem --- constants ---
33 rem b$ base36 digit table 33 rem b$ base36 digit table
34 rem (the old nw$ and iw$ whitelist 34 rem sp$ forty spaces, used for padding
35 rem strings are gone - see 4160) 35 rem hd$ header text, passed to 3900
36 rem 36 rem the old nw$ and iw$ whitelist strings are
37 rem --- device and drive --- 37 rem gone - the input filter at 4160 tests
38 rem dv target device number 38 rem character codes numerically instead.
39 rem pd program's own device, peek(186) 39 rem
40 rem np count of devices that answered 40 rem --- screen colour and attribute strings ---
41 rem pv() device numbers that answered 41 rem wh$ white yl$ yellow rd$ red
42 rem sd menu index into pv() 42 rem gn$ green cy$ cyan gy$ light grey
43 rem dt drive class: 0=unknown 1=1541 2=1581 43 rem rv$ reverse on ro$ reverse off
44 rem nt$ drive name for display 44 rem
45 rem vs$ raw dos version reply 45 rem --- device and drive ---
46 rem tr header track nf name offset 46 rem dv target device number
47 rem 47 rem pd program's own device, peek(186)
48 rem --- disk state --- 48 rem np count of devices that answered
49 rem cn$ current disk name, from the header 49 rem pv() device numbers that answered
50 rem ci$ current disk id, from the header 50 rem sd menu index into pv()
51 rem hr 1 = header read succeeded 51 rem dt drive class: 0=unknown 1=1541 2=1581
52 rem dn$ new disk name, normalized 52 rem nt$ drive name for display
53 rem id$ new two character disk id 53 rem vs$ raw dos version reply
54 rem h hash accumulator, always < 1296 54 rem tr header track nf name offset
55 rem hi lo high and low base36 digits 55 rem
56 rem 56 rem --- disk state ---
57 rem --- dos --- 57 rem cn$ current disk name, from the header
58 rem en dos error number 58 rem ci$ current disk id, from the header
59 rem em$ dos reply text, whole line 59 rem hr 1 = header read succeeded
61 rem 60 rem dn$ new disk name, normalized
62 rem --- input routine, 4000 --- 61 rem id$ new two character disk id
63 rem ml fc df$ in$ ff ky$ a 62 rem h hash accumulator, always < 1296
64 rem --- scan routine, 3000 --- 63 rem hi lo high and low base36 digits
65 rem hs$ fs$ fd ln i 64 rem
66 rem --- hash routine, 3600 --- 65 rem --- dos ---
67 rem nm$ i 66 rem en dos error number
67 rem em$ dos reply text, whole line
68 rem 68 rem
69 rem k general loop counter 69 rem --- input routine, 4000 ---
70 rem a$ keypress / byte scratch 70 rem ml fc df$ in$ ff ky$ a
71 rem *********************************************** 71 rem --- scan routine, 3000 ---
72 rem 72 rem hs$ fs$ fd ln i
73 rem --- hash routine, 3600 ---
74 rem nm$ i
75 rem
76 rem k general loop counter
77 rem a$ keypress / byte scratch
78 rem ***********************************************
79 rem
100 rem --- constants --------------------------------- 100 rem --- constants ---------------------------------
101 rem b$ is the base36 digit table, used only by 101 rem b$ is the base36 digit table, used only by
102 rem the encoder at 3800. the old nw$ and iw$ 102 rem the encoder at 3800. the old nw$ and iw$
103 rem whitelist strings are gone: the input filter 103 rem whitelist strings are gone: the input filter
104 rem now tests character codes numerically. 104 rem now tests character codes numerically.
110 b$="0123456789abcdefghijklmnopqrstuvwxyz" 110 b$="0123456789abcdefghijklmnopqrstuvwxyz"
112 sp$=" "
114 rem -- petscii colour and attribute codes
115 wh$=chr$(5) : yl$=chr$(158) : rd$=chr$(28)
116 gn$=chr$(30) : cy$=chr$(159) : gy$=chr$(155)
117 rv$=chr$(18) : ro$=chr$(146)
118 rem -- black border and background. printing a
119 rem colour code also updates location 646, so
120 rem every line that changes colour ends by
121 rem restoring gy$ - otherwise the next plain
122 rem print inherits whatever was set last.
124 poke 53280,0 : poke 53281,0 : poke 646,15
140 dim pv(4) 140 dim pv(4)
150 pd=peek(186) 150 pd=peek(186)
160 rem 160 rem
200 rem --- splash ------------------------------------ 200 rem --- splash ------------------------------------
210 print chr$(147); 210 print chr$(147);
220 print "disk formatter" 215 hd$="disk formatter" : gosub 3900
230 print "1541 / 1571 / 1581" 220 print
230 print gy$;"1541 / 1571 / 1581"
240 print 240 print
250 print "loaded from device";pd 250 print "loaded from device";pd
260 print 260 print
270 rem 270 rem
300 rem --- probe the bus ----------------------------- 300 rem --- probe the bus -----------------------------
310 print "scanning devices 8-11..." 310 print cy$;"scanning devices 8-11...";gy$
320 gosub 2800 320 gosub 2800
330 if np=0 then print : print "no drives answered." : end 330 if np=0 then print rd$;"no drives answered." : gosub 3950 : end
340 print 340 print
350 print "found:" 350 print wh$;"found:";gy$
360 for k=1 to np : print " ";k;" = device";pv(k) : next k 360 for k=1 to np : print " ";k;" = device";pv(k) : next k
370 print 370 print
380 print "select 1-";np;": "; 380 print cy$;"select 1-";np;": ";gy$;
390 get a$ : if a$="" then 390 390 get a$ : if a$="" then 390
400 sd=val(a$) 400 sd=val(a$)
410 if sd<1 or sd>np then 390 410 if sd<1 or sd>np then 390
@ -104,11 +124,11 @@
440 rem 440 rem
450 rem --- identify the drive ------------------------ 450 rem --- identify the drive ------------------------
460 print 460 print
470 print "identifying..." 470 print cy$;"identifying...";gy$
480 gosub 2200 480 gosub 2200
490 print "reply : ";vs$ 490 print "reply : ";vs$
500 print "drive : ";nt$ 500 print "drive : ";wh$;nt$;gy$
510 if dt=0 then print : print "unrecognised drive." : goto 1020 510 if dt=0 then print : print rd$;"unrecognised drive.";gy$ : goto 1020
520 rem 520 rem
530 rem --- read the current header ------------------- 530 rem --- read the current header -------------------
531 rem a brand new disk fails this. that is the 531 rem a brand new disk fails this. that is the
@ -117,19 +137,19 @@
534 rem blocks writes only, so the header read 534 rem blocks writes only, so the header read
535 rem succeeds and dos reports 26 at format time. 535 rem succeeds and dos reports 26 at format time.
540 print 540 print
550 print "reading disk..." 550 print cy$;"reading disk...";gy$
560 gosub 2600 560 gosub 2600
570 if hr=1 then print "current: ";cn$;" id ";ci$ 570 if hr=1 then print yl$;"current: ";cn$;" id ";ci$;gy$
580 if hr=0 then print "current: unformatted or unreadable" 580 if hr=0 then print "current: unformatted or unreadable"
590 rem 590 rem
610 rem --- collect the new name ---------------------- 610 rem --- collect the new name ----------------------
620 print 620 print
630 print "new disk name, 16 max" 630 print cy$;"new disk name, 16 max";gy$
640 print ">"; 640 print wh$;">";gy$;
650 ml=16 : fc=1 : df$="" : gosub 4000 650 ml=16 : fc=1 : df$="" : gosub 4000
660 gosub 3400 660 gosub 3400
670 dn$=in$ 670 dn$=in$
680 if dn$="" then print "name cannot be empty." : goto 640 680 if dn$="" then print rd$;"name cannot be empty.";gy$ : goto 640
690 rem 690 rem
700 rem --- hash it, then offer the id ---------------- 700 rem --- hash it, then offer the id ----------------
701 rem enter accepts the computed value. typing any 701 rem enter accepts the computed value. typing any
@ -138,23 +158,25 @@
710 nm$=dn$ : gosub 3600 710 nm$=dn$ : gosub 3600
720 gosub 3800 720 gosub 3800
730 print 730 print
740 print "disk id, enter accepts the hash" 740 print cy$;"disk id, enter accepts the hash";gy$
750 print ">"; 750 print wh$;">";gy$;
760 ml=2 : fc=2 : df$=id$ : gosub 4000 760 ml=2 : fc=2 : df$=id$ : gosub 4000
770 if len(in$)<2 then print "id must be 2 characters." : goto 750 770 if len(in$)<2 then print rd$;"id must be 2 characters.";gy$ : goto 750
780 id$=in$ 780 id$=in$
790 rem 790 rem
800 rem --- confirmation ------------------------------ 800 rem --- confirmation ------------------------------
801 rem everything destructive is behind this screen. 801 rem everything destructive is behind this screen.
805 print chr$(147); 805 print chr$(147);
810 print "confirm format" 808 hd$="confirm format" : gosub 3900
815 print 810 print
820 print "device :";dv;" ";nt$ 815 print gy$;"device :";dv;" ";nt$
825 if hr=1 then print "erasing: ";cn$;" id ";ci$ 820 rem -- the line that prevents the mistake gets
821 rem the strongest treatment on the screen.
825 if hr=1 then print rv$;yl$;left$("erasing: "+cn$+" id "+ci$+sp$,39);ro$;gy$
830 if hr=0 then print "erasing: unformatted disk" 830 if hr=0 then print "erasing: unformatted disk"
835 print 835 print
840 print "new name: ";dn$ 840 print "new name: ";wh$;dn$;gy$
845 print "new id : ";id$ 845 print "new id : ";wh$;id$;gy$
850 print 850 print
855 print "command : n0:";dn$;",";id$ 855 print "command : n0:";dn$;",";id$
860 print 860 print
@ -166,18 +188,18 @@
875 rem it without reading. 875 rem it without reading.
876 if hr=0 then 890 876 if hr=0 then 890
879 rem -- disk holds data: require the whole word 879 rem -- disk holds data: require the whole word
880 print "all data on this disk will be lost." 880 print rv$;rd$;left$("all data on this disk will be lost."+sp$,39);ro$;gy$
882 print "type yes to proceed: "; 882 print cy$;"type yes to proceed: ";wh$;
884 ml=3 : fc=3 : df$="" : gosub 4000 884 ml=3 : fc=3 : df$="" : gosub 4000
886 if in$<>"yes" then print : print "cancelled." : goto 1020 886 if in$<>"yes" then print : print gy$;"cancelled." : goto 1020
888 goto 899 888 goto 899
889 rem 889 rem
890 rem -- blank disk: one keypress is enough 890 rem -- blank disk: one keypress is enough
891 print "disk is blank. press y to format," 891 print gy$;"disk is blank. press y to format,"
892 print "any other key to cancel: "; 892 print cy$;"any other key to cancel: ";wh$;
894 get a$ : if a$="" then 894 894 get a$ : if a$="" then 894
895 print a$ 895 print a$
896 if a$<>"y" then print : print "cancelled." : goto 1020 896 if a$<>"y" then print : print gy$;"cancelled." : goto 1020
899 rem falls through to execute 899 rem falls through to execute
900 rem --- execute ----------------------------------- 900 rem --- execute -----------------------------------
901 rem the get# inside the error channel reader 901 rem the get# inside the error channel reader
@ -186,23 +208,24 @@
904 rem display is possible - the bus is busy for the 904 rem display is possible - the bus is busy for the
905 rem whole operation. 905 rem whole operation.
910 print 910 print
920 print "formatting. do not switch off." 920 print rv$;yl$;left$("formatting. do not switch off."+sp$,39);ro$;gy$
940 gosub 2000 940 gosub 2000
960 print 960 print
970 print "status:";en 970 print "status:";en
980 print "reply : ";em$ 980 print "reply : ";em$
1000 print 1000 print
1005 if en=0 then print "format complete." 1005 if en=0 then print rv$;gn$;left$("format complete."+sp$,39);ro$;gy$
1010 if en<>0 then print "format failed." 1010 if en<>0 then print rv$;rd$;left$("format failed."+sp$,39);ro$;gy$
1019 rem 1019 rem
1020 rem --- menu loop --------------------------------- 1020 rem --- menu loop ---------------------------------
1030 print 1030 print
1040 print "another disk? y/n"; 1040 print cy$;"another disk? y/n";gy$;
1050 get a$ : if a$="" then 1050 1050 get a$ : if a$="" then 1050
1060 if a$="y" then 200 1060 if a$="y" then 200
1070 if a$<>"n" then 1050 1070 if a$<>"n" then 1050
1080 print : print : print "done." 1080 print : print : print "done."
1085 close 2 : close 15 1085 close 2 : close 15
1087 gosub 3950
1090 end 1090 end
1099 rem 1099 rem
2000 rem --- format ------------------------------------ 2000 rem --- format ------------------------------------
@ -385,9 +408,9 @@
3201 rem peek(186) holds the device of the last i/o, 3201 rem peek(186) holds the device of the last i/o,
3202 rem which for a freshly loaded program is where 3202 rem which for a freshly loaded program is where
3203 rem it came from. 3203 rem it came from.
3210 print "*** this is the device this program" 3210 print rv$;rd$;left$("*** this is the device this program"+sp$,39);ro$
3220 print "*** was loaded from. formatting it" 3215 print rv$;rd$;left$("*** was loaded from. formatting it"+sp$,39);ro$
3230 print "*** will destroy this program." 3220 print rv$;rd$;left$("*** will destroy this program."+sp$,39);ro$;gy$
3240 print 3240 print
3250 return 3250 return
3260 rem 3260 rem
@ -429,6 +452,29 @@
3830 id$=mid$(b$,hi+1,1)+mid$(b$,lo+1,1) 3830 id$=mid$(b$,hi+1,1)+mid$(b$,lo+1,1)
3840 return 3840 return
3850 rem 3850 rem
3900 rem --- header bar --------------------------------
3901 rem prints hd$ as a reverse video bar across the
3902 rem full screen width.
3903 rem
3904 rem 39 characters, not 40: printing exactly 40
3905 rem makes the cursor wrap on its own and the
3906 rem trailing semicolon then has no effect, which
3907 rem costs a line and scrolls the bar off sooner.
3908 rem 39 plus the newline leaves the bar intact.
3909 rem
3910 rem this only stays put because every page is
3911 rem short enough not to scroll. a page that runs
3912 rem past row 24 will push it off the top.
3920 print rv$;wh$;left$(hd$+sp$,39);ro$;gy$
3930 return
3940 rem
3950 rem --- restore default screen colours ------------
3951 rem called before every end, so the ready
3952 rem prompt is not left on a black screen with
3953 rem grey text.
3960 poke 53280,14 : poke 53281,6 : poke 646,14
3970 return
3980 rem
4000 rem --- filtered input ---------------------------- 4000 rem --- filtered input ----------------------------
4001 rem in: ml maximum characters 4001 rem in: ml maximum characters
4002 rem fc field code: 1 name, 2 id, 4002 rem fc field code: 1 name, 2 id,