{   Copyright by Werner Zsolt, 1993. oct. 09.
    This is a FREEWARE SOURCE. Any suggestion should be reported to:
    Werner Zsolt,   MTTT022@URSUS.BKE.HU  (Usenet addr)
                    36/1/1823513  (Voice/14400 modem)
                    Hungary, Budapest, Fej‚r Lip¢t 65. XI. 86. Zip: 1119

   This program copies ANYTHING to a C64 disc image. Great program!! :-)

   And long live, Miha!
}


{$i-}
var I,filesize_of_tape,free_on_disk,_filepos,
    previous_sector:LONGINT;
    FIRST_TRACK,first_sector,B1,b2:BYTE;
    INFILE,OUTFILE:FILE OF BYTE;
    free_track,free_block,TRACK,SECTOR,
    sectors_free_in_the_block,FREESECTOR:byte;
      { a byte indicates which block (and track) is free at one track. We
        search it from the BAM. }

function which_track(abspos:longint):byte;
begin
  if abspos<91392 then which_track:=(abspos div 5376)+1;   { 1-17 }
  if (abspos>=96256) and (abspos<125440) then which_track:=
                                         17+(abspos-96256) div 19;
                       { 18 (19) -22,we don't check dir area! }
  if (abspos>=125440) and (abspos<153088) then
                      which_track:=24+(abspos-125440) div 18;
                                     {  25 - 30 }
  if (abspos>=153088) then which_track:=30+(abspos-153088) div 17;
end;

function which_sector(abspos:longint):byte;
begin
  if abspos<91392 then which_sector:=(abspos div 5376);   { 1-21 }
  if (abspos>=96256) and (abspos<125440) then
      which_sector:=17+(abspos-96256) div 19;
            { 18 (19) -22,we don't check dir area! }
  if (abspos>=125440) and (abspos<153088) then
      which_sector:=24+(abspos-125440) div 18;
                                     {  25 - 30 }
  if (abspos>=153088) then which_sector:=30+(abspos-153088) div 17;
end;



procedure make_dir_entry;
{ if we have the previous_sector updated, we can establish
the directory entry. At first, seek to 16602h and read. Is
 it 0 or 80h? All right, let's write out the dir entry.
   If it isn't 00 or 80h, then seek +31d (assuming we have
just read 16602), and read the next byte - and so on.
   One problem: when we find a dir entry, what is in a block (so
it must be the FIRST entry in that block and the LATEST block (w/
00 FF beginning) holds all the 8 possible entries; then the value
of the inner value: last_dir_block (only SECTOR number!) will be the
(_filepos-16502h) div 256 (look, there is again a saving of a
sector-counter variable! We could use a variable to COUNT,
when seeking, the blocks, but this is simplier!).
 Now: Position to _filepos (XXXX2)-102h and write ot 12h (track) and
last_dir_block.

 The dir entry's format is:
  12/01=16600h=
    0,1:   the following DIRECTORY BLOCK's track and sector
    02h-1fh:  1st. file
    22  3f    2nd.
    42  5f    3rd.
    62  7f    4th.
    82  9f    5th.
    a2  bf    6th.
    c2  df    7th.
    e2  ff    8th.

  When the following dir block is 00/ffh, then this is the latest block.
  And the unused blocks in the directory area contain 00/00 begin so
  we can simply check if the checked is a free dir block or not.

  Directory entry format:

  0:             type of file (use 82h!)
  1,2:           the first data block's __track__ and sector address
  03h-12h:       name (w/ A0h end-spacing)
  13h,14h:       only rel files!
  15h:           rel files only!
  16h-19h:       unused
  1ah-1bh:       the new file's track & sector adress when we overwrite it
                 w/ @s.
  1ch, 1dh:     number of blocks in the file. Low byte/high byte. This can be
computed by the value: (filesize_of_tape div 254)+1.

  Type of file: 7th. bit: was it closed?  }
var last_dir_block:byte;  phisical_addr_of_entry,temp:longint;
    block,entry:longint; filename:string; tempint:integer;
begin
_filepos:=$16602;
block:=1;    { counting the block }
entry:=1;    { counting the entry in all blocks }

repeat
 seek(outfile,_filepos);
 read(outfile,b1);
 if (b1=0) or (b1=$80) then begin
              phisical_addr_of_entry:=_filepos;
                IF BLOCK>1 THEN BEGIN
                _filepos:=$16500+(block-1)*256;
                   { always the PREVIOUS block is the last-but-one block! WE
                     ALWAYS STEP BACK TO THE PREVIOUS DIR BLOCK (ASSUMING
                     (AND CHECKING) IF THE CURRENT DIR BLOCK IS GREATER THAN
                     1), AND CHECK IF THAT IS THE LATEST BLOCK. THEN WE MAKE
                     THE POINTER TO THE CURRENT BLOCK. WE _ALWAYS_ CHECK W/
                     THIS METHOD: JUST IMAGINE IF WE ARE ON A BLOCK WHERE
                     THE BEGINNING IS NOT 00 00 (E.G. ERASED BLOCK OR AFTER
                     DIR FORMAT WE ARE ON 04th TRACK AND THE LATEST IS 03rd
                     TRACK! }
                SEEK(OUTFILE,_FILEPOS);   { WE ASSUME HERE THAT THE DIRECTORY
                                           IS ALREADY FORMATTED, SO THE PREVIOUS
                                           DIR BLOCK IS _PHISICAL_ THE PREV! }
                READ(OUTFILE,B2);
                IF B2=0 THEN BEGIN
                 SEEK(OUTFILE,_FILEPOS);
                 b2:=18;
                 write(outfile,b2);
                 b2:=block;
                 write(outfile,b2);
                 _filepos:=$16500+block*256;
                   { AND UPDATE THE PRESENT DIR BLOCK: WRITE 00 FF AT THE
                                BEGINNING! }
                 SEEK(OUTFILE,_FILEPOS);
                 b2:=0;
                 write(outfile,b2);
                 b2:=$FF;
                 write(outfile,b2);

                          end;  { IF THE PREV BLOCK WAS BEGINNING W/ 00 FF}
                                { WE OVERWROTE IT W/ PTR AND UPDATED THE CURRENT HEADER, TOO! }
              END; { we didn't step back to the 0th dir block (the BAM)
                     if we were in the first dir block! }
              seek(outfile,phisical_addr_of_entry);
              b2:=$82;
              write(outfile,b2);
              write(outfile,FIRST_TRACK);
              write(outfile,FIRST_SECTOR);
              for i:=1 to 20 do filename[i]:=chr($a0);
              writeln('Enter new filename, up to 16 chars! USE UPPER CASE CHARS!');
              readln(filename);
              for i:=1 to 16 do begin
                                b2:=ord(filename[i]);
                                write(outfile,b2);
                                end;
              b2:=0;
              write(outfile,b2);
              write(outfile,b2);
              write(outfile,b2);
              write(outfile,b2);
              write(outfile,b2);
              write(outfile,b2);
              write(outfile,b2);
              write(outfile,b2);
              write(outfile,b2);
              tempint:=(filesize_of_tape div 254)+1;
              b2:=tempint mod 256;
              write(outfile,b2);
              b2:=tempint div 256;
              write(outfile,b2);
              end;
 _filepos:=_filepos+32;
 inc(entry);
 if entry=9 then begin
                 inc(block);
                 entry:=1;
                 end;
until (b1=0) or (b1=$80) or (_filepos>=96256);
if _filepos>=96256 then begin
      writeln(' Argh... Not enough dir entry... DELETE testdisk.d64!');
                        exit;
                        end;

end;  { proc }



function search_with_AND_the_free_block_in_BAM
                      (current_looked_BAM_byte:byte):byte;
begin
              if (current_looked_BAM_byte and 1)=1 then begin
                                   search_with_AND_the_free_block_in_BAM:=1;
                                   b2:=current_looked_BAM_byte and (255-1);
                                   seek(outfile, filepos(outfile)-1);
                                   write(outfile,b2);
                                   current_looked_BAM_byte:=0;
               { so the next ANDs won't give  TRUE back! }
                                   end;
              if (current_looked_BAM_byte and 2)=2 then begin
                                   search_with_AND_the_free_block_in_BAM:=2;
                                   b2:=current_looked_BAM_byte and (255-2);
                                   seek(outfile, filepos(outfile)-1);
                                   write(outfile,b2);
                                   current_looked_BAM_byte:=0;
                                   end;
              if (current_looked_BAM_byte and 4)=4 then begin
                                   search_with_AND_the_free_block_in_BAM:=3;
                                   b2:=current_looked_BAM_byte and (255-4);
                                   seek(outfile, filepos(outfile)-1);
                                   write(outfile,b2);
                                   current_looked_BAM_byte:=0;
                                   end;
              if (current_looked_BAM_byte and 8)=8 then begin
                                   search_with_AND_the_free_block_in_BAM:=4;
                                   b2:=current_looked_BAM_byte and (255-8);
                                   seek(outfile, filepos(outfile)-1);
                                   write(outfile,b2);
                                   current_looked_BAM_byte:=0;
                                   end;
              if (current_looked_BAM_byte and 16)=16 then begin
                                     search_with_AND_the_free_block_in_BAM:=5;
                                   b2:=current_looked_BAM_byte and (255-16);
                                   seek(outfile, filepos(outfile)-1);
                                   write(outfile,b2);
                                   current_looked_BAM_byte:=0;
                                   end;
              if (current_looked_BAM_byte and 32)=32 then begin
                                     search_with_AND_the_free_block_in_BAM:=6;
                                   b2:=current_looked_BAM_byte and (255-32);
                                   seek(outfile, filepos(outfile)-1);
                                   write(outfile,b2);
                                   current_looked_BAM_byte:=0;
                                   end;
              if (current_looked_BAM_byte and 64)=64 then begin
                                     search_with_AND_the_free_block_in_BAM:=7;
                                   b2:=current_looked_BAM_byte and (255-64);
                                   seek(outfile, filepos(outfile)-1);
                                   write(outfile,b2);
                                   current_looked_BAM_byte:=0;
                                   end;
              if (current_looked_BAM_byte and 128)=128 then begin
                                       search_with_AND_the_free_block_in_BAM:=8;
                                       b2:=current_looked_BAM_byte and (255-128);
                                       seek(outfile, filepos(outfile)-1);
                                       write(outfile,b2);
                                       current_looked_BAM_byte:=0;
                                       end;
end;
   { this routine can be used in BAM byte 1, 2 and 3; we have ONLY
     to do is to add 0, 8 and 16 to the given back value; respectively }

function absolute_adress(free_track, free_block:longint):longint;
 { the func computes back the _absolute_ adress from track and block number.
  We overdefinied the input variables from byte type to longint type, coz we
  will multiply them! At the higher track values (8) it causes big problems,
  e.g. the _filepos=absolute... will give back negative adress! }
begin
  if free_track<18 then absolute_adress:=
        (free_track-1)*21*256+(free_block)*256;
  if (free_track>18) and (free_track<25) then
     absolute_adress:=17*21*256+(free_track-1-17)*19*256+(free_block)*256;
  if (free_track>=25) and (free_track<31) then
     absolute_adress:=17*21*256+7*19*256+(free_track-1-17-7)*18*256+
     (free_block)*256;
  if (free_track>=31) then
     absolute_adress:=17*21*256+7*19*256+6*18*256+
      (free_track-1-17-7-6)*17*256+(free_block)*256;
end;

procedure dir_format;
var  unformatted_dir_array:array [1..18] of array [1..256] of byte;
     just_written_phisical_dir_block:byte;
     which_block_is_the_next:byte;
     block_we_now_read:byte;
     i,j:integer;
begin
_filepos:=$16600;
seek(outfile,_filepos);
for i:=1 to 18 do
    for j:=1 to 256 do read(outfile,unformatted_dir_array[i,j]);

_filepos:=$16600;
seek(outfile,_filepos);

b1:=0;
for i:=1 to 4608 do write(outfile,b1);  { erasing the prev dir area! }

_filepos:=$16600;
seek(outfile,_filepos);


just_written_phisical_dir_block:=1;    { at 12-01 }
which_block_is_the_next:=1;
block_we_now_read:=1;

repeat
which_block_is_the_next:=unformatted_dir_array
               [block_we_now_read,2];
if which_block_is_the_next<>255 then unformatted_dir_array
               [block_we_now_read,2]:=just_written_phisical_dir_block+1;
                  { points to the NEXT PHISICAL dir block! }
for i:=1 to 256 do write(outfile,unformatted_dir_array
               [block_we_now_read,i]);
inc(just_written_phisical_dir_block);               { check the next block }
block_we_now_read:=which_block_is_the_next;
until which_block_is_the_next=255;
end;


begin
WRITELN(' This program copies ANY FILES to a virtual C64 disk. Great thing, isn''t it?');
WRITELN(' CuZ Miha''s C64S.EXE doesn''t haandle disk <-> tape conversion at all, and ');
WRITELN(' always freezes with ?OUT OF MEMORY ERROR....');
WRITELN;
wRITELN('  The program is PUBLIC DOMAIN !!!!!!!!!!!!');
WRITELN;
WRITELN(' COPYRIGHT BY WERNER ZSOLT.');
WRITELN;
WRITELN(' Contact adress:  MTTT022@URSUS.BKE.HU   (Internet),');
writeln('                  36/1/1823513           (Voice & 14400 Modem)');



  ASSIGN(INFILE,PARAMSTR(1));
  RESET(INFILE);

  ASSIGN(OUTFILE,'testdisk.d64');
  REset(OUTFILE);

writeln(' Now formatting the directory area...');
dir_format;

filesize_of_tape:=filesize(infile);
seek(outfile,91392+4);      { pos to BAM's first
                            HOW_MUCH_FREE_BLOCK_IN_THE_TRACK byte }
free_on_disk:=0;
for i:=1 to 35 do begin
    read(outfile,b1);
    free_on_disk:=free_on_disk+b1;
    read(outfile,b1);
    read(outfile,b1);
    read(outfile,b1);   { 3 blank read }
end; { for, summarizing the free disk space }

 if (free_on_disk*256-19*256)<=filesize_of_tape then begin
                 writeln('Not enough free disk space!!!');
                 exit;
                 end;

{ there are 35 tracks on the disk! Now we are
  looking for a track where there are at least 1 free blocks }

  PREVIOUS_SECTOR:=500000;

for track:=1 to 35 do begin
  if track<>18 then begin
    seek(outfile,91392+4*track); { we _always_ get back to the FREE BYTE of
                                all of the tracks! Computing is more easily
                                than storing the bam_reading_pos and
                                substracting 1,2 or 3 from it, respectively
                                CuZ we can use ONE routine to ALL of the
                                tree BAM free/unfree byte; we must only
                                add 8 or 16 to the FREE_BLOCK, if we read
                                the second or the third byte }
 read(outfile,sectors_free_in_the_block);
 if sectors_free_in_the_block>0 then    { there are at least 1 free
                        blocks. Now we begin an
                        inner routine. When we get back to the FOR freeblock
                        header, we have just written out one sector. }
   for freesector:=1 to sectors_free_in_the_block do begin
     free_block:=0;   { we use it as a boolean variable, too; look skipping
                        9-16 and 17-21 block's checking! We had to
                        use another
                        boolean variable OR make a JMP, and with a simple
                        two-way variable access we solved the problem... }
     seek(outfile,91392+4*track);  { decrease the free block number! }
     read(outfile,b1);
     seek(outfile,91392+4*track);  { we don't use another temp 
                                       variable like 
                                   temp_sectors_free_in_the_block }
     dec(b1);
     write(outfile,b1);
        read(outfile,b1);    { first byte of BAM's sector map }
        if b1<>0 then      { there are free blocks between !!!1st!!! and
                           !!!8th!!! blck: 0: not free; 1: free. So if we AND
                                 00000000 (if there aen't any free blocks)
                                 w/ 11111111 (ffh), the result will be 0: then
                                 there aren't any free blocks -> step to 8-16
                                 blocks! }
            free_block:=search_with_AND_the_free_block_in_BAM(b1);
                         { if there was the free block in 1-8 blocks }
       if free_block=0 then begin  { look 8-15 sectors if there any free
                                    blocks! }
        read(outfile,b1);    { SECOND byte of BAM's sector map.}
        if b1<>0 then      { there are free blocks between !!!8th!!! and
                           !!!15th!!! blck: 0: not free; 1: free. So if we AND
                                 00000000 (if there aen't any free blocks)
                                 w/ 11111111 (ffh), the result will be 0: then
                                 there aren't any free blocks -> step to 8-16
                                 blocks! }
            free_block:=search_with_AND_the_free_block_in_BAM(b1)+8;
                            end;  { search for free block between 8th and 15th
                                    sector }

       if free_block=0 then begin  { look 15-21 sectors if there any free
                                    blocks! }
        read(outfile,b1);    { THIRD byte of BAM's sector map.}
        if b1<>0 then      { there are free blocks between !!!15th!!! and
                           !!!21th!!! blck: 0: not free; 1: free. So if we AND
                                 00000000 (if there aen't any free blocks)
                                 w/ 11111111 (ffh), the result will be 0: then
                                 there aren't any free blocks -> step to 8-16
                                 blocks! }
            free_block:=search_with_AND_the_free_block_in_BAM(b1)+16;
                            end;  { search for free block between 8th and 15th
                                    sector }


       { now we have written back a 0 bit to the BAM, and
                               decreased the FREE-byte. AND NOW: position to
                               the free 254 bytes and
                               write out from the input file to the destination
                               disk }
              free_track:=TRACK;  { 1-35 }
              dec(free_block);   { we count free blocks from 0!!!! }
              _filepos:=absolute_adress(free_track,free_block);
               writeln(free_track,'  sector:  ',free_block,'  filepos:',_filepos);
              IF PREVIOUS_SECTOR<>500000 THEN BEGIN  { UPDATING THE PREV BLOCK IF
                                                  WE AREN'T JUST BEGINNING THE
                                                  WRITING AND THIS IS OUR FIRST
                                                  FOUND SECTOR }
                                         SEEK (OUTFILE,PREVIOUS_SECTOR);
                                         WRITE(OUTFILE,FREE_TRACK);
                                         WRITE(OUTFILE,FREE_BLOCK);
                                         END
                                          else BEGIN
                                               first_sector:=FREE_BLOCK;
                                               first_TRACK:=FREE_TRACK;
                                               END;
                                            { to write in DIR area }

              seek(outfile,_filepos);
              previous_sector:=_filepos;  { previous sector contains the absolute
                                            value of the PREVIOUS sector. We'll
                                            seek to here when we have found the
                                            NEXT free block to update the
                                            string information }
             read(outfile,b1);
             read(outfile,b1);   { 2 blank reads }
             i:=0;    { coz we read FROM a file, too; and if there EOF,
                        we must use UNTIL EOF and a COUNTER <=254 }

               repeat
                 inc(i);
                 read (infile,b1);
                 write(outfile,b1);
               until (eof(infile)) or (i=254);
               if eof(infile) then begin
                                         SEEK (OUTFILE,PREVIOUS_SECTOR);
                   { if there is END of the input file, we write 00 to the
                     next track in the current block and number of bytes as
                     the next sector. }
                                         b1:=0;
                                         WRITE(OUTFILE,b1);
                                         b1:=i;
                                         WRITE(OUTFILE,b1);
                                         make_dir_entry;
                                          close(outfile);
                                         exit;
                                         END;


               { now we filepos back to BAM and search for next occurence of
                 free block }

           end;  { if there are free blocks in ALL first 8 blocks!!}
       end; { if there are at least 1 free blocks in current track }
  end;  { preserving track 18 }
end. {for}

close(outfile);
close(infile);

end.

