#!/usr/bin/perl
use strict;
use warnings;
use SDL;
use SDL::App;
use SDL::Color;
use SDL::Rect;
use SDL::Event;

my $APP_WIDTH  = 320;
my $APP_HEIGHT = 240;
my $APP_DEPTH  = 32;
my $APP_TITLE  = 'Infection';

my $COLOR_BLACK = SDL::Color->new(
	-r => 0x00,
	-g => 0x00,
	-b => 0x00,
);
my $COLOR_GREEN = SDL::Color->new(
	-r => 0x00,
	-g => 0xFF,
	-b => 0x00,
);
my $COLOR_BLUE = SDL::Color->new(
	-r => 0x00,
	-g => 0x00,
	-b => 0xFF,
);
my $DEFAULT_OBJECT_WIDTH   = 20;
my $DEFAULT_OBJECT_HEIGHT  = 20;
my $DEFAULT_OBJECT_SPEED   = 10;



{
	my $sdl_app;
	sub set_sdl_app { $sdl_app = shift }
	my $tk_app;
	sub set_tk_app { $tk_app = shift }
	my ($bg, $bg_color);
	sub set_bg { ($bg, $bg_color) = @_ }
	my $infected_color;
	sub set_infected_color { $infected_color = shift }
	my $innoculated_color;
	sub set_innoculated_color { $innoculated_color = shift }


	sub copy
	{
		my @to_copy = @{ +shift };
		my @new_array;
		foreach my $x (0 .. $#to_copy) {
			my @row = @{ $to_copy[$x] };
			foreach my $y (0 .. $#row) {
				$new_array[$x][$y] = $to_copy[$x][$y];
			}
		}

		return @new_array;
	}

	my @cells = (
		map {[
			map 0, 0 .. $APP_HEIGHT - 1
		]} 0 .. $APP_WIDTH - 1
	);
	my @cells_copy = copy( \@cells );
	sub infect_cell_copy
	{
		my ($x, $y) = @_;
		$cells_copy[$x][$y] = 1;
	}
	sub innoculate_cell_copy
	{
		my ($x, $y) = @_;
		$cells_copy[$x][$y] = -1;
	}
	sub infect_cell
	{
		my ($x, $y) = @_;
		$cells[$x][$y] = 1;
	}
	sub innoculate_cell
	{
		my ($x, $y) = @_;
		$cells[$x][$y] = -1;
	}

	my $generation = 0;
	sub next_generation
	{
		foreach my $x (0 .. $APP_WIDTH) {
			foreach my $y (0 .. $APP_HEIGHT-1) {
				no warnings; # About unintitlized vars
				if( $cells[$x][$y] > 0 ) {
					infect_neighbors( $x, $y );
				}
				elsif( $cells[$x][$y] < 0 ) {
					innoculate_neighbors( $x, $y );
				}
			}
		}

		@cells = copy( \@cells_copy );
		$generation++;
		return $generation;
	}
	sub neighbor_list
	{
		my ($x, $y) = @_;
		return (
			[ $x + 1, $y     ],
			[ $x - 1, $y     ],
			[ $x + 1, $y + 1 ],
			[ $x - 1, $y + 1 ],
			[ $x + 1, $y - 1 ],
			[ $x - 1, $y - 1 ],
			[ $x    , $y + 1 ],
			[ $x    , $y - 1 ],
		);
	}

	sub will_change { int rand 2 }
	sub infect_neighbors
	{
		my ($x, $y) = @_;
		my @neighbors = neighbor_list( $x, $y );
		foreach my $neighbor (@neighbors) {
			my ($nx, $ny) = @$neighbor;
			no warnings; # About unintitilized vars
			infect_cell_copy( @$neighbor ) if(
				($cells[$nx][$ny] == 0) &&
				(will_change));
		}
	}

	sub innoculate_neighbors
	{
		my ($x, $y) = @_;
		my @neighbors = neighbor_list( $x, $y );
		foreach my $neighbor (@neighbors) {
			my ($nx, $ny) = @$neighbor;
			innoculate_cell_copy( @$neighbor ) if will_change;
		}
	}


	sub draw
	{
		my $app = shift;

		$app->fill( $bg => $bg_color );
		foreach my $x (0 .. $APP_WIDTH-1) {
			foreach my $y (0 .. $APP_HEIGHT-1) {
				if( $cells[$x][$y] > 0 ) {
					$app->pixel( $x, $y, 
					    $infected_color );
				} 
				elsif( $cells[$x][$y] < 0 ) {
					$app->pixel( $x, $y, 
					    $innoculated_color );
				}
			}
		}

		$app->update( $bg );
	}
}


{
	my $running = 0;
	sub toggle_running { $running ^= 1 }

	sub run
	{
		my ($sdl_app) = @_;
		while(1) {
			handle_events( $sdl_app );
			if( $running ) {
				my $gen = next_generation;
				local $| = 1;
				print "Generation $gen\r";
			}
			draw( $sdl_app );
		}
	}

	my $mouse_button = 0;
	sub handle_events
	{
		my ($sdl_app) = @_;

		my $event = SDL::Event->new;
		while( $event->poll ) {
			my $type = $event->type;
			if( $type == SDL_MOUSEBUTTONDOWN ) {
				my $x = $event->button_x;
				my $y = $event->button_y;
				$mouse_button = $event->button;
				if(! $running ) {
					if( $mouse_button == 1 ) {
						infect_cell( $x, $y );
					}
					elsif( $mouse_button == 3 ) {
						innoculate_cell( $x, $y );
					}
				}
			}
			elsif( $type == SDL_MOUSEMOTION ) {
				next unless $mouse_button;
				my $x = $event->button_x;
				my $y = $event->button_y;
				if(! $running ) {
					if( $mouse_button == 1 ) {
						infect_cell( $x, $y );
					}
					elsif( $mouse_button == 3 ) {
						innoculate_cell( $x, $y );
					}
				}
			}
			elsif( $type == SDL_MOUSEBUTTONUP ) {
				$mouse_button = 0;
			}
			elsif( $type == SDL_KEYDOWN ) {
				toggle_running 
					if $event->key_state( SDLK_RETURN );
			}
			elsif( $type == SDL_QUIT ) {
				exit 0;
			}
		}
	}
}

sub init_sdl
{
	my $app = SDL::App->new(
		-title   => $APP_TITLE,
		-width   => $APP_WIDTH,
		-height  => $APP_HEIGHT,
		-depth   => $APP_DEPTH,
	);
	set_sdl_app( $app );

	my $bg = SDL::Rect->new(
		-height  => $APP_HEIGHT,
		-width   => $APP_WIDTH,
	);
	set_bg( $bg => $COLOR_BLACK );

	set_infected_color( $COLOR_GREEN );
	set_innoculated_color( $COLOR_BLUE );

	return $app;
}


{
	my $sdl_app  = init_sdl;

	run( $sdl_app );
}