#!/usr/bin/perl
# 
# Copyright © 2015-2020 by Vincent Slyngstad
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE
# FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
# CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
# 
# Except as contained in this notice, the names of the authors above
# shall not be used in advertising or otherwise to promote the sale, use
# or other dealings in this Software without prior written authorization
# from those authors.

# Convert packed "os8p" to disk images.

# The bytes are packed.  Each sector is 128 (RX01) 
# or 256 (RX02) bytes.  There are 77 tracks and 
# 26 sectors/track.

# This gives a size of 128*77*26 = 256256 bytes 
# for RX01, and 512512 bytes for RX02.

# The RX8E (in 8 bit mode) just reads the 128
# byte sectors.  This means a 256 word OS/8
# block requires 3 sectors.

# Track 0 is not used, so 76*26/3 would give
# a theoretical capacity of 658 blocks.
# Note: 660 are reported in the DIR listings!
# 667 OS/8 blocks is the theoretical maximum
# for an RX01 in 8-bit mode.  660 free  data
# blocks is the maximim, since the directory
# segments occupy blocks 1-6.
# We work around this by offsetting track by 
# 1, then wrapping to use track 0 last.

sub readsector {
  local($lsect) = @_;
  local($track, $sector, $spos);
  local($count);

  $track = int($lsect/26); # 26 sectors/track
  # Offset 3 per track.
  $sector = $lsect % 26;
  # Then interleave 2 within the track.
  # This needs to perform as two 13-long rotors.
  $sector = ($track*6 + $sector*2 + ($sector > 12)) % 26;
  # Offset the track mapping to move track 0.
  $track = ($track+1) % 77;
  # Now find and read it.
  $spos = (($track*26)+$sector) * $size;
#printf "$lsect->$track $sector %lo; ", $spos;
  seek(INPUT, $spos, 0) || die "seek($flp): $!";
  $count = read(INPUT, $buf, $size);
  die "read($flp): $!" if $count < 0;
  last unless $count;
  die "read($flp): wrong count $!" if $count != $size;
  return unpack("C*", $buf);
}

foreach $flp (@ARGV) {
  open(INPUT, $flp) || die "$flp: $!";
  binmode(INPUT);
  $f = $flp; $f =~ s/[.]os8p$//;
  $f .= ".dsk";
  ($_, $_, $_, $_, $_, $_, $_, $size) = stat(INPUT);
  die "$flp: volume is not a floppy image" if $size % (77*16);
  $size /= 77 * 26; # Calculate sector size
  die "$flp: volume is not an RX01 image"
    unless ($size == 128);
  $ds = $size * 3 / 4;
  # Interleave is 2 for RX01, but 3 for RX02!
  $ileave = 2 + ($size > 128);

# die "$f: exists" if -f $f;
  open(OUTPUT, ">$f") || die "$f: $!";
  binmode(OUTPUT);

  # The tracks are in the right order, except track 0,
  # which is logically last, not first.
  # RX01: 26*76 = 1976 sectors.  1976 sectors == 494 OS/8 blocks.
  # RX02: Packed RX02 format doesn't seem reasonable, as each OS/8 
  # block would be 1.5 sectors!
  # The last sector of track 0 is not accessible, as
  # it is not paart of a triplet.
  for ($block = 0; $block < 667; $block++) {
    $lsect = 3*$block;
    @buf = &readsector($lsect);
    $lsect++;
    push(@buf, &readsector($lsect));
    $lsect++;
    push(@buf, &readsector($lsect));
#printf "output: %lo\n", tell(OUTPUT);
    while (@buf) {
      $b1 = shift @buf;
      $b2 = shift @buf;
      $b3 = shift @buf;
      # The bit ordering is OS8:
      # abcdefgh ijklmnop qrstuvwx
      # -> qrstabcdefgh uvwxijklmnop
      $word1 = $b1 + (($b3 >> 4)<<8);
      $word2 = $b2 + (($b3 & 017)<<8);
      print OUTPUT pack("SS", $word1, $word2);
    }
  }
}
exit 0;