File Coverage

blib/lib/Language/Homespring.pm

Criterion	Covered	Total	%
statement	136	144	94.4
branch	36	46	78.2
condition	11	21	52.3
subroutine	17	18	94.4
pod	4	4	100.0
total	204	233	87.5

package Language::Homespring;

$VERSION = 0.04;

use strict;
use warnings;

use Language::Homespring::Node;
use Language::Homespring::Salmon;
use Language::Homespring::Snowmelt;
use Language::Homespring::River;

sub new {
	my $class = shift;
	my $self = bless {}, $class;

	my $options = shift;
	$self->{root_node} = undef;
	$self->{salmon} = [];
	$self->{snowmelt} = [];
	$self->{new_salmon} = [];
	$self->{dead_salmon} = [];
	$self->{output} = '';
	$self->{universe_ok} = 1;

	return $self;
}

sub parse {
	my ($self, $source) = @_;

	my @tokens =
		map{s/(\.$)|(^\.)/\n/g; $_}
		map{s/\. / /g; $_}
		map{s/ \././g; $_}
		split /(?:(?

	#print((join '|', @tokens)."\n\n");

	$self->{root_node} = new Language::Homespring::Node({
		'interp' => $self,
		'node_name' => shift @tokens,
	});
	my $parent = $self->{root_node};

	for my $token(@tokens){
		if ($token){
			my $new_node = new Language::Homespring::Node({
				'interp' => $self,
				'node_name' => $token,
				'parent_node' => $parent,
			});
			$parent->add_child($new_node);

			my $new_river = new Language::Homespring::River({
				'interp' => $self,
				'up_node' => $new_node,
				'down_node' => $parent,
			});
			$parent->add_river_up($new_river);
			$new_node->add_river_down($new_river);

			$parent = $new_node;
		}else{
			if (defined $parent->{parent_node}){
				$parent = $parent->{parent_node};
			}
		}
	}
}

sub tick {
	my ($self) = @_;
	my @nodes;

	$self->{output} = '';

	# has our universe been smashed?
	return if !$self->{universe_ok};

	# process snowmelts
		@nodes = $self->_get_nodes('snowmelt');
		for (@nodes){
			#spawn a new snowmelt
			my $snowmelt = new Language::Homespring::Snowmelt({'interp' => $self, 'location' => $_});
			push @{$self->{snowmelt}}, $snowmelt;
		}
		$_->move() for (@{$self->{snowmelt}});

		# has our universe been smashed?
		return if !$self->{universe_ok};


	# process water

		# turn everything off
		$self->_set_all('water', 0);

		# water from springs
		@nodes = $self->_get_all_nodes();
		for (@nodes){
			$self->_water_downwards($_) if $_->{spring};
		}

	# process electricity

		# turn everything off
		$self->_set_recurse($self->{root_node}, 'power', 0);

		# process "powers"
		@nodes = $self->_get_nodes('powers');
		for(@nodes){
			if (!$_->{destroyed}){
				$self->_power_downwards($_);
			}
		}

		# process "hydro power"
		@nodes = $self->_get_nodes('hydro power');
		for (@nodes){
			$self->_power_downwards($_) if $_->{water} && !$_->{destroyed};
		}

		# process "power invert"
		@nodes = $self->_get_nodes('power invert');
		for (@nodes){
			$self->_power_downwards($_) if !$_->{power} && !$_->{destroyed};
		}

	# process salmon

		$_->move() for (@{$self->{salmon}});

		# sort out dead salmon
		@{$self->{salmon}} = grep{
			my $ok = 1;
			for my $dead(@{$self->{dead_salmon}}){
				$ok = 0 if $_ == $dead;
			}
			$ok;
		}@{$self->{salmon}};

		# sort out new salmon
		push @{$self->{salmon}}, @{$self->{new_salmon}};
		$self->{new_salmon} = [];

	# process others

		@nodes = $self->_get_nodes('hatchery');
		for (@nodes){
			if ($_->{power}){
				my $location = @{$_->{rivers_up}}[0];
				my $salmon = new Language::Homespring::Salmon({'interp' => $self,'mature' => 1, 'upstream' => 1, 'location' => $location});
				push @{$self->{salmon}}, $salmon;
			}
		}

	#	@nodes = $self->_get_nodes('bear');
	#	for (@nodes){
	#		for my $salmon($_->get_salmon()){
	#			$salmon->kill() if $salmon->{mature};
	#		}
	#	}

	return $self->{output};
}

sub run{
	my ($self, $max_ticks, $delimit) = @_;
	my $tick = 0;
	while(1){
		print $self->tick();
		print $delimit if defined($delimit);
		$tick++;
		return if (defined($max_ticks) && ($tick >= $max_ticks));
		return if !$self->{universe_ok};
	}
}

sub _set_all {
	my ($self, $prop, $value) = @_;
	$self->_set_recurse($self->{root_node}, $prop, $value);
}

sub _set_recurse {
	my ($self, $node, $prop, $value) = @_;
	$node->{$prop} = $value;
	$self->_set_recurse($_, $prop, $value) for @{$node->{child_nodes}};
}

sub _get_nodes {
	my ($self, $name) = @_;
	return $self->_get_nodes_i($self->{root_node}, $name);
}

sub _get_nodes_i {
	my ($self, $node, $name) = @_;
	my @out = ();
	push @out, $node if ($node->{node_name} eq $name);
	push @out, $self->_get_nodes_i($_, $name) for @{$node->{child_nodes}};
	return @out;
}

sub _get_all_nodes {
	my ($self) = @_;
	return $self->_get_all_nodes_i($self->{root_node});
}

sub _get_all_nodes_i {
	my ($self, $node) = @_;
	my @out = ();
	push @out, $node;
	push @out, $self->_get_all_nodes_i($_) for @{$node->{child_nodes}};
	return @out;
}

sub _power_downwards {
	my ($self, $node) = @_;

	return if (!$node->{parent_node});

	$node->{parent_node}->{power} = 1;

	return if ($node->{parent_node}->{node_name} eq 'power invert');
	return if ($node->{parent_node}->{node_name} eq 'insulated');
	return if ($node->{parent_node}->{node_name} eq 'force field');
	return if (($node->{parent_node}->{node_name} eq 'bridge') && ($node->{parent_node}->{destroyed}));

	# TODO: "sense" and "switch"

	$self->_power_downwards($node->{parent_node});
}

sub _water_downwards {
	my ($self, $node) = @_;

	return if (!$node->{parent_node});

	$node->{parent_node}->{water} = 1;

	return if (($node->{parent_node}->{node_name} eq 'force field') && ($node->{parent_node}->{power}));
	return if (($node->{parent_node}->{node_name} eq 'bridge') && ($node->{parent_node}->{destroyed}));
	return if (($node->{parent_node}->{node_name} eq 'evaporates') && ($node->{parent_node}->{power}));

	$self->_water_downwards($node->{parent_node});
}

__END__