DEFINT A-Z

'
' Disk Doctor for disk images V1.0 written by Peter Weighill April 1994.
'

DECLARE SUB SETUP ()
DECLARE SUB BAM ()
DECLARE FUNCTION BIN$ (in$)
DECLARE SUB CENTER (row, text$)
DECLARE SUB LOAD (t, s)
DECLARE SUB SAVE (t, s)
DECLARE SUB DIR ()
DECLARE SUB SAVEBAM ()
DECLARE SUB SAVEBAM18 ()
DECLARE SUB LOADDIR ()
DECLARE SUB SAVEDIR ()
DECLARE SUB LOADBAM ()
DECLARE SUB EDITFILENAME (filepos, location)
DECLARE SUB EDITDISKNAME ()
DECLARE SUB DIRSHOW (display(), position, numbsectors)

OPTION BASE 0
DIM SHARED blockrange(1 TO 35), tsoffset(1 TO 35, 0 TO 20) AS LONG
DIM SHARED buffer AS STRING * 256, buffer2 AS STRING * 256
DIM SHARED filetype(0 TO 16) AS STRING * 3
DIM SHARED diskname AS STRING * 16, diskid AS STRING * 5
DIM SHARED diskname2 AS STRING * 16, diskid2 AS STRING * 5
DIM SHARED bamalloc(1 TO 35, 0 TO 20), bf
DIM SHARED bamalloc2(1 TO 35, 0 TO 20), bf2
DIM SHARED direntry(1 TO 144) AS STRING * 30, sectors(1 TO 18)
DIM SHARED direntry2(1 TO 144) AS STRING * 30, sectors2(1 TO 18)

CONST ver$ = "v0.5 beta"

SETUP

CLS
COLOR 14, 0: CENTER 1, "Disk Doctor for disk images " + ver$
CENTER 2, "by Peter Weighill"
COLOR 7: LOCATE 5, 10
INPUT "Disk image name "; filename$
IF UCASE$(RIGHT$(filename$, 4)) = ".D64" THEN filename$ = MID$(filename$, LEN(filename$) - 4)
IF filename$ = "" THEN PRINT , "No file requested.": SYSTEM

OPEN filename$ + ".d64" FOR BINARY AS 1

LOAD 18, 0

IF MID$(buffer, 3, 1) <> "A" THEN PRINT "Not valid disk image.": SYSTEM

diskname = MID$(buffer, 145, 16)
diskid = MID$(buffer, 163, 5)
diskname2 = diskname
diskid2 = diskid

start:

CLS
COLOR 14, 0: CENTER 1, "Disk Doctor for disk images " + ver$
CENTER 2, "by Peter Weighill"
COLOR 15: CENTER 4, CHR$(34) + diskname + "úú" + diskid + CHR$(34)
COLOR 7
LOCATE 8, 25: PRINT "NO.     OPTION"
COLOR 13
LOCATE 10, 25: PRINT "1       View/Edit Block Allocation Map"
LOCATE 11, 25: PRINT "2       View/Edit Directory"
LOCATE 13, 25: PRINT "0       Exit"

COLOR 15
LOCATE 17, 1
PRINT "Option 1 works fully, option 2 works partly but NO save directory available"
PRINT "at the moment."
PRINT
PRINT "Please use this program at your own risk. Exit now if you are not sure."

DO
  kbd$ = INKEY$
  SELECT CASE kbd$
    CASE "1"
      BAM
      COLOR 7, 0
      EXIT DO
    CASE "2"
      DIR
      COLOR 7, 0
      EXIT DO
    CASE "0"
      EXIT DO
  END SELECT
LOOP

IF kbd$ <> "0" THEN GOTO start

CLOSE 1

COLOR 7, 0: CLS : PRINT "Ready."

SYSTEM

SUB BAM

DIM bamdisp$(0 TO 2)

bamdisp$(0) = "": bamdisp$(1) = ":-": bamdisp$(2) = ""

CLS
COLOR 3: LOCATE 1, 72: PRINT bamdisp$(0); " USED  "
LOCATE 2, 72: PRINT bamdisp$(1); " FREE"
COLOR 15: LOCATE 1, 44: PRINT CHR$(34); diskname; "úú"; diskid; CHR$(34)
bf = 999: GOSUB bamblocksfree
LOCATE 22, 6
FOR i = 1 TO 35
COLOR 11 + (INT(i / 2) = i / 2) * 8
LOCATE 22, 4 + i * 2: PRINT RIGHT$(STR$(i), 2);
IF i < 22 THEN LOCATE 22 - i, 4: PRINT RIGHT$(STR$(i - 1), 2);
NEXT i
COLOR 14: LOCATE 23, 1
PRINT "     Use arrow keys to move the cursor. RETURN to toggle block allocation.";
PRINT "  A to allocate all sectors F to free all sectors (on current track) U to undo.";
LOCATE 25, 1
PRINT "  CTRL+A / CTRL+F (excludes tr 18)  CTRL+U to undo all changes.  ESC to quit.";

LOADBAM

GOSUB bamdisplay

nt = 1: ns = 0
 t = 1: s = 0

DO
  IF nt <> t OR ns <> s THEN
    COLOR 7, 0: IF t = 18 THEN COLOR 3
    LOCATE 21 - s, t * 2 + 4: PRINT bamdisp$(bamalloc(t, s));
    t = nt: s = ns
  END IF
  COLOR 0, 7: IF t = 18 THEN COLOR , 3
  LOCATE 21 - s, t * 2 + 4: PRINT bamdisp$(bamalloc(t, s));
  keyput$ = UCASE$(INKEY$)
  SELECT CASE keyput$
    CASE CHR$(0) + "K"
      nt = nt - 1: IF nt < 1 THEN nt = 35
      WHILE bamalloc(nt, s) = 2: nt = nt - 1: WEND
    CASE CHR$(0) + "M"
      nt = nt + 1: IF nt > 35 THEN nt = 1
      IF bamalloc(nt, s) = 2 THEN nt = 1
    CASE CHR$(0) + "P"
      ns = ns - 1: IF ns < 0 THEN ns = blockrange(t)
    CASE CHR$(0) + "H"
      ns = ns + 1: IF ns > blockrange(t) THEN ns = 0
    CASE CHR$(13)
      bamalloc(t, s) = 1 - bamalloc(t, s)
      IF t <> 18 THEN bf = bf - 1 + bamalloc(t, s) * 2: GOSUB bamblocksfree
    CASE CHR$(1)
      FOR i = 1 TO 35
        FOR j = 0 TO 20
          IF i <> 18 AND bamalloc(i, j) <> 2 THEN bamalloc(i, j) = 0
        NEXT j
      NEXT i
      bf = 0
      GOSUB bamdisplay
    CASE CHR$(6)
      FOR i = 1 TO 35
        FOR j = 0 TO 20
          IF i <> 18 AND bamalloc(i, j) <> 2 THEN bamalloc(i, j) = 1
        NEXT j
      NEXT i
      bf = 664
      GOSUB bamdisplay
    CASE "A"
      FOR j = 0 TO 20
        IF t <> 18 AND bamalloc(t, j) = 1 THEN bf = bf - 1
        IF bamalloc(t, j) <> 2 THEN bamalloc(t, j) = 0
      NEXT j
      GOSUB bamdisplay
    CASE "F"
      FOR j = 0 TO 20
        IF t <> 18 AND bamalloc(t, j) = 0 THEN bf = bf + 1
        IF bamalloc(t, j) <> 2 THEN bamalloc(t, j) = 1
      NEXT j
      GOSUB bamdisplay
    CASE "U"
      FOR j = 0 TO 20
        IF t <> 18 THEN bf = bf + (bamalloc2(t, j) - bamalloc(t, j))
        IF bamalloc(t, j) <> 2 THEN bamalloc(t, j) = bamalloc2(t, j)
      NEXT j
      GOSUB bamdisplay
    CASE CHR$(21)
      FOR i = 1 TO 35
        FOR j = 0 TO 20
          bamalloc(i, j) = bamalloc2(i, j)
        NEXT j
      NEXT i
      bf = bf2
      GOSUB bamdisplay
    CASE ELSE
  END SELECT
LOOP UNTIL keyput$ = CHR$(27)

flag = 0
FOR t = 1 TO 35
  FOR s = 0 TO 20
    IF bamalloc(t, s) <> bamalloc2(t, s) THEN flag = 1: EXIT FOR
  NEXT s
  IF flag = 1 THEN EXIT FOR
NEXT t

IF flag = 0 THEN EXIT SUB

COLOR 14, 5
CALL CENTER(11, " Ú" + STRING$(33, "Ä") + "¿ ")
CALL CENTER(12, " ³ BAM is different from original. ³ ")
CALL CENTER(13, " ³" + SPACE$(33) + "³ ")
CALL CENTER(14, " ³  Do you wish to save it (Y/N)?  ³ ")
CALL CENTER(15, " À" + STRING$(33, "Ä") + "Ù ")
BEEP

DO
  a$ = UCASE$(INKEY$)
LOOP UNTIL a$ = "Y" OR a$ = "N"

IF a$ = "N" THEN EXIT SUB
SAVEBAM

EXIT SUB

bamdisplay:
GOSUB bamblocksfree
FOR i = 1 TO 35
  FOR j = 0 TO 20
    COLOR 7: IF i = 18 THEN COLOR 3
    LOCATE 21 - j, i * 2 + 4: PRINT bamdisp$(bamalloc(i, j));
  NEXT j
NEXT i
RETURN

bamblocksfree:
COLOR 7, 0: LOCATE 2, 53: PRINT USING "Blocks free: ###"; bf
RETURN

END SUB

FUNCTION BIN$ (in$)

i = ASC(in$)
b$ = STRING$(8, 0)
n = 0

FOR j = 7 TO 0 STEP -1
  n = i - 2 ^ j
  IF n > -1 THEN i = n: MID$(b$, j + 1, 1) = CHR$(1)
NEXT j

BIN$ = b$

END FUNCTION

SUB CENTER (row, text$)
 LOCATE row, INT(40 - (LEN(text$) / 2))
 PRINT text$;
END SUB

SUB DIR

DIM display(16)

LOADDIR

COLOR 15, 0
CLS
CENTER 1, CHR$(34) + diskname + "úú" + diskid + CHR$(34)
COLOR 14
LOCATE 9, 40: PRINT "Left/Right arrow keys to change"
LOCATE 10, 40
PRINT filetype$(0); " - ";
PRINT filetype$(1); " - ";
PRINT filetype$(2); " - ";
PRINT filetype$(3); " - ";
PRINT filetype$(4)
LOCATE 11, 40: PRINT "Also the * and < keys as well"

LOCATE 13, 40: PRINT "Home/End PgUp/PgDn Up/Down moves cursor"

LOCATE 15, 40: PRINT "+/- to change file size"

LOCATE 17, 40: PRINT "Return to edit filename"
LOCATE 18, 40: PRINT "- press CTRL+A for   (shifted space)"

LOCATE 20, 40: PRINT "D to edit disk name"

LOCATE 22, 40: PRINT "Insert - Add    8 new  filenames"
LOCATE 23, 40: PRINT "Delete - Remove 8 last filenames"

LOCATE 25, 40: PRINT "M to move file";

numbsectors = 0
FOR j = 1 TO 18
  IF sectors(j) <> 0 THEN numbsectors = numbsectors + 1 ELSE EXIT FOR
NEXT j
numbsectors2 = numbsectors

FOR j = 1 TO 16
  display(j) = j
NEXT j

position = 0
newposition = 1

DO
  IF newposition <> position THEN
    position = newposition
    IF numbsectors <> 1 THEN
      IF position < display(1) THEN
        FOR i = 1 TO 16
          display(i) = position + i - 1
        NEXT i
      END IF
      IF position > display(16) THEN
        FOR i = 1 TO 16
          display(i) = position + i - 16
        NEXT i
      END IF
    END IF
    DIRSHOW display(), position, numbsectors
  END IF
 
  COLOR 3
  LOCATE 4, 40: PRINT USING "Number of entries: ###"; numbsectors * 8
  LOCATE 6, 40: PRINT USING "Current postion  : ###"; position

  keyput$ = UCASE$(INKEY$)
  SELECT CASE keyput$
    CASE CHR$(0) + "O"
      newposition = numbsectors * 8
    CASE CHR$(0) + "G"
      newposition = 1
    CASE CHR$(0) + "P"
      newposition = position + 1: IF newposition > numbsectors * 8 THEN newposition = numbsectors * 8
    CASE CHR$(0) + "H"
      newposition = position - 1: IF newposition < 1 THEN newposition = 1
    CASE CHR$(0) + "Q"
      newposition = position + 16: IF newposition > numbsectors * 8 THEN newposition = numbsectors * 8
      temp = display(1): IF temp > numbsectors * 8 - 31 THEN temp = numbsectors * 8 - 31
      IF numbsectors = 1 THEN temp = -15
      FOR i = 1 TO 16
        display(i) = temp + i + 15
      NEXT i
    CASE CHR$(0) + "I"
      newposition = position - 16: IF newposition < 1 THEN newposition = 1
      temp = display(1): IF temp < 16 THEN temp = 17
      FOR i = 1 TO 16
        display(i) = temp + i - 17
      NEXT i
    CASE "<"
      f = ASC(MID$(direntry(position), 1, 1))
      IF (f AND 64) = 64 THEN f = f - 64 ELSE f = f + 64
      MID$(direntry(position), 1, 1) = CHR$(f)
      position = 0
    CASE "*"
      f = ASC(MID$(direntry(position), 1, 1))
      IF (f AND 128) = 128 THEN f = f - 128 ELSE f = f + 128
      MID$(direntry(position), 1, 1) = CHR$(f)
      position = 0
    CASE CHR$(0) + "K"
      f = ASC(MID$(direntry(position), 1, 1))
      ftype = (f AND 15) - 1
      IF ftype < 0 THEN ftype = 4
      f = ftype + (f AND 240)
      MID$(direntry(position), 1, 1) = CHR$(f)
      position = 0
    CASE CHR$(0) + "M"
      f = ASC(MID$(direntry(position), 1, 1))
      ftype = (f AND 15) + 1
      IF ftype > 4 THEN ftype = 0
      f = ftype + (f AND 240)
      MID$(direntry(position), 1, 1) = CHR$(f)
      position = 0
    CASE "+", "="
      sizehi = ASC(MID$(direntry(position), 30, 1))
      sizelo = ASC(MID$(direntry(position), 29, 1))
      sizelo = (sizelo + 1) AND 255
      IF sizelo = 0 THEN sizehi = (sizehi + 1) AND 127
      MID$(direntry(position), 30, 1) = CHR$(sizehi)
      MID$(direntry(position), 29, 1) = CHR$(sizelo)
      position = 0
    CASE "-", "_"
      sizehi = ASC(MID$(direntry(position), 30, 1))
      sizelo = ASC(MID$(direntry(position), 29, 1))
      sizelo = (sizelo - 1) AND 255
      IF sizelo = 255 THEN sizehi = (sizehi - 1) AND 127
      MID$(direntry(position), 30, 1) = CHR$(sizehi)
      MID$(direntry(position), 29, 1) = CHR$(sizelo)
      position = 0
    CASE CHR$(13)
      EDITFILENAME position, 4 + position - display(1)
      position = 0
    CASE "U"
      FOR i = 1 TO 18
        sectors(i) = sectors2(i)
      NEXT i
      FOR i = 1 TO 144
        direntry(i) = direntry2(i)
      NEXT i
      position = 0
      diskname = diskname2
      diskid = diskid2
      COLOR 15
      CENTER 1, CHR$(34) + diskname + "úú" + diskid + CHR$(34)
    CASE "D"
      EDITDISKNAME
      COLOR 15
      CENTER 1, CHR$(34) + diskname + "úú" + diskid + CHR$(34)
    CASE CHR$(0) + "S"
      IF numbsectors > 1 THEN
        sectors(numbsectors) = 0
        numbsectors = numbsectors - 1
        position = 0: newposition = 1
      END IF
    CASE CHR$(0) + "R"
      IF numbsectors < 18 THEN
        BEEP
        'numbsectors = numbsectors + 1
        'sectors(numbsectors) = ??
        position = 0: newposition = 1
      END IF
    CASE "M"
      BEEP
    CASE ELSE
  END SELECT
LOOP UNTIL keyput$ = CHR$(27)

flag = 0
FOR i = 1 TO 144
  IF direntry(i) <> direntry2(i) THEN flag = 1: EXIT FOR
NEXT i
FOR i = 1 TO 18
  IF sectors(i) <> sectors2(i) THEN flag = 1: EXIT FOR
NEXT i
IF diskname <> diskname2 THEN flag = 1
IF diskid <> diskid2 THEN flag = 1


IF flag = 0 THEN EXIT SUB

COLOR 14, 5
CALL CENTER(11, " Ú" + STRING$(33, "Ä") + "¿ ")
CALL CENTER(12, " ³ Dir is different from original. ³ ")
CALL CENTER(13, " ³" + SPACE$(33) + "³ ")
CALL CENTER(14, " ³  Do you wish to save it (Y/N)?  ³ ")
CALL CENTER(15, " À" + STRING$(33, "Ä") + "Ù ")
BEEP

DO
  a$ = UCASE$(INKEY$)
LOOP UNTIL a$ = "Y" OR a$ = "N"

IF a$ = "N" THEN
  diskname = diskname2
  diskid = diskid2
  EXIT SUB
END IF

SAVEDIR

EXIT SUB

END SUB

SUB DIRSHOW (display(), position, numbsectors)

COLOR 7, 0
FOR i = 1 TO 16
  LOCATE i + 3, 5
  IF NOT (numbsectors = 1 AND i > 8) THEN
    f = ASC(MID$(direntry(display(i)), 1, 1))
    f$ = "*": IF (f AND 128) = 128 THEN f$ = " "
    f$ = f$ + filetype(f AND 15)
    IF (f AND 64) = 64 THEN f$ = f$ + "<" ELSE f$ = f$ + " "
    size = ASC(MID$(direntry(display(i)), 30, 1)) * 256 + ASC(MID$(direntry(display(i)), 29, 1))
    COLOR 7, 0
    PRINT USING "##### "; size;
    IF display(i) = position THEN COLOR , 1
    PRINT MID$(direntry(display(i)), 4, 16);
    COLOR 7, 0
    PRINT " "; f$
  ELSE
    PRINT SPACE$(28)
  END IF
NEXT i

END SUB

SUB EDITDISKNAME

result$ = diskname + "úú" + diskid

done = 0
quit = 0
length = 23
cpos = 1

DO WHILE NOT done

  result$ = LEFT$(result$, 23)
 
  LOCATE 1, 28
  COLOR 14, 6: PRINT LEFT$(result$, cpos - 1);
  COLOR 0, 3: PRINT MID$(result$, cpos, 1);
  IF cpos < length + 1 THEN COLOR 14, 6: PRINT MID$(result$, cpos + 1, length);
  COLOR 3, 0: IF cpos = length + 1 THEN PRINT "±";  ELSE COLOR 15: PRINT CHR$(34);

  kbd$ = INKEY$
  IF kbd$ = CHR$(1) THEN kbd$ = CHR$(160)
  SELECT CASE kbd$
      CASE " " TO CHR$(255)
          IF cpos < length + 1 THEN
            MID$(result$, cpos, 1) = kbd$
            cpos = cpos + 1: IF cpos = 17 THEN cpos = 19
          END IF
      CASE CHR$(13), CHR$(9)
          done = -1
      CASE CHR$(27)
          done = -1
          quit = -1
      CASE CHR$(0) + "M"
          cpos = cpos + 1: IF cpos > length + 1 THEN cpos = length + 1
          IF cpos = 17 THEN cpos = 19
      CASE CHR$(0) + "K"
          cpos = cpos - 1: IF cpos < 1 THEN cpos = 1
          IF cpos = 18 THEN cpos = 16
      CASE CHR$(0) + "G", CHR$(0) + "?"
          cpos = 1
      CASE CHR$(0) + "O", CHR$(0) + "@"
          cpos = length + 1
      CASE CHR$(0) + "S"
          p1$ = LEFT$(result$, 16)
          p2$ = RIGHT$(result$, 5)
          SELECT CASE cpos
            CASE 1 TO 16
              p1$ = LEFT$(p1$, cpos - 1) + MID$(p1$, cpos + 1) + " "
            CASE 19 TO 23
              p2$ = LEFT$(p2$, cpos - 19) + MID$(p2$, cpos - 17) + " "
          END SELECT
          result$ = LEFT$(p1$, 16) + "úú" + LEFT$(p2$, 5)
      CASE CHR$(0) + "R"
          p1$ = LEFT$(result$, 16)
          p2$ = RIGHT$(result$, 5)
          SELECT CASE cpos
            CASE 1 TO 15
              p1$ = LEFT$(p1$, cpos - 1) + " " + MID$(p1$, cpos)
            CASE 19 TO 22
              p2$ = LEFT$(p2$, cpos - 19) + " " + MID$(p2$, cpos - 18)
          END SELECT
          result$ = LEFT$(p1$, 16) + "úú" + LEFT$(p2$, 5)
      CASE CHR$(8)
          p1$ = LEFT$(result$, 16)
          p2$ = RIGHT$(result$, 5)
          SELECT CASE cpos
            CASE 2 TO 16
              cpos = cpos - 1
              p1$ = LEFT$(p1$, cpos - 1) + MID$(p1$, cpos + 1) + " "
            CASE 20 TO 23
              cpos = cpos - 1
              p2$ = LEFT$(p2$, cpos - 19) + MID$(p2$, cpos - 17) + " "
          END SELECT
          result$ = LEFT$(p1$, 16) + "úú" + LEFT$(p2$, 5)
  END SELECT

LOOP

COLOR 7, 0

IF quit = -1 THEN EXIT SUB
         
diskname = LEFT$(result$, 16)
diskid = RIGHT$(result$, 5)


END SUB

SUB EDITFILENAME (filepos, location)

result$ = MID$(direntry(filepos), 4, 16)

IF result$ = STRING$(16, 0) THEN result$ = STRING$(16, 160)

done = 0
quit = 0
length = 16
cpos = 1

DO WHILE NOT done

  result$ = LEFT$(result$, 16)

  LOCATE location, 11
  COLOR 14, 6: PRINT LEFT$(result$, cpos - 1);
  COLOR 0, 3: PRINT MID$(result$, cpos, 1);
  IF cpos < length + 1 THEN COLOR 14, 6: PRINT MID$(result$, cpos + 1, length);
  COLOR 3, 0: IF cpos = length + 1 THEN PRINT "±";  ELSE PRINT " ";

  kbd$ = INKEY$
  IF kbd$ = CHR$(1) THEN kbd$ = CHR$(160)
  SELECT CASE kbd$
      CASE " " TO CHR$(255)
          IF cpos < length + 1 THEN
            MID$(result$, cpos, 1) = kbd$
            cpos = cpos + 1
          END IF
      CASE CHR$(13), CHR$(9)
          done = -1
      CASE CHR$(27)
          done = -1
          quit = -1
      CASE CHR$(0) + "M"
          cpos = cpos + 1: IF cpos > length + 1 THEN cpos = length + 1
      CASE CHR$(0) + "K"
          cpos = cpos - 1: IF cpos < 1 THEN cpos = 1
      CASE CHR$(0) + "G", CHR$(0) + "?"
          cpos = 1
      CASE CHR$(0) + "O", CHR$(0) + "@"
          cpos = length + 1
      CASE CHR$(0) + "S"
          result$ = LEFT$(result$, cpos - 1) + MID$(result$, cpos + 1) + " "
      CASE CHR$(0) + "R"
          IF cpos < length + 1 THEN
            result$ = LEFT$(result$, cpos - 1) + " " + MID$(result$, cpos)
          END IF
      CASE CHR$(8)
          IF cpos > 1 THEN
            cpos = cpos - 1
            result$ = LEFT$(result$, cpos - 1) + MID$(result$, cpos + 1) + " "
         END IF
  END SELECT

LOOP

COLOR 7, 0

IF quit = -1 THEN EXIT SUB

MID$(direntry(filepos), 4, 16) = result$

END SUB

SUB LOAD (t, s)

' Load a sector.

SEEK 1, tsoffset(t, s)
GET 1, , buffer
buffer2 = buffer

END SUB

SUB LOADBAM

LOAD 18, 0

LOCATE 10, 30: PRINT "Please wait - Track:"


bf = 0
FOR t = 1 TO 35
  LOCATE 10, 51: PRINT USING "##"; t
  b$ = MID$(buffer, 5 + (t - 1) * 4, 4)
  j$ = ""
  IF t <> 18 THEN bf = bf + ASC(b$)
  FOR s = 2 TO 4
    j$ = j$ + BIN$(MID$(b$, s, 1))
  NEXT s
  MID$(j$, blockrange(t) + 2, 4) = STRING$(4, 2)
  FOR s = 1 TO 21
    bamalloc(t, s - 1) = ASC(MID$(j$, s, 1))
    bamalloc2(t, s - 1) = bamalloc(t, s - 1)
  NEXT s
NEXT t

bf2 = bf

END SUB

SUB LOADDIR

LOAD 18, 0

t = ASC(MID$(buffer, 1, 1))
s = ASC(MID$(buffer, 2, 1))

numbentry = 0
numbsectors = 0
DO
  IF t <> 18 AND s > 18 THEN CLS : PRINT "67; ILLEGAL SYSTEM T OR S": SYSTEM
  LOAD t, s
  numbsectors = numbsectors + 1
  sectors(numbsectors) = s
  sectors2(numbsectors) = sectors(numbsectors)
  FOR i = 0 TO 7
    numbentry = numbentry + 1
    direntry(numbentry) = MID$(buffer, 3 + i * 32, 30)
    direntry2(numbentry) = direntry(numbentry)
  NEXT i
  t = ASC(MID$(buffer, 1, 1))
  s = ASC(MID$(buffer, 2, 1))
LOOP UNTIL t = 0

END SUB

SUB SAVE (t, s)

' Save a sector.

SEEK 1, tsoffset(t, s)
PUT 1, , buffer

END SUB

SUB SAVEBAM

LOAD 18, 0

FOR t = 1 TO 35
  b$ = STRING$(4, 0)
  free = 0
  D = 0
  FOR s = 0 TO 7
    free = free + bamalloc(t, s)
    D = D + bamalloc(t, s) * 2 ^ s
  NEXT s
  MID$(b$, 2, 1) = CHR$(D)
  D = 0
  FOR s = 8 TO 15
    free = free + bamalloc(t, s)
    D = D + bamalloc(t, s) * 2 ^ (s - 8)
  NEXT s
  MID$(b$, 3, 1) = CHR$(D)
  D = 0
  FOR s = 16 TO blockrange(t)
    free = free + bamalloc(t, s)
    D = D + bamalloc(t, s) * 2 ^ (s - 16)
  NEXT s
  MID$(b$, 4, 1) = CHR$(D)
  MID$(b$, 1, 1) = CHR$(free)
  MID$(buffer, 5 + (t - 1) * 4, 4) = b$
NEXT t

SAVE 18, 0

END SUB

SUB SAVEBAM18

LOAD 18, 0

FOR i = 2 TO 20
  bamalloc(18, i) = 1
NEXT i
FOR i = 1 TO 18
  bamalloc(18, sectors(i)) = 0
NEXT i
bamalloc(18, 0) = 1

b$ = STRING$(4, 0)
free = 0
D = 0
FOR s = 0 TO 7
  free = free + bamalloc(18, s)
  D = D + bamalloc(18, s) * 2 ^ s
NEXT s
MID$(b$, 2, 1) = CHR$(D)
D = 0
FOR s = 8 TO 15
  free = free + bamalloc(18, s)
  D = D + bamalloc(18, s) * 2 ^ (s - 8)
NEXT s
MID$(b$, 3, 1) = CHR$(D)
D = 0
FOR s = 16 TO blockrange(18)
  free = free + bamalloc(18, s)
  D = D + bamalloc(18, s) * 2 ^ (s - 16)
NEXT s
MID$(b$, 4, 1) = CHR$(D)
MID$(b$, 1, 1) = CHR$(free)
MID$(buffer, 5 + (18 - 1) * 4, 4) = b$

MID$(buffer, 145, 16) = diskname
MID$(buffer, 163, 5) = diskid

SAVE 18, 0

END SUB

SUB SAVEDIR

'SAVEBAM18
BEEP

END SUB

SUB SETUP

' Setup initial constants.

FOR i = 1 TO 35
  blockrange(i) = 20 + (i > 17) * 2 + (i > 24) + (i > 30)
NEXT i

offset& = 1
FOR i = 1 TO 35
  FOR j = 0 TO 20
    IF j > blockrange(i) THEN EXIT FOR
    tsoffset(i, j) = offset&: offset& = offset& + 256
  NEXT j
NEXT i

buffer = "": buffer2 = ""

FOR i = 1 TO 144
  direntry(i) = STRING$(30, 0)
NEXT i

filetype(0) = "DEL"
filetype(1) = "SEQ"
filetype(2) = "PRG"
filetype(3) = "USR"
filetype(4) = "REL"

END SUB