#!/usr/local/bin/perl use strict; package Maze; $Maze::VERSION = "1.01"; =head1 NAME Maze.pm - Simple rectangular mazes =head1 AUTHOR David M. Chess, chess@theogeny.com =head1 SYNOPSIS use strict; use Maze; srand(); # The module doesn't do any seeding itself # create a simple maze, twelve corridors high and eight wide my $maze = new Maze(12,8); # Display it as ASCII art print $maze->display_ascii(); # Or as a bunch of IMG tags (images in ../gifs/) my $tags = $maze->display_html("../gifs/"); =head1 HISTORY 2000/12/18 - First release version, 1.00 2000/12/19 - Allow specifying where the images are, 1.01 =cut 1; =head1 Creating a new object =head2 my $maze = new Maze($height,$width); returns a new maze object of the given height and width (in "corridor" units). =cut sub new { my $class = shift; my ($h,$w) = @_; my $self = {}; bless $self, $class; $self->{width} = $w; $self->{height} = $h; # You can fiddle with these if you like; these # seem like pretty good values, though. See # the try_wall() sub for what they do. $self->{random_stop} = 0.5; $self->{stop_spawning} = 0.6; $self->_init(); $self->fill; return $self; } =head1 Rendering the maze =head2 print $maze->display_ascii(); returns a string representing the maze as a primitive bit of ASCII art, as in: *--*--*--*--* * | | * *--*--*--* * | | | | *--* * * *--* | | | * *--*--*--*--* =cut sub display_ascii { my $self = shift; my $answer = " "; for my $h (0..($self->{height}-1)) { for my $w (0..($self->{width}-1)) { # The acrosses $answer .= "*"; $answer .= ($self->{data}->[$h][$w]->{right}) ? "--" : " "; } $answer .= "*\n "; for my $w (0..($self->{width}-1)) { # The downs $answer .= ($self->{data}->[$h][$w]->{down}) ? "| " : " "; } $answer .= ($self->{data}->[$h][$self->{width}]->{down}) ? "| " : " "; $answer .= "\n "; } for my $w (0..($self->{width}-1)) { # The acrosses $answer .= "*"; $answer .= ($self->{data}->[$self->{height}][$w]->{right}) ? "--" : " "; } $answer .= "*\n "; return $answer; } =head2 print $maze->display_html($gif_prefix); returns a string representing the maze as a bunch of HTML "IMG" tags. The tags returned will reference images called "post.gif" (used for the "posts" where walls come together), "vwall.gif" (a vertical wall), "hwall.gif" (a horizontal wall), "vopen.gif" (a vertical open space, where there isn't a wall), "hopen.gif" (a horizontal open space, where there isn't a wall), and "hall.gif" (the open areas between potential walls). All image names will be prefixed with the given prefix, if given. post.gif, vwall.gif and vopen.gif should all be the same width. hall.gif, hwall.gif and hopen.gif should all be the same width. post.gif, hwall.gif and hopen.gif should all be the same height. hall.gif, vwall.gif and vopen.gif should all be the same height. Got all that? =cut sub display_html { my $self = shift; my $pref = shift || ""; my $answer = ""; for my $h (0..($self->{height}-1)) { for my $w (0..($self->{width}-1)) { # The acrosses $answer .= ""; $answer .= ($self->{data}->[$h][$w]->{right}) ? "" : ""; } $answer .= "
\n"; for my $w (0..($self->{width}-1)) { # The downs $answer .= ($self->{data}->[$h][$w]->{down}) ? "" : ""; $answer .= ""; } $answer .= ($self->{data}->[$h][$self->{width}]->{down}) ? "" : ""; $answer .= "
\n"; } for my $w (0..($self->{width}-1)) { # The acrosses $answer .= ""; $answer .= ($self->{data}->[$self->{height}][$w]->{right}) ? "" : ""; } $answer .= "
\n"; return $answer; } ################ Package-internal routines from here on down ############ # # Set the maze to an empty box with only exterior walls # sub _init { my $self = shift; for my $h (0..($self->{height})) { for my $w (0..($self->{width})) { $self->{data}->[$h][$w] = { right => (($h==0) or ($h==$self->{height})) ? 1 : 0, down => (($w==0) or ($w==$self->{width})) ? 1 : 0, touched => (($h==0) or ($h==$self->{height}) or ($w==0) or ($w==$self->{width})) ? 1 : 0, } } } } # # Put random interior walls into the maze in a quasi-clever fashion # sub fill { my $self = shift; # First make one directed crossing interior wall in each direction. # This prevents the maze from being utterly trivial by accident. $self->try_wall(1+int rand ( $self->{height}-1 ) , 0, 0, 0, 1); $self->try_wall(1+int rand ( $self->{height}-1 ) , $self->{width}, 0, 0, -1); # Next make a list of all (non-corner) posts on the outer walls my $posts = []; for (1..($self->{height}-1)) { push @$posts, [$_,0]; push @$posts, [$_,$self->{width}]; } for (1..($self->{width}-1)) { push @$posts, [0,$_]; push @$posts, [$self->{height},$_]; } # Shuffle the list fisher_yates_shuffle($posts); # And see about generating an interior wall from each one for (@$posts) { $self->try_wall(@$_,0); } # Lastly, connect up any remaining untouched interior posts. # By always connecting an untouched post to a touched one, we # avoid having any interior "islands" that make the maze too easy. my $moretodo = 1; for (;$moretodo;) { $moretodo = 0; for my $h (0..$self->{height}) { for my $w (0..$self->{width}) { next if $self->{data}->[$h][$w]->{touched}; my $candidates = []; for ( ([0,1],[1,0],[0,-1],[-1,0]) ) { push @$candidates, $_ if ( $self->{data}->[$h+$_->[0]][$w+$_->[1]]->{touched} ); } if (not scalar @$candidates) { $moretodo = 1; next; } my @vector = @{$candidates->[int rand(scalar @$candidates)]}; $self->connect($h,$w,@vector); } } } # Finally make the openings. This could be more random. $self->{data}->[0][$self->{width}-1]->{right} = 0; $self->{data}->[$self->{height}][0]->{right} = 0; } # # Recursively grow a wall from # the given point. # The third argument is a generation counter, # and the fourth and fifth arguments are a preferred-direction vector; # if they are defined, the wall will never move opposite that # direction (although some of its secondary children might). # sub try_wall { my $self = shift; my ($h,$w,$n,$dh,$dw) = @_; return if ($n>0 and rand()<$self->{random_stop} and not defined $dh); return if ( (defined $dh) and ( ($h+$dh <= 0) or ($w+$dw <= 0) or ($h+$dh >= $self->{height}) or ($w+$dw >= $self->{width}) ) ); my $candidates; my @vector; for (;;) { $candidates = []; for ( ([0,1],[1,0],[0,-1],[-1,0]) ) { push @$candidates, $_ if ( ($self->available($h+$_->[0],$w+$_->[1])) and ( (not defined $dh) or ($_->[0]*$dh==0) or ($dh == $_->[0]) ) and ( (not defined $dw) or ($_->[1]*$dw==0) or ($dw == $_->[1]) ) ); } return if not scalar @$candidates; @vector = @{$candidates->[int rand(scalar @$candidates)]}; $self->connect($h,$w,@vector); $self->try_wall($h+$vector[0],$w+$vector[1],$n+1,$dh,$dw); undef $dw; undef $dh; return if rand()<$self->{stop_spawning}; } } # # Do the given h and w specify an untouched post in the maze? # sub available { my $self = shift; my ($h,$w) = @_; return 0 if $h < 0; return 0 if $w < 0; return 0 if $h > $self->{height}; return 0 if $w > $self->{width}; return 0 if $self->{data}->[$h][$w]->{touched}; return 1; } # # Connect the given post to the post in the given direction away from # it. Mark both posts as touched, and set the down or right bit that # corresponds to the new connection. # sub connect { my $self = shift; my ($h,$w,$dh,$dw) = @_; if ($dh==1) { $self->{data}->[$h][$w]->{down} = 1; } elsif ($dw==1) { $self->{data}->[$h][$w]->{right} = 1; } elsif ($dh==-1) { $self->{data}->[$h-1][$w]->{down} = 1; } elsif ($dw==-1) { $self->{data}->[$h][$w-1]->{right} = 1; } $self->{data}->[$h+$dh][$w+$dw]->{touched} = 1; $self->{data}->[$h][$w]->{touched} = 1; } # fisher_yates_shuffle( \@array ) : # generate a random permutation of @array in place; from the Camel book sub fisher_yates_shuffle { my $array = shift; my $i; for ($i = @$array; --$i; ) { my $j = int rand ($i+1); next if $i == $j; @$array[$i,$j] = @$array[$j,$i]; } }