File Coverage

blib/lib/Game/Life/Infinite/Board.pm

Criterion	Covered	Total	%
statement	415	522	79.5
branch	185	270	68.5
condition	49	78	62.8
subroutine	24	28	85.7
pod	17	22	77.2
total	690	920	75.0

#!/usr/bin/perl

package Game::Life::Infinite::Board;

use strict;
use warnings;
use Time::HiRes;
require 5.10.1;

BEGIN {
    use Exporter   ();
    use vars       qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
    $VERSION     = sprintf( "%d.%02d", q($Revision: 0.07 $) =~ /\s(\d+)\.(\d+)/ );
    @ISA         = qw(Exporter);
    @EXPORT_OK   = qw(format_is);
    %EXPORT_TAGS = ( );
}

sub new {
	my ( $class, $rulesRef, @args ) = @_;
	my $self = {};
	$self->{'maxx'} = $self->{'maxy'} = $self->{'minx'} = $self->{'miny'} = 0;	# Board boundaries.
	$self->{'gen'} = $self->{'liveCells'} = $self->{'usedCells'} = 0;
	$self->{'delta'} = -1;	# Number of cells that changed state since previous epoch (newborns+dead).
	$self->{'factor2'} = 1;
	$self->{'oscilator'} = 0; 		# If oscilator is detected, contains the period.
	$self->{'cells'} = {};
	$self->{'currentFn'} = 'Untitled.cells';
	$self->{'name'} = 'Untitled';
	$self->{'totalTime'} = 0;
	$self->{'osccheck'} = 0;
	$self->{'color'} = 0;
	# Check for rules:
	&setRules($self, $rulesRef);
	&updateCell($self, 0, 0, 0);	# Create first cell in 0,0 coordinates.
	bless $self, $class;
	return $self;
};

sub setRules {
	my ( $self, $rulesRef) = @_;
	my ($breedRef, $liveRef) = (ref($rulesRef) eq "ARRAY") ? ($rulesRef->[0], $rulesRef->[1]) : ([3], [2,3]);
	if ($self->{'color'} > 0) {
		# Force standard rules in colourised board.
		($breedRef, $liveRef) = ([3], [2,3]);
	};
	$self->{'breedRules'} = (ref($breedRef) eq "ARRAY") ? $breedRef : [];
	$self->{'liveRules'} = (ref($liveRef) eq "ARRAY") ? $liveRef : [];
	return;
};

sub setColor {
	my ($self, $color) = @_;
	$color = (defined $color) ? $color : '';
	if ($self->{'gen'} > 0) {return;};
	if (lc($color) eq 'immigration') {
		$self->{'color'} = 1;
		# Reset rules to standard:
		&setRules($self, undef);
		return 1;
	} elsif (lc($color) eq 'quadlife') {
		$self->{'color'} = 2;
		# Reset rules to standard:
		&setRules($self, undef);
		return 2;
	} elsif (lc($color) eq 'normal') {
		$self->{'color'} = 0;
		return 0;
	} else {
		return;
	};
};

sub getColor {
	my $self = shift;
	return $self->{'color'};
};

sub updateCell {
	# Update the state of a cell. If non-existing, create it.
	my ( $self, $xpos, $ypos, $state ) = @_;
	defined ($self->{'cells'}->{$xpos, $ypos}) or &createCell($self, $xpos, $ypos);
	if (($self->{'cells'}->{$xpos, $ypos}->{'state'}) and (not $state)) {
		my $oldstate = $self->{'cells'}->{$xpos, $ypos}->{'state'};
		--$self->{'liveCells'};
		# Update neighbours counts:
		foreach my $xx ($xpos-1 .. $xpos+1) {
			foreach my $yy ($ypos-1 .. $ypos+1) {
				if (($xx == $xpos) and ($yy == $ypos)) {
					next;
				};
				if (defined ($self->{'cells'}->{$xx, $yy})) {
					--$self->{'cells'}->{$xx, $yy}->{'neighbours'}->{$oldstate};
					--$self->{'cells'}->{$xx, $yy}->{'neighbours'}->{'total'};
				} else {
					#&createCell($self, $xx, $yy);
				};
			};
		};
	};
	if ((not $self->{'cells'}->{$xpos, $ypos}->{'state'}) and ($state)) {
		# Check validity:
		if (
			(($state > 1) and ($self->{'color'} < 1)) or
			(($state > 2) and ($self->{'color'} < 2)) or
			($state > 4) or
			($state < 0)
		) {
			# Invalid state for current color.
			return -1;
		};
		++$self->{'liveCells'};
		# Update neighbours counts:
		foreach my $xx ($xpos-1 .. $xpos+1) {
			foreach my $yy ($ypos-1 .. $ypos+1) {
				if (($xx == $xpos) and ($yy == $ypos)) {
					next;
				};
				if (defined ($self->{'cells'}->{$xx, $yy})) {
					++$self->{'cells'}->{$xx, $yy}->{'neighbours'}->{$state};
					++$self->{'cells'}->{$xx, $yy}->{'neighbours'}->{'total'};
				} else {
					&createCell($self, $xx, $yy);
					++$self->{'cells'}->{$xx, $yy}->{'neighbours'}->{$state};
					++$self->{'cells'}->{$xx, $yy}->{'neighbours'}->{'total'};
				};
			};
		};
	};
	$self->{'cells'}->{$xpos, $ypos}->{'state'} = $state;
	return;
};

sub queryCell {
	# Return the state of a cell:
	my ( $self, $xpos, $ypos ) = @_;
	if (defined $self->{'cells'}->{$xpos, $ypos}) {
		return $self->{'cells'}->{$xpos, $ypos}->{'state'};
	} else {
		return;
	};
};

sub createCell {
	# Create an empty cell.
	my ($self, $xpos, $ypos, @rest) = @_;
	$self->{'cells'}->{$xpos, $ypos}->{'state'} = 0;
	$self->{'cells'}->{$xpos, $ypos}->{'neighbours'}->{1} = 0;
	$self->{'cells'}->{$xpos, $ypos}->{'neighbours'}->{2} = 0;
	$self->{'cells'}->{$xpos, $ypos}->{'neighbours'}->{3} = 0;
	$self->{'cells'}->{$xpos, $ypos}->{'neighbours'}->{4} = 0;
	$self->{'cells'}->{$xpos, $ypos}->{'neighbours'}->{'total'} = 0;
	# Update boundaries:
	$self->{'maxx'} < $xpos and $self->{'maxx'} = $xpos;
	$self->{'minx'} > $xpos and $self->{'minx'} = $xpos;
	$self->{'maxy'} < $ypos and $self->{'maxy'} = $ypos;
	$self->{'miny'} > $ypos and $self->{'miny'} = $ypos;
	++$self->{'usedCells'};
	return;
};

sub loadInit {
	# Load an initial grid from a file.
	my ($self, $fn, @rest) = @_;
	my $untitled = 'Untitled.cells';
	if (not defined $fn) { return $untitled; };
	my @array;
	open(my $fh,"<:crlf", $fn) or die "Failed to open $fn: $!";
	while (<$fh>) { push @array, $_; };
	close $fh;
	my $ftype = &format_is(\@array);
	my $loadok;
	if (not defined $ftype) {
		print "DEBUG: File format could not be detected.\n";
		return $untitled;
	};
	if ($ftype->{'format'} eq 'CELLS') {
		$loadok = $self->loadCells(\@array);
		print "DEBUG: Loaded CELLS\n";
	} elsif ($ftype->{'format'} eq 'RLE') {
		$loadok = $self->loadRLE(\@array);
		print "DEBUG: Loaded RLE\n";
	} elsif (($ftype->{'format'} eq 'Life') and ($ftype->{'version'} eq '1.05')) {
		$loadok = $self->loadL105(\@array);
		print "DEBUG: Loaded Life 1.05\n";
	} elsif (($ftype->{'format'} eq 'Life') and ($ftype->{'version'} eq '1.06')) {
		$loadok = $self->loadL106(\@array);
		print "DEBUG: Loaded Life 1.06\n";
	} else {
		print "DEBUG: " . $ftype->{'format'} . " V. " . $ftype->{'version'} . " not supported yet.\n";
		return $untitled;
	};
	if (not $loadok) {
		print "DEBUG: Load failed!\n";
		return $untitled;
	} else {
		$self->{'currentFn'} = $fn;
		return $fn;
	};
};

sub saveGridTxt {
	# Save a grid to a txt file.
	my ($self, $fn, @rest) = @_;
	if (not defined $fn) { return; };
	my $output;
	open($output, ">", $fn) or die "cannot open $fn: $!\n";
	for (my $yy = $self->{'miny'}; $yy <= $self->{'maxy'}; $yy++) {
		foreach my $xx ($self->{'minx'} .. $self->{'maxx'}) {
			if (defined ($self->{'cells'}->{$xx, $yy})) {
				if ($self->{'cells'}->{$xx, $yy}->{'state'} == 1) {
					print $output 'O';
				} elsif ($self->{'cells'}->{$xx, $yy}->{'state'} > 1) {
					print $output $self->{'cells'}->{$xx, $yy}->{'state'};
				} else {
					print $output '.';
				};
			} else {
				print $output '.';
			};
		};
		print $output "\n";
	};
	close $output;
	return $fn;
};


sub crudePrintBoard {
	# Basic board print.
	my $self = shift;
	for (1 .. 80) {
		print "-";
	};
	print "\n";
	for (my $yy = $self->{'miny'}; $yy <= $self->{'maxy'}; $yy++) {
		foreach my $xx ($self->{'minx'} .. $self->{'maxx'}) {
			if (defined ($self->{'cells'}->{$xx, $yy})) {
				if ($self->{'cells'}->{$xx, $yy}->{'state'} == 1) {
					print 'O';
				} elsif ($self->{'cells'}->{$xx, $yy}->{'state'} > 1) {
					print $self->{'cells'}->{$xx, $yy}->{'state'};
				} else {
					print '_';
				};
			} else {
				print '.';
			};
		};
		print "\n";
	};
	my $stats = &statistics($self);
	print "---\tGeneration: " . $stats->{'generation'} . " x: " . $stats->{'minx'} . ".." . $stats->{'maxx'} . " y: " . $stats->{'miny'} . ".." . $stats->{'maxy'} . " Size: $stats->{'size'} LiveCells: " . $stats->{'liveCells'} . "\n";
	print "\tDelta: " . $stats->{'delta'} . "\n";
	return;
};

sub tick {
	# Calculate next epoch.
	my ($self, $oscCheck) = @_;
	my $t0 = [Time::HiRes::gettimeofday()];
	$oscCheck = &setOscCheck($self, $oscCheck);

	my $resref = &tickMainLoop($self);
	my @newCells = @{$resref->{'newCells'}};
	my @dieCells = @{$resref->{'dieCells'}};
	my @delCells = @{$resref->{'delCells'}};
	#use Data::Dumper;
	$self->{'delta'} = scalar(@newCells) + scalar(@dieCells);
	# Apply changes on board:
	foreach my $rec (@newCells) {
		# TODO: Do something in case of error?
		my $error = &updateCell($self, $rec->[0], $rec->[1], $rec->[2]);
		$error = (defined $error) ? $error : 0;
	};
	foreach my $rec (@dieCells) {
		my $error = &updateCell($self, $rec->[0], $rec->[1], 0);
	};
	foreach my $rec (@delCells) {
		# Verify that these cells are still without neighbours:
		if ($self->{'cells'}->{$rec->[0], $rec->[1]}->{'neighbours'}->{'total'} == 0) {
			delete $self->{'cells'}->{$rec->[0], $rec->[1]};
			--$self->{'usedCells'};
		};
	};
	$self->{'gen'} = $self->{'gen'} + 1;
	$self->{'factor2'} = ((defined $self->{'usedCells'}) and ($self->{'usedCells'} > 0)) ? $self->{'liveCells'} / $self->{'usedCells'} : 1;
	if ($oscCheck > 1) { &oscCheck($self, $oscCheck); };
  	my $t1 = [Time::HiRes::gettimeofday];
  	my $t0_t1 = Time::HiRes::tv_interval( $t0, $t1 );
	$self->{'lastTI'} = $t0_t1;	# Time spend to calculate last epoch.
	$self->{'totalTime'} += $t0_t1;	# Total Time spend calculating this board.
	return;
};

sub tickMainLoop {
	# TODO: Return new cell's color if board is immigration or quadlife.
	my ($self) = @_;
	my @newCells;
	my @dieCells;
	my @delCells;
	foreach my $key (keys %{ $self->{'cells'} }) {
		my ($xx, $yy) = split(/$;/, $key, 2);
		my $rec = [$xx, $yy];
		if (
			($self->{'cells'}->{$xx, $yy}->{'state'} > 0) and
			(not $self->{'cells'}->{$xx, $yy}->{'neighbours'}->{'total'} ~~ $self->{'liveRules'})
		) {
			# Die.
			push @dieCells, $rec;
		} elsif (
			($self->{'cells'}->{$xx, $yy}->{'state'} == 0) and
			($self->{'cells'}->{$xx, $yy}->{'neighbours'}->{'total'} ~~ $self->{'breedRules'})
		) {
			# New.
			if ($self->{'color'} == 0) {
				# Standard
				$rec->[2] = 1;
				push @newCells, $rec;
			} else {
				# Colorized
				#use Data::Dumper;
				my @colorcounts = ();
				my $ccnt = 0;
				foreach my $state (keys %{ $self->{'cells'}->{$xx, $yy}->{'neighbours'} }) {
					if ($state ne 'total') {
						if ($self->{'cells'}->{$xx, $yy}->{'neighbours'}->{$state} > 0) {
							$colorcounts[$state] = $self->{'cells'}->{$xx, $yy}->{'neighbours'}->{$state};
							$ccnt++;
						};
					};
				};
				if ($ccnt == 2) {
					# Immigration, or first rule of Quadlife (Identical).
					# Select maximum.
					my $max = -1;
					for my $i (1..4) {
						if (defined $colorcounts[$i]) {
							if ($colorcounts[$i] > $max) {
								$max = $colorcounts[$i];
								$rec->[2] = $i
							};
						};
					};
				} elsif ($ccnt == 3) {
					# Second rule of Quadlife
					for my $i (1..4) {
						if (not defined $colorcounts[$i]) {
							$rec->[2] = $i;
							last;
						};
					};
				} elsif ($ccnt == 1) {
					# Same color as parents:
					for my $i (1..4) {
						if (defined $colorcounts[$i]) {
							$rec->[2] = $i;
							last;
						};
					};
				} else {
					# Unsupported or standard. Return first color.
					$rec->[2] = 1;
				};
				push @newCells, $rec;
			};
		} elsif (
			($self->{'cells'}->{$xx, $yy}->{'state'} == 0) and
			($self->{'cells'}->{$xx, $yy}->{'neighbours'}->{'total'} == 0)
		) {
			# Isolated empty cell. GC.
			push @delCells, $rec;
		};
	};
	return {'newCells' => \@newCells, 'dieCells' => \@dieCells, 'delCells' => \@delCells};
};

sub setOscCheck {
	my ($self, $oscCheck) = @_;

	$oscCheck = (defined $oscCheck) ? $oscCheck : 0;
	if ($oscCheck != $self->{'osccheck'}) {
		# Change, delete all previous snapshots:
		delete $self->{'snapshots'};
	};
	$self->{'osccheck'} = $oscCheck;
	return $oscCheck;
};

sub oscCheck {
	my ($self, $oscCheck) = @_;
	my $lgen = $self->{'gen'};
	my $lgenString = sprintf("s%d", $lgen);
	my $ogen;
	my $ogenString;
	$self->{'snapshots'}->{$lgenString} = &snapshot($self);	# Smile!
	for (my $i = 2; $i <= $oscCheck; $i++) {
		$ogen = $lgen - $i;
		$ogenString = sprintf("s%d", $ogen);
		if (defined ($self->{'snapshots'}->{$ogenString})) {
			# Snapshot of grandma!
			if (
				($self->{'snapshots'}->{$ogenString}->{'snapshot'} eq $self->{'snapshots'}->{$lgenString}->{'snapshot'}) and
				($self->{'snapshots'}->{$ogenString}->{'minx'} == $self->{'snapshots'}->{$lgenString}->{'minx'}) and
				($self->{'snapshots'}->{$ogenString}->{'maxx'} == $self->{'snapshots'}->{$lgenString}->{'maxx'}) and
				($self->{'snapshots'}->{$ogenString}->{'miny'} == $self->{'snapshots'}->{$lgenString}->{'miny'}) and
				($self->{'snapshots'}->{$ogenString}->{'maxy'} == $self->{'snapshots'}->{$lgenString}->{'maxy'})
			) {
				# Grandma and grandson are identical!
				$self->{'oscilator'} = $i;
				last;
			} else {
				$self->{'oscilator'} = 0;
			};
		};
	};
	# Delete oldest snapshot.
	delete $self->{'snapshots'}->{$ogenString};
	return;
};

sub snapshot {
	# Take a snapshot of the board, in a way that it can be easily stored and compared
	# to another snapshot.
	my $self = shift;
	my $snapshot = '';
	for (my $yy = $self->{'miny'}; $yy <= $self->{'maxy'}; $yy++) {
		foreach my $xx ($self->{'minx'} .. $self->{'maxx'}) {
			if (defined ($self->{'cells'}->{$xx, $yy})) {
				if ($self->{'cells'}->{$xx, $yy}->{'state'} == 1) {
					$snapshot .= 'O';
				} elsif ($self->{'cells'}->{$xx, $yy}->{'state'} > 1) {
					$snapshot .= $self->{'cells'}->{$xx, $yy}->{'state'};
				} else {
					$snapshot .= '.';
				};
			} else {
				$snapshot .= '.';
			};
		};
		$snapshot .= "\n";
	};
	return {
		'snapshot'	=> $snapshot,
		'minx'		=> $self->{'minx'},
		'maxx'		=> $self->{'maxx'},
		'miny'		=> $self->{'miny'},
		'maxy'		=> $self->{'maxy'},
	};
};

sub shrinkBoard {
	# Shrink board: Now mostly used to keep boundaries track, for printing and snapshot.
	my $self = shift;
	$self->{'minx'} = $self->{'maxx'} = $self->{'miny'} = $self->{'maxy'} = 0;
	my $ok = 0;
	foreach my $key (keys %{ $self->{'cells'} }) {
		my ($xx, $yy) = split(/$;/, $key, 2);
		if (($self->{'cells'}->{$xx, $yy}->{'state'} == 0) and ($self->{'cells'}->{$xx, $yy}->{'neighbours'}->{'total'} == 0)) {
			delete $self->{'cells'}->{$key};
			--$self->{'usedCells'};
		} else {
			if ($ok) {
				if ($xx > $self->{'maxx'}) { $self->{'maxx'} = $xx; };
				if ($xx < $self->{'minx'}) { $self->{'minx'} = $xx; };
				if ($yy > $self->{'maxy'}) { $self->{'maxy'} = $yy; };
				if ($yy < $self->{'miny'}) { $self->{'miny'} = $yy; };
			} else {
				$self->{'minx'} = $xx;
				$self->{'maxx'} = $xx;
				$self->{'miny'} = $yy;
				$self->{'maxy'} = $yy;
				$ok = 1;
			};
		};
	};
	return;
};

sub statistics {
	my $self = shift;
	return {
		'size'		=> (($self->{'maxx'} - $self->{'minx'}) * ($self->{'maxy'} - $self->{'miny'})),
		'generation'	=> $self->{'gen'},
		'minx'		=> $self->{'minx'},
		'maxx'		=> $self->{'maxx'},
		'miny'		=> $self->{'miny'},
		'maxy'		=> $self->{'maxy'},
		'liveCells'	=> $self->{'liveCells'},
		'delta'		=> $self->{'delta'},
		'oscilator'	=> $self->{'oscilator'},
		'totalTime'	=> $self->{'totalTime'},
		'usedCells'	=> $self->{'usedCells'},
		'factor2'	=> $self->{'factor2'},
		'lastTI'	=> $self->{'lastTI'},
	};
};

sub format_is {
	my ($faref) = @_;	# Array ref containing file.
	my %result = (
		format	=> undef,
		version	=> undef
	);
	foreach my $line (@{ $faref }) {
		chomp($line);
		if (($line =~ /^#Life 1.05/) or ($line =~ /^#Life 1.06/) or ($line =~ /^#MCell/)) {
			($result{format}, $result{version}) = split / /, $line, 2;
			$result{format} =~ s/#//;
			return \%result;
		} elsif ($line =~ /^(b|o|[[:digit:]])/) {
			($result{format}, $result{version}) = ('RLE', 'N/A');
			return \%result;
		} elsif ($line =~ /^(\.|O|!)/) {
			($result{format}, $result{version}) = ('CELLS', 'N/A');
			return \%result;
		} elsif ($line =~ /^(\.|O|2|3|4|!)/) {
			($result{format}, $result{version}) = ('CELLS', 'N/A');
			return \%result;
		};
	};
	return undef;
};

sub loadL106 {
	# Load an initial grid from an array containing
	# a file in Life 1.06 format.
	my ($self, $array, @rest) = @_;
	if (not defined $array) { return undef; };
	foreach my $input (@{ $array }) {
		chomp($input);
		$input =~ s/^\s*(.*?)\s*$/$1/;
		if ($input eq '') { next; };
		if ($input =~ /^#Life 1.06/) { next; };
		# Not much checks here. Assume that data are numbers.
		my ($xx, $yy) = split / /, $input, 2;
		$xx += 0;
		$yy += 0;
		$self->updateCell($xx, $yy, 1);
	};
	$self->{'name'} = '#Life 1.06 file'; # :-)
	return 1;
};


sub loadL105 {
	# Load an initial grid from an array containing
	# a file in Life 1.05 format.
	my ($self, $array, @rest) = @_;
	if (not defined $array) { return undef; };
	my $posState = 0;
	my $name = 'Untitled';
	my $rules = '';
	my $dataline = '';
	my @descrArr = ();
	my $ulcx = my $ulcy = 0; # Upper left corner
	my $dlinecnt = 0;
	foreach my $input (@{ $array }) {
		chomp($input);
		if ($input eq '') { next; };
		if ($input =~ /^#Life 1.05/) {
			next;
		} elsif ($input =~ /^#D Name: /) {
			# Out of spec, but it seems that it's used:
			(undef, undef, $name) = split /(^#D Name: )/, $input, 3;
			next;
		} elsif ($input =~ /^#D /) {
			if ($dlinecnt >= 22) { return undef }; # Specs.
			my (undef, undef, $dline) = split /(^#D )/, $input, 3;
			$dline =~ s/^\s*(.*?)\s*$/$1/;
			if (length($dline) > 78) {
				print "DEBUG ERROR: D-line too long\n";
				return undef; # Specs.
			} else {
				push @descrArr, $dline;
			};
			$dlinecnt++;
		} elsif ($input =~ /^#N/) {
			next;
		} elsif ($input =~ /^#R /) {
			# Rules.
			(undef, undef, $rules) = split /(^#R )/, $input, 3;
			my ($sstr, $bstr) = split /\//, $rules, 2;

			my $barr = [];
			my $sarr = [];
			for (my $i = 0; $i < length($bstr); $i++) {
				if (substr($bstr, $i, 1) =~ /[0-8]/) {
					push @{ $barr }, substr($bstr, $i, 1);
				} else {
					# Fail. Specs.
					print "DEBUG ERROR: wrong rules\n";
					return undef;
				};
			};
			for (my $i = 0; $i < length($sstr); $i++) {
				if (substr($sstr, $i, 1) =~ /[0-8]/) {
					push @{ $sarr }, substr($sstr, $i, 1);
				} else {
					# Fail. Specs.
					print "DEBUG ERROR: wrong rules\n";
					return undef;
				};
			};
			$self->setRules([$barr, $sarr]);
		} elsif ($input =~ /^#P /) {
			(undef, $ulcx, $ulcy) = split / /, $input, 3;
			$ulcx += 0;
			$ulcy += 0;
			$posState = 1;
		} elsif (
			($input =~/^(\.|\*)/) and
			($posState == 1)
		) {
			# Data line:
			#print "DEBUG: DL: $input\n";
			my $xx = $ulcx;
			my $yy = $ulcy;
			while (length($input) > 0) {
				my $char = substr($input, 0, 1);
				$input = substr($input, 1);
				if ($char eq '*') {
					#print "\tDEBUG: LIVE ($xx,$yy)\n";
					$self->updateCell($xx, $yy, 1);
					$xx++;
				} elsif ($char eq '.') {
					$xx++;
				} else {
					# Fail.
					print "DEBUG ERROR: unknown char\n";
					return undef;
				};
			};
			$ulcy++;
		} else {
			# Unrecognized input:
			print "DEBUG ERROR: unknown input:\n\t|$input|\n";
			return undef;
		};
	};
	$self->{'description'} = \@descrArr;
	$self->{'name'} = $name;
	return 1;
};


sub loadRLE {
	# Load an initial grid from an array containing
	# a file in RLE format.
	my ($self, $array, @rest) = @_;
	if (not defined $array) { return undef; };
	my $posState = 0;
	my $name = 'Untitled';
	my $headRules = my $rules = '';
	my $dataline = '';
	my $ulcx = my $ulcy = 0; # Upper left corner
	foreach my $input (@{ $array }) {
		chomp($input);
		if ($input =~ /^#N /) {
			(undef, undef, $name) = split /(^#N )/, $input, 3;
			next;
		} elsif ($input =~ /^#r /) {
			# Rules:
			(undef, undef, $headRules) = split /(^#r )/, $input, 3;
			next;
		} elsif (($input =~ /^#P /) or ($input =~ /^#R /)) {
			(undef, $ulcx, $ulcy) = split / /, $input, 3;
			next;
		} elsif ($input =~ /^#/) {
			# Ignore all other # lines:
			next;
		} elsif ($input =~ /^x/) {
			# Header line.
			$input =~ s/ //g;
			my ($xc, $yc);
			($xc, $yc, $rules) = split /,/ , $input;
			if ((not ($xc =~ /x=/)) or (not ($yc =~ /y=/))) {
				# Fail.
				return undef;
			};
			$posState = 1;
			next;
		} else {
			# Normal line:
			if (not $posState) {
				# No header?
				return undef;
			};
			# Join in one big string:
			$dataline .= $input;
			next;
		};
	};
	# Now parse actual data:
	my @dataArr = split /\$/, $dataline;
	my %extraStates = ();
	my $extraStatesCnt = 0;
	my $xx = $ulcx;
	my $yy = $ulcy;
	#print "DEBUG: " . scalar(@dataArr) . " lines\n";
REC:	foreach my $rec (@dataArr) {
		#print "DEBUG: RLE REC: \n\t$rec\n";
		#print "\tLINE: $yy\n";
		my $cntstr = '0';
	CHAR:	while (length($rec) > 0) {
			my $char = substr($rec, 0, 1);
			$rec = substr($rec, 1);
			if ($char =~ /\d/) {
				$cntstr .= $char;
				next CHAR;
			} elsif ($char eq 'o') {
				my $cnt = ($cntstr eq '0') ? 1 : $cntstr + 0;
				$cntstr = '0'; # Reset.
				for (my $i = 0; $i < $cnt; $i++) {
					$self->updateCell($xx++, $yy, 1);
				};
			} elsif ($char eq 'b') {
				my $cnt = ($cntstr eq '0') ? 1 : $cntstr + 0;
				$cntstr = '0'; # Reset.
				$xx += $cnt;
			} elsif ($char eq '!') {
				# No more!
				last REC;
			} else {
				# Handle unknown characters as extra states. Good luck with that.
				# We will handle a max of 3 extra states (Immigration/Quadlife).
				my $cnt = ($cntstr eq '0') ? 1 : $cntstr + 0;
				if (defined $extraStates{$char}) {
					for (my $i = 0; $i < $cnt; $i++) {
						$self->updateCell($xx++, $yy, $extraStates{$char});
					};
				} else {
					# New state
					$extraStatesCnt++;
					if ($extraStatesCnt > 3) {
						# Fail.
						return undef;
					} else {
						$extraStates{$char} = $extraStatesCnt+1;
					};
					if ($extraStatesCnt == 1) {
						$self->setColor('immigration') or die "Failed to set color on load!\n";
					} elsif ($extraStatesCnt > 1) {
						$self->setColor('quadlife') or die "Failed to set color on load!\n";
					};
					for (my $i = 0; $i < $cnt; $i++) {
						$self->updateCell($xx++, $yy, $extraStates{$char});
					};
				};
			};
		};
		# If there are digits left, they are empty lines.
		my $cnt = ($cntstr eq '0') ? 1 : $cntstr + 0;
		$cntstr = '0'; # Reset.
		$yy += $cnt;	# Next line or skip lines.
		$xx = $ulcx;	# Reset
	};
	$self->{'name'} = $name;
	if ($extraStatesCnt > 1) {
		$self->setColor('quadlife') or die "Failed to set color on load!\n";
		#print "DEBUG: RLE: Quadlife\n";
	} elsif ($extraStatesCnt == 1) {
		$self->setColor('immigration') or die "Failed to set color on load!\n";
		#print "DEBUG: RLE: Immigration\n";
	};
	# Handle rules:
	my $bstr = my $sstr = '';
	if ($rules ne '') {
		# Rules in header line have priority over comment line rules:
		(undef, $rules) = split /=/, $rules, 2;
		($bstr, $sstr) = split /\//, $rules, 2;
	} elsif ($headRules ne '') {
		my ($sstr, $bstr) = split /\//, $headRules, 2;
	};
	if (($rules ne '') or ($headRules ne '')) {
		my $barr = [];
		my $sarr = [];
		for (my $i = 0; $i < length($bstr); $i++) {
			if (substr($bstr, $i, 1) =~ /\d/) { push @{ $barr }, substr($bstr, $i, 1); };
		};
		for (my $i = 0; $i < length($sstr); $i++) {
			if (substr($sstr, $i, 1) =~ /\d/) { push @{ $sarr }, substr($sstr, $i, 1); };
		};
		$self->setRules([$barr, $sarr]);
	};
	return 1;
};

sub loadCells {
	# Load an initial grid from an array containing
	# a file in cells (ASCII) format.
	my ($self, $array, @rest) = @_;
	if (not defined $array) { return undef; };
	my $name = 'Untitled';
	my @descrArr = ();
	my $xx = my $yy = my $cnt = 0;
	my $immigration = my $quadlife = 0;
	#my $input;
	#open($input, "<", $fn) or die "cannot open $input: $!\n";
	#while (<$input>) {
	foreach my $input (@{ $array }) {
		chomp($input);
		if ($input =~ /^!Name: /) {
			(undef, undef, $name) = split /(^!Name: )/, $input, 3;
			next;
		} elsif ($input =~ /^!/) {
			push @descrArr, $input;
			next;
		};
		for ($yy = 0; $yy <= length($input); $yy++) {
			if (substr($input, $yy, 1) eq 'O') {
				$self->updateCell($yy, $xx, 1);
				$cnt++;
			} elsif (substr($input, $yy, 1) eq '2') {
				$self->setColor('immigration') or die "Failed to set color on load!\n";
				$self->updateCell($yy, $xx, 2);
				$immigration = 1;
				$cnt++;
			} elsif (substr($input, $yy, 1) eq '3') {
				$self->setColor('quadlife') or die "Failed to set color on load!\n";
				$self->updateCell($yy, $xx, 3);
				$quadlife = 1;
				$cnt++;
			} elsif (substr($input, $yy, 1) eq '4') {
				$self->setColor('quadlife') or die "Failed to set color on load!\n";
				$self->updateCell($yy, $xx, 4);
				$quadlife = 1;
				$cnt++;
			};
		};
		$xx++;
	};
	$self->{'name'} = $name;
	$self->{'description'} = \@descrArr;
	# Finalize board colour:
	if ($quadlife) {
		$self->setColor('quadlife') or die "Failed to set color on load!\n";
	} elsif ($immigration) {
		$self->setColor('immigration') or die "Failed to set color on load!\n";
	};
	return 1;
};

42;

__END__