###################################################################################
# life.pl
# A Perl/Tk-based "Game of Life" according to John Conway v. 1.3b
# (c) 2008-2013 by Ingram Braun (http://www.ingram-braun.net/)
###################################################################################
#!/usr/bin/perl
-wT;
use strict;
use FileHandle;
use Tk;
use Tk::FileSelect;
use Tk::Pane;

###################################################################################
# Declare global variables and call main loop.
###################################################################################
my (@matrix);
my @birth = (0, 0, 0, 1, 0, 0, 0, 0, 0);  # true if $birth[Number of living neighbours] == 1.
my @survive = (0, 0, 1, 1, 0, 0, 0, 0, 0); # true if $survive[Number of living neighbours] == 1.
my $delay = 5; # Delay between matrix updates in 1/10 sec.
my $sync = 1; # Cell updates (1 = syncronously, 0 = successively)
my $shape = 1; # Matrix shape (1 = torus, 0 = rectangular)
my $percent = 40; # Probability of living cells in start matrix.
my $scale = 12; # Width and height of cell (px).
my $grid = 'groove'; # Display mode of Grid (Tk edge);
my $x = 40; # Number of cells on the x-axis.
my $y = 40; # Number of cells on the y-axis.
my $manual = 0; # Fill matrix by random generator (0) or mnanually (1).
my $VERSION = '1.3b';
my $title = 'Conway\'s "Life" v.'.$VERSION.' by Ingram Braun (http://www.ingram-braun.net/)';
InitGeometry();
InitMatrix();
CallSimulation();
MainLoop;

###################################################################################
# Configuration window
###################################################################################
sub InitGeometry {
	my $mw = MainWindow->new;
	$mw->title($title);
	$mw->Label(-text => "Set up configuration")->pack(-side => 'top');
	$mw->Scale(-orient => 'horizontal', -length => 500,
		-label => "Length of rows (cells)", -variable => \$x, -from => 10, -to => 100)->pack;
	$mw->Scale(-orient => 'vertical', -length => 400, 
		-label => "Length of columns (cells)", -variable => \$y, -from => 10,
		-to => 75)->pack(-side => 'left');
	$mw->Scale(-orient => 'horizontal', -length => 200,
		-label => "Length of cells (pixel)", -variable => \$scale, -from => 3, -to => 25)->pack;
	$mw->Scale(-orient => 'horizontal', -length => 200,
		-label => "Window update delay (1/10 sec)", -variable => \$delay, -from => 1, -to => 30)->pack;
	$mw->Button(-text => "Continue", -command => sub {$mw->destroy()},
		)->pack(-side => 'bottom', -anchor => 's');
	my $frame1 = $mw->Frame(-borderwidth => 2)->pack;
	my $frame4 = $frame1->Frame(-borderwidth => 2, -relief => 'groove')->pack(-side => 'left', -anchor => 'e');
	my $frame5 = $frame1->Frame(-borderwidth => 2, -relief => 'groove')->pack(-side => 'left', -anchor => 'e');
	$frame4->Label(-text => 'Initial state')->pack(-side => 'top', -anchor => 'w');
	$frame4->Radiobutton(-text => "Random", -value => 0,
		-variable => \$manual)->pack(-side => 'bottom', -anchor => 'w');
	$frame4->Radiobutton(-text => "Manual", -value => 1,
		-variable => \$manual)->pack(-side => 'bottom', -anchor => 'w');
	$frame4->Radiobutton(-text => "Upload", -value => 2,
		-variable => \$manual)->pack(-side => 'bottom', -anchor => 'w');
	$frame5->Checkbutton(-text => "Show grid", -variable => \$grid,	-onvalue => 'groove',
		-offvalue => 'flat')->pack(-side => 'bottom', -anchor => 'w');
	$frame5->Checkbutton(-text => "Torus shaped matrix", -variable => \$shape
		)->pack(-side => 'bottom', -anchor => 'w');
	$frame5->Checkbutton(-text => "Synchronous matrix updates", -variable => \$sync
		)->pack(-side => 'bottom', -anchor => 'w');
	my $frame2 = $frame1->Frame(-label => "Birth", -borderwidth => 2, -relief => 'groove'
		)->pack(-side => 'left', -anchor => 'e');
	for (my $i = 8; $i >= 0; $i--) {
		$frame2->Checkbutton(-text => "$i", -variable => \$birth[$i]
		)->pack(-side => 'bottom', -anchor => 'w');}
	my $frame3 = $frame1->Frame(-label => "Survival", -borderwidth => 2, -relief => 'groove'
		)->pack(-side => 'left', -anchor => 'e');
	for (my $i = 8; $i >= 0; $i--) {
		$frame3->Checkbutton(-text => "$i", -variable => \$survive[$i]
		)->pack(-side => 'bottom', -anchor => 'w');}
	$mw->waitWindow();}

###################################################################################
# Matrix initialization:a matrix with n squares is a list { 0, 1, ..., n-1}.
# Edge squares are to be found by calculation.
# 1 = living; 0 = dead.
# Uploaded files are simply text files representing a condition by a single
# character: 1100001110110000 etc. Missing conditions are 0, superflous ones are
# simply ignored. No line breaking allowed.
###################################################################################
sub InitMatrix {
	for (my $i = 0; $i < $x * $y; $i++) {$matrix[$i] = 0;}
	my $mw = MainWindow->new;
	$mw->title($title);
	my $frame = $mw->Frame()->pack(-side => 'top');;
	my $button = $frame->Button(-text => "Continue", -command => sub {$mw->destroy()},
		)->pack(-side => 'bottom');
	if ($manual == 0) {
		my $count1 = 0; my $count2 = 0;
		$frame->Scale(-orient => 'horizontal', -variable => \$percent, -from => 1, -to => 99,
			-label => "% living cells", -length => 200)->pack(-side => 'left');
		$mw->waitWindow();      # otherwise $percent is updated too early
		srand();
		$percent *= int $x * $y / 100;
		while ($count1 < $percent) {
			if ($matrix[$count2] == 0) {
				if ($percent > int(rand($x * $y))) {
					$matrix[$count2] = 1;
					$count1++;}}
			if ($count2 < $#matrix) {$count2++;}
			else {$count2 = 0;}}}
	elsif ($manual == 1) {
		my $width = 20; my $col = $width; my $row = 0; my @box;
		$mw->Label(-text => "Mark living cells"
		   )->pack(-side => 'top', -anchor => 's');
		$frame->Button(-text => "Save", -command => sub {
			my $fs = $mw->FileSelect();
			my $file = $fs->Show;
			my $fh = FileHandle->new("> $file");
			if (defined $fh) {
        print $fh join('',@matrix);
        $fh->close;}},
		)->pack(-side => 'left');
		my $frame = $mw->Scrolled('Pane', -scrollbars => 'ose', -width => 500, -height => 500
			)->pack(-side => 'bottom');
		for (my $i = 0; $i < $x * $y; $i++) {
			$col++;
			if ($i % $x == 0) {$col = 0; $row++;}
			$box[$i] = $frame->Checkbutton(-variable => \$matrix[$i], -text => $col.'/'.($row-1),
				-relief => 'groove')->grid(-row => $row, -column => $col);}
		$mw->waitWindow();}
	else {
		$button->destroy();
		my @in;
		my $fs = $mw->FileSelect();
		my $file = $fs->Show;
		$mw->destroy();
		my $fh = FileHandle->new;
    if ($fh->open("< $file")) {
        @in = split(//,<$fh>);
        $fh->close;}
		print @in;
		for (my $i = 0; $i < $x * $y; $i++) {
			if ($i <= $#in) {$matrix[$i] = $in[$i];}
			else {$matrix[$i] = 0;}}}}

###################################################################################
# Simulation window
###################################################################################
sub CallSimulation {
	my $mw = MainWindow->new;
	$mw->title($title);
	my $counter = 0; my $col = 0; my $row = 0; my $run = 0;
	my $living = CountLivingCells(); my (@box, $colour);
	my $livperc = PercentLivingCells();
	my $break = 0;
	$mw->title($title);
	my $frame1 = $mw->Frame()->pack(-side => 'left');
	my $frame2 = $mw->Frame()->pack(-side => 'right');
	my $frame3 = $frame2->Frame()->pack(-side => 'top');
	my $frame4 = $frame2->Frame()->pack(-side => 'top');
	my $break_button = $frame4->Button(-text => "Break", -command => sub{
		if (!$break) {$break = 1;}
		else {
			$break = 0;}})->pack(-side => 'left');
	my $frame5 = $frame3->Frame()->pack(-side => 'top');
	my $frame6 = $frame3->Frame()->pack(-side => 'top');
	my $frame7 = $frame3->Frame()->pack(-side => 'top');
	my $frame8 = $frame3->Frame()->pack(-side => 'top');
	$frame4->Button(-text => "Exit", -command => sub{ exit }
		)->pack(-side => 'left');
	$frame5->Label(-text => 'World:',-anchor => 'w')->pack(-side => 'left');
	my $display0 = $frame5->Label(-text => GetWorldString(),-anchor => 'w'
		)->pack(-side => 'left');
	$frame6->Label(-text => 'Generation:',-anchor => 'w')->pack(-side => 'left');
	my $display1 = $frame6->Label(-textvariable => \$run,-anchor => 'w'
		)->pack(-side => 'left');
	$frame7->Label(-text => 'Living cells:',	-anchor => 'w')->pack(-side => 'left');
	my $display2 = $frame7->Label(-textvariable => \$living,	-anchor => 'w'
		)->pack(-side => 'left');
	$frame8->Label(-text => '% living cells:', -anchor => 'w')->pack(-side => 'left');
	my $display3 = $frame8->Label(-textvariable => \$livperc,
		-anchor => 'w')->pack(-side => 'left');
	$frame3->Label(-text => "\t\t\t\t\t",-anchor => 'w')->pack(-side => 'top');
	for (my $i = 0; $i < $x * $y; $i++) {
		$col++;
		if ($i % $x == 0) {$col = 0; $row++;}
		if ($matrix[$i] == 0) {$colour = 'white';}
		else {$colour = 'black';}
		$box[$i] = $frame1->Frame(-bg => 'grey', -borderwidth => 1, -relief => $grid, -width 
		=> $scale, -height => $scale, -bg => $colour)->grid(-row => $row, -column => $col, -sticky => 'nsew');}
	$box[-1]->waitVisibility();
	$frame1->repeat($delay * 100, sub {
		if (!$break) {
			UpdateMatrix();
			$run++;
			for (my $i = 0; $i < $x * $y; $i++) {
				if ($matrix[$i] == 0) {$colour = 'white';}
				else {$colour = 'black';}
				if ($box[$i]->cget(-bg) ne $colour) {$box[$i]->configure(-bg => $colour);}}
			$break_button->configure(-text => 'Break');
			$living = CountLivingCells();
			$livperc = PercentLivingCells();}
		else {$break_button->configure(-text => 'Continue');}})}

###################################################################################
# Set up cell by evaluating neighbours.
# Parameter is index of cell.
# This function can handle more then two cell conditions.
###################################################################################
sub UpdateMatrix {
	my @buffer = @matrix;       # Matrix manipulation is carried out in a buffer
	for (my $i = 0; $i <= $#matrix; $i++) {
		my @neighbours = ReturnNeighbours($i);
		my %cond;
		foreach (@neighbours) {$cond{$matrix[$_]}++;}
		($sync == 0) ? $matrix[$i] = Rule($i, \%cond) : $buffer[$i] = Rule($i, \%cond);}
	if ($sync == 1) {@matrix = @buffer;}}

###################################################################################
# This function needs a cell index and returns a list of all its neighbours.
###################################################################################
sub ReturnNeighbours {
	my $p = shift;
	my @return;
	if ($shape == 1) {
		if (1 == Top($p)) {
			push @return, $p+($y-1)*$x;
			if (1 == Right($p)) {push @return, ($p+($y-2)*$x+1, $p+($y-1)*$x-1, $p+1, $p-$x+1);}
			elsif (1 == Left($p)) {push @return, ($p+$y*$x-1, $p+($y-1)*$x+1, $p+2*$x-1, $p+$x-1);}
			else {push @return, ($p+($y-1)*$x-1,$p+($y-1)*$x+1);}}
		elsif (1 == Bottom($p)) {
			push @return, $p-($y-1)*$x;
			if (1 == Right($p)) {push @return, ($p-2*$x+1, $p-($y-1)*$x-1, $p-$x*$y+1, $p-$x+1);}
			elsif (1 == Left($p)) {push @return, ($p-($y-2)*$x-1, $p-($y-1)*$x+1, $p-1, $p+$x-1);}
			else {push @return, ($p-($y-1)*$x-1, $p-($y-1)*$x+1);}}
		elsif (1 == Right($p)) {push @return, ($p-$x+1, $p-2*$x+1, $p+1);}
		elsif (1 == Left($p)) {push @return, ($p+$x-1, $p-1, $p+2*$x-1);}
		else {}}
	if (0 == Top($p) && 0 == Right($p)) {push @return, $p-$x+1;}
	if (0 == Top($p) && 0 == Left($p)) {push @return, $p-$x-1;}
	if (0 == Bottom($p) && 0 == Left($p)) {push @return, $p+$x-1;}
	if (0 == Bottom($p) && 0 == Right($p)) {push @return, $p+$x+1;}
	if (0 == Top($p)) {push @return, $p-$x;}
	if (0 == Bottom($p)) {push @return, $p+$x;}
	if (0 == Right($p)) {push @return, $p+1;}
	if (0 == Left($p)) {push @return, $p-1;}
	return @return;}

###################################################################################
# This function tests if a particular cell meets a rule.
# Needs: cell index and a hash (condition => number of cases}
# Returns next cell state.
# Changed rules must be programmed here.
###################################################################################
sub Rule {
	if ($matrix[$_[0]] == 0 && $birth[$_[1]->{1}] == 1) {return 1;}
	elsif ($matrix[$_[0]] == 1 && $survive[$_[1]->{1}] == 1) {return 1;}
	else {return 0};}

###################################################################################
# Returns number of living cells.
###################################################################################
sub CountLivingCells {
	my $counter = 0;
	foreach (@matrix) {$counter += $_;}
	return $counter;}

###################################################################################
# Returns percentage of living cells.
###################################################################################
sub PercentLivingCells() {return(sprintf("%.2f",(CountLivingCells()/($#matrix+1)*100)));}

###################################################################################
# These subroutines take a cell index and tests on them being edge.
# Return 1 if an edge cell, otherwise 0.
###################################################################################
sub Top {($_[0] < $x) ? return 1 : return 0;}
sub Bottom {($_[0] > $x * ($y - 1) - 1) ? return 1 : return 0;}
sub Left{($_[0] % $x == 0) ? return 1 : return 0;}
sub Right {($_[0] % $x == $x - 1) ? return 1 : return 0;}

###################################################################################
# Returns the current world as string.
###################################################################################
sub GetWorldString {
	my $string;
	for(my $i = 0; $i <= $#survive; $i++) {$string .= $i if $survive[$i] == 1;}
	$string .= '/';
	for(my $i = 0; $i <= $#birth; $i++) {$string .= $i if $birth[$i] == 1;}
	if ($shape == 1) {$string .= ' torus';}
	else {$string .= ' rectangular';}
	return $string . ' (' . $x . ' x ' . $y . ')';}

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

Educational

=head1 NAME

F<life_1_3b.pl>

=head1 DESCRIPTION

This script implements a Game of Life according to John Conway. Matrix size as well as birth and survival rules are editable. The initial state can be set up by random generator or manually.

=head1 SYNOPSIS

C<% life_1_3a.pl>

=head1 PREREQUISITES

This script requires the C<strict> and the C<FileHandle> modules. It also requires
C<Tk> including C<Tk::Pane> and C<Tk::FileSelect>.

=head1 AUTHOR

Copyright 2008-2013 Ingram Braun <ibraun@cpan.org> and L<http://www.ingram-braun.net/>. All rights reserved.

This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
THIS SOFTWARE DOES NOT COME WITH ANY WARRANTY WHATSOEVER. USE AT YOUR OWN RISK.

=head1 CHANGELOG

=head2 2.0:

Translated script into JavaScript library in order to include it into my web page. Visit L<http://www.ingram-braun.net/public/research/demography-and-simulation/life/life_intro/>.

=head2 1.3b:

URL corrected.

This is the final Perl release!

=head2 1.3a:

Cleaned up code and changed documentation.

=head2 1.3:

Scrolling and numbering in manual matrix window added.

Uploading and saving matrices added.

=head2 1.2:

Added break button in simulation window.

Information rearranged and world displayed in simulation window.

Renamed $torus => $shape.

Print $VERSION in window title;

Typos corrected.

=head1 README

This script implements a Game of Life according to John Conway. Matrix size as well as birth and survival rules are editable. The initial state can be set up by random generator or manually.

An up to date perl distribution (5.6 or higher) and the Tk module is required.

Copyright 2008-2013 Ingram Braun http://www.ingram-braun.net/ and <ibraun@cpan.org>. All rights reserved.

Please note that the Perl version is discontinued as I translated it into JavaScript in order to put it on my web page. Visit http://www.ingram-braun.net/public/research/demography_and_simulation/life/life_intro/. 

This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
THIS SOFTWARE DOES NOT COME WITH ANY WARRANTY WHATSOEVER. USE AT YOUR OWN RISK.

=cut