start tok64 d64-bIc8Jg
100 REM******************************
120 REM* display any track $ sector *
140 REM* on the disk to the screen  *
160 REM* or the printer             *
180 REM******************************
200 PRINT"{clear}{down*2}{R*22}"
220 PRINT"display block contents"
240 PRINT"{E*22}":
260 REM******************************
280 REM* set program constant       *
300 REM******************************
320 sp$=" ":nl$=CHR$(0):hx$="0123456789abcdef"
340 fs$="":FORi=64 TO 95:fs$=fs$+"{reverse on}"+CHR$(i)+"{reverse off}":NEXT i
360 ss$="{space*2}":FOR i=192 TO 223:ss$=ss$+"{reverse on}"+CHR$(i)+"{reverse off}":NEXT i
380 DIM a$(15),nb(2)
400 d$="0"
420 PRINT"{space*8}{reverse on}s{reverse off}creen{down}{left*8}or {down}{left}{reverse on}p{reverse off}rinter"
440 GETjj$:IF jj$="" THEN440
460 IF jj$="s"THENPRINT"{space*8}{down}{reverse on}screen{reverse off}"
480 IF jj$="p"THENPRINT"{space*8}{down}{reverse on}printer{reverse off}"
500 GOSUB4940: REM opens files
520 REM   ***************************
540 REM   *  load track and sector  *
560 REM   *    into disk buffer     *
580 REM   ***************************
600 INPUT"{down}{right*2}track, sector";t,s
620 IF t=0 OR t>35 THEN PRINT#15,"i"d$:CLOSE2:CLOSE4:CLOSE15:PRINT"end":END
640 IF jj$="s" THEN GOSUB2240
660 IF jj$="p" THEN PRINT#4:PRINT#4,"track"t" sector"s:PRINT#4
680 PRINT#15,"u1:2,"d$;t;s:GOSUB1900
700 REM  ******************************
720 REM  * read byte 0 of disk buffer *
740 REM  ******************************
760 PRINT#15,"b-p:2,1"
780 PRINT#15,"m-r"CHR$(0)CHR$(5)
800 GET#15,a$(0):IFa$(0)=""THENa$(0)=nl$
820 IF jj$="s"THEN840
840 IF jj$="p"THEN1200
860 REM   *****************************
880 REM   *    read & crt display     *
900 REM   *  rest of the disk buffer  *
920 REM   *****************************
940 k=1:nb(1)=ASC(a$(0)):m=1
960 k=0:FORj=0TO63:IFj=16ORj=32ORj=48THENGOSUB2020:IFz$="n"THENj=80:GOTO1160
980 PRINT#15,"b-p:2"+STR$(j*4)
1000 FOR i=k TO 3
1020 GET#2,a$(i):IF a$(i)="" THEN a$(i)=nl$
1040 IF m=1 AND i<2 THEN nb(2)=ASC(a$(i))
1060 NEXT i:k=0:m=2
1080 a$="":b$=":":n=j*4:GOSUB2260:a$=a$+":"
1100 FOR i=0 TO 3:n=ASC(a$(i)):GOSUB2260
1120 c$=a$(i):GOSUB2380:b$=b$+c$
1140 NEXT i:IF jj$="s" THEN PRINTa$b$
1160 NEXT j: IF j<80 THEN GOSUB2020
1180 GOTO1500
1200 REM  ****************************
1220 REM  *  read & printer display  *
1240 REM  ****************************
1260 k=1:nb(1)=ASC(a$(0))
1280 FOR j=0 TO 15
1300 FOR i=k TO 15
1320 GET#2,a$(i):IF a$(i)="" THEN a$(i)=nl$
1340 IF k=1 AND i<2 THEN nb(2)=ASC(a$(i))
1360 NEXT i:k=0
1380 a$="":b$=":":n=j*16:GOSUB2260:a$=a$+":"
1400 FOR i=0 TO 15:n=ASC(a$(i)):GOSUB2260:IF z$="n"THEN j=40:GOTO1500
1420 c$=a$(i):GOSUB2380:b$=b$+c$
1440 NEXT i
1460 IF jj$="p" THEN PRINT#4,a$b$
1480 NEXT j:GOTO1500
1500 REM******************************
1520 REM* next track and sector      *
1540 REM******************************
1560 PRINT"{clear}next track and sector"nb(1)nb(2)"{down}"
1580 PRINT"do you want next track and sector? ({reverse on}y{reverse off}/{reverse on}n{reverse off})":PRINT"{down} or"
1600 PRINT"{down}change {reverse on}d{reverse off}isk name{space*2}or{space*2}disk {reverse on}i{reverse off}d":PRINT"{down} or"
1620 PRINT"{down}{reverse on}u{reverse off}nscratch files{space*3}or{space*2}{reverse on}s{reverse off}cratch files","{down} or"
1640 PRINT"{down}{reverse on}e{reverse off}nd program"
1660 PRINT"{down*2}enter (y, n, d, i, u, s, e)
1680 GET z$:IF z$="" THEN1680
1700 IF z$="y" THEN t=nb(1):s=nb(2):GOTO620
1720 IF z$="n" THEN600
1740 IF z$="d"THEN3240: REM change disk name
1760 IF z$="i"THEN3540: REM change disk id
1780 IF z$="u"THEN3820: REM unscratch files
1800 IF z$="s"THEN4340: REM scratch files
1820 IF z$="e" THEN5300:REM end program
1840 GOTO1680
1860 REM      *******************
1880 REM      **  subroutines  **
1900 REM      *******************
1920 REM       * error routine *
1940 REM       *****************
1960 INPUT#15,en,em$,et,es:IF en=0 THEN RETURN
1980 PRINT"{reverse on}disk error{reverse off}"en,em$,et,es
2000 END
2020 REM *****************************
2040 REM *  screen continue message  *
2060 REM *****************************
2080 PRINT"{right*4}continue(y/n)","{right}{space*3}change{space*2}(c)","{space*4}rewrite (w)",
2100 PRINT"{space*4}end{space*5}(e)"
2120 GETz$:IFz$="" THEN2120
2140 IF z$="c" THEN2520:REM change data in buffer
2160 IF z$="n" THEN RETURN                  :REM don't continue
2180 IF z$="w"  THEN3040:REM rewrite block
2200 IF z$="e" THEN5300:REM end
2220 IF z$<>"y" THEN2120:REM invalid option
2240 PRINT"{clear}{reverse on}track ";t;"{left} sector"s"{reverse off}":RETURN
2260 REM    **************************
2280 REM    * disk byte to hex print *
2300 REM    **************************
2320 a1=INT(n/16):a$=a$+MID$(hx$,a1+1,1)
2340 a2=INT(n-16*a1):a$=a$+MID$(hx$,a2+1,1)
2360 a$=a$+sp$:RETURN
2380 REM     *************************
2400 REM     *  change disk byte to  *
2420 REM     * asc display charactor *
2440 REM     *************************
2460 IF ASC(c$)<32 THEN c$=" ":RETURN
2480 IF ASC(c$)<128 OR ASC(c$)>159 THEN RETURN
2500 c$=MID$(ss$,3*(ASC(c$)-127),3):RETURN
2520 REM      ***********************
2540 REM      * change data on disk *
2560 REM      ***********************
2580 z9$=""
2600 PRINT"enter starting point{space*2}for change 0-ff":INPUT cs$
2620 FORz=0 TO LEN(hx$):IF MID$(hx$,z+1,1)=LEFT$(cs$,1)THENtx=z*16
2640 IF MID$(hx$,z+1,1)=RIGHT$(cs$,1)THENty=z
2660 NEXT:cs=ty+tx
2680 PRINT#15,"b-p:2",cstart                :REM position to start
2700 GET#2,a$(0)
2720 IF a$(0)=""THENa$(0)=nl$
2740 n=ASC(a$(0))
2760 a$="":GOSUB2260:GOSUB5180:PRINT"-";   :REM display byte in hex
2780 n1=0
2800 FOR j1=1TO0 STEP-1
2820 GETz$:IF z$=""THEN2820:REM get 2 characters
2840 IFz$=","THENn1=n:j1=-1:GOTO2940:REM handle comma key
2860 IF z$=CHR$(13)THENj1=-1:GOTO2940:REM handle return key
2880 REM convert hex entry to decimal equivalent
2900 FORi=1TO16:IF z$=MID$(hx$,i,1)THENn1=n1+(i-1)*(16^j1)
2920 NEXT i
2940 NEXTj1:IFz$=CHR$(13)THENPRINTz$:PRINT#15,"b-p:2",cs:PRINT#2,z9$;:GOTO2080
2960 REM if return key hit make changes in disk buffer
2980 n=n1:a$="":GOSUB2260:GOSUB5180:PRINT",";
3000 REM add newly changed byte to           previous changes in z9$
3020 z9$=z9$+CHR$(n):GOTO2700
3040 REM    *****************
3060 REM    * rewrite block *
3080 REM    *****************
3100 PRINT#15,"u2:2,"d$;t;s:GOSUB1900
3120 PRINT"track ";t;" sector ";s,"has been rewritten"
3140 GOTO2080
3160 REM  **********************
3180 REM  *    program # 1     *
3200 REM  *  change disk name  *
3220 REM  **********************
3240 GOSUB5080:             REM to close open files
3260 INPUT "{clear}new disk name";dn$
3280 IF LEN (dn$)<16 THEN dn$=dn$+CHR$(160):GOTO3280: REM stretch to 16 chars
3300 IF LEN(dn$)>16 THEN dn$=LEFT$(dn$,16): REM shorten name to 16 characters
3320 OPEN15,8,15,"i":        REM open disk command channel
3340 OPEN 8,8,8,"#":         REM open direct access channel
3360 PRINT#15,"u1:"8;0;18;0: REM read track 18,sector 0 into channel 8 buffer
3380 PRINT#15,"b-p:"8;144:    REM move buffer-pointer to first byte of disk name
3400 PRINT#8, dn$;:     REM put new name in channel 8 buffer, replacing old name
3420 PRINT#15,"u2:"8;0;18;0:  REM write buffer with name changed
3440 GOTO4880:                REM close channels and return to main menu
3460 REM  ******************
3480 REM  *   program #2   *
3500 REM  * change disk id *
3520 REM  ******************
3540 GOSUB5080: REM  closes open files
3560 INPUT "{clear}new disk id";id$
3580 IF LEN(id$)<>2 THEN3540: REM reject improper id length
3600 OPEN 15,8,15,"i":        REM open disk command channel
3620 OPEN 8,8,8,"#":          REM open direct access channel
3640 PRINT#15,"u1:"8;0;18;0:  REM read track 18, sector 0 into channel 8 buffer
3660 PRINT#15,"b-p:"8;162:    REM move buffer-pointer to first byte of disk id
3680 PRINT#8,id$;:          REM put new id in channel 8 buffer, replacing old id
3700 PRINT#15,"u2:"8;0;18;0:  REM store buffer to disk
3720 GOTO4880:                REM close channels and return to main menu
3740 REM  ***********************
3760 REM  *    program #3   *   *
3780 REM  * unscratch files *id *
3800 REM  ***********************
3820 GOSUB5080: REM to close open files
3840 INPUT "{clear}which sector";s$: s=VAL(s$): IF s<0 OR s>19 THEN3820
3860 PRINT "{down*2}what is the first byte": PRINT"of the file you wish"
3880 PRINT "to unscratch?"
3900 GOSUB4600
3920 PRINT "{down*2}select file type:"
3940 PRINT "{down}{space*2}1. sequential"
3960 PRINT "{space*2}2. program"
3980 PRINT "{space*2}3. user"
4000 PRINT "{space*2}4. relative"
4020 PRINT "{down*2}which one?"
4040 GET a$: IF a$="" THEN4040
4060 a=VAL(a$): IF a<1 OR a>4 THEN4040:     REM reject invalid choice
4080 b=a+128:                 REM set input byte to match dos file codes
4100 OPEN 15,8,15,"i":        REM open command channel to disk
4120 OPEN 8,8,8,"#":          REM open direct access channel to disk
4140 PRINT#15,"u1:"8;0;18;s:  REM load sector containing file to be unscratched
4160 PRINT#15,"b-p:"8;bp:     REM set buffer pointer to target address
4180 PRINT#8, CHR$(b);:       REM change target file code in channel 8 buffer
4200 PRINT#15,"u2:"8;0;18;s:  REM return changed contents to target sector
4220 GOTO4880:                REM close channels and return to main menu
4240 REM **********************
4260 REM *     scratch or     *
4280 REM * scratch and leave  *
4300 REM *    on directory    *
4320 REM **********************
4340 GOSUB5080:               REM to close open files
4360 PRINT"{clear}select option:"
4380 PRINT"{down}1. complete scratch"
4400 PRINT "2. scratch, but leave"
4420 PRINT"{space*4}on directory"
4440 GET a$: IF a$="" THEN4440
4460 a=VAL(a$): IF a<1 OR a>2 THEN4440:    REM reject invalid input
4480 IF a=1 THEN b=0:          REM set to permanently delete
4500 IF a=2 THEN b=128:        REM set to leave on directory
4520 INPUT"{down*2}which sector";s$: s=VAL(s$): IF s<0 OR s>19 THEN4520
4540 PRINT"{down*2}what is the first byte":PRINT"of the file you wish"
4560 PRINT "to scratch?"
4580 GOSUB4600:GOTO4760
4600 PRINT"{down*2}input must be in decimal."
4620 PRINT"2, 34, 66, 98, 130, 162, 194, 226"
4640 PRINT"for byte locations of"
4660 PRINT"2, 22, 42, 62,{space*2}82,{space*2}a2,{space*2}c2,{space*2}e2"
4680 INPUT bp$: bp=VAL(bp$):   REM input file target byte for scratch
4700 bs=(bp=2)+(bp=34)+(bp=66)+(bp=98)+(bp=130)+(bp=162)+(bp=194)+(bp=226)
4720 IFbs<>-1THEN4680:         REM reject invalid input
4740 RETURN
4760 OPEN15,8,15,"i":          REM open command channel to disk
4780 OPEN8,8,8,"#":            REM open direct access channel to disk
4800 PRINT#15,"u1:"8;0;18;s:   REM load sector containing file to be scratched
4820 PRINT#15,"b-p:"8;bp:      REM set buffer pointer to target address
4840 PRINT#8,CHR$(b);:         REM change target file code in channel 8 buffer
4860 PRINT#15,"u2:"8;0;18;s:   REM return changed contents to target sector
4880 CLOSE 8:                  REM close direct access channel
4900 CLOSE 15:                 REM close command channel
4920 GOSUB5000: GOTO1560:     REM restart display t&s program if appended
4940 REM ****************************
4960 REM * reopen display t&s files *
4980 REM ****************************
5000 OPEN15,8,15,"i"+d$:GOSUB1900
5020 OPEN4,4
5040 OPEN 2,8,2,"#":GOSUB1900
5060 RETURN
5080 REM ***************************
5100 REM * close display t&s files *
5120 REM ***************************
5140 CLOSE2:CLOSE15:CLOSE4
5160 RETURN
5180 PRINTLEFT$(a$,2);:RETURN
5200 REM  **************************
5220 REM  * close files and update *
5240 REM  *   disk bam to recover  *
5260 REM  *    unscratched files   *
5280 REM  **************************
5300 CLOSE2:CLOSE15:CLOSE4
5320 PRINT"{clear}validate disk to update bam?","{down}(y/n)"
5340 PRINT"************"
5360 PRINT"* caution! *"
5380 PRINT"************"
5400 PRINT"{down}will destroy relative files!"
5420 GET z$:IF z$=""THEN5420
5440 IF z$="y"THEN OPEN15,8,15:PRINT#15,"v0":CLOSE15
5460 END
stop tok64
(bastext 1.0)