package Park;
use strict;
use vars qw/$PARK $BUILDING/;

=comments

This is an implementation of the November Dr Dobbs puzzle
[Dr Ecco's Omniheurist Corner]

It implements the park grid, and performs the spreading of
development every bump

=cut

$PARK = 'P';
$BUILDING = 'B';

my $GRID_HEIGHT = 12;
my $GRID_WIDTH = 12;

sub new {
    my $class = shift;
    my %args = (height => $GRID_HEIGHT,
        width => $GRID_WIDTH,
        setup => 'default', # default, empty
        @_);

    my $self = bless \%args, $class;

    if ($self->{height} <= 0 || $self->{width} <= 0) {
    die "Illegal size for height or width";
    }

    # initialize our variables
    $self->{bumps} = 0; # our count of time
    $self->{houses} = 0; # count of houses
    $self->{parks} = 0; # count of parks
    $self->{parcels} = $self->{height} * $self->{width};
    my $grid = [];
    for (my $i = 0; $i < $self->{height}; $i++) {
    my $row = [];
    for (my $j = 0; $j < $self->{width}; $j++) {
        push @$row, ' ';
    }
    push @$grid, $row;
    }
    $self->{grid} = $grid;

    my $setup = delete $self->{setup};
    if ($setup eq 'default') {
    $self->build(3,3);
    $self->build(3,4);
    $self->build(9,9);
    $self->build(8,9);
    } elsif ($setup ne 'empty') {
    die "Illegal parameter for setup of '$setup'";
    } # else empty

    return $self;
}

sub free_parcels { # how many parcels are neither park nor built?
    my $self = shift;

    return ($self->{parcels} - $self->{houses} - $self->{parks});
}
    
sub build { # put a building on a lot
    my $self = shift;
    my ($x, $y) = @_;

    $self->{houses}++; # we don't check the previous state
    return $self->{grid}->[$x]->[$y] = $BUILDING;
}

sub park { # put a park on a lot
    my $self = shift;
    my ($x, $y) = @_;
    
    $self->{parks}++; # we don't check the previous state
    return $self->{grid}->[$x]->[$y] = $PARK;
}

sub grid { # get the value of a particular spot
    my $self = shift;
    my ($x, $y) = @_;
    if ($x < 0 || $x > ($self->{height} -1) || $y < 0 || $y > ($self->
+{width} -1)) {
    return undef;
    }

    return $self->{grid}->[$x]->[$y];
}

sub str_status { # string of current stats
    my $self = shift;

    return sprintf("%d turns, %d parks, %d/%d houses built",
           $self->{bumps},
           $self->{parks},
           $self->{houses},
           $self->{parcels},
           );
}

sub str_grid { # string of ASCII grid
    my $self = shift;

    my $str = '';
    my $bar;
    for ((-1..$self->{width})) { $bar .= '-'; }
    $bar .= "\n";
    $str .= $bar;
    for (my $i = 0; $i < $self->{height}; $i++) {
    $str .= '|';
    for (my $j = 0; $j < $self->{width}; $j++) {
        $str .= $self->grid($i, $j);
    }
    $str .= "|\n";
    }
    $str .= $bar;
    return $str;
}

sub bump { # increase the time by one, 
    my $self = shift;

    my @coords;
    for (my $i = 0; $i < $self->{height}; $i++) {
    for (my $j = 0; $j < $self->{width}; $j++) {
        if ($self->needs_building($i, $j)) {
        push @coords, ($i, $j);
        }
    }
    }
    while (@coords) {
    my ($x, $y) = splice(@coords, 0, 2);
    $self->build($x, $y);
    }

    $self->{bumps}++;
}

sub bump_and_run { # bump until completion
    my $self = shift;
    my $last = -1;
    while ($self->free_parcels != 0 && $self->free_parcels != $last) {
    $last = $self->free_parcels;
    $self->bump;
    }
}

# This routine could use lots of optimization
sub needs_building { # has two neighbors that are built
    my $self = shift;
    my ($x, $y) = @_;

    my $current = $self->grid($x, $y);

    return 0 if ($current eq $PARK || $current eq $BUILDING);

    my @coords = ($x    , $y + 1,
          $x - 1, $y + 1,
          $x + 1, $y + 1,
          $x + 1, $y,
          $x - 1, $y,
          $x    , $y - 1,
          $x - 1, $y - 1,
          $x + 1, $y - 1,
          );

    my $neighbor_cnt = 0;
    while (@coords) {
    my ($i, $j) = splice(@coords, 0, 2);
    $neighbor_cnt += ($self->grid($i, $j) eq $BUILDING && 1);
    }

    return ($neighbor_cnt >= 2 && 1);
}

sub spoiler1 { # solution to the first (simple) puzzle
    my $p = shift;
    $p->park(11, 6);
    $p->park(10, 5);
    $p->park(9, 4);
    $p->park(9, 3);
    $p->park(9, 2);
}

1;
[download]