Minor updates
This commit is contained in:
parent
91965273ae
commit
7d17685973
192
src/fmt3.bas
192
src/fmt3.bas
|
|
@ -32,70 +32,90 @@
|
|||
31 rem
|
||||
32 rem --- constants ---
|
||||
33 rem b$ base36 digit table
|
||||
34 rem (the old nw$ and iw$ whitelist
|
||||
35 rem strings are gone - see 4160)
|
||||
36 rem
|
||||
37 rem --- device and drive ---
|
||||
38 rem dv target device number
|
||||
39 rem pd program's own device, peek(186)
|
||||
40 rem np count of devices that answered
|
||||
41 rem pv() device numbers that answered
|
||||
42 rem sd menu index into pv()
|
||||
43 rem dt drive class: 0=unknown 1=1541 2=1581
|
||||
44 rem nt$ drive name for display
|
||||
45 rem vs$ raw dos version reply
|
||||
46 rem tr header track nf name offset
|
||||
47 rem
|
||||
48 rem --- disk state ---
|
||||
49 rem cn$ current disk name, from the header
|
||||
50 rem ci$ current disk id, from the header
|
||||
51 rem hr 1 = header read succeeded
|
||||
52 rem dn$ new disk name, normalized
|
||||
53 rem id$ new two character disk id
|
||||
54 rem h hash accumulator, always < 1296
|
||||
55 rem hi lo high and low base36 digits
|
||||
56 rem
|
||||
57 rem --- dos ---
|
||||
58 rem en dos error number
|
||||
59 rem em$ dos reply text, whole line
|
||||
61 rem
|
||||
62 rem --- input routine, 4000 ---
|
||||
63 rem ml fc df$ in$ ff ky$ a
|
||||
64 rem --- scan routine, 3000 ---
|
||||
65 rem hs$ fs$ fd ln i
|
||||
66 rem --- hash routine, 3600 ---
|
||||
67 rem nm$ i
|
||||
34 rem sp$ forty spaces, used for padding
|
||||
35 rem hd$ header text, passed to 3900
|
||||
36 rem the old nw$ and iw$ whitelist strings are
|
||||
37 rem gone - the input filter at 4160 tests
|
||||
38 rem character codes numerically instead.
|
||||
39 rem
|
||||
40 rem --- screen colour and attribute strings ---
|
||||
41 rem wh$ white yl$ yellow rd$ red
|
||||
42 rem gn$ green cy$ cyan gy$ light grey
|
||||
43 rem rv$ reverse on ro$ reverse off
|
||||
44 rem
|
||||
45 rem --- device and drive ---
|
||||
46 rem dv target device number
|
||||
47 rem pd program's own device, peek(186)
|
||||
48 rem np count of devices that answered
|
||||
49 rem pv() device numbers that answered
|
||||
50 rem sd menu index into pv()
|
||||
51 rem dt drive class: 0=unknown 1=1541 2=1581
|
||||
52 rem nt$ drive name for display
|
||||
53 rem vs$ raw dos version reply
|
||||
54 rem tr header track nf name offset
|
||||
55 rem
|
||||
56 rem --- disk state ---
|
||||
57 rem cn$ current disk name, from the header
|
||||
58 rem ci$ current disk id, from the header
|
||||
59 rem hr 1 = header read succeeded
|
||||
60 rem dn$ new disk name, normalized
|
||||
61 rem id$ new two character disk id
|
||||
62 rem h hash accumulator, always < 1296
|
||||
63 rem hi lo high and low base36 digits
|
||||
64 rem
|
||||
65 rem --- dos ---
|
||||
66 rem en dos error number
|
||||
67 rem em$ dos reply text, whole line
|
||||
68 rem
|
||||
69 rem k general loop counter
|
||||
70 rem a$ keypress / byte scratch
|
||||
71 rem ***********************************************
|
||||
72 rem
|
||||
69 rem --- input routine, 4000 ---
|
||||
70 rem ml fc df$ in$ ff ky$ a
|
||||
71 rem --- scan routine, 3000 ---
|
||||
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 ---------------------------------
|
||||
101 rem b$ is the base36 digit table, used only by
|
||||
102 rem the encoder at 3800. the old nw$ and iw$
|
||||
103 rem whitelist strings are gone: the input filter
|
||||
104 rem now tests character codes numerically.
|
||||
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)
|
||||
150 pd=peek(186)
|
||||
160 rem
|
||||
200 rem --- splash ------------------------------------
|
||||
210 print chr$(147);
|
||||
220 print "disk formatter"
|
||||
230 print "1541 / 1571 / 1581"
|
||||
215 hd$="disk formatter" : gosub 3900
|
||||
220 print
|
||||
230 print gy$;"1541 / 1571 / 1581"
|
||||
240 print
|
||||
250 print "loaded from device";pd
|
||||
260 print
|
||||
270 rem
|
||||
300 rem --- probe the bus -----------------------------
|
||||
310 print "scanning devices 8-11..."
|
||||
310 print cy$;"scanning devices 8-11...";gy$
|
||||
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
|
||||
350 print "found:"
|
||||
350 print wh$;"found:";gy$
|
||||
360 for k=1 to np : print " ";k;" = device";pv(k) : next k
|
||||
370 print
|
||||
380 print "select 1-";np;": ";
|
||||
380 print cy$;"select 1-";np;": ";gy$;
|
||||
390 get a$ : if a$="" then 390
|
||||
400 sd=val(a$)
|
||||
410 if sd<1 or sd>np then 390
|
||||
|
|
@ -104,11 +124,11 @@
|
|||
440 rem
|
||||
450 rem --- identify the drive ------------------------
|
||||
460 print
|
||||
470 print "identifying..."
|
||||
470 print cy$;"identifying...";gy$
|
||||
480 gosub 2200
|
||||
490 print "reply : ";vs$
|
||||
500 print "drive : ";nt$
|
||||
510 if dt=0 then print : print "unrecognised drive." : goto 1020
|
||||
500 print "drive : ";wh$;nt$;gy$
|
||||
510 if dt=0 then print : print rd$;"unrecognised drive.";gy$ : goto 1020
|
||||
520 rem
|
||||
530 rem --- read the current header -------------------
|
||||
531 rem a brand new disk fails this. that is the
|
||||
|
|
@ -117,19 +137,19 @@
|
|||
534 rem blocks writes only, so the header read
|
||||
535 rem succeeds and dos reports 26 at format time.
|
||||
540 print
|
||||
550 print "reading disk..."
|
||||
550 print cy$;"reading disk...";gy$
|
||||
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"
|
||||
590 rem
|
||||
610 rem --- collect the new name ----------------------
|
||||
620 print
|
||||
630 print "new disk name, 16 max"
|
||||
640 print ">";
|
||||
630 print cy$;"new disk name, 16 max";gy$
|
||||
640 print wh$;">";gy$;
|
||||
650 ml=16 : fc=1 : df$="" : gosub 4000
|
||||
660 gosub 3400
|
||||
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
|
||||
700 rem --- hash it, then offer the id ----------------
|
||||
701 rem enter accepts the computed value. typing any
|
||||
|
|
@ -138,23 +158,25 @@
|
|||
710 nm$=dn$ : gosub 3600
|
||||
720 gosub 3800
|
||||
730 print
|
||||
740 print "disk id, enter accepts the hash"
|
||||
750 print ">";
|
||||
740 print cy$;"disk id, enter accepts the hash";gy$
|
||||
750 print wh$;">";gy$;
|
||||
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$
|
||||
790 rem
|
||||
800 rem --- confirmation ------------------------------
|
||||
801 rem everything destructive is behind this screen.
|
||||
805 print chr$(147);
|
||||
810 print "confirm format"
|
||||
815 print
|
||||
820 print "device :";dv;" ";nt$
|
||||
825 if hr=1 then print "erasing: ";cn$;" id ";ci$
|
||||
808 hd$="confirm format" : gosub 3900
|
||||
810 print
|
||||
815 print gy$;"device :";dv;" ";nt$
|
||||
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"
|
||||
835 print
|
||||
840 print "new name: ";dn$
|
||||
845 print "new id : ";id$
|
||||
840 print "new name: ";wh$;dn$;gy$
|
||||
845 print "new id : ";wh$;id$;gy$
|
||||
850 print
|
||||
855 print "command : n0:";dn$;",";id$
|
||||
860 print
|
||||
|
|
@ -166,18 +188,18 @@
|
|||
875 rem it without reading.
|
||||
876 if hr=0 then 890
|
||||
879 rem -- disk holds data: require the whole word
|
||||
880 print "all data on this disk will be lost."
|
||||
882 print "type yes to proceed: ";
|
||||
880 print rv$;rd$;left$("all data on this disk will be lost."+sp$,39);ro$;gy$
|
||||
882 print cy$;"type yes to proceed: ";wh$;
|
||||
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
|
||||
889 rem
|
||||
890 rem -- blank disk: one keypress is enough
|
||||
891 print "disk is blank. press y to format,"
|
||||
892 print "any other key to cancel: ";
|
||||
891 print gy$;"disk is blank. press y to format,"
|
||||
892 print cy$;"any other key to cancel: ";wh$;
|
||||
894 get a$ : if a$="" then 894
|
||||
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
|
||||
900 rem --- execute -----------------------------------
|
||||
901 rem the get# inside the error channel reader
|
||||
|
|
@ -186,23 +208,24 @@
|
|||
904 rem display is possible - the bus is busy for the
|
||||
905 rem whole operation.
|
||||
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
|
||||
960 print
|
||||
970 print "status:";en
|
||||
980 print "reply : ";em$
|
||||
1000 print
|
||||
1005 if en=0 then print "format complete."
|
||||
1010 if en<>0 then print "format failed."
|
||||
1005 if en=0 then print rv$;gn$;left$("format complete."+sp$,39);ro$;gy$
|
||||
1010 if en<>0 then print rv$;rd$;left$("format failed."+sp$,39);ro$;gy$
|
||||
1019 rem
|
||||
1020 rem --- menu loop ---------------------------------
|
||||
1030 print
|
||||
1040 print "another disk? y/n";
|
||||
1040 print cy$;"another disk? y/n";gy$;
|
||||
1050 get a$ : if a$="" then 1050
|
||||
1060 if a$="y" then 200
|
||||
1070 if a$<>"n" then 1050
|
||||
1080 print : print : print "done."
|
||||
1085 close 2 : close 15
|
||||
1087 gosub 3950
|
||||
1090 end
|
||||
1099 rem
|
||||
2000 rem --- format ------------------------------------
|
||||
|
|
@ -385,9 +408,9 @@
|
|||
3201 rem peek(186) holds the device of the last i/o,
|
||||
3202 rem which for a freshly loaded program is where
|
||||
3203 rem it came from.
|
||||
3210 print "*** this is the device this program"
|
||||
3220 print "*** was loaded from. formatting it"
|
||||
3230 print "*** will destroy this program."
|
||||
3210 print rv$;rd$;left$("*** this is the device this program"+sp$,39);ro$
|
||||
3215 print rv$;rd$;left$("*** was loaded from. formatting it"+sp$,39);ro$
|
||||
3220 print rv$;rd$;left$("*** will destroy this program."+sp$,39);ro$;gy$
|
||||
3240 print
|
||||
3250 return
|
||||
3260 rem
|
||||
|
|
@ -429,6 +452,29 @@
|
|||
3830 id$=mid$(b$,hi+1,1)+mid$(b$,lo+1,1)
|
||||
3840 return
|
||||
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 ----------------------------
|
||||
4001 rem in: ml maximum characters
|
||||
4002 rem fc field code: 1 name, 2 id,
|
||||
|
|
|
|||
Loading…
Reference in a new issue