From 7d17685973e8a44c498d4f4e406f79195dd192db Mon Sep 17 00:00:00 2001 From: jshackney Date: Sat, 19 Sep 2026 20:28:00 -0400 Subject: [PATCH] Minor updates --- src/fmt3.bas | 192 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 119 insertions(+), 73 deletions(-) diff --git a/src/fmt3.bas b/src/fmt3.bas index bfc8a4a..1ff5fb2 100644 --- a/src/fmt3.bas +++ b/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,