# SVG maze output # Handles the common code between Hex and RectHex mazes. package Games::Maze::SVG::HexCells; use base Games::Maze::SVG; use Carp; use Games::Maze; use strict; use warnings; =head1 NAME Games::Maze::SVG::HexCells - Base class for Hex and RectHex mazes. =head1 VERSION Version 0.72 =cut our $VERSION = 0.72; =head1 SYNOPSIS The class is intended to only be used as a base class. It should not instatiated directly. =cut use constant DELTA_X => 10; use constant DELTA_Y => 10; # ---------------- # Shape transformation tables # in-line # l r dl dr my %Blocks = ( ' _/ ' => 'tl', '_ \\' => 'tr', '\\_ ' => 'bl', '_/ ' => 'br', ' / \\' => 'cl', '\\ / ' => 'cr', '__ ' => 'hz', '_ ' => 'hzl', ' _ ' => 'hzr', '\\_/ ' => 'yr', '_/ \\' => 'yl', '\\ ' => 'slb', ' \\'=> 'slt', ' / ' => 'srb', ' / ' => 'srt', ' /' => 0, ' \\ ' => 0, '/ \\_' => 0, ' __' => 0, ' \\_/' => 0, ' \\ ' => 0, '/ ' => 0, ' \\_' => 0, ' _/' => 0, ' ' => 0, '/ \\ ' => 0, ' \\ /' => 0, '/ _' => 0, ' \\_ ' => 0, ' _' => 0, ' _ ' => 0, '/ ' => 0, ); # Between lines # l r dl dr my %BlocksBetween = ( ' /' => 'sr', ' \\_/' => 'sr', ' _/' => 'sr', ' \\ /' => 'sr', '_ \\' => 'sl', ' / \\' => 'sl', ' \\' => 'sl', '_/ \\' => 'sl', ' _/ ' => q{$}, ' \\ ' => q{$}, '/ \\_' => q{$}, '\\ / ' => q{$}, ' \\_' => q{$}, '/ \\ ' => q{$}, '\\_/ ' => q{$}, '__ ' => 0, ' __' => 0, ' ' => 0, '_/ ' => 0, '/ _' => 0, ' \\_ ' => 0, '\\ ' => 0, '_ ' => 0, ' _' => 0, ' _ ' => 0, ' _ ' => 0, '\\_ ' => 0, ' \\ ' => 0, ' / ' => 0, '/ ' => 0, ' / ' => 0, ); my %Walls = _get_wall_forms(); =head1 FUNCTIONS =cut # ---------------------------------------------- # Subroutines =over 4 =item new Create a new Games::Maze::SVG object. Supports the following named parameters: Takes one positional parameter that is the maze type: Rect, RectHex, or Hex =over 4 =item wallform String naming the wall format. Legal values are bevel, round, roundcorners, and straight. =item crumb String describing the breadcrumb design. Legal values are dash, dot, line, and none =item dx The size of the tiles in the X direction. =item dy The size of the tiles in the Y direction. =item dir Directory in which to find the ecmascript for the maze interactivity. Should either be relative, or in URL form. =back =cut sub new { my $class = shift; my $obj = { Games::Maze::SVG::init_object( @_ ), @_, }; if(!exists $Walls{$obj->{wallform}}) { my $forms = join( ", ", sort keys %Walls ); croak "\n'$obj->{wallform}' is not a valid wall form.\nTry one of: $forms\n\n"; } $obj->{mazeparms}->{cell} = 'Hex'; $obj->{scriptname} = "hexmaze.es"; $obj->{dx} = DELTA_X; $obj->{dy} = DELTA_Y; return bless $obj, $class; } =item set_wall_form Set the wall format for the current maze. =over 4 =item $form String specifying a wall format. =back Returns a reference to self for chaining. =cut sub set_wall_form { my $self = shift; my $form = shift; if(exists $Walls{$form}) { $self->{wallform} = $form; } else { my $forms = join( ", ", sort keys %Walls ); croak "\n'$form' is not a valid wall form.\nTry one of: $forms\n\n"; } return $self; } =item transform_grid Convert the hexagonal grid from ascii format to SVG definition references. =over 4 =item $rows Reference to an array of rows =item $walls String specifying wall format. (Unused at present.) =back =cut sub transform_grid { my $self = shift; my $rows = shift; my $walls = shift; my @out = (); # transform the printout into block commands my $height = @{$rows}; my $width = @{$rows->[0]}+2; for(my $r=0; $r < $height-1; ++$r) { # on line push @out, _calc_on_line( $rows, $r, $width ); # between push @out, _calc_between_line( $rows, $r, $width ); } push @out, _calc_on_line( $rows, $height-1, $width ); return @{$rows} = @out; } sub _calc_between_line { my $rows = shift; my $index = shift; my $width = shift; my @out = (); for(my $c = 0; $c < $width;++$c) { my $sig = ($c ? $rows->[$index][$c-1]||q{ } : q{ }) . ($rows->[$index][$c]||q{ }) . ($c ? $rows->[$index+1][$c-1]||q{ } : q{ }) . ($rows->[$index+1][$c]||q{ }); croak "Missing between block for '$sig'.\n" unless exists $BlocksBetween{$sig}; push @out, $BlocksBetween{$sig}; } return \@out; } sub _calc_on_line { my $rows = shift; my $index = shift; my $width = shift; my @out = (); for(my $c = 0; $c < $width;++$c) { my $sig = ($c ? $rows->[$index][$c-1]||q{ } : q{ }) . ($rows->[$index][$c]||q{ }) . ($c ? $rows->[$index+1][$c-1]||q{ } : q{ }) . ($rows->[$index+1][$c]||q{ }); croak "Missing block for '$sig'.\n" unless exists $Blocks{$sig}; push @out, $Blocks{$sig}; } return \@out; } =item wall_definitions Method that returns the definition for the shapes used to build the walls. =cut sub wall_definitions { my $self = shift; return $Walls{$self->{wallform}} } # _get_wall_forms # #Extract the wall forms from the DATA file handle. # #Returns a hash of wall forms. sub _get_wall_forms { local $/ = "\n===\n"; chomp( my @list = ); $/ = "\n"; chomp( @list ); return @list; } =item convert_start_position Convert the supplied x and y coordinates into the appropriate real coordinates for a start position on this map. =over 4 =item $x x coord from the maze =item $y y coord from the maze =back returns a two element list containing (x, y). =cut sub convert_start_position { my $self = shift; my ($x, $y) = @_; $x = 3*($x-1)+2; $y = 4*($y-1); return ($x, $y); } =item convert_end_position Convert the supplied x and y coordinates into the appropriate real coordinates for a end position on this map. =over 4 =item $x x coord from the maze =item $y y coord from the maze =back returns a two element list containing (x, y). =cut sub convert_end_position { my $self = shift; my ($x, $y) = @_; $x = 3*($x-1)+2; $y = 4*($y)+2; return ($x, $y); } =back =head1 AUTHOR G. Wade Johnson, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks go to Valen Johnson and Jason Wood for extensive test play of the mazes. =head1 COPYRIGHT & LICENSE Copyright 2004-2006 G. Wade Johnson, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; __DATA__ straight === === roundcorners === === round ===