棒倒し法

use strict;
use warnings;
use utf8;
use feature "switch";

# map 生成
my @map;
my $MAP_SIZE = 35;

my $iter = sub {
    my $code = shift;
    my $max = $MAP_SIZE;

    my $num = 0;
    for my $y ( 0 ..  $max  ) {
        for my $x ( 0 .. $max ) {
            $code->($x,$y,$num++,$max);
        }
    }

};

$iter->(sub{
    my ($x,$y,$num,$max) = @_;
    $map[$x][$y] = {
        wall => ( $x == 0 or $x == $max or $y == 0 or $y == $max ) ? 1 : 0, 
        poll => (
            ( $x != 0 && $y != 0 && $x != $max && $y != $max )
            &&
            ( not $x % 2 ) 
            && 
            ( not $y % 2 )
        ) ? 1 : 0 ,
        num  => $num++,
    };
});

my $show = sub {

    $iter->(sub{
        my ($x,$y,$num,$max) = @_;

        if( $map[$x][$y]->{wall} or $map[$x][$y]->{poll} or $map[$x][$y]->{new_poll} ) {
            printf("[X]");
        }
        else {
#            printf("[%s/%s]",$x,$y);
            print "[ ]";
        }

        if( $max == $x ) { print "\n" }
    });
};

my $get_way = sub {
    my $num = int rand(4);

    ( $num == 3 ) ? 'north' :
    ( $num == 2 ) ? 'south' :
    ( $num == 1 ) ? 'east'  : 'west';
};

my $get_x_y = sub {
    my ($x,$y,$way) = @_;

    ( $way eq 'north' ) ? ($x , $y - 1) :
    ( $way eq 'south' ) ? ($x , $y + 1) :
    ( $way eq 'east'  ) ? ($x - 1 , $y) : ( $x + 1, $y);
};

$iter->(sub{
    my ($x,$y,$num,$max) = @_;
    if( $map[$x][$y]->{poll} ) {
        my $end_fg = 0;
        while( not $end_fg ) {
            my $way = $get_way->();
            my ($new_y,$new_x) = $get_x_y->($x,$y,$way);
            next if( $y == 2 && $way eq 'north');
            unless( $map[$new_y][$new_x]->{new_poll} ) {
                $map[$new_y][$new_x]->{new_poll} = 1;
                $end_fg = 1;
            }
        }
    }
        
});

$show->();