package RISCOS::DrawFile::Path;

use strict;
use vars qw ($VERSION @ISA %winding @winding @winding_map);

@ISA = 'RISCOS::DrawFile::Object';
require RISCOS::DrawFile::Object;
use RISCOS::Draw qw(what unwhat pack_dash_block pack_path_block split_path_block
		    path_bbox split_dash_block path_transform);
use RISCOS::Colour qw(pack_colour unpack_colour);
$VERSION = 0.02;

# 0.02 PrePack calls BBox not BBox calc

# These differ from Draw. (ie the Draw module, as in RISCOS::Draw)
%winding = ('non-zero' => 0, 'even-odd' => 1);
@winding = ('non-zero', 'even-odd');
@winding_map = (0, 2);

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

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

    my ($tri_w, $tri_l, $fill_col, $line_col, $width, $join, $start, $end,
	$winding, $dash) = (1, 2);
    return wantarray ? () : undef unless defined $_[0];
    if (ref $_[0] eq 'ARRAY') {
	my ($cols0, $path);
	($path, $fill_col, $line_col, $width, $join, $start, $end, $winding,
	 $dash) = @{$_[0]};
	$width ||= 0;
	$join = what ('join', 2, $join);
	$line_col = 0 unless defined $line_col or defined $fill_col;
	($fill_col, $line_col) = pack_colour ($fill_col, $line_col);
	if (ref ($start) eq 'ARRAY') {
	    ($tri_w, $tri_l) = @$start;
	    $start = 3;
	} else {
	    $start = what ('cap', 0, $start);
	}
	if (ref ($end) eq 'ARRAY') {
	    ($tri_w, $tri_l) = @$start;
	    $end = 3;
	} else {
	    $end = what ('cap', 0, $end);
	}
	$winding = what (\*winding, 0, $winding);
	# use local winding names
	@{$self->{'__PATH'}} = pack_path_block ($path);
    } 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, @{$self->{'__BBOX'}}) = unpack 'x4Ii4', $_[0];
	    return undef unless length ($_[0]) == $length or $length & 3;
	    $data = substr $_[0], 24;
	}
	my $style;
	($fill_col, $line_col, $width, $style, $tri_w, $tri_l)
	  = unpack 'a4a4ICxC2', $data;
	$tri_w /= 16;
	$tri_l /= 16;
	$join = $style & 3;
	$start = ($style >> 2) & 3;	# PRM lies. Start *is* first.
	$end = ($style >> 4) & 3;
	$winding = ($style >> 6) & 1;
	if ($style & 0x80) {
	    $dash = unpack 'x20I', $data;	# Get number of elements
	    $dash = substr $data, 16, 8 + 4 * $dash;
	    # Ref to scalar will be 'packed' by spitting
	    $self->{'__PATH'} = substr $data, 16 + length $dash;
	} else {
	    $self->{'__PATH'} = substr $data, 16;
	}
    }
    # Leave it uncalculated
    # $self->{'__BBOX'} = $bbox;
    $self->{'__FILLC'} = $fill_col;
    $self->{'__LINEC'} = $line_col;
    $self->{'__WIDTH'} = $width;
    $self->{'__JOIN'} = $join;
    $self->{'__START'} = $start;
    $self->{'__END'} = $end;
    $self->{'__TRIW'} = $tri_w;
    $self->{'__TRIL'} = $tri_l;
    $self->{'__WIND'} = $winding;
    $self->{'__DASH'} = $dash;

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

sub Type { 2; }

sub BBox_Calc {
    my $self = shift;
    $self->{'__BBOX'} = path_bbox ($self->{'__PATH'}, $self->{'__WIND'}, undef,
				   $self->{'__WIDTH'}, $self->{'__JOIN'},
				   (($self->{'__START'} == 3)
				     ? [$self->{'__TRIW'}, $self->{'__TRIL'}]
				     : $self->{'__START'}),
				   (($self->{'__END'} == 3)
				     ? [$self->{'__TRIW'}, $self->{'__TRIL'}]
				     : $self->{'__END'}), $self->{'__DASH'});
}

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;
    }
    $self->{'__PATH'} = path_transform $self->{'__PATH'}, [1,0,0,1,$x,$y];
    ();
}

sub Size {
    my $self = shift;
    my $path = $self->{'__PATH'};
    40 + (defined ($self->{'__DASH'})
	    ? length pack_dash_block ($self->{'__DASH'})
	    : 0) + length (ref ($path) ? pack_path_block ($path) : $path);
}

sub PrePack {
    my $self = shift;
    $self->PackPathBlock;	# Make things fast.
    $self->PackDashBlock;
    $self->BBox (@_);
}

sub Pack {
    my $self = shift;
    my $dash = pack_dash_block ($self->{'__DASH'});
    $self->PackPathBlock();	# Make sure its a scalar
    my $style = 0;


    if (defined $dash) {
	$style = 0x80 if length $dash;
    } else {
	$dash = '';
    }

    $style |= ($self->{'__JOIN'} & 3) | (($self->{'__START'} & 3) << 2)
	      | (($self->{'__END'} & 3) << 4) | (($self->{'__WIND'} & 1) << 6);
    $self->PackTypeSizeBBox(2)
     . pack ('a4a4ICxC2', $self->{'__FILLC'}, $self->{'__LINEC'},
	     $self->{'__WIDTH'}, $style, 16 * $self->{'__TRIW'},
	     16 * $self->{'__TRIL'})
     . $dash . $self->{'__PATH'}	# It has to be a scalar now
}

# Ensures that the path is in the form of an array of scalars that can be
# concatenated into a path block.
sub PackPathBlock {
    my $self = shift;
    my $path = $self->{'__PATH'};
    return wantarray ? split_path_block ($path) : $path
      unless (ref $path);

    return $self->{'__PATH'} = pack_path_block $path unless wantarray;
    # OK, it's a reference to something, and array context return is wanted.
    my (@result) = pack_path_block $path;
    $self->{'__PATH'} = join '', @result;
    @result;
}

sub PackDashBlock {
    my $self = shift;
    $self->{'__DASH'} = pack_dash_block ($self->{'__DASH'});
}

sub FillColour {
    my $self = shift;
    my $old = $self->{'__FILLC'};
    # Need to be able to pass in undef
    $self->{'__FILLC'} = &pack_colour if @_;
    unpack_colour $old;
}

sub LineColour {
    my $self = shift;
    my $old = $self->{'__LINEC'};
    # Need to be able to pass in undef
    $self->{'__LINEC'} = &pack_colour if @_;
    unpack_colour $old;
}

sub Width {
    my $self = shift;
    my $old = $self->{'__WIDTH'};
    if (@_) {
	$self->{'__WIDTH'} = $_[0];
	undef $self->{'__BBOX'}
    }
    $old;
}

sub Join {
    my $self = shift;
    my $old = unwhat ('join', undef, $self->{'__JOIN'});
    if (@_) {
	$self->{'__JOIN'} = what ('join', 2, $_[0]);
    }
    $old;
}

sub StartCap {
    my $self = shift;
    my @old = (unwhat ('cap', undef, $self->{'__START'}),
	       $self->{'__TRIW'}, $self->{'__TRIL'});
    if (@_) {
	my $start = shift;
	if (ref ($start) eq 'ARRAY') {
	    ($self->{'__TRIW'}, $self->{'__TRIL'}) = @$start;
	    $start = 3;
	} else {
	    $start = what ('cap', 0, $start);
	}
	$self->{'__START'} = $start;
	undef $self->{'__BBOX'}
    }
    wantarray ? @old : $old[0];
}

sub EndCap {
    my $self = shift;
    my @old = (unwhat ('cap', undef, $self->{'__END'}),
	       $self->{'__TRIW'}, $self->{'__TRIL'});
    if (@_) {
	my $end = shift;
	if (ref ($end) eq 'ARRAY') {
	    ($self->{'__TRIW'}, $self->{'__TRIL'}) = @$end;
	    $end = 3;
	} else {
	    $end = what ('cap', 0, $end);
	}
	$self->{'__END'} = $end;
	undef $self->{'__BBOX'}
    }
    wantarray ? @old : $old[0];
}

sub Wind {
    my $self = shift;
    my $old = unwhat (\*winding, undef, $self->{'__WIND'});
    if (@_) {
	$self->{'__WIND'} = what (\*winding, 0, $_[0]) if @_;
	undef $self->{'__BBOX'}
    }
    $old;
}

sub Dash {
    my $self = shift;
    my $old = $self->{'__DASH'};
    if (@_) {
	$self->{'__DASH'} = $_[0] if @_;
	undef $self->{'__BBOX'}
    }
    split_dash_block ($old);
}

#$path, $fill_col, $line_col, $width, $join, $start, $end, $winding, $dash
sub rectangle {
    my ($x0, $y0, $x1, $y1) = @{shift @_};
    $y1 = $y0 + $x1 - $x0 unless defined $y1;
    # The implicit pass by reference bites sometimes.
    unshift @_,
#      [[2, $x0, $y0], [8, $x1, $y0], [8, $x1, $y1], [8, $x0, $y1], [5]];
      [[2, $x0, $y0, 8, $x1, $y0, 8, $x1, $y1, 8, $x0, $y1, 5]];	# Cheat!
    RISCOS::DrawFile::Path->new (\@_);
}

#$path, $scale, $close, $fill_col, $line_col, $width, $join, $start, $end, $winding, $dash
sub join_the_dots {
    my $inpath = shift;
    my $scale = shift || 1;
    my $close = shift;
    my $path = [2];
    my ($x, $y);
    my $i = 0;
    if (ref $inpath eq 'ARRAY') {
	while ($i < @$inpath) {
	    $x = $$inpath[$i++];
	    if (ref $x eq 'ARRAY') {
		($x, $y) = @$x;
	    } else {
		$y = $$inpath[$i++];
	    }
	    push @$path, $x * $scale, $y * $scale, 8;
	}
    } else {
	# \[[x0, x1, x2], [y0, y1, y2]]
	# (I think)
	# or more usefully $foo = [@x, @y]; join_the_dots \$foo;
	$inpath = $$inpath;
	while ($i < @{$$inpath[0]}) {
	    $x = $inpath->[0]->[$i];
	    $y = $inpath->[1]->[$i++];
	    push @$path, $x * $scale, $y * $scale, 8;
	}
    }
    pop @$path;		# Remove the last 8, which would start the next "line"
    push @$path, 5 if $close;

    unshift @_, [$path];
    RISCOS::DrawFile::Path->new (\@_);
}
1;
__END__

=head1 NAME

RISCOS::DrawFile::Path

=head1 SYNOPSIS

Class to handle path objects in DrawFiles.

=head1 DESCRIPTION

=head1 BUGS

Not tested enough.

=head1 AUTHOR

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