view release on metacpan or  search on metacpan

lib/D64/Disk/Image.pm  view on Meta::CPAN

  # Print BAM:
  print "TRK  FREE  MAP\n";
  for (my $track = 1; $track <= $d64->tracks($imageType); $track++) {
    my $sectors = $d64->sectors_per_track($imageType, $track);
    printf "%3d: %2d/%d ", $track, $d64->track_blocks_free($track), $sectors;
    for (my $sector = 0; $sector < $sectors; $sector++) {
      printf "%d", $d64->is_ts_free($track, $sector);
    }
    print "\n";
  }
  print "\n";

  # Print number of blocks free:
  my $blocksFree = $d64->blocksfree();
  printf "%d blocks free\n", $blocksFree;

  # Release image:
  $d64->free_image();

List the directory:

  my @file_types = qw/del seq prg usr rel cbm dir ???/;

  # Load image into RAM:
  my $d64 = D64::Disk::Image->load_image('image.d64');

  # Open directory for reading:
  my $dir = $d64->open('$', T_PRG, F_READ);

  # Convert title to ASCII:
  my ($title, $id) = $d64->title();
  $title = $d64->name_from_rawname($title);
  $title = $d64->petscii_to_ascii($title);

  # Convert ID to ASCII:
  $id = $d64->name_from_rawname($id);
  $id = $d64->petscii_to_ascii($id);

  # Print title and disk ID:
  printf "0 \"%-16s\" %s\n", $title, $id;

  # Read first block into buffer:
  my ($counter, $buffer) = $dir->read(254);
  die 'BAM read failed' if $counter != 254;

  # Read directory blocks:
  while (1) {
    my ($counter, $buffer) = $dir->read(254);
    last unless $counter == 254;

    for (my $offset = -2; $offset < 254; $offset += 32) {

      # If file type != 0:
      my $file_type = ord (substr $buffer, $offset + 2, 1);
      if ($file_type != 0) {

        my $rawname = substr $buffer, $offset + 5;
        my $name = $d64->name_from_rawname($rawname);
        my $type = $file_type & 7;
        my $closed = $file_type & 0x80;
        my $locked = $file_type & 0x40;
        my $size = ord (substr $buffer, $offset + 31, 1) << 8 | ord (substr $buffer, $offset + 30, 1);

        # Convert to ASCII and add quotes:
        $name = $d64->petscii_to_ascii($name);
        my $quotename = sprintf "\"%s\"", $name;

        # Print directory entry:
        printf "%-4d  %-18s%c%s%c\n", $size, $quotename, $closed ? ord ' ' : ord '*', $file_types[$type], $locked ? ord '<' : ord ' ';
      }
    }
  }

  # Print number of blocks free:
  my $blocksFree = $d64->blocksfree();
  printf "%d blocks free\n", $blocksFree;

  # Close directory:
  $dir->close();

  # Release image:
  $d64->free_image();

Copy a file from a disk image:

  # Load image into RAM:
  my $d64 = D64::Disk::Image->load_image('image.d64');

  # Convert filename:
  my $name = 'filename';
  my $rawname = $d64->rawname_from_name($d64->ascii_to_petscii($name));

  # Open file for reading:
  my $prg = $d64->open($rawname, T_PRG, F_READ);

  # Open file for writing:
  die "$name file already exists" if -e $name;
  open PRG, '>:bytes', $name or die "Couldn't open $name file for writing";

  # Read data from file:
  my ($size, $buffer) = $prg->read();
  print PRG $buffer;
  printf "Read %d bytes from %s\n", $size, $disk;

  # Close files:
  close PRG;
  $prg->close();

  # Release image:
  $d64->free_image();

Copy a file to a disk image:

  # Load image into RAM:
  my $d64 = D64::Disk::Image->load_image('image.d64');

  # Convert filename:
  my $name = 'filename';
  my $rawname = $d64->rawname_from_name($d64->ascii_to_petscii($name));

  # Open file for writing:
  my $prg = $d64->open($rawname, T_PRG, F_WRITE);

  # Open file for reading:
  die "$name file does not exist" unless -e $name;
  open PRG, '<:bytes', $name or die "Couldn't open $name file for reading";

  # Write data to file:
  my $buffer;