Region.pm

package Region;
@ISA = qw( Cloneable Saveable );

# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
# All rights reserved.
# Distributed under a BSD-style license; see the file LICENSE for more info.

use Carp;

# our $AUTOLOAD;  # it's a package global

my %fields =
(
  'name'         => 'area',
  'sizex'        => 20,
  'sizey'        => 20,
  'offsetx'      => 0,
  'offsety'      => 0,
  'worldx'       => 0,
  'worldy'       => 0,
  'map'          => [],
  'lit'          => [],
  'actors'       => [],
  '_collmap'     => [],
  'generated'    => 0,
  'genpattern'   => 'random',
  'outside'      => $::sc{dark},
  'border'       => undef,
  'ambient'      => undef,
  'terraind'     => undef,
  'terrgradn'    => undef,
  'terrgrads'    => undef,
  'terrgrade'    => undef,
  'terrgradw'    => undef,
  'coast_dir'    => '',
  'coast_begin'  => 0,
  'coast_end'    => 0,
  'monsterd'     => undef,
  'itemd'        => undef,
  'unique'       => undef,
  'apropos_exit' => undef,
  'music'        => '',
  'msg'          => '',
  'template'     => '',
  'legend'       => '',
);

sub new
{
  my $class = shift;
  my %f = @_;
  my $self =
  {
    '_permitted' => \%fields,
    %fields,
    'map'          => [],
    'lit'          => [],
    'actors'       => [],
    '_collmap'     => [],
    %f,
  };
  bless $self, $class;
}

sub get_terrain
{
  my $self = shift;
  my $x = shift;
  my $y = shift;
  my $oi = 0;
  my $thing = $self->{map}[$x][$y][$oi];
  while (ref($thing) eq 'Item')
  {
    $thing = $self->{map}[$x][$y][++$oi];
  }
  if (not defined $thing)
  {
    ::msg("Why is the terrain at ($x,$y) missing?");
    $thing = $self->{ambient}->clone;
    $self->{map}[$x][$y] = [ $thing ];
    if (defined($self->{border}) and
        ($x == 0 or $y == 0 or $x == $self->sizex-1 or $y == $self->sizey-1))
    {
      $thing = $self->{border}->clone;
      unshift @{$self->{map}[$x][$y]}, $thing;
    }
  }
  if (ref($thing) ne 'Terrain')
  {
    carp "Ref of thing can't be " . ref($thing);
  }
  return $thing;
}

sub get_top
{
  my $self = shift;
  my $x = shift;
  my $y = shift;
  my $oi = 0;
  my $thing = $self->{map}[$x][$y][$oi];
  if (not defined $thing)
  {
    ::msg("Why is the terrain at ($x,$y) missing?");
    $thing = $self->{ambient}->clone;
    $self->{map}[$x][$y] = [ $thing ];
    if (defined($self->{border}) and
        ($x == 0 or $y == 0 or $x == $self->{sizex}-1 or $y == $self->{sizey}-1))
    {
      $thing = $self->{border}->clone;
      unshift @{$self->{map}[$x][$y]}, $thing;
    }
  }
  return $thing;
}

sub fill
{
  my $self = shift;
  my $t_dist = shift || $self->{terraind};
  my $o_dist = shift || $self->{itemd};
  my $m_dist = shift || $self->{monsterd};
  $self->{map}[$self->{sizex}][$self->{sizey}] = [];  # pre-extend
  $self->fill_random($t_dist) if $self->{genpattern} eq 'random';
  $self->fill_accretion($t_dist) if $self->{genpattern} eq 'accretion';
  $self->fill_recursive($t_dist, 0, 0, $self->{sizex}-1, $self->{sizey}-1) if $self->{genpattern} eq 'recursive';
  $self->fill_canned($t_dist) if $self->{genpattern} eq 'canned';
  $self->fill_dungeon($t_dist) if $self->{genpattern} eq 'dungeon';
  $self->fill_gradient if $self->{genpattern} eq 'gradient';
  $self->fill_coastline if $self->{genpattern} eq 'coastline';
  $self->fill_maze if $self->{genpattern} eq 'maze';
  $self->fresh_items($o_dist) if defined $o_dist;
  $self->fresh_monsters($m_dist) if defined $m_dist;

  my $u;
  $self->{unique} = [] if not defined $self->{unique};
  foreach $u (@{$self->{unique}})
  {
    if (ref($u) eq 'Actor')
    {
      $self->enter($u->clone);
    } elsif (ref($u) eq 'Terrain' or ref($u) eq 'Item')
    {
      my $x; my $y;
      $x = ::d(1,$self->{sizex})-1;
      $y = ::d(1,$self->{sizex})-1;
      while (not $self->get_terrain($x,$y)->allows($u))
      {
        $x = ::d(1,$self->{sizex})-1;
        $y = ::d(1,$self->{sizex})-1;
      }
      $u = $u->clone;
      $u->{location} = $self;
      $u->{x} = $x;
      $u->{y} = $y;
      unshift @{$self->{map}[$x][$y]}, $u;
    }
  }
}

sub gel
{
  my $self = shift;
  my $x = shift;
  my $y = shift;
  if (not $self->{gelled}[$x][$y])
  {
    $self->{gelled}[$x][$y] = 1;
    if ($self->{map}[$x][$y][$#{$self->{map}[$x][$y]}] ne $self->{ambient})
    {
      push @{$self->{map}[$x][$y]}, $self->{ambient};
    }
    for($k = 0; $k <= $#{$self->{map}[$x][$y]}; $k++)
    {
      $self->{map}[$x][$y][$k] = $self->{map}[$x][$y][$k]->clone;
      $self->{map}[$x][$y][$k]->{x} = $x;
      $self->{map}[$x][$y][$k]->{y} = $y;
      $self->{map}[$x][$y][$k]->{location} = $self;
    }
  }
}

sub fresh_monsters
{
  my $self = shift;
  my $m_dist = shift;
  my $i = 0; my $j = 0;
  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      $self->{_collmap}[$i][$j] = 0;
      my $m = $m_dist->pick;
      if (defined $m)
      {
        if ($self->get_terrain($i,$j)->allows($m))
        {
          my $g = $m->clone;
          $g->prep;
          $self->enter($g,$i,$j);
        }
      }
    }
  }
}

sub fresh_items
{
  my $self = shift;
  my $o_dist = shift;
  my $i = 0; my $j = 0;
  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      my $o = $o_dist->pick;
      if (defined $o and $self->get_terrain($i,$j)->allows($o))
      {
        unshift @{$self->{map}[$i][$j]}, $o->clone;
      }
    }
  }
}

sub fill_random
{
  my $self = shift;
  my $t_dist = shift || $self->{terraind};

  my $i = 0; my $j = 0;

  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      if(defined($self->{border}) and ($j == 0 or $j == $self->{sizey}-1
         or $i == 0 or $i == $self->{sizex}-1))
      {
        $self->{map}[$i][$j] = [ $self->{border} ];
      } else
      {
        my $t = $t_dist->pick;
        $self->{map}[$i][$j] = [ $self->{ambient} ];
        unshift @{$self->{map}[$i][$j]}, $t if defined $t;
      }
    }
  }
}

sub fill_gradient
{
  my $self = shift;

  my $i = 0; my $j = 0;

  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      if(defined($self->{border}) and ($j == 0 or $j == $self->{sizey}-1
         or $i == 0 or $i == $self->{sizex}-1))
      {
        $self->{map}[$i][$j] = [ $self->{border} ];
      } else
      {
        my $t = Distribution->new( (($i)/$self->{sizex})                / 2 => $self->{terrgrade},
                                   (($self->{sizex}-$i)/$self->{sizex}) / 2 => $self->{terrgradw},
                                   (($j)/$self->{sizey})                / 2 => $self->{terrgrads},
                                   (($self->{sizey}-$j)/$self->{sizey}) / 2 => $self->{terrgradn} )->pick;
        if (defined $t)
        {
          $t = $t->pick;
        } else
        {
          $t = $self->{terraind}->pick;
        }
        $self->{map}[$i][$j] = [ $self->{ambient} ];
        unshift @{$self->{map}[$i][$j]}, $t if defined $t;
      }
    }
  }
}

sub fill_coastline
{
  my $self = shift;

  my $i = 0; my $j = 0;

  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      if(defined($self->{border}) and ($j == 0 or $j == $self->{sizey}-1
         or $i == 0 or $i == $self->{sizex}-1))
      {
        $self->{map}[$i][$j] = [ $self->{border} ];
      } else
      {
        my $t;
#        if ($self->{coast_dir} eq 'N/S')
#        {
          if ($i + ::d(1,5,-3) > ($j/$self->{sizey} * $self->{coast_end}))
          {
            $t = $self->{terrgrade};
          } else
          {
            $t = $self->{terrgradw};
          }
#        }
        if (defined $t)
        {
          $t = $t->pick;
        } else
        {
          $t = $self->{terraind}->pick;
        }
        $self->{map}[$i][$j] = [ $self->{ambient} ];
        unshift @{$self->{map}[$i][$j]}, $t if defined $t;
      }
    }
  }
}

sub fill_maze
{
  my $self = shift;

  my $i = 0; my $j = 0;

  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      if(defined($self->{border}) and ($j == 0 or $j == $self->{sizey}-1
         or $i == 0 or $i == $self->{sizex}-1))
      {
        $self->{map}[$i][$j] = [ $self->{border} ];
      } else
      {
        my $t = $self->{terraind}->pick;
        $self->{map}[$i][$j] = [ $self->{ambient} ];
        unshift @{$self->{map}[$i][$j]}, $t if defined $t;
      }
    }
  }
  $i = ::d(1, $self->{sizex})-1;
  $j = ::d(1, $self->{sizey})-1;
  my $done = 0;
  while (not $done)
  {
    $self->{map}[$i][$j] = [ $self->{ambient} ];
    my $w = ::d(1,4);
    if    ($w == 1) { $i++; }
    elsif ($w == 2) { $i--; }
    elsif ($w == 3) { $j++; }
    elsif ($w == 4) { $j--; }
    if ($i < 0 or $j < 0 or $i >= $self->{sizex} or $j >= $self->{sizey})
    {
      $done = 1;
    }
  }
}

sub fill_accretion
{
  my $self = shift;
  my $t_dist = shift || $self->{terraind};
  # my $o_dist = shift || $self->{itemd};
  # my $m_dist = shift || $self->{monsterd};
  my $mcnt = shift;

  my $i = 0;

# Method "A for Accretion":
# Step 1: Take a blank terrain grid, seed it with random terrain types in a 
# dozen or so random cells (depending on size of the grid you're populating).

  for($i = 0; $i < ($self->{sizex} * $self->{sizey} * 0.025); $i++)
  {
    my $x = ::d(1,$self->{sizex})-1;
    my $y = ::d(1,$self->{sizey})-1;
    my $t = $t_dist->pick;
    $self->{map}[$x][$y] = [ $self->{ambient} ];
    unshift @{$self->{map}[$x][$y]}, $t if defined $t;
  }

# Step 2: For a number of times equal to about 50% of the remaining cells, 
# pick a random cell to start in; if it's blank, do a 4-directional random 
# walk until you hit an already-filled cell. The last blank cell you hit in 
# the walk gets the terrain type of the filled cell. The seeds, in effect, 
# start spreading their own terrain type to nearby areas.

  my $j = int($self->{sizex} * $self->{sizey} * 0.975 * 0.5);
  for($i = 0; $i < $j; $i++)
  {
    my $x = ::d(1,$self->{sizex})-1;
    my $y = ::d(1,$self->{sizey})-1;
    if (defined $self->{map}[$x][$y])
    {
      $i--;
    } else
    {
rewalk:
      my $ox = $x; my $oy = $y;
      my $d = ::d(1,4);
      if    ($d==1) { $x -= 1; }
      elsif ($d==2) { $x += 1; }
      elsif ($d==3) { $y -= 1; }
      elsif ($d==4) { $y += 1; }
      if ($x < 0 or $y < 0 or $x > $self->{sizex}-1 or $y > $self->{sizey}-1)
      {
        $x = $ox; $y = $oy; goto rewalk;
      }
      if (defined $self->{map}[$x][$y])
      {
        $self->{map}[$ox][$oy] = [ @{$self->{map}[$x][$y]} ];
      } else
      {
        goto rewalk;
      }
    }
  }

# Step 3: For each remaining blank cell, randomly either (a) fill with a 
# random terrain type or (b) pick a direction and walk in a straight line 
# until you hit an edge, in which case you fill with a random terrain type 
# or hit a filled cell, in which case fill the last blank cell as above.

  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      if (not defined $self->{map}[$i][$j])
      {
        my $t = $t_dist->pick;
        $self->{map}[$i][$j] = [ $self->{ambient} ];
        unshift @{$self->{map}[$i][$j]}, $t if defined $t;
      }
    }
  }
}

sub fill_recursive
{
  my $self = shift;
  my $t_dist = shift || $self->{terraind};
  my $x1 = shift;
  my $y1 = shift;
  my $x2 = shift;
  my $y2 = shift;
  my $pt = shift || $self->{ambient};

#  print "filling ($x1,$y1)-($x2,$y2)"; # <STDIN>;
  if ($x1>=$x2 and $y1>=$y2)
  {
    if (not defined $self->{map}[$x2][$y2])
    {
#      print "planting a ", $pt->name; <STDIN>;
      $self->{map}[$x2][$y2] = [ $self->{ambient} ];
      unshift @{$self->{map}[$x2][$y2]}, $pt if defined $pt;
    }
  } else
  {
    my $t = $t_dist->pick || $self->{ambient};
    my @z;
    $z[0] = $pt;
    $z[1] = $pt;
    $z[2] = $pt;
    $z[3] = $pt;
    $z[::d(1,4)-1] = $t;

    my $xa = int(($x1+$x2)/2);
    my $ya = int(($y1+$y2)/2);
# print "upper left\n";
    $self->fill_recursive($t_dist, $x1, $y1, $xa, $ya, $z[0]);
# print "bottom left\n";
    $self->fill_recursive($t_dist, $x1, $ya+1, $xa, $y2, $z[1]);
# print "bottom right\n";
    $self->fill_recursive($t_dist, $xa+1, $ya+1, $x2, $y2, $z[2]);
# print "upper right\n";
    $self->fill_recursive($t_dist, $xa+1, $y1, $x2, $ya, $z[3]);
  }
}

sub fill_canned
{
  my $self = shift;
  my $t_dist = shift || $self->{terraind};

  my $i = 0; my $j = 0;

  for($i = 0; $i < $self->{sizex}; $i++)
  {
    for($j = 0; $j < $self->{sizey}; $j++)
    {
      my $mapsym = substr($self->{template}[$j], $i, 1) || " ";
      my $t = $self->{legend}{$mapsym};
      if (ref($t) eq 'Distribution') { $t = $t->pick; }
      $self->{map}[$i][$j] = [ $self->{ambient} ];
      unshift @{$self->{map}[$i][$j]}, $t if defined $t;
    }
  }
}

sub fill_dungeon
{
  my $self = shift;
  my $t_dist = shift || $self->{terraind};

  my $x = 0;
  my $y = 0;
  my $i = 0;

  # fill area

  for($x = 0; $x < $self->{sizex}; $x++)
  {
    for($y = 0; $y < $self->{sizey}; $y++)
    {
      my $t = $t_dist->pick;
      if(defined($self->{border}) and ($y == 0 or $y == $self->{sizey}-1
         or $x == 0 or $x == $self->{sizex}-1))
      {
        $t = $self->{border};
      }
      $self->{map}[$x][$y] = [ $self->{ambient} ];
      unshift @{$self->{map}[$x][$y]}, $t if defined $t;
    }
  }

  # create rooms

  for($i = 0; $i < ($self->{sizex} * $self->{sizey} * 0.02); $i++)
  {
    my $px = ::d(1,$self->{sizex}-2);
    my $py = ::d(1,$self->{sizey}-2);
    my $pw = ::d(1,int($self->{sizex}/8));
    my $ph = ::d(1,int($self->{sizey}/8));

    for($x = $px; $x <= $px+$pw and $x < $self->{sizex}-1; $x++)
    {
      for($y = $py; $y <= $py+$ph and $y < $self->{sizey}-1; $y++)
      {
        $self->{map}[$x][$y] = [ $self->{ambient} ];
      }
    }

    # create tunnels

    for($x = $px; $x <= $px+$pw and $x < $self->{sizex}-1; $x++)
    {
      if (::d(1,8) == 1)
      {
        my $d = ::d(1,8)+3;
        for($y = $py; $y > $py-$d and $y > 1; $y--)
        {
          $self->{map}[$x][$y] = [ $self->{ambient} ];
        }
      }
      if (::d(1,8) == 1)
      {
        my $d = ::d(1,8)+3;
        for($y = $py+$ph; $y < $py+$ph+$d and $y < $self->{sizey}-1; $y++)
        {
          $self->{map}[$x][$y] = [ $self->{ambient} ];
        }
      }
    }

    for($y = $py; $y <= $py+$pw and $y < $self->{sizey}-1; $y++)
    {
      if (::d(1,8) == 1)
      {
        my $d = ::d(1,8)+3;
        for($x = $px; $x > $px-$d and $x > 1; $x--)
        {
          $self->{map}[$x][$y] = [ $self->{ambient} ];
        }
      }
      if (::d(1,8) == 1)
      {
        my $d = ::d(1,8)+3;
        for($x = $px+$ph; $x < $px+$ph+$d and $x < $self->{sizex}-1; $x++)
        {
          $self->{map}[$x][$y] = [ $self->{ambient} ];
        }
      }
    }
  }
}

# puts the designated actor into this region.
# one of : enter(dude)       => random location
#        : enter(dude,x,y)   => specific location
#        : enter(dude,dude2) => near dude2
sub enter
{
  my $self = shift;
  my $actor = shift;
  if ($actor eq $::leader)
  {
    $self->{supplement}->browse if defined $self->{supplement};
  }
  if ($actor eq $::leader and not $self->{generated})
  {
    ::msg("Please wait, generating '" . $self->{name} . "' region...");
    ::clrmsg;
    ::update_display;
    $self->fill;
    $self->{generated} = 1;
  }
  if ($actor eq $::leader and defined $self->{msg} and $self->{msg})
  {
    ::msg($self->{msg});
    $self->{msg} = '';
  }

  my $x = shift; $x = ::d(1,$self->{sizex}-2) if not defined $x;
  my $y = shift; $y = ::d(1,$self->{sizey}-2) if not defined $y;
  if (ref($x) eq 'Actor')
  {
    $y = $x->{y} + ::d(1,3)-2;
    $x = $x->{x} + ::d(1,3)-2;
  }
  my $good = 0;
  my $ci = 100;
  while (not $good)
  {
    if (not defined $self->actor_at($x,$y) and
        $self->get_terrain($x,$y)->allows($actor))
    {
      $good = 1;
    } else
    {
      my $ox = $x; my $oy = $y;
arrrgh:
      $x = $ox; $y = $oy;
      $x += (::d(1,3)-2);
      $y += (::d(1,3)-2);
      goto arrrgh if $x < 0 or $y < 0 or $x >= $self->{sizex} or $y >= $self->{sizey};
    }
    $ci--;
    if ($ci == 0)
    {
      ::msg("Can't find any place for " . $actor->{name} . "!");
      $good = 1;
    }
  }
  push @{$self->{actors}}, $actor;
  $actor->{location} = $self;
  $actor->{x} = $x;
  $actor->{y} = $y;
  $self->{_collmap}[$x][$y] = 1;
  $self->gel($x,$y);
  $actor->display;
}

# removes an actor after it's demise or departure
sub relieve
{
  my $self = shift;
  my $actor = shift;
  return if not defined $actor;
  if (ref($actor) eq 'Item' or ref($actor) eq 'Terrain')
  {
    my $t; my @s;
    foreach $t (@{$actor->{location}{map}[$actor->{x}][$actor->{y}]})
    {
      push @s, $t if $t ne $actor;
    }
    $actor->{location}{map}[$actor->{x}][$actor->{y}] = [ @s ];
    $actor->{location}->draw_cell($actor->{x},$actor->{y});
    return;
  }
  my $j = 0;
  while ($j <= $#{$self->{actors}})
  {
    if (defined $self->{actors}[$j])
    {
      if ($actor eq $self->{actors}[$j])
      {
        $self->{_collmap}[$actor->{x}][$actor->{y}] = 0;
        # $#{$self->actors}--;
        $actor->undisplay;
        # $actor->location(undef); # it's not here anymore right?
        $self->{actors}[$j] = undef; # $self->actors->[$#{$self->{actors}}];
        last;
      }
    }
    $j++;
  }
}

sub queue_follow
{
  my $self = shift;
  my $actor = shift;
  my $newrg = shift;
  my $x = shift;
  my $y = shift;

  my $a;
  foreach $a (@{$self->{actors}})
  {
    next if (not defined $a) or $a eq $actor or
         $a->{blind} or $a->{paralyzed} or $a->{confused} or $a->{incapacitated} or
         $a->{sleeping} > 0;
    if ((defined $a->{target} and $a->{target} eq $actor) or
        (defined $a->{party} and $a->{party} eq $actor->{party}))
    {
      $::fuses->add(<<'END_FUSE', $a->dist($actor), [$a, $self, $newrg, $x, $y], 'resist');
      {
        my ($actor, $reg, $newrg, $x, $y) = @_;
        if (defined $actor->{location} and $actor->{location} eq $reg and $::leader->{location} ne $reg)
        {
          $reg->relieve($actor);
          $newrg->enter($actor, $x, $y);
        }
        0;
      }
END_FUSE
    }
  }
}

sub display
{
  my $self = shift;
  my $c = shift; my $ox; my $oy;
  if (ref($c) eq 'Actor')
  {
    $ox = $c->{x} - int($::pref{map_width}/2);    # center on this actor
    $oy = $c->{y} - int($::pref{map_height}/2);
  } else
  {
    $ox = $c - int($::pref{map_width}/2);    # center on these x and y coordinates
    $oy = (shift || 0) - int($::pref{map_width}/2);
  }

  $self->{offsetx} = $ox;
  $self->{offsety} = $oy;

  my $i = 0; my $j = 0; my $q;
  $q = '';
  for($j = $oy; $j <= $::pref{map_height}+$oy-1; $j++)
  {
    ::gotoxy(1,$j-$oy+1);
    for($i = $ox; $i <= $::pref{map_width}+$ox-1; $i++)
    {
      if ($i >= 0 and $j >= 0 and $i < $self->{sizex} and $j < $self->{sizey})
      {
        if ($self->{lit}[$i][$j])
        {
          # $q .= ($::sc{$self->{map}[$i][$j][0]->{appearance}} || '?');
          ::color($self->{map}[$i][$j][0]->{color},'black');
          ::display($::sc{$self->{map}[$i][$j][0]->{appearance}});
        } else
        {
          ::color('grey','black');
          ::display($::sc{dark});
          # $q .= $::sc{dark};
        }
      } else
      {
        ::color('grey','black');
        ::display($self->{outside});
        # $q .= $self->outside;
      }
    }
    # $q .= "\n" if $j != 23+$self->offsety;
  }
  # ::gotoxy(1,1); print $q;
  my $x;
  foreach $x (@{$self->{actors}})
  {
    next if not defined $x;
    $x->display;
  }
}

sub draw_cell
{
  my $self = shift;
  my $x = shift;
  my $y = shift;
  my $detect = shift || 0;
  my $q;
  # $i < $self->sizex and $j < $self->sizey
  if ($self->{lit}[$x][$y])
  {
    die("No " . $self->{map}[$x][$y][0]->{appearance}) if not exists $::sc{$self->{map}[$x][$y][0]->{appearance}};
    $q = $::sc{$self->{map}[$x][$y][0]->{appearance}};
  } else
  {
    $q = $::sc{dark};
  }
  my $i = $x - $self->{offsetx} + 1;
  my $j = $y - $self->{offsety} + 1;
  if ($i >= 1 and $j >= 1 and $i < $::pref{map_width} and $j < $::pref{map_height})
  {
    ::gotoxy($i, $j);
    if ($detect)
    {
      ::color('magenta','blue');
      ::display '*';
    } else
    {
      ::color($self->{map}[$x][$y][0]->{color},'black');
      ::display $q;
    }
  }
  ::update_display;
}

sub tick
{
  my $self = shift;
  my $leader = shift || carp "Need leader in tick";
  my $x; my $j = 0;
  while ($j <= $#{$self->{actors}})
  {
    $x = $self->{actors}[$j++];
    next if not defined $x;
    next if $x eq $leader;
    $x->move;
  }
}

sub actor_at
{
  my $self = shift;
  my $x = shift;
  my $y = shift;
  return undef if $x < 0 or $y < 0 or $x >= $self->{sizex} or $y >= $self->{sizey};
  if ($self->{_collmap}[$x][$y])
  {
    my $q;
    foreach $q (@{$self->{actors}})
    {
      next if not defined $q;
      if ($q->{x} == $x and $q->{y} == $y) { return $q; }
    }
    croak "_collmap is out of date";
  }
  return undef;
}

1;