#!/usr/bin/perl -w

#############################################################################
# Thing - a base classes representing a object/room/place in 3D space
#
# Copyright (C) 1999-2000 by Tels. All rights reserved.
#############################################################################

package CoW::Thing;
use vars qw($VERSION);
$VERSION = 1.00;    # Current version of this package
require  5.005;     # requires this Perl version or later

use base CoW::Bunch;
@EXPORT_OK	= qw( );
#@EXPORT	= qw( );
use strict;
use vars qw($AUTOLOAD);

use CoW::Angle;
use CoW::Size;
use CoW::Coord;

#############################################################################
# private, initialize self 

sub _init
  {
  my $self = shift;
  my $args = shift;

  $self->SUPER::_init($args);
  $self->_default( {
   x => new CoW::Coord (rel => '_parent::x,_parent::l', val => 0),
   y => new CoW::Coord (rel => '_parent::y,_parent::w', val => 0),
   z => new CoW::Coord (rel => '_parent::z,_parent::h', val => 0),
   l => new CoW::Size (rel => '_parent::l', val => 1),
   w => new CoW::Size (rel => '_parent::w', val => 1),
   h => new CoW::Size (rel => '_parent::h', val => 1),
   sl => 0, sw => 0, sh => 0,
   rx => new CoW::Angle (rel => '_parent::rx', val => 0),
   ry => new CoW::Angle (rel => '_parent::ry', val => 0),
   rz => new CoW::Angle (rel => '_parent::rz', val => 0),
   sides => 4,
   } );
  return $self;
  }

sub _default
  { 
  my $self = shift;
  my $args = shift;
  $self->SUPER::_default($args); 
  $self->_own_coords(); 
  return $self;
  }

sub _own_coords
  {
  my $self = shift;
  my @a = qw/x y z w l h rx ry rz/;
  @a = @_ if (defined $_[0]); 		# take given args instead of default
  # now, for each of the coordinates, store that they belong to us
  foreach ( @a )
    {
    if (ref($self->{$_}))
      {
      # if belongs to someone else, make a copy for us
      $self->{$_} = $self->{$_}->copy() if defined $self->{$_}->{_parent};
      $self->{$_}->{_parent} = $self;	# aquire
      }
    }
  return $self;
  }

sub DESTROY
  {
  # for each of our coordinates, tell them that the no longer belong to us
  my $self = shift;
  my @a = qw/x y z w l h rx ry rz/;
  @a = @_ if (defined $_[0]); 		# take given args instead of default
  foreach ( @a )
    {
    undef $self->{$_}->{_parent} if ref $self->{$_};
    }
  }

#############################################################################
# public

sub move
  {
  # move the object in x,y,z relative (+-)
  my $self = shift;
  my $mx = shift || 0;
  my $my = shift || 0;
  my $mz = shift || 0;

  $self->{x} += $mx;
  $self->{y} += $my;
  $self->{z} += $mz;
  return $self;  
  }

sub move_to
  {
  # move the object absolutely to x,y,z 
  my $self = shift;
  my $mx = shift || 0;
  my $my = shift || 0;
  my $mz = shift || 0;

  $self->{x} = $mx;
  $self->{y} = $my;
  $self->{z} = $mz;
  return $self;  
  }

sub embraces
  {
  # return true wether all given points/things are completely inside our
  # own space, this works only for cubic things, others need to override it
  my $self = shift;

  my ($i,$t);
  foreach $t (@_)
    {
    $i = 0; 	
    $i++ if $t->{x} - $t->{l}/2 < $self->{x} - $self->{l}/2; 
    $i++ if $t->{x} + $t->{l}/2 > $self->{x} + $self->{l}/2; 
    return 1 if $i != 0;
    $i++ if $t->{y} - $t->{w}/2 < $self->{y} - $self->{w}/2; 
    $i++ if $t->{y} + $t->{w}/2 > $self->{y} + $self->{w}/2; 
    return 1 if $i != 0;
    $i++ if $t->{z} - $t->{h}/2 < $self->{z} - $self->{z}/2; 
    $i++ if $t->{z} + $t->{h}/2 > $self->{z} + $self->{h}/2; 
    return 1 if $i != 0;
    }
  return;
  }

sub scale
  {
  # scale a things size by some factors
  my $self = shift;
  my $fw = shift || 1;
  my $fl = shift || 1;
  my $fh = shift || 1;
 
  $self->{w} *= $fw;
  $self->{l} *= $fl;
  $self->{h} *= $fh;
  }

sub rotate
  {
  # rotate the thing around the axes
  my $self = shift;
  my $rx = shift || 0;
  my $ry = shift || 0;
  my $rz = shift || 0;
 
  $self->{rx} += $rx;
  $self->{ry} += $ry;
  $self->{rz} += $rz;
  }

sub absolute
  {
  # make all coords/angles/sizes absolute instead of relative
  my $self = shift;
  my @a = qw/x y z w l h rx ry rz/;
  @a = @_ if (defined $_[0]); 		# take given args instead of default
  foreach (@a)
    {
    $self->{$_}->rel('') if ref($self->{$_});
    }
  return $self; 
  }

sub coord_y
  {
  # get/set y coordinate
  my $self = shift;
  my $y = shift;
  if (defined $y)
    {
    $self->{y} = $y; $self->_own_coords('y');
    }
  return $self->{y};
  }

sub coord_x
  {
  # get/set x coordinate
  my $self = shift;
  my $x = shift;
  if (defined $x)
    {
    $self->{x} = $x; $self->_own_coords('x');
    }
  return $self->{x};
  }

sub coord_z
  {
  # get/set z coordinate
  my $self = shift;
  my $z = shift;
  if (defined $z)
    {
    $self->{z} = $z; $self->_own_coords('z');
    }
  return $self->{z};
  }

1; 

__END__

#############################################################################

=pod

=head1 NAME

Thing -- a descendand from L<Bunch|Bunch>, acts as base object that represents
a Brush/Room/Object/AI or a place in 3D space etc.

=head1 SYNOPSIS

	use CoW::Thing;

	$thing = new CoW::Thing ( x => 12, y => 0, z => 0, w => 20, 
				  l => 89, h => 12 );
	print $thing->as_string();

=head1 REQUIRES

perl5.005, Exporter, L<Bunch|Bunch>, L<Coord|Coord>, L<Angle|Angle>

=head1 EXPORTS

Exports nothing.

=head1 DESCRIPTION

This module defines an object in 3D space with certain properties
like center (x,y,z), dimensions (l,w,h), rotation (rx,ry,rz) etc. It also
ensures that the coordinates (any of x,y,z,w,l,h,rx,ry and rz) have _parent set
to the Thing, in case they are L<Coords|Coord>.

Per default, the rotation of the Thing (C<rx>, C<ry> and C<rz>), 
the dimensions of the Thing (C<w>, C<l> and C<h>) and the
center of the Thing (C<x>, C<y> and C<z>) will be relative to the Things
parent. You can override this via C<new()> or by setting them later on to
absolute values.

See also L<Bunch|Bunch>.

=head1 FIELDS

The following fields are required:

=over 2

=item x,y,z

The center (X,Y,Z) of the thing.

=item w,l,h

Width, length, height of the thing. 

=item rx,ry,rz

Rotation angles of the thing around the axes X,Y and Z.

=item sides

The number of sides, only important for C<CYLINDER>, C<PYRAMID> or C<CONE>. XXX

=back

=head1 METHODS

=head2 coord_x, coord_y, coord_z

Get/set the appropriate coordinate. This is needed because you can read C<x>
directly, but not write it:

	$coord = new CoW::Coord ( rel => 'x', val => 40 ); 
	$thing->{x} = $coord;		# breaks!
	$thing->coord_x ($coord);	# works!

See L<BUGS|BUGS>.

=head2 move

Move the object in relative to the current position in x,y and z.

	$thing->move (+5,0,-4); 	# x += 4, leave y, z -= 4
	$thing->move (+1); 		# x += 1, leave y and z

=head2 move_to

Move the object to absolute position (effective setting x,y and z)

	$thing->move_to (+5,0,-4); 	# x = 5, y = 0, z = 0
	$thing->move_to (+1); 		# x = 1, y = 0, z = 0

=head2 rotate

Rotate the Thing aroung the axes X,Y and Z clock-wise (negative values
to rotate counter clock-wise):
	
	$thing->rotate (90,0,0); 	# rotate 90 degress around X
	$thing->rotate (0,-45,0); 	# rotate -45 degress around Y
	$thing->rotate (0,0,20); 	# rotate 20 degress around Z
	$thing->rotate (10,0,10); 	# rotate 10 degress around X and Z

This simple adds the values to the Things C<rx>, C<ry> and C<rz> values.

=head2 embraces

Return true when the given Things are completely inside our own 3D space. This
works more or less only for cubes, so override it for other shapes.

=head2 scale

Scale the Thing by some factors:

	$thing->scale (2,1,1);	# w = w*2, l = l, h = h

Works with relative coordinates as well.

=head2 _own_coords

This routine ensures that all the embeded coordinates are actually owned by
us. If they already belong to someone else, make copy and own this. The
C<_default> calls C<_own_coords()> for you, so your C<_init()> can just
use C<SUPER->_default> as usual.

=head2 absolute
  
Make the Thing (e.g. all its coordinates/angles/sizes) absolute instead of
relative to parent. Usefull for the outer mothercell.

=head1 BUGS

Assigning directly a value to C<x>, C<y>, C<z>, C<w>, C<rx> or any other 
coordinate/angle via 
		
	$thing->{w} = 90;

will break when:

=over 2

=item *

the coordinate hold a former CoW::Coord, CoW::Size or
CoW::Angle and you assign a scalar

=item *

the coordinate hold a scalar and you assign a Coord, Size or Angle

=back

This is because the following does occur:

	use CoW::Thing;
	use CoW::Size;

	$size = new CoW::Size ( rel => '', val => 24 );
	$thing = new CoW::Thing ( w => $size );

	$thing->{w} = 24;		# $size is no longer owned by $thing

The bug starts at the last line: $thing no longer owns $size, but $sizes's
_parent still points to $thing. If there is no other reference to $size,
it will be destroyed, so anything is fine. But if it is added to another thing
later one like:

	$thing_2 = new CoW::Thing ( w => $size );

then $thing_2 will get a copy of $size (since it will see the set _parent
field), and the first $size will still be dangling around until you destroy
$size.

The only critical condition would be to destroy $thing and then trying to
use $size. At this point $size's relative field might point to a non-existing
thing. But this should not happen, anyway.

A workaround would be to make $thing->w() which is aware of this and enforcing
the use of w() over {w}. This is exactly why there are coord_y() etc.

But setting $thing->{w} directly will still break!

=head1 AUTHOR

Tels http://bloodgate.com in late 2000.

=cut

