view release on metacpan or  search on metacpan

lib/Game/Life/Infinite/Board.pm  view on Meta::CPAN

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 {