package RISCOS::Draw;

use RISCOS::SWI;
require Exporter;
use Carp;
use strict;
# use SelfLoader;
use RISCOS::Units 'pack_transform_block';

use vars qw (@ISA @EXPORT_OK $VERSION %winding @winding %plot @plot %cap $cap
	     %join @join %tagname @tagname @taglength $draw_pp);

@ISA = qw(Exporter);
$VERSION = 0.03;
# 0.02 soops up split_path_block to accept an ARRAY reference
# 0.03 path_transform
@EXPORT_OK = qw(path_bbox pack_path_block pack_dash_block split_path_block
		split_dash_block what unwhat path_transform);

%winding = ('non-zero' => 0, 'negative' => 1, 'even-odd' => 2, 'positive'=> 3 );
%plot = ('non-boundary exterior' => 4, 'boundary exterior' => 8,
	 'boundary interior' => 16, 'non-boundary interior' => 32);
%cap = ('butt' => 0, 'round' => 1,  'square' => 2, 'triangle' => 3);
%join = ('mitred' => 0, 'round' => 1, 'bevelled' => 2);
%tagname = ('end' => 0, 'continue' => 1, 'move' => 2, 'move_same_wind' => 3,
	    'close_gap' => 4, 'close' => 5, 'bezier' => 6, 'gap_same_sub' => 7,
	    'line' => 8, 'bézier' => 6);
@taglength = (-1,1,2,2,0,0,6,2,2);

foreach my $name (qw (winding plot cap join tagname)) {
    no strict 'refs';
    my @pair;
    while (@pair = each %{$name}) {
	# map 'butt' => 0 into $cap[0] = 'butt';
	${$name}[$pair[1]] = $pair[0];
    }
}

$draw_pp = SWINumberFromString('XDraw_ProcessPath');
#__DATA__
# Cool.
# 1st arg is either reference to a GLOB to use that to lookup names/numbers
#	     or a string to use RISCOS::Draw::string as the GLOB.
#		(hence lookup stuff in the hash/array pairs defined above.
sub what ($$;@) {
    my $type = shift;
    my $default = shift;
    my @result;
    $type = (ref ($type) ne 'GLOB') ? $RISCOS::Draw::{$type} : $$type;

    if ($default =~ tr/0-9//c) {
	# Do this out here as numeric defaults are intentionally not validated
	my $lcname = lc $default;
	$_ = $type->{$lcname};
	croak "Unknown $type default name '$default'" unless defined $_;
	$default = $_
    }
    @result = map {
	# All somewhat hairy - map returns the last thing evaluated
	if (defined $_) {
	    # Shotgun.
	    local $Carp::CarpLevel = 1;
	    if (tr/0-9//c) {
		# Not just alphabetics
		my $lcname = lc $_;
		my $result = $type->{$lcname};
		croak "Unknown $type name '$_'" unless defined $result;
		$result
	    } else {
		croak "$type value $_ undefined " unless defined $$type[$_];
		$_;	# This is the return value for map.
	    }
	} else {
	    $default
	}
    } @_;
    wantarray ? @result : $result[0];
}

sub unwhat ($$;@) {
    my $type = shift;
    my $default = shift;
    my @result;
    $type = (ref ($type) ne 'GLOB') ? $RISCOS::Draw::{$type} : $$type;

    @result = map {
	# All somewhat hairy - map returns the last thing evaluated
	(defined $_) ? $$type[$_] : $default;
    } @_;
    wantarray ? @result : $result[0];
}

# Assumes ints are 32 bit.
sub pack_path_block {
    if (ref $_[0] eq 'ARRAY') {
	@_ = @{$_[0]}
    } elsif (ref $_[0] eq 'SCALAR' or ref $_[0] eq 'LVALUE') {
	return wantarray ? split_path_block (${$_[0]}) : ${$_[0]};
    } elsif (ref $_[0]) {
	croak 'Cannot make a path from a ' . ref ($_[0]) . ' reference';
    }

    my @result;
    foreach my $thing (@_) {
	if (ref ($thing) eq 'ARRAY') {
	    $thing = pack 'i*', @$thing;
	} elsif (ref $thing) {
	    carp 'Cannot make a path element from a ' . ref ($$_[0]) .
		 ' reference';
	}
	push @result, $thing;
    }
    # Ensure it finishes with a single end of path
    # Cope with equasor's empty path objects by checking @result is not empty
    pop @result while (@result and $result[$#result] =~ /^\0\0\0\0/);
    push @result, "\0\0\0\0";

    wantarray ? @result : join '', @result;
}

# Assumes ints are 32 bit.
sub pack_dash_block ($;$) {
    my ($off, $dash) = @_;

    if (ref ($off) eq 'ARRAY') {
	$dash = $off;
	$off = shift (@$dash);
    }
    if (ref ($dash) eq 'ARRAY') {
	return $dash = pack 'I*', $off, scalar (@$dash), @$dash;
    }
    $off;	# Assume first argument was already packed
}

# Assumes ints are 32 bit.
sub split_dash_block ($) {
    my $dash = $_[0];
    if (ref ($dash) eq 'ARRAY') {
	return @$dash if wantarray;
	my $off = shift (@$dash);
	return pack 'I*', $off, scalar (@$dash), @$dash;
    }
    return $dash unless wantarray;
    return () unless defined $dash;
    # Left with scalar block to unpack
    unpack 'Ix4I*', $dash;
}

# Assumes ints are 32 bit.
sub split_path_block ($) {
    my $result = [];
    return wantarray ? () : undef unless defined ($_=$_[0]);

    if ('ARRAY' eq ref $_) {
	$result = $_
    } else {
	while (defined (my $tag = unpack 'I', $_)) {
	    my $amount = $taglength[$tag];
	    croak "Unknown draw tag $tag" unless defined $amount;
	    last if $amount == -1;
	    push @$result, substr $_, 0, 4 + 4 * $amount;
	    $_ = substr $_, 4 + 4 * $amount;
	}
    }
    # Ensure it finishes with an end of path
    # Change of plan. Don't store it with an end of path.
    # push @$result, "\0\0\0\0";
    wantarray ? @$result : $result;
}

# Path	Scalar = Block
#	Ref to Array of Scalar = Block to Join
# Transform	Default none
sub path_transform ($;$) {
    my ($path, $trans) = @_;

    $path = pack_path_block($path) if (ref $path);

    # undefined paths are an error
    return undef unless defined $path;

    # empty paths are easy
    return $path unless (length $path > 4 and defined $trans);

    my $transblock = pack_transform_block $trans;

    # path, fill, transform, flatness, thickness, join/cap, dash, output
    defined kernelswi ($draw_pp, $path, 0, $transblock, 0, 0, 0, 0, 0) ? $path
								       : undef;
}

# Path	Scalar = Block
#	Ref to Array of Scalar = Block to Join
# Winding	Default 0
# Plot		Boundary
# Thickness	Default 0
# Join		Default bevelled, mitre limit defaults to 10
#		Scalar ref => mitre with this limit
# Start cap	Default Butt, Triangle is × 1, × 2
#		Array ref => Triangle, [width, length]
# End cap	as above
# Dash		Scalar = block
#		Array Ref = [Offest, Values]; length will be caclulated
# Flatness	Default 0
# Transform	Default none
sub path_bbox ($;$$$$$$$$$) {
    # A lot of this code will need to be broken out if other subs are written.
    my ($path, $winding, $plot, $thick, $join, $start, $end, $dash, $flat,
	$trans) = @_;

    $path = pack_path_block($path) if (ref $path);

    return wantarray ? () : undef unless (defined $path and length $path > 4);
    # empty paths do not have bounding boxes.

    my ($mitre_limit, $start_w, $start_l, $end_w, $end_l) = (10, 1, 2, 1, 2);

    $plot = what ('plot', 0x30, $plot);
    $plot |= what ('winding', 0, $winding) | 0x70000000;
    # Flatten, Thicken, Re-Flattened.
    $thick = 0 unless defined $thick;
    $flat = 0 unless defined $flat;

    if (ref ($join) eq 'SCALAR') {
	$mitre_limit = $$join;
	$join = 0;
    } else {
	$join = what ('join', 2, $join);
    }

    if (ref ($start) eq 'ARRAY') {
	($start_w, $start_l) = @$start;
	$start = 3;
    } else {
	$start = what ('cap', 0, $start);
    }

    if (ref ($end) eq 'ARRAY') {
	($end_w, $end_l) = @$end;
	$end = 3;
    } else {
	$end = what ('cap', 0, $end);
    }

    $dash = pack_dash_block ($dash);
    $dash = 0 unless defined ($dash) && length $dash;

    my $transblock = pack_transform_block $trans if defined $trans;
    my $joinblock = pack 'C3xiS4', $join, $start, $end, ($mitre_limit * 65536),
			 ($start_w * 256), ($start_l * 256),
			 ($end_w * 256), ($end_l * 256);

    my $output = 'x'x16;
    my $outputaddr = unpack 'I', pack 'P16', $output;
    croak sprintf 'RISC OS bug - cannot use a buffer address %X with Draw_ProcessPath - must be less than &80000000', $outputaddr unless $outputaddr < 0x80000000;
    return wantarray ? () : undef
      unless defined kernelswi ($draw_pp, $path, $plot,
				 (defined $transblock ? $transblock : 0),
				 $flat, 0 + $thick, $joinblock, $dash,
				 0x80000000 | $outputaddr);
    my $result = [];
    @$result = unpack 'i4', $output;
    wantarray ? @$result : $result;
}

$draw_pp;
__END__

=head1 NAME

RISCOS::Draw -- perl interface to the Draw module

=head1 SYNOPSIS

    use RISCOS::Draw qw(what split_path_block path_bbox);
    # Convert join name to number, default to bevelled
    $join = what ('join', 'bevelled', $join);
    # Split scalar containing path into array of path elements
    @path = split_path_block $block;
    $bbox = path_bbox $block, $width;

=head1 DESCRIPTION

C<RISCOS::Draw> provides an interface to the Draw module, which provides "an
implementation of PostScript type drawing". At present only functions necessary
to calculate path bounding boxes have been implemented, principally for use by
the DrawFile Path object.

=head2 Subroutines

=over 4

=item what <type> <default> <values...>

C<what> converts names of options into the appropriate numeric constants.
Arguments passed as numbers are faulted if they do not correspond to a named
option. I<type> can either be a reference to a typeglob (which supplies a hash
to convert from name to number and an array from number to name) or a string to
use lookup tables provided by this package. C<RISCOS::Draw> provides these
tables:

=head3 winding

	non-zero		0
	negative		1
	even-odd		2
	positive		3

=head3 plot

	non-boundary exterior	4
	boundary exterior	8
	boundary interior	16
	non-boundary interior	32

=head3 cap

	butt			0
	round			1
	square			2
	triangle		3

=head3 join

	mitred			0
	round			1
	bevelled		2

=head3 tagname

	end			0
	continue		1
	move			2
	move_same_wind		3
	close_gap		4
	close			5
	bezier			6
	gap_same_sub		7
	line			8

I<default> is a default value (string or text) to use for any undefined values
passed as arguments. Numeric defaults are deliberately not checked for validity.
In array context C<what> returns an array corresponding to the converted
arguments. In scalar context C<what> returns only the first value.

=item unwhat <type> <default> <values...>

C<unwhat> provides the reverse conversion to C<what>, converting numeric values
to text. Any undefined values are converted to the (unchecked) supplied default.In scalar context it returns the first conversion only, in array context a list
of conversions.

=item split_dash_block <block>

Splits a dash block into an array of integers, which should be regarded as a
single value followed by a list. The first value is the offset of the start of
the dash pattern in the list. The list itself gives the length of dash segments
in user units.

=item pack_dash_block <packed_block>

=item pack_dash_block <array_ref>

=item pack_dash_block <start> <array_ref>

Packs an array of integers into a block to pass to C<Draw> SWIs or to store in a
DrawFile. If a single array reference is passed it is assumed to point to an
array C<($start, @lengths)> (which is passed to shift). If two arguments are
passed the first is taken to be the start index, the second a reference to an
array of dash lengths. If a single scalar is passed it is assumed to be already
packed and is returned verbatim.

=item split_path_block <path_block>

splits the scalar containing a series of C<Draw> path elements into an array,
with each element containing the a single move, line or curve. Concatenating the
array with C<join ''> will give the original scalar, except that the terminating
end-of-path marker C<"\0\0\0\0"> (and any trailing garbage) will be absent. If
passed a reference to an array, then this array (or a reference to it) is
returned.

In array context returns this array, in scalar context returns a reference to
it.

=item pack_path_block <reference>

=item pack_path_block path elements...

packs the path block supplied. In scalar context returns the path block, in
array context returns the path block as if split by C<split_path_block>.

If the first argument is scalar reference it is assumed to point to an already
packed path block and C<split_path_block> is called if necessary.

If the first argument is an array reference, it is dereferenced and replaces
the argument list, else the supplied argument list is processed.

For each entry in turn, if it is an array reference it is assumed to point to an
array of integer values to be used as path/move type and co-ordinates, which are
C<pack>ed with the template C<'I*'> and added to the output array. Otherwise the
entry is assumed to be already packed and added to the output array verbatim.

A final C<"\0\0\0\0"> is added to the output list if necessary.

In array context the output array is returned, in scalar context it is
concatenated with C<join ''>.

=item path_bbox <path> [<winding> <plot_type> <thickness> <join> <start_cap> <end_cap> <dash> <flatness> <transform>

calculates the bounding box of I<path>, returning a reference to an array in
scalar context, or the array itself in array context. C<undef> or an empty list
are returned if an error occurs (including supplying an empty path). All
arguments except I<path> are optional, and will default to sane values if not
supplied.

I<path> is either a scalar if it is already packed as a block, or a reference to
be passed to C<pack_path_block>.

I<winding> defaults to 0 (non-zero), and is one of the B<four> values in the
C<Draw> winding table (distinct from the B<two> used by C<DrawFile>).

I<plot> is the plot type to pass to the SWI, and defaults to 'boundary'.

I<thickness> is the line thickness in user units, which defaults to 0 (thin)

I<join> is either a scalar to lookup in the join table (default bevelled, mitre
limit defaults to 10), or a scalar reference to select mitred joins with this
as the mitre limit.

I<start_cap> and I<end_cap> are each either scalars to lookup in the cap table
(default butt, triangle is width × 1, length × 2) or an array ref to select
triangle caps with C<[width, length]>.

I<dash> is either a scalar to be used verbatim as the dash block, or an array
reference of the form C<[$Offset, @Values]> to pass to C<pack_dash_block>. The
default is continuous lines.

I<flatness> defaults to 0, which is normally appropriate

I<transform> is a reference to the transformation matrix to use, defaulting
to none

=back

=head1 BUGS

Definitely not tested enough yet. Some bits not tested at all, I believe.
Bounding box calculations and sufficient packing/unpacking to manipulate
DrawFiles does work.

=head1 AUTHOR

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

=cut
