Games::Roguelike::Mob - Roguelike mobile object

Roguelike-Utils documentation Contained in the Roguelike-Utils distribution.

Index

Code Index:

NAME

Top

Games::Roguelike::Mob - Roguelike mobile object

SYNOPSIS

Top

 package myMob;
 use base 'Games::Roguelike::Mob';

 $area = Games::Roguelike::Area->new();
 $m = myMob->new($area, sym=>'D', x=>5,y=>6);       # creates a mob at location 5, 6
                                                    # with symbol 'D', inside area $area

 $m->autoex()					    # moves the mob towards the nearest unexplored area
 $m->kbdmove($c)				    # moves the mob according to keystroke '$c' using traditional roguelike semantics

DESCRIPTION

Top

Mobile object used by drawing routines in Roguelke::Area

METHODS

new($area, %options)

Area is an ::Area object, common options are:

 sym=>'@', 		# symbol to use when rendering
 items=>[], 		# array ref of contained items
 hasmem=>1,		# whether the mob uses the "memory" feature
 pov=>-1, 	        # distance the mob can "see" (-1 = infinite, 0 = blind)
 singleminded=>0,	# whether the mob will "wander" when the movetoward function is called

All "unknown" options are saved in the object's hash, with the assumption that they will be used by the game, for example "->{MaxHp}", etc.

area([new])

Either returns the current area (no arguments) or set the area (one argument).

If an area is supplied, the old area has "delmob" called on it,and the new area has "addmob" called on it.

x()
y()

Returns the location of the mob

on()

Returns the map symbol from the current area at the mob's current x, y location.

movetofeature(@ARGS)

Calls the "findfeature" function on the current area with the @ARGS, and, if one is returned, reposition with x/y coordinates to match.

Checkmove/aftermove are not called.

movetoward($x, $y, $error)

Moves the mob toward the point specified. If error is specified, the destination point is "blurred" by the error radius.

kbdmove($c[, $testonly])

Moves the mob in direction '$c': 'h' is LEFT, 'l' is RIGHT, etc.

The testonly flag is passed to the "move" function.

safetomove()

Returns true if it's safe to continue autoexploring.

Default behavior is to return false if any mobs are in view.

autoex ([bool only1])

Find closest unexplored square and move towards it until it's no longer unexplored.

If world is specified, this loops and draws the map. Otherwise, it moves only 1 step.

move (direction[, testonly])

Uses checkmove to see whether the direction is ok. If it returns > 0, then moves the mob, changing its x,y position, and saving the move in "lastmove".

Aftermove is then called if the return value of checkmove was nonzero.

lastmove

Returns the direction parameter passed to "move" that resulted in a successful move.

aftermove (direction)

Called after the mob moved with the direction it moved.

If the mob attacks or otherwise moves "nowhere" it is called with 'undef' as the direction.

checkmove (new-x, new-y, othermob (at location x/y), testonly)

Called before the mob moves with the direction it will move if allowed.

Return value 0 = no move occurs Return value 1 = move occurs Return value -1 = attack/move occured, but keep in the same place

additem (item)

Adds item to inventory. Override this to add pack full messages, etc.

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

delitem (item)

Removes item from the mob.

dropitem (item)

Removes item, changes it's coordinates, and then tries to put it in the "area".

Returns the result of the "additem" from the area object (which may be a failure).

AUTHOR

Top

Erik Aronesty earonesty@cpan.org

LICENSE

Top

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html or the included LICENSE file.

Roguelike-Utils documentation Contained in the Roguelike-Utils distribution. 
use strict;

package Games::Roguelike::Mob;

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


sub new {
        my $pkg = shift;
        my $area = shift;
	croak("can't create mob without area") unless $area && $area->isa('Games::Roguelike::Area');

        my $self = {};

        $self->{area} = $area;
	$self->{sym}='@';
	$self->{msglog} = [];
	$self->{items} = [];
	$self->{odir} = '';
	$self->{hasmem} = 1;
	$self->{pov} = -1;
	$self->{singleminded} = 0;		# whether it tries to wander around in pursuit of a goal

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

        if (!defined($self->{x})) {
                ($self->{x}, $self->{y}) = $area->findrandmap($area->{fsym}, 0, 1);
        }

        bless $self, $pkg;
        $area->addmob($self);
        return $self;
}


sub area {
        my $self = shift;
        if (@_) {
		$self->{area}->delmob($self);
        	$self->{area} = $_[0];
        	$_[0]->addmob($self);
		if ($self->{area}->{world}) {
			$self->{area}->{world}->area($self->{area});
		}
        }
        return $self->{area};
}


sub x {
	return $_[0]->{x};
}

sub y {
	return $_[0]->{y};
}


sub on {
	my $self = shift; 
	return $self->{area}->{map}->[$self->{x}][$self->{y}];
}


sub movetofeature {
	my $self = shift;
        my ($cx,$cy) = $self->{area}->findfeature(@_);
	if (defined($cx)) {
        	$self->{x} = $cx;
        	$self->{y} = $cy;
		return 1;
	} else {
		return 0;
	}
}

my %DIAGS = (
	'nw'=>['n','w'],
	'ne'=>['n','e'],
	'sw'=>['s','w'],
	'se'=>['s','e'],
	'n',=>['nw','ne'],
	's',=>['sw','se'],
	'e',=>['ne','ne'],
	'w',=>['sw','nw'],
);


sub movetoward {
	my $self = shift;
	my ($x, $y, $err) = @_;
	my ($dx, $dy) = ($x - $self->{x}, $y - $self->{y});
	
	if ($err > 0) {
		$dx += (randi($err*2+1)- $err);
		$dy += (randi($err*2+1)- $err);
		intify($dx, $dy);
	}

	return 0 if $dx == 0 && $dy == 0;
	my $d;

	if ($dy > 0) {
		$d = 's'
	} elsif ($dy < 0) {
		$d = 'n'
	}

	if ($dx > 0) {
		$d .= 'e'
	} elsif ($dx < 0) {
		$d .= 'w'
	}

	# nonzero means move happened
	my $ok = $self->move($d);
	return $ok if $ok;

	# try moving orthoganally again sometimes... to range farther
	if (($self->{singleminded}==0) && rand(2) > 1 && $self->{odir}) {
                $ok = $self->move($self->{odir});
		$self->{area}->dprint("ortho repeat of $self->{odir}") if $ok;
                return $ok if $ok;
	}

	# try moving diags of move
	my @d;
	
	if (abs($dy) > abs($dx)) {
		@d = @{$DIAGS{$d}};
	} elsif (abs($dy) < abs($dx)) {
		@d = ($DIAGS{$d}->[1],$DIAGS{$d}->[0]);
	} else {
		@d = randsort(@{$DIAGS{$d}});
	}
	
	for (@d) {
		$ok = $self->move($_);
		$self->{odir} = '' if $ok;
		return $ok if $ok;
	}

	return 0 if $self->{singleminded} > 1;

	# try moving orthoganally to the way you want to go
	for (randsort(orthogs($d))) {
                $ok = $self->move($_);
		$self->{area}->dprint("moved orthog $_") if $ok;
		$self->{odir} = $_ if $ok;
                return $ok if $ok;
	}

	return 0;
}

my %ORTHOGS = (
	'n'=>['e','w','ne','nw'],
	's'=>['e','w','se','sw'],
	'e'=>['n','s','ne','se'],
	'w'=>['n','s','nw','sw'],
	'ne'=>['nw','se'],
	'nw'=>['ne','sw'],
	'se'=>['ne','sw'],
	'sw'=>['nw','se'],
);

sub orthogs {
	my ($d) = @_;
	return @{$ORTHOGS{$d}};
}


sub kbdmove {
	my $self = shift;
	my ($c, $testonly) = @_;
        if ($c eq '.') {
                return $self->move('.', $testonly);
        }
        if ($c eq 'h' || $c eq 'LEFT') {
                return $self->move('w', $testonly);
        }
        if ($c eq 'l' || $c eq 'RIGHT') {
                return $self->move('e', $testonly);
        }
        if ($c eq 'j' || $c eq 'DOWN') {
                return $self->move('s', $testonly);
        }
        if ($c eq 'k' || $c eq 'UP') {
                return $self->move('n', $testonly);
        }
        if ($c eq 'y') {
                return $self->move('nw', $testonly);
        }
        if ($c eq 'b') {
                return $self->move('sw', $testonly);
        }
        if ($c eq 'u') {
                return $self->move('ne', $testonly);
        }
        if ($c eq 'n') {
                return $self->move('se', $testonly);
        }
	return 0;
}


sub safetomove {
        my $self = shift;
        my $area = $self->{area};
        for my $m (@{$area->{mobs}}) {
                next if $m eq $self;
                if ($area->checkpov($self, $m->{x}, $m->{y})) {
                	return 0;
                }
        }
	return 1;
}


sub autoex {
        my $self = shift;
	my ($world) = @_;

        # flood fill find unexplored area
        my $area = $self->{area};
        my ($x1, $y1) = ($self->{x}, $self->{y});
        my $f;

        my @f;
        push @f, [$x1, $y1, []];
        my @bread;
        my ($cx, $cy) = ($x1, $y1);
        my $minlen = 1000000;

	if (!$self->safetomove()) {
		return 0;
	}

	if (!$world && $self->{autopath} && @{$self->{autopath}}) {
		my $moved = $self->move(shift(@{$self->{autopath}}));
		if ($self->{memory}->{$self->{area}->{name}}->[$self->{autocx}][$self->{autocy}]) {
			$self->{autopath} = undef;
		}
		return $moved;
	}
	
	my $path;		# path to take
        while (@f) {
                my $c = shift @f;	# breadth first
                for (my $d=0;$d<8;++$d) {
                        next unless $self->{memory}->{$self->{area}->{name}}->[$c->[0]][$c->[1]];	# has to be "moving from" a place we have seen

                        my $tx = $DD[$d]->[0]+$c->[0];
                        my $ty = $DD[$d]->[1]+$c->[1];
			my $p = [@{$c->[2]}, $DIRS[$d]];

                        # not off edge
                        next if $tx < 0 || $ty < 0;
                        next if $tx >= $area->{w} || $ty >= $area->{h};

                        next if $bread[$tx][$ty];
                        $bread[$tx][$ty]='.';     #been there in this algorithm

			my $seen = $self->{memory}->{$self->{area}->{name}}->[$tx][$ty];

                        if (!$seen) {	# not explored already;
                          $path = $p;
                          $cx = $tx;
                          $cy = $ty;
			  @f = ();
			  last;
			}

                        # not thru void
                        next if !defined($area->{map}->[$tx][$ty]);
                        next if $area->{map}->[$tx][$ty] eq '';

                        # not thru wall
                        next if index($area->{nomove}, $area->{map}->[$tx][$ty]) >= 0;
	
	                push @f, [$tx, $ty, $p];    #add to list of places can get to;
                }
        }

	if ($path) {
		if (!$world) {
			my $moved = $self->move(shift(@{$path}));
                        if (!($self->{memory}->{$self->{area}->{name}}->[$cx][$cy])) {
                        	$self->{autopath} = $path;
                        	$self->{autocx} = $cx;
                        	$self->{autocy} = $cy;
                        }
			return $moved;
		} else {
			my $con = $world->{con};
			my $stm=1;
			for (@$path) {
				my $bc = $con->nbgetch();
				if ($bc eq 'q' || $bc eq 'ESC') {
					$stm = 0;
					last;
				}
				my $moved = $self->move($_);
				$stm = $self->safetomove();
				last if !$stm;
				# explored the one we were looking for...remove this to reduce recusion at the expense of wasted moves
				if (($self->{memory}->{$self->{area}->{name}}->[$cx][$cy])) {
					last;
				}
			}
			if (!$stm) {
				return 1;
			} else {
				$world->drawmap();
				$self->autoex(@_);
			}
		}
	}
}



sub move {
	my $self = shift;
	my ($d, $testonly) = @_;			# news direction
	my $nx = $self->{x} + $DD{$d}->[0];
	my $ny = $self->{y} + $DD{$d}->[1];
	my $r;
	$r = $self->checkmove($nx, $ny, scalar $self->{area}->mobat($nx, $ny), $testonly);
	# less than eq zero means remain still (but move may have occurred)
	if (!$testonly) {
	  if ($r > 0) {
		$self->{area}->dprint("moved $d");
		$self->{x} = $nx;
		$self->{y} = $ny;
		$self->{lastmove} = $d;
	        $self->aftermove($d);
	  } elsif ($r < 0) { 
	        $self->aftermove(undef);
	  }
	}
	return $r;
}

sub getmovexy {
        my $self = shift;
        my ($d, $flag) = @_;                    # news direction
        my $nx = $self->{x} + $DD{$d}->[0];
        my $ny = $self->{y} + $DD{$d}->[1];
	return ($nx, $ny); 
}

sub lastmove {
	return $_[0]->{lastmove};
}


sub aftermove {
}


sub checkmove {
	my $self = shift;
	my ($x, $y, $othermob, $testonly) = @_;
	return 0 unless $self->{area}->{map}->[$x][$y] eq $self->{area}->{fsym};
	return 0 unless !$othermob;
	return 1;
}


sub additem {
	my $self = shift;
	my $item = shift;
	# i'm never full
	return $item->setcont($self);
}


sub delitem {
        my $self = shift;
        my $ob = shift;
	confess("not a mob") unless $self->isa('Games::Roguelike::Mob');
	$self->{area}->dprint("h1");
        my $i = 0;
        for (@{$self->{items}}) {
		if ($_ == $ob) {
                	splice @{$self->{items}}, $i, 1;
			return $_;;
		}
                ++$i;
        }
	return undef;
}


sub dropitem {
        my $self = shift;
        my $item = shift;
	$item->{x} = $self->{x};
	$item->{y} = $self->{y};
        $self->{area}->additem($item);
	return 1;
}


1;