File Coverage

blib/lib/Games/Roguelike/Item.pm

Criterion	Covered	Total	%
statement	44	68	64.7
branch	13	34	38.2
condition	3	9	33.3
subroutine	7	13	53.8
pod	6	6	100.0
total	73	130	56.1

use strict;

package Games::Roguelike::Item;

use Games::Roguelike::Utils qw(:all);
use Games::Roguelike::Console;
use Games::Roguelike::Area;
use Carp qw(croak confess carp);

our $AUTOLOAD;

=head1 NAME

Games::Roguelike::Item - Roguelike item object

=head1 SYNOPSIS

 package myItem;
 use base 'Games::Roguelike::Item';

 $i = myItem->new($area, sym=>'!', x=>5,y=>6);	    # creates an item at location 5, 6
						    # with symbol '!', inside area $area

=head1 DESCRIPTION

Item object used by drawing routines in Roguelke::Area

=head2 METHODS

=over 4

=cut

=item new($container, %opts)

$container is usually an "area" or "mob" or another "item" object.

At a minimum, it must support the additem and delitem methods.

The "new" method automatically calls additem on the container.

Options include:

	sym	: symbol this item is drawn with
	color	: color this item is drawn with
	x	: map location of item
	y 	: map location of item

Other options are saved in the hash as "user defined" options.

=cut

sub new {
        my $pkg = shift;

        my $cont = shift;

        croak("can't create item without container argument")
		unless UNIVERSAL::can($cont, 'additem');

        my $self = {};

	$self->{sym}='$';			# default, just so there is one
	$self->{color}='bold yellow';		# default

	while( my ($k, $v) = splice(@_, 0, 2)) {
		$self->{$k} = $v;
	}

        bless $self, $pkg;

        $cont->additem($self);

        return $self;
}

=item x()

=item y()

Return the item's x/y members only if the item is in an ::Area object,

Otherwise, return the container's x and y members.

Direct access to the $item->{x}/{y} members is encouraged if you don't care how it's contained.

=cut

sub x {
	my $self = shift;
	if (!$self->{inarea}) {
		return $self->{cont}->x;
	}
	return $self->{x};
}

sub y {
	my $self = shift;
	if (!$self->{inarea}) {
		return $self->{cont}->y;
	}
	return $self->{y};
}

=item setcont(newcont)

Sets the container for an item, returns 0 if it's already contained within that continer.

Dies if the container has no {items} list (ie: can't contain things)

** Should only ever be called**
	- by the container's "additem" method, and
	- only if the container is derived from ::Area, ::Mob or ::Item.

(This can & will be made generic at some point)

=cut

sub setcont {
	my $self = shift;
	my $cont = shift;

	confess("not an item") unless $self->isa('Games::Roguelike::Item');
	confess("not an container") unless ref($cont->{items}) && UNIVERSAL::can($cont, 'additem');

	if ($cont) {
		if (!defined($self->{cont}) || $cont != $self->{cont}) {
			$self->{in} = $cont->isa('Games::Roguelike::Area') ? 'area'
				    : $cont->isa('Games::Roguelike::Mob') ? 'mob'
				    : $cont->isa('Games::Roguelike::Item') ? 'item' : 'void';

			$self->{"in" . $self->{in}} = 1;

			# for now, do this, until interface is better documented
			die("item must be in an area, mob or another item as a container")
				if $self->{invoid};

			$self->{cont}->delitem($self) if $self->{cont};
			push @{$cont->{items}}, $self;
			$self->{cont} = $cont;

			if ($self->{inarea}) {
				$self->{r} = $cont;
			} else {
				$self->{r} = $cont->{r};
			}

			return 1;
		}
		return 0;
	} else {
		return $self->{cont};
	}
}

# perl accessors are slow compared to just accessing the hash directly
# autoload is even slower
sub AUTOLOAD {
	my $self = shift;
	my $pkg = ref($self) or croak("$self is not an object");

	my $name = $AUTOLOAD;
	$name =~ s/.*://;   # strip fully-qualified portion
	$name =~ s/^set// if @_ && !exists $self->{$name};

	unless (exists $self->{$name}) {
	    croak "Can't access `$name' field in class $pkg";
	}

	if (@_) {
	    return $self->{$name} = $_[0];
	} else {
	    return $self->{$name};
	}
}

sub DESTROY {
}

=item additem (item)

Add item to reside within me.  Override this to make backpacks, etc.

Return value 0 		= can't add, too full/or not a backpack
Return value 1 		= add ok
Return value -1 	= move occured, but not added

Default implementation is to return "0", cannot add.

=cut

sub additem {
	my $self = shift;
	return 0;			# i'm not a backpack
}

=item delitem (item)

Deletes item from within me.  Override this to make backpacks, etc.

=cut

sub delitem {
        my $self = shift;
	croak("this should never be called, since additem always returns 0");
}

=back

=head1 SEE ALSO

L

=cut

1;