package RISCOS::BookFile::ResetPos;
use IO::File;
use strict;
sub new ($$) {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $bookfile = shift;
    my $self = [];
    $$self[0] = $bookfile->{__HANDLE};

    return undef unless defined ($$self[1] = $$self[0]->tell);
    bless ($self, $class);
}

sub DESTROY {
    my $self = shift;
    $$self[0]->seek ($$self[1], &SEEK_SET);
}

package RISCOS::BookFile;

require RISCOS::DrawFile;
use RISCOS::DrawFile::Container 'split_drawobjs';
$RISCOS::DrawFile::TextArea::Parser::cack = 1;
require RISCOS::DrawFile::TextArea::Parser;

use IO::File;
use RISCOS::Units qw(draw2inch);
# require Exporter;
use Carp;
use strict;
use vars qw (@ISA $VERSION $AUTOLOAD);


# @ISA = qw(Exporter);
$VERSION = 0.01;

sub open_file ($) {
    return undef unless my $file = shift;
    # If passed ref to scalar assume that we have been given the file's contents
    return undef if ref($file) eq 'SCALAR' or ref($file) eq 'LVALUE';

    if (ref($file) ? (ref($file) eq 'GLOB'
		      || UNIVERSAL::isa($file, 'GLOB')
		      || UNIVERSAL::isa($file, 'IO::Handle'))
		   : (ref(\$file) eq 'GLOB'))
    {
	return $file;
    }

    my $handle = new IO::File;
    $handle->open ("<$file") or return undef;
    return $handle;
}

# Manual Name
sub do_10000000 ($$) {
    my $self = shift;
    ($self->{__NAME}) = $_[0] =~ /^([^\0]*)/;
    0;	# Keep going
}
# Page text
sub do_10000001 ($$) {
    1;	# Stop
}
# Page index
sub do_10000002 ($$) {
    my $self = shift;
    ($self->{__PAGEINDEX}) = shift;
    0;	# Keep going
}
# Graphic index
sub do_10000003 ($$) {
    my $self = shift;
    ($self->{__GRAPHINDEX}) = shift;
    0;	# Keep going
}
sub do_10000004 ($$) {
    warn "\aGot a 10000004, length " . length $_[1];
    1;
}
sub do_10000005 ($$) {
    warn "\aGot a 10000005, length " . length $_[1];
    1;
}
sub do_10000006 ($$) {
    warn "\aGot a 10000006, length " . length $_[1];
    1;
}
# Copyright
sub do_10000007 ($$) {
    my $self = shift;
    ($self->{__COPY}) = $_[0] =~ /^([^\0]*)/;
    0;	# Keep going
}
sub do_10000008 ($$) {
    warn "\aGot a 10000008, length " . length $_[1];
    1;
}
# Section indexes
sub do_10000009 ($$) {
    my $self = shift;
    @{$self->{__SECTIONINDEXES}} = unpack 'I*', shift;
    0;	# Keep going
}
sub do_00000006 ($$) {
    1;	# Stop
}
sub do_00000005 ($$) {
    1;	# Stop
}

sub new ($$) {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    my $name = shift;
    my $handle;
    return undef
      unless defined ($self->{__HANDLE} = $handle = open_file ($name));

    $self->{__FILENAME} = $name;

    my $temp;
    return undef unless 40 == $handle->read($temp, 40);

    my ($id, $zero);
#    $self->{__BBOX} = [];

    ($id, $self->{__MAJOR}, $self->{__MINOR}, $self->{__PAGEINDEX},
     $self->{__GRAPHINDEX}, $zero, @{$self->{__BBOX}})	# @{} is crucial
     = unpack 'A4V9', $temp;

    unless ($id eq 'Book') {
	warn "ID '$id' not Book" if $^W;
	return undef;
    }

    if ($zero) {
	warn "First zero word is actually $zero" if $^W;
	return undef;
    }

    warn "Version number $self->{__MAJOR} != 201"
      unless $self->{__MAJOR} == 201;

    my $restore = new RISCOS::BookFile::ResetPos $self;
    # Restore file position when we leave this routine

    while (!$self->{__HANDLE}->eof) {
	my ($tag, $length, $data) = Object ($self);
	last if eval sprintf "&do_%08X (\$self, \$data)", $tag;
    }
    bless ($self, $class);
}

sub Name ($) {
    my $self = shift;
    $self->{__NAME};
}

sub Copy ($) {
    my $self = shift;
    $self->{__COPY};
}

sub Major ($) {
    my $self = shift;
    $self->{__MAJOR};
}

sub Minor ($) {
    my $self = shift;
    $self->{__MAJOR};
}

sub PageIndex ($) {
    my $self = shift;
    $self->{__PAGEINDEX}
}

sub GraphIndex ($) {
    my $self = shift;
    $self->{__GRAPHINDEX}
}

sub Object ($) {
    my $self = shift;
    my ($where, $tag, $length, $data, $handle);
    $handle = $self->{__HANDLE};
    return wantarray ? () : undef unless defined ($where = $handle->tell);

    unless (8 == $handle->read ($data, 8)) {
	$handle->seek ($where, &SEEK_SET);
	return wantarray ? () : undef;
    }

    ($tag, $length) = unpack 'I2', $data;

    unless (($length - 8) == $handle->read ($data, ($length - 8))) {
	$handle->seek ($where, &SEEK_SET);
	return wantarray ? () : undef;
    }

    return wantarray ? ($tag, $length, $data) : $tag . $length . $data;
}

sub Dump ($) {
    my $self = shift;
    my @result = (
      $self->{__NAME},
      $self->{__COPY},
      "Major: $self->{__MAJOR}\t\tMinor: $self->{__MINOR}",
      "Page index at:\t\t$self->{__PAGEINDEX}",
      "Graphic index at:\t$self->{__GRAPHINDEX}",
      draw2inch ($self->{__BBOX}->[0]) . "\"\t" .
      draw2inch ($self->{__BBOX}->[1]) . "\"\t" .
      draw2inch ($self->{__BBOX}->[2]) . "\"\t" .
      draw2inch ($self->{__BBOX}->[3]) . '"'
    );
    return @result if wantarray;
    join "\n", @result, '';
}

sub __decode_index ($$$$$) {
    my ($name_index, $pos_index, $data, $length, $position) = @_;
    my ($ofs, $datalen, $blk) = unpack "i3", substr $$data, $position;

    warn "$ofs != $position" unless $ofs == $position;

    my $end = $position + $datalen;
    $position += 12;	# What we have read already

    __decode_index ($name_index, $pos_index, $data, $length, $blk)
	unless ($blk == -1);
    while ($position <= $end) {
	($blk, $ofs) = unpack "i2", substr $$data, $position;
	__decode_index ($name_index, $pos_index, $data, $length, $blk)
	    unless ($blk == -1);
	$position += 8;
	my ($text) = substr ($$data, $position) =~ /([^\0]+)/;
	$name_index->{$text} = $ofs;
	$pos_index->{$ofs} = $text if defined $pos_index;
	$position += 4+ length ($text) & ~3;
    }
}

sub DecodeIndex ($$) {
    my $self = shift;
    my $restore = new RISCOS::BookFile::ResetPos $self;
    # Restore file position when we leave this routine

    my $handle = $self->{__HANDLE};

    unless ($handle->seek (4 + $_[0], &SEEK_SET)) {
	return wantarray ? () : undef;
    }

    my $data;
    unless (4 == $handle->read ($data, 4)) {
	return wantarray ? () : undef;
    }

    my $length = unpack 'I', $data;

    unless ($length == $handle->read ($data, $length)) {
	return wantarray ? () : undef;
    }

    my ($name, $pos) = ({}, {});
    undef $pos unless wantarray;
    __decode_index ($name ,$pos, \$data, length ($data), 0);

    return wantarray ? ($name, $pos) : $name;
}


sub DecodePage ($) {
    my $self = shift;
    my $restore = new RISCOS::BookFile::ResetPos $self;
    # Restore file position when we leave this routine

    my $handle = $self->{__HANDLE};

    unless ($handle->seek ($_[0], &SEEK_SET)) {
	return wantarray ? () : undef;
    }

    my $data;
    unless (8 == $handle->read ($data, 8)) {
	return wantarray ? () : undef;
    }

    my ($type, $length) = unpack 'I2', $data;

    unless ($type == 0x10000001) {
	warn sprintf "Unknown object type in page data (%08X)\n", $type;
	return wantarray ? () : undef;
    }

    print "Decoding $length bytes at offset $_[0]\n";
    $length -= 12;

    unless (4 == $handle->read ($data, 4)) {
	return wantarray ? () : undef;
    }

    printf "Dummy (%08X)\n", unpack 'I', $data;

    unless ($length == read $handle, $data, $length) {
	return wantarray ? () : undef;
    }
    my $split = RISCOS::DrawFile::Container->Objfunc();
    $split->{9} = sub { RISCOS::DrawFile::TextArea::Parser->new (@_) };
    split_drawobjs (undef, \$data, undef, undef, $split );
}

sub bbox ($) {
    my $data;
    my $handle = shift;
    unless (16 == $handle->read ($data, 16)) {
	return ();
    }
    unpack 'I4', $data;
}

sub scan_objects ($) {
    my $book = shift;
    my %skip = ( 0x10000001 => 'text', 5 => 'sprite', 6 => 'group' );
    $! = 0;
    while (!$book->{__HANDLE}->eof) {
	my ($tag, $length) = Object ($book);
	printf "Tag %08X, length %d\n", $tag, $length
	  if defined $tag and not $skip{$tag};
	if ($!) {
	    warn $!;
	    $! = 0;
	}
    }
}
1;
