package RISCOS::BBox;

require Exporter;
use strict;
use vars qw (@ISA @EXPORT_OK $VERSION);

@ISA = qw(Exporter);
@EXPORT_OK = qw(intersect intersect_or_touching inside inside_or_touching
		outside union);
$VERSION = 0.01;

sub intersect ($;@) {
    my $first = shift;
    unless (wantarray) {
	$_ = $_[0];
	return $first->[2] > $_->[0] && $first->[0] > $_->[2]
	       && $first->[3] > $_->[1] && $first->[1] > $_->[3]
    }
    map { $first->[2] > $_->[0] && $first->[0] > $_->[2]
	  && $first->[3] > $_->[1] && $first->[1] > $_->[3] } @_
}

sub intersect_or_touching ($;@) {
    my $first = shift;
    unless (wantarray) {
	$_ = $_[0];
	return $first->[2] >= $_->[0] && $first->[0] >= $_->[2]
	       && $first->[3] >= $_->[1] && $first->[1] >= $_->[3]
    }
    map { $first->[2] >= $_->[0] && $first->[0] >= $_->[2]
	  && $first->[3] >= $_->[1] && $first->[1] >= $_->[3] } @_
}

sub inside ($;@) {
    my $first = shift;
    unless (wantarray) {
	$_ = $_[0];
	return $first->[0] < $_->[0] && $first->[2] > $_->[2]
	       && $first->[1] < $_->[1] && $first->[3] > $_->[3]
    }
    map { $first->[0] < $_->[0] && $first->[2] > $_->[2]
	       && $first->[1] < $_->[1] && $first->[3] > $_->[3] } @_
}

sub inside_or_touching ($;@) {
    my $first = shift;
    unless (wantarray) {
	$_ = $_[0];
	return $first->[0] <= $_->[0] && $first->[2] >= $_->[2]
	       && $first->[1] <= $_->[1] && $first->[3] >= $_->[3]
    }
    map { $first->[0] <= $_->[0] && $first->[2] >= $_->[2]
	       && $first->[1] <= $_->[1] && $first->[3] >= $_->[3] } @_
}

sub outside ($;@) {
    my $first = shift;
    unless (wantarray) {
	$_ = $_[0];
	return $first->[2] < $_->[0] || $first->[0] < $_->[2]
	       || $first->[3] < $_->[1] || $first->[1] < $_->[3]
    }
    map { $first->[2] < $_->[0] || $first->[0] < $_->[2]
	       || $first->[3] < $_->[1] || $first->[1] < $_->[3] } @_
}

sub union {
    return unless @_;
    my $box = [@{shift @_}];
    foreach (@_) {
	$$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];
    }
    wantarray ? @$box : $box;
}
1;

__END__

=head1 NAME

RISCOS::BBox -- functions to compute relationships between bounding boxes

=head1 SYNOPSIS

    use RISCOS::BBox qw(union intersect);
    @bbox = union (\@thing, \@other);
    @problems = intersect \@dinsdale, \@plan, \@other_plan, \@other_other_plan
    
=head1 DESCRIPTION

This module provides functions to compute relationships between rectangular
bounding boxes, which are always passed as references to four value arrays. They
are primarily of use when processing Drawfiles with C<Do> or C<Change>

=head2 union

C<union> returns the union of the bounding boxes passed to it as array
references. In scalar context it returns a reference to the union bounding box
array, in array context the array itself.

=head2 Spatial Relationships

All other subroutines are identical in calling conventions. The first argument
is a box to test against, and all other arguments generate true or false values
if they match or fail the named criterion. In scalar context only the second
argument is checked against the reference, in array context a list of true/false
corresponding to the arguments is returned

=over 4

=item intersect

True if the bounding box intersects the reference box. False if the bounding box
is entirely within or outside the reference, or touches it without crossing it.

=item intersect_or_touching

True if the bounding box intersects or touches the reference box.

=item inside

True if the bounding box is entirely inside the reference box (without
touching).

=item inside_or_touching

True if no part of the bounding box is outside the reference box.

=item outside

True if the bounding box is entirely outside the reference box (without
touching).

=back

=head1 BUGS

Not tested enough yet.

=head1 AUTHOR

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

=cut
