#!/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 disk images to SIMH RX01/RX02 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 12 bit mode) packs 64(128) 12 bit
# words into the first 96(192) bytes of a sector,
# then zeroes the last 32(64) bytes.

# This means a 256 word OS/8 block requires 4(2)
# sectors, 77*26/4(2) would give a theoretical 
# capacity of 500(1000) blocks.
# OS/8 has the size at 494(988) blocks.  What of 
# the other 6(12)?

foreach $f (@ARGV) {
  open(INPUT, $f) || die "$f: $!";
  binmode(INPUT);
  ($_, $_, $_, $_, $_, $_, $_, $size) = stat(INPUT);
  $size /= 256*2; # Convert to OS/8 blocks
  $rx02 = $size > 494;

  $flp = $f; $f =~ s/[.]dsk$//; $f =~ s/[.]new$//;
  if (!$rx02) {
    # RX01 format.  Each sector is 128 bytes, or 64 words.
    # Four such sectors are used to make a 256 word block.
    $size = 128; # Sector size in bytes
    $ds = 96;
    $waste = 32;
    $spb = 4; # Four sectors per block.
    $blocks = 494; # Blocks to output
    # Interleave is 2 for RX01, but 3 for RX02!
    $ileave = 2;
    $f .= ".rx01+";
  } else {
    # RX02 format.  Each sector is 256 bytes, or 128 words.
    # Two such sectors are used to make a 256 word block.
    die "$flp: volume won't fit on a RX02" if $size > 988;
    print "$flp will need RX02 format\n" if $rx02;
    $size = 256; # Sector size
    $ds = 192;
    $waste = 64;
    $spb = 2; # Two sectors per block.
    $blocks = 988; # Blocks to output
    # Interleave is 2 for RX01, but 3 for RX02!
    $ileave = 3;
    $f .= ".rx02+";
  }

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

  # RX01: 26*76 = 1976 sectors.  1976 sectors == 494 OS/8 blocks.
  # RX02: 26*76 = 1976 sectors.  1976 sectors == 988 OS/8 blocks.
  # Iterate over each logical sector.  Find the SIMH data, convert
  # to RX01/RX02 format, and write it at the correct *physical*
  # sector location.
  # We rely on the OS/8 data already being in logical sector order
  # within the SIMH dsk format (no seek is done).
  for ($lsect = 0; $lsect < $blocks*$spb; $lsect++) {
    # Read the SIMH block and repack the bytes.
    # The sector size is the correct number of bytes to read,
    # even though only 3 of the 4 bytes are interesting.
    $count = read(INPUT, $buf, $size);
    # $count == 0 if we've hit EOF on the input.
    # We could pad the output with blocks of nulls here, but
    # for now, we just skip outputting the sector.
    next if $count <= 0; # Skip sectors with no data
    # SIMH .dsk data is one word per 16 bit "short".
    @buf = unpack("S*", $buf);
    @obuf = ();
    # RX01/RX02 data is 3 bytes for every word pair.
    # The two words can be thought of as a 24 bit integer, MSB first.
    while (@buf) {
      $words = shift(@buf);
      $words = ($words<<12) + shift(@buf);
      $char1 = 0377 & ($words>>16);
      $char2 = 0377 & ($words>>8);
      $char3 = 0377 & $words;
      push(@obuf, $char1, $char2, $char3);
    }
    # Expected to get $ds bytes!
    warn "$lsect: $#obuf doesn't match $ds\n" unless 1+$#obuf == $ds;
    # Pad out the output buffer with $waste nulls.
    # (Could make this just once and output it below.)
    for ($i = 0; $i < $waste; $i++) {
      push(@obuf, 0);
    }
    $obuf = pack("C*", @obuf);

    # Calculate the track and sector numbers, then seek there
    # and write the track.  (In the case of RX01, do two halves
    # of the block.
    # The tracks are in the right order.
    # Add one here to skip the first track.
    $tpos = 1 + int($lsect / 26);
    $tpos *= (26 * $size); # Beginning of relevant track
    $ls = $lsect % 26; # Logical sector within track
    $psect = ($ls*2) % 26 + ($ls > 12) if $ileave == 2;
    $psect = ($ls*$ileave) % 26 unless $ileave == 2;
    $spos = $tpos + $psect * $size;
    seek(OUTPUT, $spos, 0) || die "seek($flp): $!";
    print OUTPUT $obuf;
  }
}
exit 0;