io.subs

#!perl
use strict;
use warnings 'FATAL' => 'all';
use Encode ();

sub ReadUint32
{
  return ReadPacked('N', 4);
}
sub ReadSint32
{
  my $v = ReadPacked('N', 4);
  if ($v >= (2 << 30))
  {
    $v -= (2 << 31);
  }
  return $v;
}
sub ReadUint16
{
  return ReadPacked('n', 2);
}
sub ReadSint16
{
  my $v = ReadPacked('n', 2);
  if ($v >= (2 << 14))
  {
    $v -= (2 << 15);
  }
  return $v;
}
sub ReadUint8
{
  return ReadPacked('C', 1);
}
sub ReadFixed
{
  my $fixed = ReadSint32();
  return $fixed / 65536.0;
}
sub ReadBits
{
  my ($bits) = @_;
  my $bytes = int(($bits + 7)/8);
  return map { $_ + 0 } split(//, ReadPacked('b' . $bits, $bytes));
}
sub ReadString
{
  my ($size) = @_;
  return '' unless $size > 0;
  return Encode::decode('MacRoman', ReadRaw($size));
}
sub ReadPStr
{
  my ($size) = @_;
  my $namesize = ReadUint8();
  die 'String too large' if ($namesize >= $size);
  my $nm = ReadString($namesize);
  ReadPadding($size - 1 - $namesize);
  return $nm;
}

our $BLOB = undef;
our $READfh = \*STDIN;
our $BLOBoff = 0;
our $BLOBlen = 0;
sub SetReadSource
{
  my ($data) = @_;
  unless (defined $data)
  {
    $BLOB = undef;
    $READfh = \*STDIN;
  }
  elsif (ref($data))
  {
    $BLOB = undef;
    $READfh = $data;
  }
  else
  {
    $BLOB = $data;
    $READfh = undef;
  }
  $BLOBoff = 0;
  $BLOBlen = defined($BLOB) ? length($BLOB) : 0;
}
sub SetReadOffset
{
  my ($off) = @_;
  die "Can't set offset for piped data" unless defined $BLOB;
  die "Bad offset for data" if (($off < 0) || ($off > $BLOBlen));
  $BLOBoff = $off;
}
sub CurOffset
{
  return $BLOBoff;
}
sub ReadRaw
{
  my ($size, $nofail) = @_;
  die "Can't read negative size" if $size < 0;
  return '' if $size == 0;
  if (defined $BLOB)
  {
    my $left = $BLOBlen - $BLOBoff;
    if ($size > $left)
    {
      return undef if $nofail;
      die "Not enough data in blob (offset $BLOBoff, length $BLOBlen)";
    }
    $BLOBoff += $size;
    return substr($BLOB, $BLOBoff - $size, $size);
  }
  else
  {
    my $chunk;
    my $rsize = read $READfh, $chunk, $size;
    $BLOBoff += $rsize;
    unless ($rsize == $size)
    {
      return undef if $nofail;
      die "Failed to read $size bytes";
    }
    return $chunk;
  }
}
sub ReadPadding
{
  ReadRaw(@_);
}
sub ReadPacked
{
  my ($template, $size) = @_;
  return unpack($template, ReadRaw($size));
}
sub ReadDone
{
  if (defined $BLOB)
  {
    return $BLOBlen > $BLOBoff;
  }
  return eof $READfh;
}


our $WRITEfh = \*STDOUT;
our $WRITEdata = undef;
sub SetWriteSource
{
  my ($source) = @_;
  if (ref($source))
  {
    $WRITEfh = $source;
    $WRITEdata = undef;
  }
  else
  {
    $WRITEfh = undef;
    $WRITEdata = '';
  }
}
sub GetWriteData
{
  my $d = $WRITEdata;
  $WRITEdata = undef;
  return $d;
}
sub WriteUint32
{
  WritePacked('N', Num(@_));
}
sub WriteSint32
{
  my $v = Num(@_);
  if ($v < 0)
  {
    $v += (2 << 31);
  }
  WritePacked('N', $v);
}
sub WriteUint16
{
  WritePacked('n', Num(@_));
}
sub WriteSint16
{
  my $v = Num(@_);
  if ($v < 0)
  {
    $v += (2 << 15);
  }
  WritePacked('n', $v);
}
sub WriteUint8
{
  WritePacked('C', Num(@_));
}
sub WritePStr
{
  my ($size, $string) = @_;
  my $nm = Encode::encode('MacRoman', $string);
  my $namesize = length($nm);
  die 'String too large' if ($namesize > 255 || $namesize >= $size);
  WriteUint8($namesize);
  WriteRaw($nm);
  WritePadding($size - 1 - $namesize);
}
sub WritePadding
{
  WriteRaw("\0" x $_[0]);
}
sub WritePacked
{
  return WriteRaw(pack($_[0], $_[1]));
}
sub WriteRaw
{
  if ($WRITEfh)
  {
    print $WRITEfh @_;
  }
  else
  {
    $WRITEdata .= join('', @_);
  }
}


sub Num
{
  my ($val, $default) = @_;
  $default = 0 unless defined $default;
  $val = $default unless defined $val;
  return $val + 0;
} # end Num

sub WriteThrough
{
  WriteRaw(ReadRaw(@_));
}

############################

1;