Term::Animation::Entity - Term::Animation::Entity documentation

  use Term::Animation::Entity;

  # Constructor
  my $entity = Term::Animation::Entity->new(
      shape         => ';-)',
      position      => [ 1, 2, 3 ],
      callback_args => [ 0, 1, 0, 0 ],
  );

  name < SCALAR >
        A string uniquely identifying this object

  shape < REF >
        The ASCII art for this object. It can be provided as:
                  1) A single multi-line text string (no animation)
                  2) An array of multi-line text strings, where each
		     element is a single animation frame
                  3) An array of 2D arrays. Each element in the outer
		     array is a single animation frame.
        If you provide an array, each element is a single frame of animation.
	If you provide either 1) or 2), a single newline will be stripped off
	of the beginning of each string. 3) is what the module uses internally.

  auto_trans < BOOLEAN >
        Whether to automatically make whitespace at the beginning of each line
	transparent.  Default: 0

  position < ARRAY_REF >
        A list specifying initial x,y and z coordinates
        Default: [ 0, 0, 0 ]

  callback < SUBROUTINE_REF >
        Callback routine for this entity. Default: I<move_entity()>

  callback_args < REF >
        Arguments to the callback routine.

  curr_frame < INTEGER >
        Animation frame to begin with. Default: 0

  wrap < BOOLEAN >
        Whether this entity should wrap around the edge of the screen. Default: 0

  transparent < SCALAR >
        Character used to indicate transparency. Default: ?

  die_offscreen < BOOLEAN >
  	Whether this entity should be killed if
	it goes off the screen. Default: 0

  die_entity < ENTITY >
  	Specifies an entity (ref or name). When the named
	entity dies, this entity should die as well. Default: undef

  die_time < INTEGER >
  	The time at which this entity should be killed. This 
	should be a UNIX epoch time, as returned
	by I<time>.  Default: undef

  die_frame < INTEGER >
  	Specifies the number of frames that should be displayed
	before this entity is killed. Default: undef

  death_cb < SUBROUTINE_REF >
        Callback routine used when this entity dies

  dcb_args < REF >
        Arguments to the entity death callback routine

  color
        Color mask. This follows the same format as 'shape'.
	See the 'COLOR' section below for more details.

  default_color < SCALAR >
        A default color to use for the entity.  See the 'COLOR' section
	for more details.

  data < REF >
  	Store some data about this entity. It is not used by the module.
	You can use it to store state information about this entity.

package Term::Animation::Entity;

use 5.006;
use strict;
use warnings;
use Carp;
use Curses;
use Term::Animation;

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	my %p = @_;

	# default sprite is a single asterisk
	unless(defined($p{'shape'})) { $p{'shape'} = '*'; } 

	# if no name is supplied, generate a random one
	if(defined($p{'name'})) {
		$self->{NAME} = $p{'name'};
	} else {
		my $rand_name = rand();
		while(defined($self->{OBJECTS}{$rand_name})) {
			$rand_name = rand();
		}
		$self->{NAME} = $rand_name;
	}

	# appearance
	$self->{TRANSPARENT}		= defined($p{'transparent'})	? $p{'transparent'}		: '?';
	$self->{AUTO_TRANS}		= defined($p{'auto_trans'})	? $p{'auto_trans'}		: 0;
	if($self->{AUTO_TRANS}) { $p{'shape'} = _auto_trans($p{'shape'}, $self->{TRANSPARENT}); }
	($self->{SHAPE}, $self->{HEIGHT}, $self->{WIDTH}) = _build_shape($self, $p{'shape'});
	($self->{X}, $self->{Y}, $self->{Z})	= defined($p{'position'})	? @{$p{'position'}}		: ( 0, 0, 0 );
	$self->{DEF_COLOR}		= defined($p{'default_color'})	? Term::Animation::color_id($p{'default_color'}) : 'w';
	_build_mask($self, $p{'color'});

	# collision detection
	$self->{DEPTH}		= defined($p{'depth'})        ? $p{'depth'}        : 1;
	$self->{PHYSICAL}	= defined($p{'physical'})     ? $p{'physical'}     : 0;
	$self->{COLL_HANDLER}	= defined($p{'coll_handler'}) ? $p{'coll_handler'} : undef;

	# behavior
	$self->{CALLBACK_ARGS}	= defined($p{'callback_args'})? $p{'callback_args'}: undef;
	$self->{WRAP}		= defined($p{'wrap'})         ? $p{'wrap'}         : 0;
	if   (defined($p{'callback'}))      { $self->{CALLBACK} = $p{'callback'}; }
	elsif(defined($p{'callback_args'})) { $self->{CALLBACK} = \&move_entity;  }
	else                                { $self->{CALLBACK} = undef;          }
	$self->{FOLLOW_ENTITY}  = defined($p{'follow_entity'})? $self->_get_entity_name($p{'follow_entity'}) : undef;
	$self->{FOLLOW_OFFSET}  = defined($p{'follow_offset'})? $p{'follow_offset'} : undef;

	# state
	$self->{CURR_FRAME}	= defined($p{'curr_frame'})   ? $p{'curr_frame'}   : 0;

	# entity death
	$self->{DIE_OFFSCREEN}  = defined($p{'die_offscreen'}) ? $p{'die_offscreen'} : 0;
	$self->{DIE_TIME}       = defined($p{'die_time'})      ? $p{'die_time'}      : undef;
	$self->{DIE_FRAME}      = defined($p{'die_frame'})     ? $p{'die_frame'}     : undef;
	$self->{DEATH_CB}	= defined($p{'death_cb'})      ? $p{'death_cb'}      : undef;
	$self->{DCB_ARGS}	= defined($p{'dcb_args'})      ? $p{'dcb_args'}      : undef;
	$self->{DIE_ENTITY}     = defined($p{'die_entity'})    ? $self->_get_entity_name($p{'die_entity'}) : undef;

	# misc
	$self->{TYPE}		= defined($p{'type'})		? $p{'type'}	: "self";
	$self->{DATA}		= defined($p{'data'})		? $p{'data'}	: undef;

	bless($self, $class);
	return $self;
}

sub physical {
	my $self = shift;
	if (@_) {
		my $new_physical = shift;
		if($new_physical != $self->{PHYSICAL}) {
			$self->{PHYSICAL} = $new_physical;
			if(defined($self->{ANIMATION})) {
				$self->{ANIMATION}->_update_physical($self);
			}
		}
	}
        return $self->{PHYSICAL};
}

sub auto_trans {
	my $self = shift;
	if(@_) { $self->{AUTO_TRANS} = shift; }
	return $self->{AUTO_TRANS};
}

sub transparent {
	my $self = shift;
	if(@_) { $self->{TRANSPARENT} = shift; }
	return $self->{TRANSPARENT};
}

sub wrap {
	my $self = shift;
	if(@_) { $self->{WRAP} = shift; }
	return $self->{WRAP};
}

sub data {
	my $self = shift;
	if(@_) { $self->{DATA} = shift; }
	return $self->{DATA};
}

sub name {
	my $self = shift;
	return $self->{NAME};
}

sub type {
	my $self = shift;
	if (@_) { $self->{TYPE} = shift }
        return $self->{TYPE};
}

sub frame {
	my $self = shift;
	if (@_) {
		my $new_frame = shift;
		unless($new_frame =~ /^\d+$/ &&
			$new_frame >= 0 &&
			$new_frame <= $#{$self->{SHAPE}}) {
			carp "Invalid frame number: $new_frame\n";
			return $self->{CURR_FRAME};
		}
		$self->{CURR_FRAME} = $new_frame;
	}
	return $self->{CURR_FRAME};
}

sub width {
	my $self = shift;
	return $self->{WIDTH};
}

sub height {
	my $self = shift;
	return $self->{HEIGHT};
}

sub depth {
	my $self = shift;
	return $self->{DEPTH};
}

sub size {
	my $self = shift;
	return ($self->{WIDTH}, $self->{HEIGHT}, $self->{DEPTH});
}

sub position {
	my $self = shift;
	if(@_) { ($self->{X}, $self->{Y}, $self->{Z}) = @_; }
	return ($self->{X}, $self->{Y}, $self->{Z});
}

sub x {
	my $self = shift;
	if(@_) { ($self->{X}) = @_ }
	return $self->{X};
}

sub y {
	my $self = shift;
	if(@_) { ($self->{Y}) = @_ }
	return $self->{Y};
}

sub z {
	my $self = shift;
	if(@_) { ($self->{Z}) = @_ }
	return $self->{Z};
}

sub callback_args {
	my $self = shift;
	if(@_) { $self->{CALLBACK_ARGS} = shift; }
	return $self->{CALLBACK_ARGS};
}

sub callback {
	my $self = shift;
	if(@_) { $self->{CALLBACK} = shift; }
	return $self->{CALLBACK};
}

sub death_cb {
	my $self = shift;
	if(@_) { $self->{DEATH_CB} = shift; }
	return $self->{DEATH_CB};
}

sub die_offscreen {
	my $self = shift;
	if(@_) { $self->{DIE_OFFSCREEN} = shift; }
	return $self->{DIE_OFFSCREEN};
}

sub die_frame {
	my $self = shift;
	if(@_) { $self->{DIE_FRAME} = shift; }
	return $self->{DIE_FRAME};
}

sub die_time {
	my $self = shift;
	if(@_) { $self->{DIE_TIME} = shift; }
	return $self->{DIE_TIME};
}

sub die_entity {
	my $self = shift;
	if(@_) {
		my $ent = shift;
		if(ref($ent)) {
			$ent = $ent->name;
		}
		$self->{DIE_ENTITY} = $ent;
	}
	return $self->{DIE_ENTITY};
}

sub follow_entity {
	my $self = shift;
	if(@_ && defined($self->animation)) {
		
		my ($ent) = @_;

		if(defined($ent)) {
			$self->{FOLLOW_ENTITY} = $self->_get_entity_name($ent);
		} else {
			$self->{FOLLOW_ENTITY} = undef;
		}
	}
	return $self->{FOLLOW_ENTITY};

}

sub follow_offset {
	my $self = shift;

	if(@_) {
		$self->{FOLLOW_OFFSET} = shift;
	}
	return $self->{FOLLOW_OFFSET};
}

sub shape {
	my $self = shift;
	if(@_) {
		my $shape = shift;
		if($self->{AUTO_TRANS}) {
			$shape = _auto_trans($shape, $self->{TRANSPARENT});
		}
		($self->{SHAPE},$self->{HEIGHT},$self->{WIDTH}) = $self->_build_shape($shape);
	}
}

sub collisions {
	my $self = shift;
	return $self->{COLLISIONS};
}

sub animation {
	my $self = shift;
	if(@_) { $self->{ANIMATION} = shift; }
	return $self->{ANIMATION};
}

sub default_color {
	my $self = shift;
	if(@_) {
		my $color = shift;
		if(is_valid_color($color)) {
			$self->{DEF_COLOR} = color_id($color);
			$self->_build_mask();
		} else {
			carp("Invalid color supplied: $color");
		}
	}
	return $self->{DEF_COLOR};
}

sub color_mask {
	my $self = shift;
	if(@_) { $self->_build_mask(shift); }
}

sub move_entity {
	my ($ent, $anim) = @_;
	my $cb_args;
	my $f;
	# figure out if we just have a set of deltas, or if we have
	# a full animation path to follow
	if(ref($ent->{CALLBACK_ARGS}[1]) eq 'ARRAY') {
		$cb_args = $ent->{CALLBACK_ARGS}[1][$ent->{CALLBACK_ARGS}[0]];
		$ent->{CALLBACK_ARGS}[0]++;
		if($ent->{CALLBACK_ARGS}[0] > $#{$ent->{CALLBACK_ARGS}[1]}) {
			$ent->{CALLBACK_ARGS}[0] = 0;
		}
		$f = $cb_args->[3];
	} else {
		$cb_args = $ent->{CALLBACK_ARGS};
		if($cb_args->[3]) {
			$f = $ent->{CURR_FRAME} + $cb_args->[3];
			$f = ($f - int($f)) + ($f % ($#{$ent->{SHAPE}} + 1));
		}
	}

	my $x = $ent->{X} + $cb_args->[0];
	my $y = $ent->{Y} + $cb_args->[1];
	my $z = $ent->{Z} + $cb_args->[2];

	if($ent->{WRAP}) {
		if($x >= $anim->{WIDTH})  { $x = ($x - int($x)) + ($x % $anim->{WIDTH});  }
		elsif($x < 0)            { $x = ($x - int($x)) + ($x % $anim->{WIDTH});  }
		if($y >= $anim->{HEIGHT}) { $y = ($y - int($y)) + ($y % $anim->{HEIGHT}); }
		elsif($y < 0)            { $y = ($y - int($y)) + ($y % $anim->{HEIGHT}); }
	}
	return($x, $y, $z, $f);
}

sub kill {
	my $self = shift;
	if(defined($self->{ANIMATION})) {
		$self->{ANIMATION}->del_entity($self);
	}
}

# create a color mask for an entity
sub _build_mask {
	my ($self, $shape) = @_;

	my @amask;
	my $mask = ();

	# store the color mask in case we are asked to 
	# change the default color later
	if(defined($shape)) {
		$self->{SUPPLIED_MASK} = $shape;
		($mask) = _build_shape($self, $shape);
	} elsif(defined($self->{SUPPLIED_MASK})) {
		$shape = $self->{SUPPLIED_MASK};
		($mask) = _build_shape($self, $shape);
	}

	# if we were given fewer mask frames
	# than we have animation frames, then
	# repeat what we got to make up the difference.
	# this allows the user to pass a single color
	# mask that is the same for every animation frame
	if($#{$mask} < $#{$self->{SHAPE}}) {
		my $diff = $#{$self->{SHAPE}} - $#{$mask};
		for (1..$diff) {
			push(@{$mask}, $mask->[$_ - 1]);
		}
	}

	$self->{COLOR} = ();
	for my $f (0..$#{$self->{SHAPE}}) {
		for my $i (0..$self->{HEIGHT}-1) {
			for my $j (0..$self->{WIDTH}-1) {
				if(!defined($mask->[$f][$i][$j]) or $mask->[$f][$i][$j] eq ' ') {
					$mask->[$f][$i][$j] = $self->{DEF_COLOR};
				} elsif(defined($mask->[$f][$i][$j])) {
					# make sure it's a valid color
					unless(Term::Animation::is_valid_color($mask->[$f][$i][$j]) ) {
						carp("Invalid color mask: $mask->[$f][$i][$j]");
						$mask->[$f][$i][$j] = undef;
					}
				}

				# capital letters indicate bold colors
				if($mask->[$f][$i][$j] =~ /[A-Z]/) {
					$self->{COLOR}->[$f][$i][$j] = lc($mask->[$f][$i][$j]);
					$amask[$f][$i][$j] = Curses::A_BOLD;
				} else {
					$self->{COLOR}->[$f][$i][$j] = lc($mask->[$f][$i][$j]);
				}
			}
		}
	}
	$self->{ATTR} = \@amask;
}

# automatically make whitespace appearing on a line before the first non-
# whitespace character transparent
sub _auto_trans {
	my ($shape, $char) = @_;
	unless(defined($char)) { $char = '?'; }

	if(ref($shape) eq 'ARRAY') {
		my @shape_array = ();
		foreach my $i (0..$#{$shape}) {
			if(ref($shape->[$i] eq 'ARRAY')) {
				# unimplemented
			}
			else { push(@shape_array, _trans_fill_string($shape->[$i], $char)); }
		}
		return \@shape_array;
	} else {
		return _trans_fill_string($shape, $char);
	}

}

# called by _auto_trans to handle a single string
sub _trans_fill_string {
	my ($shape, $char) = @_;
	my $new = '';
	foreach my $line (split("\n", $shape)) {
		my $len = length(($line =~ /^(\s*)/)[0]);
		my $fill = ${char}x$len;
		$line =~ s/^\s{$len}/$fill/;
		$new .= $line . "\n";
	}
	return $new;
}

# take one of 1) a string 2) an array of strings 3) an array of 2D arrays
# use these to generate a shape in the format we want (which is #3 above)
sub _build_shape {
	my ($self, $shape) = @_;

	my @shape_array = ();
	my $height = 0;
	my $width = 0;

	if(ref($shape) eq 'ARRAY') {
		for my $i (0..$#{$shape}) {
			my $this_height = 0;
			if(ref($shape->[$i]) eq 'ARRAY') {
				$this_height = $#{$shape->[$i]};
				$shape_array[$i] = $shape->[$i];
			}
			else {
				# strip an empty line from the top, for convenience
				$shape->[$i] =~ s/^\n//;
				for my $line (split("\n", $shape->[$i])) {
					$this_height++;
					if(length($line) > $width) { $width = length($line); }
					push @{$shape_array[$i]}, [split('', $line)];
				}
			}
			if($this_height > $height) { $height = $this_height; }
		}
	} else {
		# strip an empty line from the top, for convenience
		$shape =~ s/^\n//;
		for my $line (split("\n", $shape)) {
			$height++;
			if(length($line) > $width) { $width = length($line); }
			push @{$shape_array[0]}, [split('', $line)];
		}
	}
	return \@shape_array, $height, $width;
}

# look up the name of an entity if given an entity,
# just return the string if we got a string
sub _get_entity_name {
	my ($self, $entity) = @_;

	if(ref($entity)) {
		return $entity->name;
	} else {
		return $entity;
	}
}

1;