#!/usr/bin/perl

use strict;
use warnings;

use File::Path;
use CGI qw( :standard );
use Image::Magick;
use Time::HiRes;

use constant VACUUM => 0;
use constant VAPOR => 1;
use constant ICE => 3;

use vars qw(
	$rootdir	$subdir
	$rows	$cols	$vapor	$ice	$maxgen	$drawgen $seed	$ident	$circle
	$gen
	$grid
	$im
	$image_scale
	$conclude_reason
);

$rootdir = '/web/lvalue.com';
$subdir = 'qotw7';
mkpath([ "$rootdir/$subdir" ], 0, 0777);

$| = 1;
print_header();
run() if param();
exit 0;

sub print_header {
	print header, start_html("Perl Expert QOTW 7");
	print h2("Simulation of Frost");
	print start_form;
	print p, "Rows:", textfield(-name => "rows", -size => 4);
	print br, "Columns:", textfield(-name => "cols", -size => 4);
	print br, "Vapor Percent:", textfield(-name => "vapor", -size => 4);
	print br, "Ice crystals:", textfield(-name => "ice", -size => 4);
	print br, "Generation max:", textfield(-name => "maxgen", -size => 4);
	print br, "Draw every ", textfield(-name => "drawgen", -size => 4), " generations";
	print br, "Random seed (optional):", textfield(-name => "seed", -size => 10);
	print br, "Identifier for you (optional)", textfield(-name => "ident", -size => 20);
	print br, "Circle radius? (optional)", textfield(-name => "circle", -size => 4);
	print br, submit, end_form;
}

sub run {
	print hr;

	parse_input();

	# Set the initial values.

	$gen = 0;
	$conclude_reason = "";
	setup_grid();
	setup_im();

	# Draw initial setup.

	im_draw(1);

	# Main loop to generate the stuff.

	my $start_time = Time::HiRes::time;
	my $done = 0;
	while (!$done) {
		$done = next_gen();
	}
	im_draw_final();
	my $elapsed_time = sprintf("%0.3f", Time::HiRes::time-$start_time);
	
	print p, "Concluded after generation ", $gen-1, ": $conclude_reason ($elapsed_time seconds)";
}

sub parse_input {
	$rows = param("rows");
	if ($rows =~ /(\d+)/) { $rows = $1 } else { $rows = 0 }
	$rows = 200 if $rows > 200;
	$cols = param("cols");
	if ($cols =~ /(\d+)/) { $cols = $1 } else { $cols = 0 }
	$cols = 200 if $cols > 200;
	if ($rows/2 != int($rows/2) || $cols/2 != int($cols/2)
		|| $rows <= 0 || $cols <= 0) {
		print p, "Rows and Cols must both be even and positive.";
		return;
	}

	$image_scale = 1;
	my $max = $rows; $max = $cols if $cols > $rows;
	$image_scale = int(400/$max) if $max < 400;
	$image_scale = 6 if $image_scale > 6;

	$vapor = param("vapor");
	if ($vapor =~ /(\d+)/) { $vapor = $1 } else { $vapor = 0 }
	$vapor /= 100;
	$vapor = 1 if $vapor > 1;
	if ($vapor == 0) {
		print p, "A simulation without any vapor would be pretty dull.";
		return;
	} elsif ($vapor == 1) {
		print p, "A simulation with no vacuum would be pretty dull.";
		return;
	}

	$ice = param("ice");
	if ($ice =~ /(\d+)/) { $ice = $1 } else { $ice = 0 }
	if ($ice >= $rows*$cols/4) {
		print p, "That's a lot of ice, but... well, OK."
	}
	# A simulation without any ice is OK, it's a sort of gas diffusion
	# thing going on... I guess.

	$drawgen = param("drawgen");
	if ($drawgen =~ /(\d+)/) { $drawgen = $1 } else { $drawgen = 1 }
	$drawgen = 1 if $drawgen < 1;
	$drawgen = 100 if $drawgen > 100;

	$maxgen = param("maxgen");
	if ($maxgen =~ /(\d+)/) { $maxgen = $1 } else { $maxgen = 0 }
	$maxgen = 999 if $maxgen < 1 || $maxgen > 999;

	$ident = param("ident");
	$ident =~ s/\W+//g;
	if ($ident =~ /(\w+)/) { $ident = $1 } else { $ident = '' }
	if (!length($ident)) {
		srand(time() ^ ($$ + ($$<<15)));
		while (length($ident) < 10) {
			$ident .= chr(int(rand(26))+ord("a"));
		}
	}
	$ident = substr($ident, 0, 20) if length($ident) > 20;

	$seed = param("seed");
	if ($seed =~ /(\d+)/) { $seed = $1 } else { $seed = 0 }
	$seed ||= (time() ^ ($$ + ($$<<15)));
	srand($seed);

	$circle = param("circle");
	if ($circle =~ /(\d+)/) { $circle = $1 } else { $circle = 0 }
}

sub setup_grid {
	$grid = [ ];
	if ($circle) {
		my $row_center = $rows/2;
		my $col_center = $cols/2;
		my $radius_squ = $circle**2;
		for (my $row = 0; $row < $rows; ++$row) {
			push @$grid, [ ];
			for (my $col = 0; $col < $cols; ++$col) {
				if ($row == int($row_center) && $col == int($col_center)) {
					push @{$grid->[-1]}, ICE;
					next;
				}
				push @{$grid->[-1]},
					( (($col-$col_center)**2 + ($row-$row_center)**2 < $radius_squ)
					? VAPOR : VACUUM);
			}
		}
	} else {
		for (my $row = 0; $row < $rows; ++$row) {
			push @$grid, [ ];
			for (my $col = 0; $col < $cols; ++$col) {
				push @{$grid->[-1]}, (rand(1) < $vapor ? VAPOR : VACUUM);
			}
		}
		my $ice_needed = $ice;
		while ($ice_needed) {
			my $row = int(rand(1)*$rows);
			my $col = int(rand(1)*$cols);
			next if $grid->[$row][$col] == ICE;
			$grid->[$row][$col] = ICE;
			--$ice_needed;
		}
	}
}

sub setup_im {
	$im = Image::Magick->new(size => "${rows}x$cols}");
}

sub next_gen {
	++$gen;
	if ($gen > $maxgen) {
		$conclude_reason = "maximum number of generations exceeded";
		return 1;
	}

	my $stable = grid_next_tick();
	im_draw($stable);
	if ($stable) {
		# No change in the grid; we're done.
		$conclude_reason = "no change from previous generation";
		return 1;
	}
	# Grid changed and we're not past maxgen;  we're not done.
	return 0;
}

sub grid_next_tick {
	my $stable = 1;
	my $offset = $gen % 2 - 1;
	for (my $row = 0; $row < $rows; $row += 2) {
		for (my $col = 0; $col < $cols; $col += 2) {
			my @box = (
				$grid->[$row+$offset  ][$col+$offset  ],
				$grid->[$row+$offset+1][$col+$offset  ],
				$grid->[$row+$offset+1][$col+$offset+1],
				$grid->[$row+$offset  ][$col+$offset+1],
			);
			my $ice = scalar(grep { $_ == ICE } @box);
			if ($ice == 4) {
				# Solid ice, no change.
				next;
			} elsif ($ice == 0) {
				my $vapor = scalar(grep { $_ == VAPOR } @box);
				if ($vapor == 0 || $vapor == 4) {
					# All vacuum or all vapor;
					# rotation makes no difference.
					next;
				}
				# Part vapor and part vacuum;  rotate.
				if (rand(1) < 0.5) {
					push @box, shift @box;
				} else {
					unshift @box, pop @box;
				}
			} else {
				# Part ice;  convert any vapor to ice.
				my $vapor = scalar(grep { $_ == VAPOR } @box);
				next if !$vapor;
				for (@box) { $_ = ICE if $_ == VAPOR }
			}
			(
				$grid->[$row+$offset  ][$col+$offset  ],
				$grid->[$row+$offset+1][$col+$offset  ],
				$grid->[$row+$offset+1][$col+$offset+1],
				$grid->[$row+$offset  ][$col+$offset+1],
			) = @box;
			$stable = 0;
		}
	}
	return $stable;
}

sub im_draw {
	my($stable) = @_;
	return if !$stable && $gen != $maxgen && ($gen % $drawgen);

#	print p;
#	for my $rowval (@$grid) {
#		print join("", @$rowval), br;
#	}
#	print "Generation $gen";
#	print " for $ident" if $ident;

	my $color;
	$im->ReadImage("xc:black");
	$im->[-1]->Scale(width => $cols, height => $rows);
	for my $row (0..$rows-1) {
		for my $col (0..$cols-1) {
			my $val = $grid->[$row][$col];
			if ($val == VACUUM) {
				$color = 'black';
			} elsif ($val == VAPOR) {
				$color = 'blue';
			} else {
				$color = 'white';
			}
			$im->[-1]->Set("pixel[$col,$row]" => $color);
		}
	}
	$im->[-1]->Annotate(text => $gen, gravity => 'SouthEast', stroke => 'gray');
	$im->[-1]->Write("$rootdir/$subdir/$ident.$gen.png");
	print br, img({src => "$subdir/$ident.$gen.png", alt => "gen $gen",
		width => $cols*$image_scale, height => $rows*$image_scale});

	return 1;
}

sub im_draw_final {
	$im->Set(delay => 10*$drawgen, disklimit => 20);
	$im->Write("$rootdir/$subdir/$ident.mpeg");
	print p, a({href => "$subdir/$ident.mpeg"}, "Movie");
}

