#!/usr/bin/perl -w
# Author: Dirk Stander <dst@glaskugel.org>
# License: Perl artistic

# Usage:
# -X  grid dim X
# -Y  grid dim Y
# -x  cell dim x
# -y  cell dim y
# -d  density (ICE percent)
# -t  graph. update interval
# -T  simulation ticks
# -I  ICE crystals

use strict;
use Tk qw(:eventtypes);
use Getopt::Std qw();

my $settings = {
    # FIXME check parity
    X       =>   100,   # grid dimension X
    Y       =>   100,   # grid dimension Y
    dx      =>     2,   # cell size x
    dy      =>     2,   # cell size y
    density => 0.125,   # density
    T       =>     0,   # simulation length (0 = infinite)
    t       =>    10,   # graphical update  (0 = never)
    I       =>     2,   # ice crystals
}; # settings

my $VACUUM = 0;
my $VAPOR  = 1;
my $ICE    = 2;
my $color;
$color->[$VACUUM] = 'black';
$color->[$VAPOR ] = 'blue';
$color->[$ICE   ] = 'darkgray';

# tk callbacks
my $running   = 1;
my $anykey    = 0;
my $waitkey   = 0;  # wait for interaction at end?

sub init_grid;      # grid
sub draw_grid;      # grid
sub init_neigh;     # grid
                    # -> n1, n2
sub has_ICE;        # block
sub has_VAPOR;      # block
sub VAPOR_to_ICE;   # block
sub rotate_block;   # block, direction (1: clockwise, 0: counter-)
sub frostify;       # grid, blocks

sub init_tk;        # grid
sub tk_draw;        # event_type

$SIG{ALRM} = sub { warn "TICKS: $::T\n"; exit };
alarm $ENV{TIMELIMIT} || 120;

{ # main
    $settings = getopt ($settings);
    my $grid = $settings;
    
    init_tk    ($grid);
    init_grid  ($grid);
    draw_grid  ($grid);
    tk_draw    ();
    
    our $T = 0;                                              # simulation tick nr
    # n1,n2 holding neighbourhood information (lookup tables of blocks)
    my ($n1, $n2) = init_neigh ($grid);
    my $n;  # actual neighbourhood (reference)
    
    # MainLoop:
    while ($running) {
        $T++;
        $n = ( $T % 2 ? \$n1 : \$n2 );                      # choose neighbourhood
        frostify  ($grid, $n);
        
        if ($settings->{t} and (! ($T % $settings->{t}))) { # update visual?
            draw_grid ($grid);                              # calls tk_draw
        } else {
            tk_draw ();                                     # checking tk events
        } # if t and !T%t
        # stop loop if boundary given and reached
        if ($settings->{T} and ($T>= $settings->{T})) { $running = 0 }
    } # while Exists
    
    draw_grid ($grid);
    
    if ($waitkey and $settings->{T}) {                      # wait for anykey
        print "Please press the anykey ...";                # if boundary given
        $anykey = 0; while (!$anykey) { tk_draw () };
        print "\n";
    } # if T
    $grid->{window}->destroy;
    exit 0;
} # main
##################################################

# initializes and returns 2 blocks containing Margolus neighborhoods
# each block is an array of references to cells, ordered clockwise
sub init_neigh {
    my $grid = shift;
    my ($n1, $n2);
    
    # FIXME blocksize (2x2) is hardcoded ...
    foreach my $x ( 0 .. ($grid->{X} >> 1) -1) {
        foreach my $y ( 0 .. ($grid->{Y} >> 1) -1) {
            # blocks containing Margolus neighborhoods
            # (references to grids cells
            my ($block1,$block2);
            
            foreach my $coord ( [0,0], [1,0], [1,1], [0,1] ) {  # order cells clockwise
                my $rx = $x*2 + $coord->[0];                    # for easy rotation
                my $ry = $y*2 + $coord->[1];
                
                push @$block1, \$grid->{cells}->[$rx]->[$ry];
                
                $rx ++; $ry ++;
                if ($rx > $grid->{X}-1) { $rx -= $grid->{X} }   # toroidal geometry
                if ($ry > $grid->{Y}-1) { $ry -= $grid->{Y} }
                push @$block2, \$grid->{cells}->[$rx]->[$ry];
            } # coord
            
            push @$n1, $block1;
            push @$n2, $block2;
        } # y
    } # x
    return ($n1, $n2);
} # init_neigh

# check if given block contains any ICEd cell
sub has_ICE {
    my $block = shift;
    foreach (@$block) {
        if ($$_->{status} == $ICE) { return $_ }
    } # foreach block
    return 0;
} # has_$ICE

# converts every VAPORed cell into an ICEd one
sub VAPOR_to_ICE {
    my $block = shift;
    foreach (@$block) {
        if ($$_->{status} == $VAPOR) { 
            $$_->{status} =  $ICE;
        } # if $VAPOR
    } # foreach block
} # $VAPOR_to_$ICE

# shifting blocks cells
sub rotate_block {
    my $block = shift;
    my $dir   = shift;
    
    my $swap;
    
    if ($dir) { # 1: clockwise
        $swap = ${$block->[-1]}->{status};
        for ( $_=3; $_>= 1; $_-- ) {
            ${$block->[$_]}->{status}   = ${$block->[$_-1]}->{status};
        } # foreach 3 .. 1
        ${$block->[0]}->{status} = $swap;
    } else {
        $swap = ${$block->[0]}->{status};
        for ( $_=0; $_<= 2; $_++ ) {
            ${$block->[$_]}->{status}   = ${$block->[$_+1]}->{status};
        } # foreach 0 .. 2
        ${$block->[-1]}->{status} = $swap;
    } # direction
} # rotate_block

# worker: checks blocks for ICEation or rotates VAPOR
sub frostify {
    my $grid = shift;
    my $n    = shift;
    
    foreach my $block (@$$n) {
        if (has_ICE ($block)) {
            VAPOR_to_ICE ($block);
        } else {
            rotate_block ( $block, rand >= 0.5 ? 0 : 1);
        } # if has_ICE
    } # foreach block
} # frostify

# setting random cells
sub rand_cells {
    my ($grid, $count, $status) = @_;
    my $square = $grid->{X}*$grid->{Y};
    
    foreach my $c (0 .. $count-1) {
        RAND:
        my $rand = int (rand $square);
        my $x =       $rand       % $grid->{X};
        my $y = int (($rand - $x) / $grid->{X});
        if ($grid->{cells}->[$x]->[$y]->{status} != $VACUUM) { goto RAND }
        $grid->{cells}->[$x]->[$y]->{status} = $status;
    } # 0 - count-1
} # rand_cell

# initializing cells to VACUUM; setting some ICEd cells (the specification
# says `in the middle of the grid';  these ones are placed randomly as I think
# each position in a toroid geometry is `the middle' ...);  setting VARPORed
# cells according to grids density
sub init_grid {
    my $grid = shift;
    
    for my $x ( 0 .. $grid->{X}-1) {
        for my $y ( 0 .. $grid->{Y}-1) {
            $grid->{cells}->[$x]->[$y] = { 
                status      => $VACUUM,
                old_status  => -1,      # save old status for faster drawing
            } # cell
        } # y
    } # x
    
    rand_cells ($grid, $grid->{I}, $ICE);
    my $square = $grid->{X}*$grid->{Y};
    my $count = int ($square * $grid->{density})-$grid->{I};
    rand_cells ($grid, $count, $VAPOR);
} # init_grid

# tk stuff
sub draw_grid  {
    my $grid = shift;
    foreach my $x ( 0 .. $grid->{X}-1 ) {
        foreach my $y ( 0 .. $grid->{Y}-1 ) {
            my $cell = $grid->{cells}->[$x]->[$y];
            
        # draw only if status has changed
        if ($cell->{old_status} == $cell->{status}) { next }
        
            if (exists $cell->{tk_rect}) {
                $grid->{canvas}->itemconfigure (
                    $cell->{tk_rect}, -fill => $color->[$cell->{status}]
                ); # itemconfigure
            } else {
               $cell->{tk_rect} = $grid->{canvas}->create (
                   'rectangle',
                    1+ $x*   $grid->{dx}, 1+ $y   *$grid->{dy},
                    1+($x+1)*$grid->{dx}, 1+($y+1)*$grid->{dy},
                   -outline => undef,
                   -fill    => $color->[$cell->{status}],
               ); # create
            } # switch status
            
            $cell->{old_status} =  $cell->{status};
            $y ++;
        } # foreach rows
        $x ++;
        tk_draw ();
    } # foreach cols
} # draw_grid

# tk event loop
sub tk_draw {
    my $type = shift || '';
    if ($type eq 'blocking') {
        Tk::DoOneEvent (ALL_EVENTS)
    } else {
        Tk::DoOneEvent (DONT_WAIT)
    } # if blocking
} # draw

# tk stuff
sub init_tk {
    my $grid = shift;
    
    $grid->{window}  = Tk::MainWindow->new (
            -title => 'frost'
    ); # main window
    my $h = $grid->{dx} * $grid->{X};
    my $w = $grid->{dy} * $grid->{Y};
    
    $grid->{canvas} = $grid->{window}->Canvas (
        -width          => $w,
        -height         => $h,
        -background     => 'red',
    )->pack (
        -fill => 'both',
        -expand => 1,
    ); # Canvas
    
    $grid->{window}->packPropagate (0);
    $grid->{window}->MapWindow;
    $grid->{window}->protocol (
        'WM_DELETE_WINDOW'  => sub { $running = 0 },
    ); #protocol
    $grid->{window}->bind (
        '<Any-Escape>'      => sub { $running = 0; print "ESC\n" },
    ); # bind
    $grid->{window}->bind (
        '<Any-Key>'         => sub { $anykey  = 1; print "anykey\n" },
    ); # bind
} # init_tk

sub getopt {                    # commandline processing
    my $settings = shift;
    my %opts;
    my $mapping = {
        X   => 'X',             # grid dim X
        Y   => 'Y',             # grid dim Y
        x   => 'dx',            # cell dim x
        y   => 'dy',            # cell dim y
        d   => 'density',       # density (ICE percent)
        t   => 't',             # graph. update interval
        T   => 'T',             # simulation ticks
        I   => 'I',             # ICE crystals
    }; # mapping
    Getopt::Std::getopt ((join '',keys %$mapping),\%opts);
    map {
        if (exists $mapping->{$_}) { $settings->{$mapping->{$_}} = $opts{$_} }
    } keys %opts;
    return $settings;
} # getopt
