#!/usr/bin/perl -w
use strict;

use Image::Magick;

our $image;

our @english;
our @french;
    
# --------------------------------------------------------------------------------------
sub populate_games
{
    # A script would usually read the input data from stdin or a file file, but I'm
    # going to leave that as an exercise to the reader!
    
    $french[0]   = "--011---11111-111111111111111111111-11111---111--";
    $french[1]   = "--111---10111-110111111111111111111-11111---111--";
    $french[2]   = "--111---11001-110111111111111111111-11111---111--";
    $french[3]   = "--011---10001-111111111111111111111-11111---111--";
    $french[4]   = "--100---10001-111111111111111111111-11111---111--";
    $french[5]   = "--100---11001-110111111011111111111-11111---111--";
    $french[6]   = "--100---11001-110111111111111101111-10111---111--";
    $french[7]   = "--100---11011-110101111110111101111-10111---111--";
    $french[8]   = "--100---11011-110101111110110011111-10111---111--";
    $french[9]   = "--100---11011-110101111010110001111-11111---111--";
    $french[10]  = "--100---11011-110110011010110001111-11111---111--";
    $french[11]  = "--100---11100-110110011010110001111-11111---111--";
    $french[12]  = "--100---11100-110110111010100001110-11111---111--";
    $french[13]  = "--100---11100-110111111010000001100-11111---111--";
    $french[14]  = "--100---11100-001111111010000001100-11111---111--";
    $french[15]  = "--100---11100-001111111010000000010-11111---111--";
    $french[16]  = "--100---11100-010011111010000000010-11111---111--";
    $french[17]  = "--000---10100-011011111010000000010-11111---111--";
    $french[18]  = "--000---10100-000111111010000000010-11111---111--";
    $french[19]  = "--000---10100-001001111010000000010-11111---111--";
    $french[20]  = "--000---10100-001010011010000000010-11111---111--";
    $french[21]  = "--000---10100-001010011010000001010-11011---101--";
    $french[22]  = "--000---10100-001010011010000001110-11001---100--";
    $french[23]  = "--000---10100-001010011010000001110-00101---100--";
    $french[24]  = "--000---10100-001110011000000000110-00101---100--";
    $french[25]  = "--000---10100-001110011000100000100-00100---100--";
    $french[26]  = "--000---10100-001110000100100000100-00100---100--";
    $french[27]  = "--000---11100-000110000000100000100-00100---100--";
    $french[28]  = "--010---11000-000010000000100000100-00100---100--";
    $french[29]  = "--010---00100-000010000000100000100-00100---100--";
    $french[30]  = "--000---00000-000110000000100000100-00100---100--";
    $french[31]  = "--000---00000-000001000000100000100-00100---100--";
    $french[32]  = "--000---00000-000000000000000000110-00100---100--";
    $french[33]  = "--000---00000-000000000000000001000-00100---100--";
    $french[34]  = "--000---00000-000000000000000000000-00000---110--";
    $french[35]  = "--000---00000-000000000000000000000-00000---001--";
    
    $english[0]  = "--111----111--111111111101111111111--111----111--";
    $english[1]  = "--111----101--111011111111111111111--111----111--";
    $english[2]  = "--111----101--100111111111111111111--111----111--";
    $english[3]  = "--111----101--110111110111111011111--111----111--";
    $english[4]  = "--111----101--110111110111111100111--111----111--";
    $english[5]  = "--111----101--110111110111111101111--101----101--";
    $english[6]  = "--111----101--110111110111110011111--101----101--";
    $english[7]  = "--111----101--110111111001110011111--101----101--";
    $english[8]  = "--111----101--110111100101110011111--101----101--";
    $english[9]  = "--111----101--110111100101110100111--101----101--";
    $english[10] = "--111----101--001111100101110100111--101----101--";
    $english[11] = "--111----101--001111100101110110111--001----001--";
    $english[12] = "--111----101--010011100101110110111--001----001--";
    $english[13] = "--111----101--010011100101110001111--001----001--";
    $english[14] = "--111----101--010011100101110010011--001----001--";
    $english[15] = "--111----101--010011100101110010111--000----000--";
    $english[16] = "--111----101--010100100101110010111--000----000--";
    $english[17] = "--011----001--011100100101110010111--000----000--";
    $english[18] = "--011----101--010100100001110010111--000----000--";
    $english[19] = "--100----101--010100100001110010111--000----000--";
    $english[20] = "--100----101--010100100001110011001--000----000--";
    $english[21] = "--100----101--010100100001110000101--000----000--";
    $english[22] = "--100----101--010110100000110000001--000----000--";
    $english[23] = "--100----101--010001100000110000001--000----000--";
    $english[24] = "--100----101--010010000000110000001--000----000--";
    $english[25] = "--000----001--011010000000110000001--000----000--";
    $english[26] = "--000----001--000110000000110000001--000----000--";
    $english[27] = "--000----001--000001000000110000001--000----000--";
    $english[28] = "--000----001--000001100000100000000--000----000--";
    $english[29] = "--000----001--000010000000100000000--000----000--";
    $english[30] = "--000----000--000000000001100000000--000----000--";
    $english[31] = "--000----000--000000000010000000000--000----000--";
}
# --------------------------------------------------------------------------------------
sub draw_board
{
    my $map   = $_[0]; # String map of the board contents
    my $width = $_[1]; # Pixel width/height of the board ... assumes GIF is big enough
    my $units = $_[2]; # Max number of pegs in an edge.  For Peg Solitaire, this is 7
    my $movei = $_[3]; # For all but the last board, we note the coordinates of the next
    my $movej = $_[4]; #  peg to move and its direction.
    my $orientation = $_[5];
    
    my $cellwidth;     # Pixel width of cells
    my $i;
    my $j;
    my $offset;
    my $c;
    my $x1;
    my $y1;
    my $x2;
    my $y2;
    my $rlen; #Radius length, which I'd like to not fully consume the available cell width
    my $centerx;
    my $centery;
    my $edge;
    my @pp;
    my $pegfill = "lightblue";
    # my $pegfill = "#DADAE3";
    
    $cellwidth = int ($width / $units);
    $rlen = (($cellwidth % 2) ? ($cellwidth - 7) / 2 : ($cellwidth - 6) / 2);
    
    # ImageMagick rectangles take arguments that define the upper left and lower right corners
    #             circle arguments define the center, and then a point on the outer edge
    
    for ($i = 0;$i < $units;$i++) {
        for ($j = 0;$j < $units;$j++) {
            $offset = ($i * $units) + $j;
            $c = substr($map,$offset,1);
            if ($c eq "-") {
                next; # Don't draw anything
            }
            
            # Draw the cell box
            $x1 = ($j + 0) * $cellwidth;
            $x2 = ($j + 1) * $cellwidth;
            $y1 = ($i + 0) * $cellwidth;
            $y2 = ($i + 1) * $cellwidth;
            
            $image -> Draw(stroke => 'black', primitive => 'rectangle',
                points => "$x1,$y1 $x2,$y2");
            
            # Draw the peg, white if empty, red if in use
            
            $centerx = $x1 + int ($cellwidth / 2);
            $centery = $y1 + int ($cellwidth / 2);
            $edge    = $centerx + $rlen;
            
            if (($i == $movei) && ($j == $movej)) {
                if ($orientation == 0) { # Arrow will point East
                    $pp[0] = $centerx - $rlen;
                    $pp[1] = $centery - $rlen;
                    $pp[2] = $centerx + $rlen;
                    $pp[3] = $centery;
                    $pp[4] = $centerx - $rlen;
                    $pp[5] = $centery + $rlen;
                    $pp[6] = $centerx - $rlen / 2;
                    $pp[7] = $centery;
                }
                if ($orientation == 1) { # Arrow will point North
                    $pp[0] = $centerx - $rlen;
                    $pp[1] = $centery + $rlen;
                    $pp[2] = $centerx;
                    $pp[3] = $centery - $rlen;
                    $pp[4] = $centerx + $rlen;
                    $pp[5] = $centery + $rlen;
                    $pp[6] = $centerx;
                    $pp[7] = $centery + $rlen / 2;
                }
                if ($orientation == 2) { # Arrow will point West
                    $pp[0] = $centerx + $rlen;
                    $pp[1] = $centery - $rlen;
                    $pp[2] = $centerx - $rlen;
                    $pp[3] = $centery;
                    $pp[4] = $centerx + $rlen;
                    $pp[5] = $centery + $rlen;
                    $pp[6] = $centerx + $rlen / 2;
                    $pp[7] = $centery;
                }
                if ($orientation == 3) { # Arrow will point South
                    $pp[0] = $centerx - $rlen;
                    $pp[1] = $centery - $rlen;
                    $pp[2] = $centerx;
                    $pp[3] = $centery + $rlen;
                    $pp[4] = $centerx + $rlen;
                    $pp[5] = $centery - $rlen;
                    $pp[6] = $centerx;
                    $pp[7] = $centery - $rlen / 2;
                }
            }
            
            if ($c eq "1") {
                $image -> Draw(stroke => 'black', primitive => 'circle',
                   points => "$centerx,$centery $edge,$centery", fill => "$pegfill");
                
                if (($i == $movei) && ($j == $movej)) {
                    $image -> Draw(stroke => 'black', primitive => 'polygon',
                        points => "$pp[0],$pp[1] $pp[2],$pp[3] $pp[4],$pp[5] $pp[6],$pp[7]",
                        fill => 'black');
                }
            }
            else {
                $image -> Draw(stroke => 'black', primitive => 'circle',
                   points => "$centerx,$centery $edge,$centery", fill => 'white');
            }
        }
    }
}
# --------------------------------------------------------------------------------------
sub mask
{
    my $b1 = $_[0];
    my $b2 = $_[1];
    my $c1;
    my $c2;
    my $i;
    my $j;
    my $offset;
    my $s;
    my $east  = "001";
    my $north = "1------0------0";
    my $west  = "100";
    my $south = "0------0------1";
    my $movei;
    my $movej;
    my $orientation;
    my @results;
    
    $s = $b1;
    for ($i = 0;$i < length($b1);$i++) {
        $c1 = substr($b1,$i,1);
        $c2 = substr($b2,$i,1);
        
        substr($s,$i,1) = ($c1 eq $c2 ? "-" : $c2)
    }
    
    if (index($s,$east) > -1) {
        $offset = index($s,$east);
        $orientation = 0;
    }
    elsif (index($s,$north) > -1) {
        $offset = index($s,$north) + length($north) - 1;
        $orientation = 1;
    }
    elsif (index($s,$west) > -1) {
        $offset = index($s,$west) + length($west) - 1;
        $orientation = 2;
    }
    elsif (index($s,$south) > -1) {
        $offset = index($s,$south);
        $orientation = 3;
    }
    else {
        $orientation = -1;
    }
    
    if ($orientation == -1) {
        $movei = -1;
        $movej = -1;
    }
    else {
        $movej = $offset % 7;
        $movei = ($offset - $movej) / 7;
    }
    
    $results[0] = $movei;
    $results[1] = $movej;
    $results[2] = $orientation;
    
    return(@results);
}
# --------------------------------------------------------------------------------------
sub print_row
{
    my $i           = $_[0];
    my $movei       = $_[1];
    my $movej       = $_[2];
    my $orientation = $_[3];
    
    print "<tr>";
    print "<td>" . ($i + 1) . "</td>";
    print "<td>" . ($movei + 1) . "</td>";
    print "<td>" . ($movej + 1) . "</td>";
    print "<td>";
    if ($orientation == 0) {
        print "East";
    }
    elsif ($orientation == 1) {
        print "North";
    }
    elsif ($orientation == 2) {
        print "West";
    }
    elsif ($orientation == 3) {
        print "South";
    }
    print "</td>";
    print "</tr>\n";
}
# --------------------------------------------------------------------------------------
my $i;
my $width    = 200;
my $nfrench  =  36;
my $nenglish =  32;
my $movei;
my $movej;
my $orientation;
my $filename;
my @results;
my @images;
my $animation1;
my $animation2;

populate_games();

# Create the English animation

print "<table>\n";
print "<tr><td>Move #</td><td>Start Row</td><td>Start Column</td><td>Move Direction</td></tr>\n";
for ($i = 0;$i < $nenglish;$i++) {
    
    $images[$i] = Image::Magick->new(size => "$width" . "x" . "$width");
    
    $image = $images[$i];
    $image -> ReadImage('xc:white');
    
    if (($i + 1) < $nenglish) {
        @results = mask($english[$i],$english[$i + 1]);
        
        $movei       = $results[0];
        $movej       = $results[1];
        $orientation = $results[2];
        
        print_row($i,$movei,$movej,$orientation);
    }
    else {
        $movei = -1;
        $movej = -1;
        $orientation = -1;
    }
    
    draw_board($english[$i],$width,7,$movei,$movej,$orientation);
    
    $filename = "x" . $i . ".gif";
    
    $image -> Write("$filename");
}
print "</table>\n";

# Animation steps
$animation1 = Image::Magick -> new;
for ($i = 0;$i < $nenglish;$i++) {
    $animation1 -> Read("x" . $i . ".gif");
}
$animation1 -> Write('english.gif');

# Create the French animation

print "<table>\n";
print "<tr><td>Move #</td><td>Start Row</td><td>Start Column</td><td>Move Direction</td></tr>\n";
for ($i = 0;$i < $nfrench;$i++) {
    
    $images[$i] = Image::Magick->new(size => "$width" . "x" . "$width");
    
    $image = $images[$i];
    $image -> ReadImage('xc:white');
    
    if (($i + 1) < $nfrench) {
        @results = mask($french[$i],$french[$i + 1]);
        
        $movei       = $results[0];
        $movej       = $results[1];
        $orientation = $results[2];
        
        print_row($i,$movei,$movej,$orientation);
    }
    else {
        $movei = -1;
        $movej = -1;
        $orientation = -1;
    }
    
    draw_board($french[$i],$width,7,$movei,$movej,$orientation);
    
    $filename = "y" . $i . ".gif";
    
    $image -> Write("$filename");
}
print "</table>\n";

# Animation steps
$animation2 = Image::Magick -> new;
for ($i = 0;$i < $nfrench;$i++) {
    $animation2 -> Read("y" . $i . ".gif");
}
$animation2 -> Write('french.gif');