program ImageUtility;
{  3/17/98  }

{$path "PasI:"}
{$incl "libraries/dos.h" }

const addrK = #$96;
      dataK = #$AD;
      secImSize = 143360;

type imageDef = (none, notIm, bitIm, secDO, secPO);
     DOSdef = (DOS33, Pascal, ProDOS, unknown);
     modeDef = (cat, insert, extract, delete, reord, cvt);
     dateStr = string[9];
     timeStr = string[5];
     pathN = string[107];
     sector = array[0..255] of byte;
     track = array[0..15] of sector;

var firstTime, parmsOK, hit, xlate, scanData, match, done: Boolean;
    volHi, volLo, trkNo, prevT, secNo, s, AReg, entTyp, byt: byte;
    access, hi, lo, ch: char;
    answer, fileSz, offset, start, firstThree: long;
    front, back, count,
    entCount, entSz, mapBlock, totBlocks, blkNo, offs,
    entries, blocks, free, used, largest, unused,
    file_type, stop, size, limit,
    lastTrk, countA, countD,
    i, j, k: integer;
    ifTyp: imageDef;
    mode: modeDef;
    format: DOSdef;
    option{, headK, tailK, head, tail}: string[3];
    fileTyp, kind: string[4];
    volN: string[15];
    mDate, cDate: dateStr;
    mTime, cTime: timeStr;
    afName, dirName: string[32];
    f: BPTR;
    af: file of byte;
    ifName, afPath, ofName: pathN;
    months: array[0..12] of string[3];
    XORTable: array[$96..$FF] of byte;
    fTypes: array[1..13] of record
                              value: byte;
                              desc: string[3]
                            end;
    rawData: array[0..342] of byte
    LowBits: array[0..85] of byte;
    workSector: sector;
    rearrTrack: track;
    dirEnt: array[0..39] of byte;
    sectors: array[0..34] of track;
    blkAddrs: array[0..255] of word;
    image: array[0..249999] of byte;

function classify(n: pathN): imageDef;
  var fileSize: long;
      lockPtr: BPTR;
      FileIB: p_FileInfoBlock;
  begin
    lockPtr := Lock(n, ACCESS_READ);
    if lockPtr = 0
        then classify := none
      else begin
        new(FileIB);
        answer := Examine(lockPtr, FileIB);
        fileSize := FileIB^.fib_size;
        Unlock(lockPtr);
        dispose(FileIB);
        if fileSize = secImSize
            then begin
              { determine if 'DO' or 'PO' }
              classify := secDO  { default, for now }
            end
          else begin
            if fileSize < secImSize
                then classify := notIm
              else begin
                { validate part of file? }
                classify := bitIm
              end
          end
      end
  end;

function un4x4(xx, yy: byte): byte;
  begin
    un4x4 := ((xx and $55) shl 1) + (yy and $55)
  end;

function get_dir_byte(o: integer): byte;
  begin
    get_dir_byte := sectors[0][4 + o div 256][o mod 256]
  end;

function get_dir_word(o: integer): integer;
  begin
    get_dir_word := get_dir_byte(o + 1) * 256 + get_dir_byte(o)
  end;

procedure formatDate(high, low: byte; var d: dateStr);
  var year, month, day: integer;
      temp: dateStr;
  begin
    if high + low = 0
        then temp := '<NO DATE>'
      else begin
        year := high div 2;
        if format = Pascal
            then begin
              month := low mod 16;
              day := low div 16;
              if odd(high)
                  then day := day + 16;
            end
          else begin
            month := low shr 5;
            if odd(high)
                then month := month + 8;
            day := low and $1F
          end;
        if (month < 1) or (month > 12)
            then month := 0;
        temp := chr(day div 10 + 48) + chr(day mod 10 + 48)
                + '-' + months[month] + '-'
                + chr(year div 10 + 48) + chr(year mod 10 + 48);
        if temp[1] = '0'
            then temp[1] := ' '
      end;
    d := temp
  end;

procedure formatTime(high, low: byte; var d: timeStr);
  var hour, min: integer;
      temp: timeStr;
  begin
    temp := chr(high div 10 + 48) + chr(high mod 10 + 48)
            + ':'
            + chr(low div 10 + 48) + chr(low mod 10 + 48);
    if temp[1] = '0'
        then temp[1] := ' ';
    d := temp
  end;

procedure show_free(f: integer);
  begin
    if f > largest
         then largest := f;
    unused := unused + f;
    writeln('< UNUSED >      ', f:4, '           ', stop:4)
  end;

procedure toHex(v: byte; var a, b: char);
  function hexNyb(n: byte): char;
    begin
      if n < 10
          then hexNyb := chr(n + 48)
        else hexNyb := chr(n + 55)
    end;
  begin
    a := hexNyb(v shr 4);
    b := hexNyb(v and $0F)
  end;

procedure catalog;
  begin
    case format of
      DOS33: begin
               writeln('Volume number: ', sectors[17][0][6]);
               writeln('Diskette initialized by version ', sectors[17][0][3]);
               writeln(sectors[17][0][52], ' tracks');
               writeln(sectors[17][0][53], ' sectors');
               writeln(sectors[17][0][55] * 256 + sectors[17][0][54],
                       ' bytes per sector');
               repeat
                 for i := 0 to 6
                   do begin
                     for j := 0 to 34
                       do dirEnt[j] := sectors[trkNo][secNo][i * 35 + j + 11];
                     if (dirEnt[0] > 0) and (dirEnt[0] <> 255)
                         then begin
                           dirName := '';
                           for j := 0 to 29
                             do dirName := dirName + chr(dirEnt[3 + j] and $7F);
                           fileSz := dirEnt[34] * 256 + dirEnt[33];
                           case dirEnt[2] and $7F of
                               0: fileTyp := 'TEXT';
                               1: fileTyp := 'IBAS';
                               2: fileTyp := 'ABAS';
                               4: fileTyp := 'BIN ';
                               8: fileTyp := 'TypS';
                               16: fileTyp := 'RELO';
                               32: fileTyp := 'TypA';
                               64: fileTyp := 'TypB'
                             else fileTyp := 'Unk '
                           end;
                           writeln(dirName, fileSz:6, ' ', fileTyp)
                         end
                   end;
                 prevT := trkNo;
                 trkNo := sectors[prevT][secNo][1];
                 secNo := sectors[prevT][secNo][2];
                 if (secNo <> 0) and (secNo <> 15)
                     then secNo := 15 - secNo
               until trkNo = 0;
               writeln
             end;
      Pascal: begin
                volN := '';
                for i := 1 to get_dir_byte(6)
                  do volN := volN + chr(get_dir_byte(6 + i));
                formatDate(sectors[0][4][21], sectors[0][4][20], cDate);
                writeln(volN, ':              ', cDate);
                blocks := get_dir_word(14);
                entries := get_dir_byte(16);
                unused := 0;
                largest := 0;
                stop := 6;
                for i := 1 to entries
                  do begin
                    offset := i * 26;
                    start := get_dir_word(offset);
                    if (start <> stop)
                        then show_free(start - stop);
                    stop := get_dir_word(offset + 2);
                    file_type := get_dir_word(offset + 4);
                    size := get_dir_byte(offset + 6);
                    dirName := '';
                    for j := 1 to size
                      do dirName := dirName + chr(get_dir_byte(offset + 6 + j));
                    if size < 15
                        then for j := 15 downto size + 1
                               do dirName := dirName + ' ';
                    formatDate(get_dir_byte(offset + 25),
                               get_dir_byte(offset + 24),
                               cDate);
                    write(dirName, ' ', stop - start:4, ' ', cDate, start:5, ' ');
                    case file_type of
                      2: kind := 'Code';
                      3: kind := 'Text';
                      4: kind := 'Typ4';
                      5: kind := 'Data';
                      7: kind := 'Typ7'
                    end;
                    writeln(kind)
                  end;
                if stop<>blocks
                    then show_free(blocks-stop);
                writeln(entries, '/', entries, ' files, ',
                        unused, ' unused, ',
                        largest, ' in largest');
                writeln
              end;
      ProDOS: begin
                volN := '/';
                for i := 1 to sectors[0][4][4] and $0F
                  do volN := volN + chr(sectors[0][4][4 + i]);
                writeln(volN);
                writeln;
                writeln(' NAME           TYPE  BLOCKS  ',
                        'MODIFIED         CREATED          ENDFILE SUBT.');
                writeln;
                entCount := sectors[0][4][36];
                entSz := sectors[0][4][35];
                blkNo := 2;
                repeat
                  trkNo := blkNo div 8;
                  secNo := (blkNo * 2) mod 16;
                  for i := 0 {+ firstTime }to entCount - 1
                    do begin
                      for j := 0 to entSz - 1
                        do begin
                          offs := i * entSz + j + 4;
                          dirEnt[j] := sectors[trkNo][secNo + offs div 256][offs mod 256]
                        end;
                      entTyp := dirEnt[0] shr 4;
                      if ((entTyp >= 1) and (entTyp <= 3)) or (entTyp = 13)
                          then begin
                            if dirEnt[30] and $02 = 0
                                then access := '*'
                              else access := ' ';
                            dirName := '';
                            size := dirEnt[0] and $0F;
                            for j := 1 to size
                              do dirName := dirName + chr(dirEnt[j]);
                            for j := size + 1 to 16
                              do dirName := dirName + ' ';
                            j := 0;
                            repeat
                              J := j + 1;
                              match := dirEnt[16] = fTypes[j].value
                            until match or (j = 13);
                            if match
                                then fileTyp := fTypes[j].desc
                              else begin
                                toHex(dirEnt[16], hi, lo);
                                fileTyp := '$' + hi + lo
                              end;
                            formatDate(dirEnt[34], dirEnt[33], mDate);
                            if mDate = '<NO DATE>'
                                then mTime := '     '
                              else formatTime(dirEnt[36], dirEnt[35], mTime);
                            formatDate(dirEnt[25], dirEnt[24], cDate);
                            if cDate = '<NO DATE>'
                                then cTime := '     '
                              else formatTime(dirEnt[27], dirEnt[26], cTime);
                            writeln(access, dirName, fileTyp,
                                    dirEnt[20] * 256 + dirEnt[19]:8,
                                    '  ', mDate, ' ', mTime,
                                    '  ', cDate, ' ', cTime,
                                    dirEnt[23] * 65536 + dirEnt[22] * 256 + dirEnt[21]:9)
                          end
                    end;
                  blkNo := sectors[trkNo][secNo][3] * 256 + sectors[trkNo][secNo][2]
                until blkNo = 0;
                writeln;
                totBlocks := sectors[0][4][42] * 256 + sectors[0][4][41];
                mapBlock := (sectors[0][4][40] * 256 + sectors[0][4][39]) * 2;
                free := 0;
                used := 0;
                for i := 0 to totBlocks - 1
                  do begin
                    if sectors[0][mapBlock][i div 8] and (1 shl (i mod 8)) = 0
                        then used := used + 1
                      else free := free + 1
                  end;
                writeln('BLOCKS FREE:', free:5,
                        '     BLOCKS USED:', used:5,
                        '     TOTAL BLOCKS:', totBlocks:5);
                writeln
              end;
      unknown: writeln('Unknown operating system!')
    end
  end;

begin
{$r-}
  for i := $98 to $FF
    do XORTable[i] := 0;
  XORTable[$96] := 0;
  XORTable[$97] := 1;
  XORTable[$9A] := 2;
  XORTable[$9B] := 3;
  XORTable[$9D] := 4;
  XORTable[$9E] := 5;
  XORTable[$9F] := 6;
  XORTable[$A6] := 7;
  XORTable[$A7] := 8;
  XORTable[$AB] := 9;
  XORTable[$AC] := 10;
  XORTable[$AD] := 11;
  XORTable[$AE] := 12;
  XORTable[$AF] := 13;
  XORTable[$B2] := 14;
  XORTable[$B3] := 15;
  XORTable[$B4] := 16;
  XORTable[$B5] := 17;
  XORTable[$B6] := 18;
  XORTable[$B7] := 19;
  XORTable[$B9] := 20;
  XORTable[$BA] := 21;
  XORTable[$BB] := 22;
  XORTable[$BC] := 23;
  XORTable[$BD] := 24;
  XORTable[$BE] := 25;
  XORTable[$BF] := 26;
  XORTable[$CB] := 27;
  XORTable[$CD] := 28;
  XORTable[$CE] := 29;
  XORTable[$CF] := 30;
  XORTable[$D3] := 31;
  XORTable[$D6] := 32;
  XORTable[$D7] := 33;
  XORTable[$D9] := 34;
  XORTable[$DA] := 35;
  XORTable[$DB] := 36;
  XORTable[$DC] := 37;
  XORTable[$DD] := 38;
  XORTable[$DE] := 39;
  XORTable[$DF] := 40;
  XORTable[$E5] := 41;
  XORTable[$E6] := 42;
  XORTable[$E7] := 43;
  XORTable[$E9] := 44;
  XORTable[$EA] := 45;
  XORTable[$EB] := 46;
  XORTable[$EC] := 47;
  XORTable[$ED] := 48;
  XORTable[$EE] := 49;
  XORTable[$EF] := 50;
  XORTable[$F2] := 51;
  XORTable[$F3] := 52;
  XORTable[$F4] := 53;
  XORTable[$F5] := 54;
  XORTable[$F6] := 55;
  XORTable[$F7] := 56;
  XORTable[$F9] := 57;
  XORTable[$FA] := 58;
  XORTable[$FB] := 59;
  XORTable[$FC] := 60;
  XORTable[$FD] := 61;
  XORTable[$FE] := 62;
  XORTable[$FF] := 63;
  months[0] := '???';
  months[1] := 'Jan';
  months[2] := 'Feb';
  months[3] := 'Mar';
  months[4] := 'Apr';
  months[5] := 'May';
  months[6] := 'Jun';
  months[7] := 'Jul';
  months[8] := 'Aug';
  months[9] := 'Sep';
  months[10] := 'Oct';
  months[11] := 'Nov';
  months[12] := 'Dec';
  fTypes[1].value := $01;
  fTypes[1].desc := 'BAD';
  fTypes[2].value := $04;
  fTypes[2].desc := 'TXT';
  fTypes[3].value := $06;
  fTypes[3].desc := 'BIN';
  fTypes[4].value := $0F;
  fTypes[4].desc := 'DIR';
  fTypes[5].value := $19;
  fTypes[5].desc := 'ADB';
  fTypes[6].value := $1A;
  fTypes[6].desc := 'AWP';
  fTypes[7].value := $1B;
  fTypes[7].desc := 'ASP';
  fTypes[8].value := $EF;
  fTypes[8].desc := 'PAS';
  fTypes[9].value := $F0;
  fTypes[9].desc := 'CMD';
  fTypes[10].value := $FC;
  fTypes[10].desc := 'BAS';
  fTypes[11].value := $FD;
  fTypes[11].desc := 'VAR';
  fTypes[12].value := $FE;
  fTypes[12].desc := 'REL';
  fTypes[13].value := $FF;
  fTypes[13].desc := 'SYS';
{$r+}
  clrscr;
  writeln;
  writeln('Apple Image Utility - version 0.3');
  writeln;
  parmsOK := true;
  case ParamCount of
      0: begin
           write('File name? ');
           readln(ifName);
           ifTyp := classify(ifName);
           mode := cat
         end;
      1: begin
           ifName := ParamStr(1);
           ifTyp := classify(ifName);
           mode := cat
         end;
      2: begin
           ifName := ParamStr(1);
           ifTyp := classify(ifName);
           if (ParamStr(2) = '-r') or (ParamStr(2) = '-R')
               then begin
                 if ifTyp = bitIm
                     then begin
                       writeln('Can''t reorder bit image!');
                       parmsOK := false
                     end
                   else begin
                     if size <> 2
                         then parmsOK := false
                       else begin
                         ofName := ifName + '.ro';
                         mode := reord
                       end
                   end
               end
             else if (ParamStr(2) = '-c') or (ParamStr(2) = '-C')
                      then begin
                        if ifTyp <> bitIm
                            then begin
                              writeln('Can''t convert sector image!');
                              parmsOK := false
                            end
                          else begin
                            ofName := ifName + '.si';
                            mode := cvt
                          end
                      end
             else parmsOK := false
         end;
      3: begin
           ifName := ParamStr(1);
           ifTyp := classify(ifName);
           option := ParamStr(2);
           size := length(option);
           if option[1] <> '-'
               then parmsOK := false
             else begin
               case option[2] of
                   'i',
                   'I': begin
                          afName := ParamStr(3);
                          assign(af, afName);
                          {$i-}
                          reset(af);
                          {$i+}
                          if IOResult <> 0
                              then begin
                                writeln('Can''t open ''', afName, '''!');
                                parmsOK := false
                              end
                            else begin
                              close(af);
                              afPath := afName;
                              i := length(afPath);
                              repeat
                                ch := afPath[i];
                                hit := (ch = ':') or (ch = '/') or (ch = '\');
                                if not hit
                                    then i := i - 1
                              until (i = 0) or hit;
                              if hit
                                  then afName := copy(afPath, i + 1, length(afPath) - i);
                            end;
                          if size = 2
                              then xlate := false
                            else if size <> 3
                                     then parmsOK := false
                            else if UpCase(option[3]) <> 'T'
                                     then parmsOK := false
                            else xlate := true;
                          mode := insert
                        end;
                   'x',
                   'X': begin
                          afName := ParamStr(3);
                          for i := 1 to length(afName)
                            do afName[i] := UpCase(afName[i]);
                          if size = 2
                              then xlate := false
                            else if size <> 3
                                     then parmsOK := false
                            else if UpCase(option[3]) <> 'T'
                                     then parmsOK := false
                            else xlate := true;
                          mode := extract
                        end;
                   'd',
                   'D': begin
                          afName := ParamStr(3);
                          for i := 1 to length(afName)
                            do afName[i] := UpCase(afName[i]);
                          if size <> 2
                              then parmsOK := false
                            else mode := delete
                        end;
                   'c',
                   'C': begin
                        if ifTyp <> bitIm
                            then begin
                              writeln('Can''t convert sector image!');
                              parmsOK := false
                            end
                          else begin
                            if size <> 2
                                then parmsOK := false
                              else begin
                                ofName := ParamStr(3);
                                mode := cvt
                              end
                          end
                        end;
                   'r',
                   'R': begin
                          if ifTyp = bitIm
                              then begin
                                writeln('Can''t reorder bit image!');
                                parmsOK := false
                              end
                            else begin
                              if size <> 2
                                  then parmsOK := false
                                else begin
                                  ofName := ParamStr(3);
                                  mode := reord
                                end
                            end
                        end
                 else parmsOK := false
               end
             end
         end
    else parmsOK := false
  end;
  if not parmsOK
      then begin
        writeln('  Usage:');
        writeln('    "ImU" - Directory listing of diskette image file');
        writeln('    "ImU ifN" - Directory listing of "ifN"');
        writeln('    "ImU ifN -x mfN" - Extract "mfN" from "ifN"');
        writeln('    "ImU ifN -xt mfN" - ''-x'' plus translate ''EOL''');
        writeln('    "ImU ifN -i fN" - Insert "fN" into "ifN"');
        writeln('    "ImU ifN -it fN" - ''-i'' plus translate ''EOL''');
        writeln('    "ImU ifN -d mfN" - Delete "mfN" from "ifN"');
        writeln('    "ImU ifN -r" - Reorder "ifN" creating "ifN.ro"');
        writeln('    "ImU ifN -r ofN" - Reorder "ifN" creating "ofN"');
        writeln('    "ImU ifN -c" - Convert "ifN" to "ifN.si"');
        writeln('    "ImU ifN -c ofN" - Convert "ifN" to "ofN"');
        halt(20)
      end;
  if ifTyp < bitIm
      then begin
        writeln('File missing or not image file!');
        halt(20)
      end;
  case mode of
    cat: ;
    insert: begin
              writeln('Can''t insert a file into an image yet!');
              halt(20)
            end;
    extract: begin
               writeln('Attempting to extract ''', afName,
                       ''' from ''', ifName, '''');
               writeln
             end;
    delete: begin
              writeln('Can''t delete a file from an image yet!');
              halt(20)
            end;
    reord: begin
             writeln('Reordering sector image file ''', ifName,
                     ''' as ''', ofName, '''')
           end;
    cvt: begin
           writeln('Converting bit image file ''', ifName,
                   ''' as sector image file ''',  ofName, '''')
         end
  end;
  if ifTyp <> bitIm
      then begin  { Load sector image file }
        f := Open(ifName, MODE_OLDFILE);
        if f = 0
            then begin
              writeln('Illogical error while opening ''', ifName, '''!');
              halt(20)
            end;
        if _Read(f, ^sectors, secImSize) <> secImSize
            then begin
              writeln('Error reading ''', ifName, '''!');
              _Close(f);
              halt(20)
            end;
        _Close(f);
        for i := 0 to 34
          do begin
            rearrTrack[0] := sectors[i][0];
            rearrTrack[1] := sectors[i][14];
            rearrTrack[2] := sectors[i][13];
            rearrTrack[3] := sectors[i][12];
            rearrTrack[4] := sectors[i][11];
            rearrTrack[5] := sectors[i][10];
            rearrTrack[6] := sectors[i][9];
            rearrTrack[7] := sectors[i][8];
            rearrTrack[8] := sectors[i][7];
            rearrTrack[9] := sectors[i][6];
            rearrTrack[10] := sectors[i][5];
            rearrTrack[11] := sectors[i][4];
            rearrTrack[12] := sectors[i][3];
            rearrTrack[13] := sectors[i][2];
            rearrTrack[14] := sectors[i][1];
            rearrTrack[15] := sectors[i][15];
            sectors[i] := rearrTrack
          end
      end  { Load sector image file }
    else begin  { Load bit image file }
      f := Open(ifName, MODE_OLDFILE);
      if f = 0
          then begin
            writeln('Couldn''t find ''', ifName, '''!');
            halt(20)
          end;
      fileSz :=  _Read(f, ^image, 250000);
      _Close(f);
      firstTime := true;
      lastTrk := -1;
      countA := 0;
      countD := 0;
      offset := 0;
      done := false;
      scanData := false;
      repeat
        if image[offset] = $D5
            then if image[offset + 1] = $AA
                     then if image[offset + 2] = $96
                              then begin
                                if scanData
                                    then begin
                                      writeln;
                                      writeln('Address/Data field sequence error!')
                                    end;
                                if firstTime
                                    then begin
                                      volHi := image[offset + 3];
                                      volLo := image[offset + 4]
                                      firstTime := false
                                    end
                                  else if (image[offset + 3] <> volHi)
                                          or (image[offset + 4] <> volLo)
                                           then begin
                                             writeln;
                                             writeln('Volume number mismatch!')
                                           end;
                                trkNo := un4x4(image[offset + 5], image[offset + 6]);
                                secNo := un4x4(image[offset + 7], image[offset + 8]);
                                if trkNo <> lastTrk
                                    then begin
                                      lastTrk := trkNo;
                                      if trkNo mod 7 = 0
                                          then writeln;
                                      write(trkNo:3)
                                    end;
                                if not ((image[offset + 11] = $DE)
                                        and (image[offset + 12] = $AA)
                                       {and (image[offset + 13] = $EB)})
                                    then begin
                                      writeln;
                                      writeln('Address field epilogue error!')
                                    end;
                                offset := offset + 12;
                                countA := countA + 1;
                                scanData := true
                              end
                            else if image[offset + 2] = $AD
                                 then begin
                                   if not scanData
                                       then begin
                                         writeln;
                                         writeln('Address/Data field sequence error!')
                                       end;
                                   if not ((image[offset + 346] = $DE)
                                           and (image[offset + 347] = $AA)
                                          {and (image[offset + 348] = $EB)})
                                       then begin
                                         writeln;
                                         writeln(image[offset + 346]:4, image[offset + 347]:4,
                                                 ' Data field epilogue error!')
                                       end
                                     else begin
                                       for j := 0 to 342
                                         do rawData[j] := image[offset + 3 + j];
                                       AReg := 0;
                                       for j := 0 to 85
                                         do begin
                                           AReg := AReg xor XORTable[rawData[j]];
                                           LowBits[85 - j] := AReg
                                         end;
                                       for j := 86 to 341
                                         do begin
                                           AReg := AReg xor XORTable[rawData[j]];
                                           workSector[j - 86] := AReg
                                         end;
                                       AReg := AReg xor XORTable[rawData[342]];
                                       if AReg <> 0
                                           then begin
                                             writeln(' Checksum error!')
                                             halt(20)
                                           end;
                                       k := 0;
                                       for j := 0 to 255
                                         do begin
                                           k := k - 1;
                                           if k < 0
                                               then k := 85;
                                           AReg := LowBits[k] and 1;
                                           AReg := AReg shl 1;
                                           LowBits[k] := LowBits[k] shr 1;
                                           AReg := AReg + (LowBits[k] and 1);
                                           LowBits[k] := LowBits[k] shr 1;
                                           workSector[j] := workSector[j] shl 2 + AReg
                                         end
                                       sectors[trkNo][(secNo mod 2) * 8 + secNo div 2] := workSector;
                                     end;
                                   offset := offset + 348;
                                   countD := countD + 1;
                                   scanData := false
                                 end
                            else begin
                              writeln;
                              writeln('Invalid byte after ''$D5AA''!')
                            end;
        offset := offset + 1
      until (offset = fileSz) or done;
      writeln;
      writeln;
      if (countA <> 560) or (countD <> 560)
          then begin
            writeln('Found ', countA, ' address fields!');
            writeln('Found ', countD, ' data fields!')
          end
    end;  { Load bit image file }
  trkNo := sectors[17][0][1];
  secNo := sectors[17][0][2];
  if (trkNo = 17) and (secNo = 15)
      then format := DOS33
    else begin
      firstThree := 0;
      for i := 0 to 2
        do firstThree := firstThree shl 8 + sectors[0][4][i];
      if (firstThree = 3)
         and (sectors[0][4][3] = 0)
         and (sectors[0][4][4] shr 4 = 15)
          then format := ProDOS
        else if firstThree = 6
                 then format := Pascal
               else format := unknown
    end;
  case mode of
    cat: catalog;
    insert: begin
            end;
    extract: begin
               catalog;
               case format of
                 unknown: ;
                 DOS33: begin
                          trkNo := 17;
                          secNo := 15;
                          repeat
                            i := 0;
                            repeat
                              for j := 0 to 34
                                do dirEnt[j] := sectors[trkNo][secNo][i * 35 + j + 11];
                              if (dirEnt[0] > 0) and (dirEnt[0] <> 255)
                                  then begin
                                    dirName := '';
                                    for j := 0 to 29
                                      do dirName := dirName + UpCase(chr(dirEnt[3 + j] and $7F));
                                    while dirName[length(dirName)] = ' '
                                      do dirName := copy(dirName, 1, length(dirName) - 1);
                                    match := afName = dirName
                                  end;
                              i := i + 1
                            until (i = 7) or match;
                            if not match
                                then begin
                                  prevT := trkNo;
                                  trkNo := sectors[prevT][secNo][1];
                                  secNo := sectors[prevT][secNo][2];
                                  if (secNo <> 0) and (secNo <> 15)
                                      then secNo := 15 - secNo
                                end
                          until (trkNo = 0) or match;
                          if not match
                              then begin
                                writeln('Can''t locate ''', afName, ''' in ''', ifName, '''');
                                writeln
                              end
                            else begin
                              writeln('Oops, can''t extract yet!')
                            end
                        end;
                 Pascal: begin
                           entries := get_dir_byte(16);
                           i := 0;
                           repeat
                             i := i + 1;
                             offset := i * 26;
                             size := get_dir_byte(offset + 6);
                             dirName := '';
                             for j := 1 to size
                               do dirName := dirName + UpCase(chr(get_dir_byte(offset + 6 + j)));
                             match := afName = dirName
                           until (i = entries) or match;
                           if not match
                               then begin
                                 writeln('Can''t locate ''', afName, ''' in ''', ifName, '''');
                                 writeln
                               end
                             else begin
                               writeln('Oops, can''t extract yet!')
                             end
                         end;
                 ProDOS: begin
                           entCount := sectors[0][4][36];
                           entSz := sectors[0][4][35];
                           match := false;
                           blkNo := 2;
                           repeat
                             trkNo := blkNo div 8;
                             secNo := (blkNo * 2) mod 16;
                             i := 0;
                             repeat
                               for j := 0 to entSz - 1
                                 do begin
                                   offs := i * entSz + j + 4;
                                   dirEnt[j] := sectors[trkNo][secNo + offs div 256][offs mod 256]
                                 end;
                               entTyp := dirEnt[0] shr 4;
                               if (entTyp >= 1) and (entTyp <= 3)
                                   then begin
                                     dirName := '';
                                     size := dirEnt[0] and $0F;
                                     for j := 1 to size
                                       do dirName := dirName
                                                     + UpCase(chr(dirEnt[j]))
                                   end;
                               match := dirName = afName;
                               i := i + 1
                             until (i = entCount) or match
                             if not match
                                 then blkNo := sectors[trkNo][secNo][3] * 256
                                               + sectors[trkNo][secNo][2]
                           until (blkNo = 0) or match;
                           if not match
                               then begin
                                 writeln('Can''t locate ''', afName, ''' in ''', ifName, '''');
                                 writeln
                               end
                             else begin
                               i := (dirEnt[0] and $F0) shr 4;
                               if (i < 1) or (i > 2)
                                   then writeln('Can''t handle file type!')
                                 else begin
                                   { get file size }
                                   fileSz :=  dirEnt[23] * 65536 + dirEnt[22] * 256 + dirEnt[21];
                                   start := dirEnt[18] * 256 + dirEnt[17];
                                   if i = 1
                                       then begin
                                         blocks := 1;
                                         blkAddrs[0] := start
                                       end
                                     else begin
                                       i := 0;
                                       trkNo := start div 8;
                                       secNo := (start * 2) mod 16;
                                       repeat
                                         blkNo := sectors[trkNo][secNo + 1][i]
                                                * 256 + sectors[trkNo][secNo][i];
                                         blkAddrs[i] := blkNo;
                                         i := i + 1
                                       until blkNo = 0;
                                       blocks := i
                                     end;
                                   assign(af, dirName);
                                   rewrite(af);
                                   limit := 511;
                                   for i := 0 to blocks - 2
                                     do begin
                                       trkNo := blkAddrs[i] div 8;
                                       secNo := (blkAddrs[i] * 2) mod 16;
                                       if i = blocks - 2
                                           then limit := fileSz mod 512 - 1;
                                       for j := 0 to limit
                                         do write(af, sectors[trkNo][secNo + j div 256][j mod 256])
                                     end
                                   close(af)
                                 end
                             end
                         end
               end
             end;
    delete: begin
            end;
    reord: begin
             f := Open(ofName, MODE_NEWFILE);
             if _Write(f, ^sectors, secImSize) <> secImSize
                 then begin
                   writeln('Error writing reordered file!');
                   halt(20)
                 end;
             _Close(f);
             writeln
           end;
    cvt: begin
           for i := 0 to 34
             do begin
               rearrTrack[0] := sectors[i][0];
               rearrTrack[1] := sectors[i][14];
               rearrTrack[2] := sectors[i][13];
               rearrTrack[3] := sectors[i][12];
               rearrTrack[4] := sectors[i][11];
               rearrTrack[5] := sectors[i][10];
               rearrTrack[6] := sectors[i][9];
               rearrTrack[7] := sectors[i][8];
               rearrTrack[8] := sectors[i][7];
               rearrTrack[9] := sectors[i][6];
               rearrTrack[10] := sectors[i][5];
               rearrTrack[11] := sectors[i][4];
               rearrTrack[12] := sectors[i][3];
               rearrTrack[13] := sectors[i][2];
               rearrTrack[14] := sectors[i][1];
               rearrTrack[15] := sectors[i][15];
               sectors[i] := rearrTrack
             end
           f := Open(ofName, MODE_NEWFILE);
           if _Write(f, ^sectors, secImSize) <> secImSize
               then begin
                 writeln('Error writing sector image file!');
                 halt(20)
               end;
           _Close(f);
           writeln
         end
  end
end.