package RISCOS::DrawFile::TextArea;
use Carp;

use strict;
use vars qw ($VERSION @ISA $default_header $user_default_header);
#use RISCOS::Units qw(pack_transform_block unpack_transform_block
#		     millipoint2draw point2draw);
require RISCOS::DrawFile::Object;
# require RISCOS::Font;

$VERSION = 0.04;
# 0.04 adds Translate
# 0.03 adds TextArea method
# 0.02 keep colours internally as 4 bytes packed
@ISA = 'RISCOS::DrawFile::Object';

$default_header = <<'Wizzo';
\! 1
\F 0 Trinity.Medium 12
\F 1 Corpus.Medium 12
\0\AD/\L12
Wizzo

sub DefaultHeader ($) {
    my $result = defined $user_default_header ? $user_default_header
					      : $default_header;
    $user_default_header = shift if (@_);
    $result;
}

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

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

    my ($bbox, $fore, $back, $text, $cols) = ([]);
    return wantarray ? () : undef unless defined $_[0];
    if (ref $_[0] eq 'ARRAY') {
	($text, $fore, $back, $cols) = @{$_[0]};
	$cols = [@$cols];	# Copy theirs, rather than taking a reference.
	$text = $self->DefaultHeader() unless $text =~ /^\\!/;
	$text .= "\n" unless $text =~ /\n$/s;
    } else {
	# Time to unpack data
	my $data;
	if (ref $_[0] eq 'SCALAR' or ref $_[0] eq 'LVALUE') {
	    # Has bounding box stripped
	    $data = ${$_[0]};
	} else {
	    my $length;
	    ($length, @$bbox) = unpack 'x4Ii4', $_[0];
	    return undef unless length ($_[0]) == $length or $length & 3;
	    $data = substr $_[0], 24;
	}
	while (length $data) {
	    # Hmm. I think that I know why there are two reserved words...
	    my ($ctype, $sublength, @box) = unpack 'I2i4', $data;
	    # Text area is at least 24 bytes after the columns
	    last if ($ctype == 0);
	    if ($ctype != 10 or $sublength != 24) {
		warn sprintf "Tag &%X length $sublength when expecting text " .
			     'column object', $ctype;
		return wantarray ? () : undef;
	    }
	    push @$cols, [@box];
	    $data = substr $data, 24;
	}
	my ($res1, $res2);
	($res1, $res2, $fore, $back, $text) = unpack 'x4I2a4a4a*', $data;
	carp sprintf 'Text area reserved words area &%08X &%08X - should be 0',
		     $res1, $res2 if $res1 or $res2;
	$text =~ s/\0.*//s;
    }
    $self->{'__BBOX'} = $bbox;
    $self->{'__COLS'} = $cols;
    $self->{'__FORE'} = $fore;
    $self->{'__BACK'} = $back;
    $self->{'__TEXT'} = $text;

    wantarray ? ($self, $type) : $self;
}

sub Type { 9; }

sub Cols {
    my $self = shift;
    my $old = $self->{'__COLS'};
    $self->{'__COLS'} = $_[0] if (@_);
    $old;
}

sub ShiftCols {
    my $self = shift;
    shift @{$self->{'__COLS'}};
}

sub TextArea {
    my $self = shift;
    my $old = $self->{'__TEXT'};
    $self->{'__TEXT'} = $_[0] if (@_);
    $old;
}

sub Translate ($$$$) {
    my ($self, $x, $y) = @_;
    my $bbox = $self->{'__BBOX'};
    if (defined $bbox) {
	$$bbox[0] += $x;
	$$bbox[1] += $y;
	$$bbox[2] += $x;
	$$bbox[3] += $y;
    }
    foreach (@{$self->{'__COLS'}}) {
	$$_[0] += $x;
	$$_[1] += $y;
	$$_[2] += $x;
	$$_[3] += $y;
    }
    ();
}
    
    
sub BBox_Calc {
    my $self = shift;
    my $box = [0x7FFFFFFF, 0x7FFFFFFF, -0x7FFFFFF, -0x7FFFFFF];

    foreach (@{$self->{'__COLS'}}) {
	$$box[0] = $$_[0] if $$box[0] > $$_[0];	# min
	$$box[1] = $$_[1] if $$box[1] > $$_[1];
	$$box[2] = $$_[2] if $$box[2] < $$_[2];	# max
	$$box[3] = $$_[3] if $$box[3] < $$_[3];
    }
    $self->{'__BBOX'} = $box;	# Return the bbox we made, and store it
}

sub Size {
    my $self = shift;
    # 4 for '\0' and padding.
    (24 + 24 * @{$self->{'__COLS'}} + 20 + 4 + length $self->{'__TEXT'}) & ~3;
}

sub Pack ($$) {
    my $self = shift;
    $self->PackTypeSizeBBox(9)
      . join ('', map { $self->PackTypeSizeBBox(10, 24, $_) }
		      @{$self->{'__COLS'}})
      . pack ('I3a4a4', 0, 0, 0, $self->{'__FORE'}, $self->{'__BACK'})
      . $self->{'__TEXT'} . "\0" x (4 - (length ($self->{'__TEXT'}) & 3))
}

1;
__END__

=head1 NAME

RISCOS::Drawfile

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 BUGS

=head1 AUTHOR

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