src/FROGS/Map.pm

   1 ##########################################################################
   2 #
   3 #   Copyright (c) 2003 Aymargeddon Development Team
   4 #
   5 #   This file is part of
   6 #   "FROGS" = Framework for Realtime Online Games of Strategy
   7 #
   8 #   FROGS is free software; you can redistribute it and/or modify it
   9 #   under the terms of the GNU General Public License as published by the Free
  10 #   Software Foundation; either version 2 of the License, or (at your option)
  11 #   any later version.
  12 #
  13 #   FROGS is distributed in the hope that it will be useful, but WITHOUT
  14 #   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 #   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  16 #   more details.
  17 #   You should have received a copy of the GNU General Public License along
  18 #   with this program; if not, write to the Free Software Foundation, Inc., 675
  19 #   Mass Ave, Cambridge, MA 02139, USA.
  20 #
  21 ###########################################################################
  22 #
  23
  24 #
  25 # This file holds a baseclass for the topology of the game.
  26 # All methods here are independent of a concrete topology.
  27 # but they require, that such dependent functions exists,
  28 # so this base class did not work if there is no derived class.
  29 #
  30 # Derived classes have to implement the following functions
  31 #
  32 # grep() - return a list of all locations with true evaluation of sub
  33 # neighbours() - returns a list of all neigbours of location
  34 # distance() - returns the distance between two locations
  35 #
  36 # have a look at HexTorus.pm to see an example
  37
  38
  39 package Map;
  40
  41 use strict;
  42
  43 # returns all locations
  44 sub get_all{
  45     my $self = shift;
  46
  47     return $self->grep(sub{1;});
  48 }
  49
  50 # returns all locations with distance <= dist arround loc
  51 sub distant_neighbours{
  52     my ($self,$loc,$dist) = @_;
  53
  54     # for performance reason
  55     # TODO: do this only, if neighbours() is avaiable in the derived class
  56     return $self->neighbours($loc) if $dist == 1;
  57
  58     return $self->grep(sub{
  59         my $loc2 = shift;
  60         return $self->distance($loc,$loc2) <= $dist;});
  61
  62 }
  63
  64 1;
  65
  66