#!perl
# Like everyone else, a fun quiz.  I actually looked at the two problems and
# decided that the Expert was more worthwhile than the Beginner this time.
# 
# I'm intrigued by the structure of people's solutions; I wrote the whole
# of the do-one-tick as one function, whereas most people seem to have
# split it up; and I'm directly manipulating each cell, rather than trying
# to marshal and unmarshal it.
# 
# Prototypes seem to be rare, as well -- most people seem to use a global
# array rather than a passed around one, which seems icky.  Of course,
# my passing around isn't very effective, due to the array-of-pointers
# nature of 2D arrays in Perl, so maybe people are right about that.
# 
# The final trick I'm proud of (well, because I'd never done it before)
# is clearing the screen with Term::Cap rather than `clear`.
# 
# I also didn't get around to doing more than ASCII art :(
# 
# --

use POSIX;
use Term::Cap;
use strict;
use constant ICE => '*';
use constant VAPOR => '.';
use constant VACUUM => ' ';

sub setup ($$$) {
    my ($x, $y, $density) = @_;
    my @rv;
    $rv[$_] = [ map { rand(1/$density) < 1 ? VAPOR : VACUUM } (undef) x $y ] 
	for 0..$x-1;
    $rv[rand($x)][rand($y)] = ICE;
    @rv;
}

# print an array of arrays
sub display (@) {
    # This started as something like:
    # print join "\n", map join('', @$_), @_; print "\n";
    # and progressive refinement yielded this.
    print map { @$_, "\n" } @_;
}

# utility function: 
# swaps the values of its two scalar arguments
# used for doing rotations of a 2x2 array
# WARNING: modifies arguments!
sub swap ($$) { 
    @_[0,1] = @_[1,0]
}

# perform one iteration.
# not a clean function, as the second argument will be altered; an array
# of arrays is done with pointers^Wreferences.
sub iterate ($@) {
    my ($iter, @rv) = @_;
    if ($iter % 2) {
	# shift the borders around, to make the cell division easier
	unshift @$_, pop @$_ for @rv;
	unshift @rv, pop @rv;
    }
    # divide into two by two cells, and process
    my ($x, $y);
    for ($x = 0; $x < @rv; $x += 2) {
	for ($y = 0; $y < @{$rv[0]}; $y += 2) { 
	    if (grep $_ eq ICE, @{$rv[$x]}[$y,$y+1], @{$rv[$x+1]}[$y,$y+1]) {
		for ($rv[$x][$y], $rv[$x][$y+1],
		     $rv[$x+1][$y], $rv[$x+1][$y+1])
		{
		    $_ = ICE if $_ eq VAPOR;
		}
	    } else {
		if (rand(2) >= 1) {
		    # counter clockwise
		    swap $rv[$x][$y], $rv[$x][$y+1];
		    swap $rv[$x][$y+1], $rv[$x+1][$y+1];
		    swap $rv[$x+1][$y+1], $rv[$x+1][$y];
		} else {
		    # clockwise
		    swap $rv[$x][$y], $rv[$x+1][$y];
		    swap $rv[$x+1][$y], $rv[$x+1][$y+1];
		    swap $rv[$x+1][$y+1], $rv[$x][$y+1];
		}
	    }
	}
    }
    if ($iter % 2) {
	# restore borders
	push @$_, shift @$_ for @rv;
	push @rv, shift @rv;
    }
    return @rv;
}

sub usage () {
    print STDERR "$0 M N density iterations\n";
    print STDERR "M, N, iterations: integer; density: decimal fraction\n";
    print STDERR "M, N must be even positive integers\n";
    exit(1);
}

my ($x, $y, $density, $iterations) = @ARGV;
usage() unless @ARGV >= 3;
usage() unless $x % 2 == 0 and $y % 2 == 0;
usage() unless $x > 0 and $y > 0;
$iterations ||= 1_000_000_000;

my $termios = new POSIX::Termios;
$termios->getattr;
my $term = Term::Cap::Tgetent 
    Term::Cap { TERM => undef, OSPEED => $termios->getospeed };

my @frost = setup $x, $y, $density;
my $t;
$SIG{ALRM} = sub { warn "TICKS: $t\n"; exit };
alarm $ENV{TIMELIMIT} || 120;
for my $i (0..$iterations) { 
    $t++;
    @frost = iterate $i, @frost if $i;
    $term->Tputs('cl', 1, *STDOUT);
    print "== iteration: " . $i . " ==\n";
    display @frost;
#    sleep 1;
}
