Grokbase Groups Perl ai August 2001
FAQ
Hey all,

I hacked a very quick Perl/Tk version of Conway's Game of Life and thought
some of you might enjoy it.

--Ala

#!/usr/bin/perl -w

use strict;
use Tk;

use vars qw/$repeat/;

my $size = 20;

#############################
# START OF USER CUSTOMIZABLE VARIABLES
#############################

# Size of the grid.
my $rows = 30;
my $cols = 30;

# The rules. An anonymous array of 2 arrays.
# The rules are like this:
# [
# [ creation list ]
# [ survival list ]
# ]
#
# The creation list is a list of numbers from 0 to 8 inclusive.
# If the sum of living neighbours of any cell is in this list
# then this cell springs up to life in the next generation.
#
# The survival list is a list of numbers from 0 to 8 inclusive.
# If the sum of living neighbours of any cell is in this list
# and the cell is alive, then it will survive to the next generation.
#
# All other cells die in the next generation.

my $rules = [
[3],
[2, 3],
];

# Anonymous list or (row, column) coordinates of the starting
# pattern.

# Some boring test shape.
# my $start = [
# [4,3],
# [4,4],
# [4,5],
# [4,6],
# ];

# The infamous Glider!!
my $start = [
[1,2],
[2,3],
[3,1],
[3,2],
[3,3],
];
#############################
# START OF USER CUSTOMIZABLE VARIABLES
#############################

drawGUI($rows, $cols, $size, $rules, $start);

MainLoop;

sub drawGUI {
my ($rows,
$cols,
$size,
$rules,
$start,
) = @_;

my $mw = new MainWindow;
my $c = $mw->Canvas(-bg => 'black',
-width => $cols * $size,
-height => $rows * $size,
)->pack(qw/-side top/);

$mw->bind('<Any-Enter>', sub { $c->Tk::focus });

my $array = [];
for my $i (0 .. $rows - 1) {
$array->[$i] = [(0) x $cols];
}

# Draw the grid.
for my $i (0 .. $rows) {
$c->createLine(0, $i * $size,
$cols * $size, $i * $size,
-fill => 'white',
);
}

for my $i (0 .. $cols) {
$c->createLine($i * $size, 0,
$i * $size, $rows * $size,
-fill => 'white',
);
}

my $frame = $mw->Frame->pack(qw/-side top -expand 1
-fill both -padx 10 -pady 10/);

$frame->Button(
-text => 'Run',
-height => 3,
-command => [\&run, $array, $rules, $rows,
$cols, $size, $c],
)->pack(qw/side left -fill both -expand 1/);

$frame->Button(
-text => 'Exit',
-command => sub { exit },
)->pack(qw/side left -fill both -expand 1/);

# Fill in the starting pattern.
for my $x (@$start) {
fill($c, $size, @$x, $array);
}
}

sub run {
my ($array, $rules, $rows, $cols, $size, $c) = @_;

$repeat = $c->repeat(200, [\&step, $array, $rules,
$rows, $cols, $size, $c]);
}

sub step {
my ($array, $rules, $rows, $cols, $size, $c) = @_;

my ($fill, $unfill) = calc(
$array,
$rules,
$rows,
$cols,
);

if (!@$unfill and !@$fill) {
print "Done!\n";
$c->afterCancel($repeat);
}

fill ($c, $size, @$_, $array) for @$fill;
unfill($c, @$_, $array) for @$unfill;
$c->update;
}

sub fill {
my ($c,
$size,
$row,
$col,
$array,
) = @_;

$array->[$row][$col] = 1;
$c->createOval(
$col * $size, $row * $size,
($col + 1) * $size, ($row + 1) * $size,
-fill => 'red',
-tags => "$row-$col",
);
}

sub unfill {
my ($c, $row, $col, $array) = @_;

$c->delete("$row-$col");
$array->[$row][$col] = 0;
}

sub calc {
my ($array, $rules, $rows, $cols) = @_;

my (@fill, @unfill);

for my $r (0 .. $rows - 1) {
for my $c (0 .. $cols - 1) {
# Look at the neighbours.
my $sum = 0;

for my $n (
[$r - 1, $c - 1],
[$r - 1, $c ],
[$r - 1, $c + 1],
[$r , $c - 1],
[$r , $c + 1],
[$r + 1, $c - 1],
[$r + 1, $c ],
[$r + 1, $c + 1],
) {

$sum += $array->[$n->[0]][$n->[1]] if
$n ->[0] >= 0 && $n->[0] < $rows &&
$n->[1] >= 0 && $n->[1] < $cols;
}

if ($array->[$r][$c]) {
# will it survive?
unless (grep {$_ == $sum} @{$rules->[1]}) {
push @unfill => [$r, $c];
}
} else {
# will it get born?
if (grep {$_ == $sum} @{$rules->[0]}) {
push @fill => [$r, $c];
}
}
}
}

return (\@fill, \@unfill);
}

Search Discussions

Discussion Posts

Follow ups

Related Discussions

Discussion Navigation
viewthread | post
posts ‹ prev | 1 of 6 | next ›
Discussion Overview
groupai @
categoriesperl
postedAug 27, '01 at 3:41p
activeAug 29, '01 at 2:03a
posts6
users4
websiteperl.org

People

Translate

site design / logo © 2021 Grokbase