Games::Maze::FirstPerson - First person viewpoint of Games::Maze

Games-Maze-FirstPerson documentation Contained in the Games-Maze-FirstPerson distribution.

Index

Code Index:

NAME

Top

Games::Maze::FirstPerson - First person viewpoint of Games::Maze

VERSION

Top

Version 0.03

SYNOPSIS

Top

    use Games::Maze::FirstPerson;

    my $maze = Games::Maze::FirstPerson->new();
    if ( $maze->south ) {
        $maze->go_south;
    }
    print $maze->to_ascii if $maze->has_won;

DESCRIPTION

Top

This module is merely a wrapper around Games::Maze. I needed a simple maze module which would represent a maze from a first-person viewpoint but nothing on the CPAN did that, hence this code.

Patches welcome.

EXPORT

Top

None.

METHODS

Top

new

    my $maze = Games::Maze::FirstPerson->new(@arguments);

This constructor takes the same arguments as Games::Maze. Currently we only support 2D rectangular mazes.

to_ascii

  print $maze->to_ascii;

This method returns an ascii representation of the maze constructed with periods and spaces. It is not the same as the Games::Maze representation.

location

  $maze->location($x, $y);

Set the X and Y location in the maze.

x

  my $x = $maze->x;

Returns the current X location in the maze.

y

  my $y = $maze->y;

Returns the current Y location in the maze.

rows

  my $rows = $maze->rows;

Returns the number of rows of the maze.

cols

  my $columns = $maze->cols;

Returns the number of columns of the maze.

columns

Same as $maze->cols.

north

  if ( $maze->north ) { ... }

Returns true if there is an opening to the north of the current position.

go_north

  $maze->go_north;

Moves one space to the north. Returns false if you cannot go that way.

south

  if ( $maze->south ) { ... }

Returns true if there is an opening to the south of the current position.

go_south

  $maze->go_south;

Moves one space to the south. Returns false if you cannot go that way.

west

  if ( $maze->west ) { ... }

Returns true if there is an opening to the west of the current position.

go_west

  $maze->go_west;

Moves one space to the west. Returns false if you cannot go that way.

east

  if ( $maze->east ) { ... }

Returns true if there is an opening to the east of the current position.

go_east

  $maze->go_east;

Moves one space to the east. Returns false if you cannot go that way.

surroundings

  print $maze->surroundings;

Prints an ascii representation of the immediate surroundings. For example, if there are exits to the north and east, it will look like this:

 . .
 .
 ...

directions

  my @directions = $maze->directions;

Returns a list of directions in which you can currently move. Directions are in lower-case and in the order "north", "south", "east" and "west".

has_won

 if ($maze->has_won) { ... }

Returns true if you have reached the exit.

facing

  my $facing = $maze->facing;
  print "You are currently facing $facing\n";

This method returns the direction you are currently facing as determined by the last direction you have moved. When a maze if first created, you are facing south.

EXAMPLE

Top

The following simple program will print out the surroundings of the location the person is currently at and allow them to move through the maze until they reach the end. It is also included in the examples/ directory of this distribution.

 #!/usr/bin/perl

 use strict;
 use warnings;
 use Term::ReadKey;
 use Games::Maze::FirstPerson;

 my $rows = 5;
 my $columns = 8;
 my $maze = Games::Maze::FirstPerson->new(
   dimensions => [$rows,$columns]
 );

 print <<"END_CONTROLS";
 q = quit

 w = move north
 a = move west
 s = move south
 d = move east

 END_CONTROLS

 ReadMode 'cbreak';

 my %move_for = (
     w => 'go_north',
     a => 'go_west',
     s => 'go_south',
     d => 'go_east'
 );

 while ( ! $maze->has_won ) {
     print $maze->surroundings;
     my $key = lc ReadKey(0);
     if ( 'q' eq $key ) {
         print "OK.  Quitting\n";
         exit;
     }
     if ( my $action = $move_for{$key} ) {
         unless ( $maze->$action ) {
             print "You can't go that direction\n\n";
         }
         else {
             print "\n";
         }
     }
     else {
         print "I don't understand\n\n";
     }
 }

 print "Congratulations!  You found the exit!\n";
 print $maze->to_ascii;

AUTHOR

Top

Curtis "Ovid" Poe, <moc.oohay@eop_divo_sitruc>

BUGS

Top

Please report any bugs or feature requests to bug-games-maze-firstperson@rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Games-Maze-FirstPerson. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

ACKNOWLEDGEMENTS

Top

See John Gamble's Games::Maze.

COPYRIGHT & LICENSE

Top

Copyright 2005 Curtis "Ovid" Poe, all rights reserved.

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

Games-Maze-FirstPerson documentation Contained in the Games-Maze-FirstPerson distribution. 
package Games::Maze::FirstPerson;

use warnings;
use strict;
use Games::Maze;

use constant MOVE_NORTH => -2;
use constant MOVE_SOUTH => 2;
use constant MOVE_WEST  => -2;
use constant MOVE_EAST  => 2;

use constant NORTH_WALL => -1;
use constant SOUTH_WALL => 1;
use constant WEST_WALL  => -1;
use constant EAST_WALL  => 1;


our $VERSION = '0.03';


sub new {
    my $class = shift;

    my %attr_for = @_;
    if ( exists $attr_for{cell} && 'Quad' ne $attr_for{cell} ) {
        die "'cell' attribute must be 'Quad'";
    }
    if ( defined( my $dimensions = $attr_for{dimensions} ) ) {
        die "dimensions must be an array ref" unless 'ARRAY' eq ref $dimensions;
        die "multi-level mazes not (yet) supported"
          if @$dimensions > 2 && $dimensions->[2] > 1;
    }

    my $maze = Games::Maze->new(@_);
    $maze->make;

    # these gymnastics make maneuvering through the maze really,
    # really easy.

    my @grid =
      map {
        s/\s+$//;
        s/ /0/g;
        [ _tighten( split '', $_ ) ]
      }
      split "\n", $maze->to_ascii;

    my $east_west;

    # find the opening and close it
    foreach my $i ( 0 .. $#{ $grid[0] } ) {
        if ( $grid[0][$i] ) {
            $grid[0][$i] = 0;
            $east_west = $i;
            last;
        }
    }

    bless {
        maze    => $maze,
        grid    => \@grid,
        has_won => 0,
        facing  => 'south',

        east_west   => $east_west,    # X coordinates
        north_south => 1,             # Y coordinates

        cols => ( @grid - 1 ) / 2,
        rows => ( @{ $grid[0] } - 1 ) / 2,
    } => $class;
}

sub _tighten {
    my @list = @_;
    my @new_list;
    for ( my $i = 0 ; $i < @list ; $i += 3 ) {
        push @new_list, map { $_ ? 0 : 1 } @list[ $i, $i + 1 ];
    }
    pop @new_list;    # get rid of the undef at the end
    @new_list;
}

##############################################################################


my $WALLS = qr/[-:|]/;

sub to_ascii {
    my $self = shift;
    my $maze = $self->{maze};
    my ( @ascii, $ascii );
    if (wantarray) {
        @ascii = $maze->to_ascii;
        return map { s/$WALLS/./g; $_ } @ascii;
    }
    else {
        $ascii = $maze->to_ascii;
        $ascii =~ s/$WALLS/./g;
        return $ascii;
    }
}

##############################################################################


sub location {
    my ( $self, $x, $y ) = @_;
    if ( grep { !defined || !/^\d+/ } ( $x, $y ) ) {
        die "Arguments to location must be positive integers";
    }
    if ( $x > $self->{cols} ) {
        die "x value out of range";
    }
    if ( $y > $self->{rows} ) {
        die "y value out of range";
    }
    $_ = ( $_ * 2 ) + 1 foreach $x, $y;
    $self->{east_west}   = $x;
    $self->{north_south} = $y;
    return $self;
}

##############################################################################


sub x { ( $_[0]{east_west} - 1 ) / 2 }

##############################################################################


sub y { ( $_[0]{north_south} - 1 ) / 2 }

##############################################################################


sub rows { $_[0]{rows} }

##############################################################################


sub cols { $_[0]{cols} }

##############################################################################


sub columns { $_[0]{cols} }

##############################################################################


sub north {
    my $self = shift;
    return $self->{grid}[ $self->{north_south} + NORTH_WALL ]
      [ $self->{east_west} ];
}

##############################################################################


sub go_north {
    my $self = shift;
    return unless $self->north;
    $self->{facing} = 'north';
    $self->{north_south} += MOVE_NORTH;
    return $self;
}

##############################################################################


sub south {
    my $self = shift;
    return $self->{grid}[ $self->{north_south} + SOUTH_WALL ]
      [ $self->{east_west} ];
}

##############################################################################


sub go_south {
    my $self = shift;
    return unless $self->south;
    $self->{facing} = 'south';
    $self->{north_south} += MOVE_SOUTH;
    $self->{has_won} = 1 if $self->{north_south} >= @{ $self->{grid} };
    return $self;
}

##############################################################################


sub west {
    my $self = shift;
    return $self->{grid}[ $self->{north_south} ]
      [ $self->{east_west} + WEST_WALL ];
}

##############################################################################


sub go_west {
    my $self = shift;
    return unless $self->west;
    $self->{facing} = 'west';
    $self->{east_west} += MOVE_WEST;
    return $self;
}

##############################################################################


sub east {
    my $self = shift;
    return $self->{grid}[ $self->{north_south} ]
      [ $self->{east_west} + EAST_WALL ];
}

##############################################################################


sub go_east {
    my $self = shift;
    return unless $self->east;
    $self->{facing} = 'east';
    $self->{east_west} += MOVE_EAST;
    return $self;
}

##############################################################################


sub surroundings {
    my $self         = shift;
    my $surroundings = '';
    for my $y ( -1 .. 1 ) {
        for my $x ( -1 .. 1 ) {
            $surroundings .= $self->{grid}[ $self->{north_south} + $y ]
              [ $self->{east_west} + $x ]
              ? ' '
              : '.';
        }
        $surroundings .= "\n";
    }
    return $surroundings;
}

##############################################################################


sub directions {
    my $self = shift;
    return grep { $self->$_ } qw/north south east west/;
}

##############################################################################


sub has_won { $_[0]{has_won} }

##############################################################################


sub facing { $_[0]{facing} }


1;