program cvtDCM;

var multiExpected, notOpen, misMatch, done, err,
    hasAddr, newStart, use: Boolean;
    ch, letter: char;
    header, code, densityCode, lo, hi, data, start, limit, fill: byte;
    size, offs, numSecs, secNo, newSec, regX, i: integer;
    count: longint;
    a: file of byte;
    b: file;
    ATRheader: array[0..15] of byte;
    fileName, inPathName, outPathName: string[64];
    buffer, pad: array[0..127] of byte;

begin
  for i := 0 to 127
    do pad[i] := 0;
  if ParamCount = 0
      then begin
        write('File name? ');
        readln(fileName)
      end
    else fileName := ParamStr(1);
  if pos('.', fileName) <> 0
      then begin
        writeln('''.'' not valid in file name!');
        halt(20)
      end;
  outPathName := fileName;
  size := length(fileName);
  if pos('/', fileName) <> 0
      then begin
        i := size;
        repeat
          ch := fileName[i];
          if ch <> '/'
              then i := i - 1
        until ch = '/';
        outPathName := copy(filename, i + 1, size - i)
      end;
  multiExpected := false;
  if size > 2
      then if (UpCase(fileName[size - 1]) = 'F') and (fileName[size] = '1')
               then begin
                 outPathName := copy(outPathName, 1, length(outPathName) - 2);
                 offs := size;
                 multiExpected := true
               end;
  inPathName := fileName + '.dcm';
  secNo := 1;
  numSecs := 720;
  notOpen := true;
  done := false;
  repeat
    assign(a, inPathName);
    reset(a);
    if eof(a)
        then begin
          if not multiExpected
              then begin
                writeln('File missing!');
                err := true
              end
            else done := true
        end
      else begin
        read(a, header);
        count := 1;
        misMatch := (multiExpected and (header = $FA))
                    or (not multiExpected and (header = $F9));
        if misMatch
            then begin
              writeln('Input file header error!');
              close(a);
              halt(20)
            end;
        read(a, code);
        count := count + 1;
        densityCode := (code and $60) shr 5 + 1;
{
        writeln('Density code is ', densityCode);
}
        if (densityCode < 1) or (densityCode > 3)
            then begin
              writeln('Invalid density code!');
              close(a);
              if not notOpen
                  then close(b);
              halt(20)
            end;
        if densityCode = 2
            then begin
              writeln('Can''t do double density yet!');
              close(a);
              if not notOpen
                  then close(b);
              halt(20)
            end;
        read(a, lo, hi);
        count := count + 2;
        newSec := hi * 256 + lo;
        if secNo <> newSec
            then begin
              writeln('Input file header error!');
              close(a);
              if not notOpen
                  then close(b);
              halt(20)
            end
        err := false;
        if notOpen
            then begin
              if densityCode = 3
                  then outPathName := outPathName + '.ATR'
                else outPathName := outPathName + '.XFD';
              assign(b, outPathName);
              rewrite(b, 16);
              if densityCode = 3
                  then begin
                    ATRheader[0] := $96;
                    ATRheader[1] := $02;
                    ATRheader[2] := 1040 mod 256;
                    ATRheader[3] := 1040 div 256;
                    ATRheader[4] := 128;
                    ATRheader[5] := 0;
                    for i := 6 to 15
                      do ATRheader[i] := 0;
                    BlockWrite(b, ATRheader, 1);
                    numsecs := 1040
                  end;
              notOpen := false
            end;
        repeat
          read(a, code);
          count := count + 1;
          hasAddr := (code and $80) = 0;
          letter := chr(code and $7F);
{
          writeln('Code is ''', letter, '''');
}
          case letter of
              'A': begin
                     read(a, start);
                     count := count + 1;
                     regX := start;
                     repeat
                       read(a, data);
                       count := count + 1;
                       buffer[regX] := data;
                       regX := regX - 1
                     until regX = - 1;
                     BlockWrite(b, buffer, 8);
                     secNo := secNo + 1
                   end;
              'B': err := true;
              'C': begin
                     regX := 0;
                     newStart := true;
                     repeat
                       if newStart
                           then begin
                             read(a, start);
                             count := count + 1;
{
                             writeln('Start=', start);
}
                             newStart := false
                           end;
                       if regX = start
                           then begin
                             read(a, limit, fill);
                             count := count + 2;
{
                             write('Limit=', limit, '  Fill=')
                             if (fill >= 32) and (fill <= 126)
                                 then writeln('''', chr(fill), '''')
                               else writeln(fill);
}
                             for i := regX to regX + limit - start - 1
                               do buffer[i] := fill;
                             regX := regX + limit - start;
                             newStart := true
                           end
                         else begin
                           read(a, data);
                           count := count + 1;
                           buffer[regX] := data
                           regX := regX + 1
                         end
                     until regX = 128;
                     BlockWrite(b, buffer, 8);
                     secNo := secNo + 1
                   end;
              'D': begin
                     read(a, start);
                     count := count + 1;
                     regX := start;
                     repeat
                       read(a, data);
                       count := count + 1;
                       buffer[regX] := data;
                       regX := regX + 1
                     until regX = 128;
                     BlockWrite(b, buffer, 8);
                     secNo := secNo + 1
                   end;
              'E': begin
                     read(a, data, data);
                     count := count + 2;
                     if eof(a)
                         then hasAddr := false
                   end;
              'F': begin
                     BlockWrite(b, buffer, 8);
                     secNo := secNo + 1
                   end;
              'G': begin
                     for i := 0 to 127
                       do begin
                         read(a, buffer[i]);
                         count := count + 1
                       end;
                     BlockWrite(b, buffer, 8);
                     secNo := secNo + 1
                   end
            else err := true
          end;
          if hasAddr and not err
              then begin
                read(a, lo, hi);
                count := count + 2;
                newSec := hi * 256 + lo;
                if (newSec <> 69) and (newSec < numSecs)
                    then begin
{
                      writeln('Current sector = ', secNo, '  new sector = ', newSec);
}
                      if newSec > secNo
                          then begin
                            for i := secNo to newSec - 1
                              do BlockWrite(b, pad, 8);
                            secNo := newSec
                          end
                    end
                  else {writeln(newSec, ' ignored!')}
              end
        until err or eof(a);
        close(a)
      end;
    if err
        then writeln('Sector = ', count div 512 + 1,
                     ' Offset = ', count mod 512)
      else if not done
               then if multiExpected
                        then begin
                          inPathName[offs] := chr(ord(inPathName[offs]) + 1)
{
writeln('offset=',offs)
writeln('''',inPathName,'''')
}
                        end
                      else done := true
  until done or err;
  if not err
      then if secNo < numSecs
            then for i := secNo to numSecs
                   do BlockWrite(b, pad, 8)
  close(b)
end.