package RISCOS::DrawFile::TagObject;

use strict;
use vars qw ($VERSION @ISA);
use Carp;

require RISCOS::DrawFile::Container;
require RISCOS::DrawFile::Object;

$VERSION = 0.03;
# 0.03 does Translate
# I think that this is no longer stuffed.
# There was a good reason why Group has Container before Object in @ISA
# I believe that it was to get the inheritence of Write and Pack correct
# (ie from Containter, not Object). new has to come from Object.
# Cure wass to re-write with same order as Group
# Also bug in that no check is made with Stuff() method that only a single
# object is being tagged.
@ISA =  qw (RISCOS::DrawFile::Container RISCOS::DrawFile::Object);

sub new ($) {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my ($self, $type) = $class->RISCOS::DrawFile::Object::new (@_);
    return $self if ref ($self) eq 'ARRAY';

    my ($tag, $length) = unpack 'x24Ix4I', $_[0];
    $self->{'__TAGDATA'} = substr $_[0], 28 + $length;
    $self->{'__TAG'} = $tag;
    local $_[0] = \(substr $_[0], 28, $length);
    my ($stuff, $a, $font) = $class->_split_drawobjs (@_);
    $self->Stuff ($stuff);
    $self->{'__TYPE'} = $type;
    
    wantarray ? ($self, $type, $font) : $self;
}


sub Translate ($$$$) {
    if (ref ($_[3]) eq 'CODE') {
	&{$_[3]}($_[0], $_[1], $_[2]);
    } elsif (not defined $_[3]) {
	warn "Cannot translate $_[0] by ($_[1], $_[2])\n";
    } elsif ($_[3] eq '') {
	$_[0]->SUPER::Translate ($_[1], $_[2], $_[3]);
    } else {
	confess "Illegal third argument to translate ('$_[3]') when attempting to translate $_[0] by ($_[1], $_[2])";
    }
    ();
}

sub Size {
    my $self = shift;
    28 + $self->SUPER::Size + length $self->{'__TAGDATA'};
}

sub Pack {
    my $self = shift;
    $self->PackTypeSizeBBox()
     . pack ('I', $self->{'__TAG'})
     . $self->SUPER::Stuff(@_)
     . $self->{'__TAGDATA'};
}

sub Write {
    my $self = shift;
    my $good = print {$_[0]} $self->PackTypeSizeBBox(),
			     pack ('I', $self->{'__TAG'});
    $good &= $self->SUPER::Write (@_);	# Pass on args
    print {$_[0]} $self->{'__TAGDATA'};
}

sub Tag {
    my $self = shift;
    my $tag = $self->{'__TAG'};
    $self->{'__TAG'} = $_[0] if defined $_[0];
    $tag;
}

sub TagData {
    my $self = shift;
    my $tagdata = $self->{'__TAGDATA'};
    $self->{'__TAGDATA'} = $_[0] if defined $_[0];
    $tagdata;
}

1;
__END__

=head1 NAME

RISCOS::Drawfile

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 BUGS

=head1 AUTHOR

Nicholas Clark <F<nick@unfortu.net>>
