home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / riscos / RISCOS / BBox.pm < prev    next >
Text File  |  1998-07-31  |  4KB  |  148 lines
  1. package RISCOS::BBox;
  2.  
  3. require Exporter;
  4. use strict;
  5. use vars qw (@ISA @EXPORT_OK $VERSION);
  6.  
  7. @ISA = qw(Exporter);
  8. @EXPORT_OK = qw(intersect intersect_or_touching inside inside_or_touching
  9.         outside union);
  10. $VERSION = 0.01;
  11.  
  12. sub intersect ($;@) {
  13.     my $first = shift;
  14.     unless (wantarray) {
  15.     $_ = $_[0];
  16.     return $first->[2] > $_->[0] && $first->[0] > $_->[2]
  17.            && $first->[3] > $_->[1] && $first->[1] > $_->[3]
  18.     }
  19.     map { $first->[2] > $_->[0] && $first->[0] > $_->[2]
  20.       && $first->[3] > $_->[1] && $first->[1] > $_->[3] } @_
  21. }
  22.  
  23. sub intersect_or_touching ($;@) {
  24.     my $first = shift;
  25.     unless (wantarray) {
  26.     $_ = $_[0];
  27.     return $first->[2] >= $_->[0] && $first->[0] >= $_->[2]
  28.            && $first->[3] >= $_->[1] && $first->[1] >= $_->[3]
  29.     }
  30.     map { $first->[2] >= $_->[0] && $first->[0] >= $_->[2]
  31.       && $first->[3] >= $_->[1] && $first->[1] >= $_->[3] } @_
  32. }
  33.  
  34. sub inside ($;@) {
  35.     my $first = shift;
  36.     unless (wantarray) {
  37.     $_ = $_[0];
  38.     return $first->[0] < $_->[0] && $first->[2] > $_->[2]
  39.            && $first->[1] < $_->[1] && $first->[3] > $_->[3]
  40.     }
  41.     map { $first->[0] < $_->[0] && $first->[2] > $_->[2]
  42.            && $first->[1] < $_->[1] && $first->[3] > $_->[3] } @_
  43. }
  44.  
  45. sub inside_or_touching ($;@) {
  46.     my $first = shift;
  47.     unless (wantarray) {
  48.     $_ = $_[0];
  49.     return $first->[0] <= $_->[0] && $first->[2] >= $_->[2]
  50.            && $first->[1] <= $_->[1] && $first->[3] >= $_->[3]
  51.     }
  52.     map { $first->[0] <= $_->[0] && $first->[2] >= $_->[2]
  53.            && $first->[1] <= $_->[1] && $first->[3] >= $_->[3] } @_
  54. }
  55.  
  56. sub outside ($;@) {
  57.     my $first = shift;
  58.     unless (wantarray) {
  59.     $_ = $_[0];
  60.     return $first->[2] < $_->[0] || $first->[0] < $_->[2]
  61.            || $first->[3] < $_->[1] || $first->[1] < $_->[3]
  62.     }
  63.     map { $first->[2] < $_->[0] || $first->[0] < $_->[2]
  64.            || $first->[3] < $_->[1] || $first->[1] < $_->[3] } @_
  65. }
  66.  
  67. sub union {
  68.     return unless @_;
  69.     my $box = [@{shift @_}];
  70.     foreach (@_) {
  71.     $$box[0] = $$_[0] if $$box[0] > $$_[0];    # min
  72.     $$box[1] = $$_[1] if $$box[1] > $$_[1];
  73.     $$box[2] = $$_[2] if $$box[2] < $$_[2];    # max
  74.     $$box[3] = $$_[3] if $$box[3] < $$_[3];
  75.     }
  76.     wantarray ? @$box : $box;
  77. }
  78. 1;
  79.  
  80. __END__
  81.  
  82. =head1 NAME
  83.  
  84. RISCOS::BBox -- functions to compute relationships between bounding boxes
  85.  
  86. =head1 SYNOPSIS
  87.  
  88.     use RISCOS::BBox qw(union intersect);
  89.     @bbox = union (\@thing, \@other);
  90.     @problems = intersect \@dinsdale, \@plan, \@other_plan, \@other_other_plan
  91.     
  92. =head1 DESCRIPTION
  93.  
  94. This module provides functions to compute relationships between rectangular
  95. bounding boxes, which are always passed as references to four value arrays. They
  96. are primarily of use when processing Drawfiles with C<Do> or C<Change>
  97.  
  98. =head2 union
  99.  
  100. C<union> returns the union of the bounding boxes passed to it as array
  101. references. In scalar context it returns a reference to the union bounding box
  102. array, in array context the array itself.
  103.  
  104. =head2 Spatial Relationships
  105.  
  106. All other subroutines are identical in calling conventions. The first argument
  107. is a box to test against, and all other arguments generate true or false values
  108. if they match or fail the named criterion. In scalar context only the second
  109. argument is checked against the reference, in array context a list of true/false
  110. corresponding to the arguments is returned
  111.  
  112. =over 4
  113.  
  114. =item intersect
  115.  
  116. True if the bounding box intersects the reference box. False if the bounding box
  117. is entirely within or outside the reference, or touches it without crossing it.
  118.  
  119. =item intersect_or_touching
  120.  
  121. True if the bounding box intersects or touches the reference box.
  122.  
  123. =item inside
  124.  
  125. True if the bounding box is entirely inside the reference box (without
  126. touching).
  127.  
  128. =item inside_or_touching
  129.  
  130. True if no part of the bounding box is outside the reference box.
  131.  
  132. =item outside
  133.  
  134. True if the bounding box is entirely outside the reference box (without
  135. touching).
  136.  
  137. =back
  138.  
  139. =head1 BUGS
  140.  
  141. Not tested enough yet.
  142.  
  143. =head1 AUTHOR
  144.  
  145. Nicholas Clark <F<nick@unfortu.net>>
  146.  
  147. =cut
  148.