use strict;
use warnings;
use integer;
package OneDCA;

sub new {
	my $type = shift;
	my $class = ref($type) || $type;
	
	## Set up $self to be an empty hash. Somewhere 
	## after all the defaults have been set, we are going 
	## to do $self = { @_ } to add user options.
	my $self = { };
	
	## Here are the defaults.
	$self->{seed} = -1;			## generate seed later
	$self->{bitfield} = "";		## empty field, will fill later
	$self->{rule} = 30;			## rule 30 makes good random
	
	## Constrain width of CA to 32 cells, but *only* if 
	## use_infinite_expansion == 0.
	$self->{channel_width} = 32;

	## If we've been given a seed, use that. Otherwise, use 1.
	if ($self->{seed} < 1) {
		$self->{seed} = 1;
	} 
	
	## Fill in nondefaults from initialization.
	my %hash = @_;
	my @keys = keys %hash;
	my @vals = values %hash;
	while (@keys) {
		$self->{pop(@keys)} = pop(@vals);
	}

	## The management respectfully suggests that you not dick with
	## the use_infinite_expansion state variable, but instead
	## manipulate channel_width directly.
	if ($self->{channel_width} < 3) {
		$self->{use_infinite_expansion} = 1;
	} else {
		$self->{use_infinite_expansion} = 0;
	}
	
	
	## Figure out what given rule actually is. Rules go from 0
	## to 255. Use anything else, and it will simply evaluate in
	## the comparison function as one of them.
	$self->{rule} = sprintf "%08b", $self->{rule};
	
	## Turn seed into initial bitfield.
	if($self->{use_infinite_expansion}) {
		$self->{bitfield} = sprintf "%032b", $self->{seed};
		$self->{bitfield} =~ s/0*(.*)/$1/;
	} else {
		my $sprintfme = "%0".$self->{channel_width}."b";
		$self->{bitfield} = sprintf $sprintfme, $self->{seed};
	}
	
	## Make the rules into an array of bits. Doing this once now 
	## will save us from doing it many times in iterate().
	my @rules;
	my $i;	
	for($i = 0; $i < 8; $i++) {
		push(@rules, (substr $self->{rule}, $i, 1));
	}
	$self->{at_rules} = [@rules];

	## Ha HA villians, I am an object!
	bless($self, $type);
	return($self);
}

## The most imporant function, the one which iterates the automaton.
sub iterate {
	my $self = shift;
	my $oldbitfield = $self->{bitfield};
	my $newbitfield = $oldbitfield;
	## Ok, as a Java programmer, this is weird as hell. In the new() 
	## constructor, we store a reference to (actually, a reference to
	## a copy of) the constructed array of rules. Here, we need to 
	## tell perl that what is coming out belongs in an array context
	## rather than a scalar context. Hence the @{ blah } business.
	my @rules = @{$self->{at_rules}};
	my $i;
	
	if($self->{use_infinite_expansion}) {
		$newbitfield = "0".$newbitfield."0";
		$oldbitfield = "00".$oldbitfield."00";
		for($i = 1; $i < ((length $oldbitfield) - 1); $i++) {
			my $compareme = substr($oldbitfield, ($i - 1), 3);
			if ($compareme eq "111") {
				substr($newbitfield, $i, 1, $rules[0]);
			} elsif ($compareme eq "110") {
				substr($newbitfield, $i, 1, $rules[1]);
			} elsif ($compareme eq "101") {
				substr($newbitfield, $i, 1, $rules[2]);
			} elsif ($compareme eq "100") {
				substr($newbitfield, $i, 1, $rules[3]);
			} elsif ($compareme eq "011") {
				substr($newbitfield, $i, 1, $rules[4]);
			} elsif ($compareme eq "010") {
				substr($newbitfield, $i, 1, $rules[5]);
			} elsif ($compareme eq "001") {
				substr($newbitfield, $i, 1, $rules[6]);
			} elsif ($compareme eq "000") {
				substr($newbitfield, $i, 1, $rules[7]);
			}
		}
		## An extra 0 is left out front. Remove it.
		substr($newbitfield, 0, 1, "");
	} else {
		## Map to a continuous channel. May wish to use known mapping
		## width for this instead of the length calculations.
		my $width = $self->{channel_width};
		$oldbitfield = "0".$oldbitfield."0";
		substr($oldbitfield, 0, 1, substr($newbitfield, ($width - 1), 1));
		substr($oldbitfield, $width + 1, 1, substr($newbitfield, 0, 1));
		for($i = 1; $i < (length($oldbitfield) - 1); $i++) {
			my $compareme = substr($oldbitfield, ($i - 1), 3);
			if ($compareme eq "111") {
				substr($newbitfield, $i, 1, $rules[0]);
			} elsif ($compareme eq "110") {
				substr($newbitfield, $i, 1, $rules[1]);
			} elsif ($compareme eq "101") {
				substr($newbitfield, $i, 1, $rules[2]);
			} elsif ($compareme eq "100") {
				substr($newbitfield, $i, 1, $rules[3]);
			} elsif ($compareme eq "011") {
				substr($newbitfield, $i, 1, $rules[4]);
			} elsif ($compareme eq "010") {
				substr($newbitfield, $i, 1, $rules[5]);
			} elsif ($compareme eq "001") {
				substr($newbitfield, $i, 1, $rules[6]);
			} elsif ($compareme eq "000") {
				substr($newbitfield, $i, 1, $rules[7]);
			}
		}
		## An extra 0 is left out front. Remove it.
		substr($newbitfield, 0, 1, "");
	}
	$self->{bitfield} = $newbitfield;
};

## Get current bitfield. Only rarely a good idea. This
## may be deleted in the future.
sub getBitfield {
	my $self = shift;
	return $self->{bitfield};
}

sub getRule {
	my $self = shift;
	return $self->{rule};
}

sub getWidth {
	my $self = shift;
	return length($self->{bitfield});
}

1;