#! /usr/bin/perl

# Copyright (c) 2014 Francesco Nidito
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights to
# use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
# of the Software, and to permit persons to whom the Software is furnished to do
# so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

use strict;
use warnings;

use Tk;
use Tk::DialogBox;

my $x = 9;
my $y = 9;
my $n = 9;
my $f = 0;

my @colour = ('black', 'green', 'blue', 'red', 'red', 'red', 'red', 'red', 'black');
my @numbers = (9, 11, 15, 21, 33);

my $cellH = 1; # 2
my $cellW = 2; # 4

my $flagChar = "\x{2691}"; # 'F'
my $mineChar = "\x{2600}"; # '*'
my $boomChar = "\x{2620}"; # 'X'
my $noneChar = " ";        # ' '

my %widgets; # maps (x,y) to the buttons/labels
my %values; # maps (x,y) to its content (-1 == mine, >= 0 how many mines)

my %uncovered = ();
my %flagged = ();

my $mw = MainWindow->new;
$mw->title("Minesweeper");
$mw->configure(-background => 'white');
$mw->resizable(0,0);

$mw->protocol('WM_DELETE_WINDOW', sub {
                my $answer = $mw->messageBox(-title => 'Why do you want to leave me?',
                                             -message => "Did I do anything wrong? Press 'no' to stay \x{263A}",
                                             -type => 'yesno', -icon => 'info', -default => 'Yes');

                if($answer eq 'Yes') {
                  $mw->destroy;
                  exit 0;
                }
              });

InitGame();

MainLoop;

# hide the main window, ask for config, draw the field...
sub InitGame {
  $mw->withdraw;
  Configure();
  InitField();
  InitUI();
  $mw->deiconify;
}

sub Configure {
  # destroy old field before picking up the new size...
  my $it = AllPairs([0..$x-1], [0..$y-1]);
  while(my ($i, $j) = $it->()) {
    $widgets{$i}{$j}->destroy() if(exists $widgets{$i}{$j} && defined $widgets{$i}{$j});
  }

  # ask for new size and config grid
  my $sizeBox = $mw->DialogBox(-title => "Field size?", -buttons => [map {$_.'x'.$_} @numbers]);
  $sizeBox->transient(undef);
  my $response = '';
  while(!defined($response = $sizeBox->Show(-popover => $mw))) { }
  ($x, $y) = ($response =~ /(\d+)x(\d+)/);

  for my $i (0..$x-1) { $mw->gridColumnconfigure($i, -pad => 2); }
  for my $i (0..$y-1) { $mw->gridRowconfigure($i, -pad => 2); }

  # ask for how many mines should be in the field
  my $mineBox = $mw->DialogBox(-title => "How many mines?", -buttons => [map { $_ } @numbers]);
  $mineBox->transient(undef);
  while(!defined($n = $mineBox->Show(-popover => $mw))) { }
}

sub InitField {
  # init grid
  my $it = AllPairs([0..$x-1], [0..$y-1]);
  while(my ($i, $j) = $it->()) {
    $values{$i}{$j} = 0;
  }

  # init mines
  srand(time());
  for (1..$n) {
    MORE_SIR:
      my $i = int(rand($x));
      my $j = int(rand($y));
      if($values{$i}{$j} != 0) { goto MORE_SIR; } # regenerate this...
      else { $values{$i}{$j} = -1; }
  }

  # init hints
  my $all = AllPairs([0..$x-1], [0..$y-1]);
  while(my ($i, $j) = $all->()) {
    # if there is a mine, place the hints around
    if($values{$i}{$j} == -1) {
      my $neighbor = Neighbors($i,$j);
      while(my ($s, $t) = $neighbor->()) {
        $values{$s}{$t} += 1 if($values{$s}{$t} != -1);
      }
    }
  }
}

sub InitUI {
  %uncovered = ();
  %flagged = ();

  my $f = 0; # number of flags...

  # init UI
  my $it = AllPairs([0..$x-1], [0..$y-1]);
  while(my ($i, $j) = $it->()) {
    $widgets{$i}{$j} = $mw->Button(-text => $noneChar,
                                   -command => [\&Check, $i, $j],
                                   -height => $cellH, -width => $cellW, -borderwidth => 1,
                                   -font => [-size => 10, -weight => 'bold', -family => 'courier']
                                  )->grid(-column => $i, -row => $j);

    $widgets{$i}{$j}->bind("<Button-3>", [\&FlagOrUnflag, $i, $j]);
  }
}

sub CheckForVictory {
  if($f > $n) {
    $mw->messageBox(-title => 'Too many flags...',
                    -message => 'There are a bit too many flags... remove some',
                    -type => 'ok', -icon => 'warning', -default => 'ok');

    return;
  }

  my $all = AllPairs([0..$x-1], [0..$y-1]);
  my $cnt = 0;
  while(my ($i, $j) = $all->()) {
    $cnt++ if($values{$i}{$j} == -1 && exists $flagged{$i}{$j});
  }

  if($cnt == $n) {
    my $all = AllPairs([0..$x-1], [0..$y-1]);
    while(my ($i, $j) = $all->()) {
      if($values{$i}{$j} == -1) {
        UncoverTile($i, $j, $mineChar);
      }
    }

    my $answer =$mw->messageBox(-title => 'Victory!',
                                -message => "Against all odds, you won!\nPlay again?",
                                -type => 'yesno', -icon => 'info', -default => 'yes');
    if ($answer eq 'Yes') {
      InitGame();
    }
    else {
      $mw->destroy;
      exit 0;
    }
  }
}

sub FlagOrUnflag {
  my ($b, $i, $j) = @_;

  # flag the cell
  if(!exists $flagged{$i}{$j}) {
    $b->configure(-text => $flagChar);
    $flagged{$i}{$j} = 1;
    $f++;
  }
  # unflag it
  else {
    $b->configure(-text => $noneChar);
    delete $flagged{$i}{$j};
    $f--;
  }

  CheckForVictory();
}

sub AllPairs {
  my ($A, $B) = @_;
  my @values = ();
  for my $i (@$A) {
    for my $j (@$B) {
      push @values, $i;
      push @values, $j;
    }
  }

  # create the closure that iterates on the pairs...
  my $i_ = 0;
  my $j_ = 1;
  return sub { return unless($i_ < @values);
               my $x_ = $values[$i_]; $i_ += 2;
               my $y_ = $values[$j_]; $j_ += 2;
               return ($x_, $y_);
             }
}

sub UncoverTile {
  my ($i, $j, $s) = @_;

  # flagged cells cannot be uncovered...
  return if(exists $flagged{$i}{$j});

  # what to write in the cell...
  my $value = $values{$i}{$j};
  $s = (($value==0)?$noneChar:$value) if(!defined $s);

  # change the button with a label...
  $widgets{$i}{$j}->destroy();

  $widgets{$i}{$j} = $mw->Label(-text => $s,
                                -bg => 'white', -fg => $colour[$value],
                                -height => $cellH, -width => $cellW, -borderwidth => 3,
                                -font => [-size => 10, -weight => 'bold', -family => 'courier']
                               )->grid(-column => $i, -row => $j);

  $uncovered{$i}{$j} = 1; # mark as uncovered...
}

# The iterative version of percolate...
sub Percolate {
  my ($i, $j) = @_;

  my @stack = ();
  push @stack, [$i, $j];

  while(@stack > 0) {
    my ($a, $b) = @{pop @stack};

    # process only if not uncovered yet...
    if(!exists $uncovered{$a}{$b}) {
      my $value = $values{$a}{$b};

      UncoverTile($a,$b);

      # will need to uncover neighbors...
      if($value == 0) {
        my $neighbor = Neighbors($a,$b);
        while(my ($s, $t) = $neighbor->()) {
          push @stack, [$s, $t];
        }
      }
    }
  }
}

# # The recursive version of percolate...
# sub Percolate {
#   my ($i, $j) = @_;

#   return if(exists $uncovered{$i}{$j});

#   my $value = $values{$i}{$j};

#   if($value != -1) {
#     UncoverTile($i,$j);

#     if($value == 0) {
#       my $neighbor = Neighbors($i,$j);
#       while(my ($s, $t) = $neighbor->()) {
#         Percolate($s,$t);
#       }
#     }
#   }
# }

sub Neighbors {
  my ($i,$j) = @_;
  my @neighbors = ();

  # create the list of all the neighbors that make sense
  my $offsets = AllPairs([-1..1],[-1..1]);
  while(my ($s, $t) = $offsets->()) {
    # i.e., skip the cell itself and deal
    # only with cells inside the board
    if(($s != 0 || $t != 0) &&
       ($i+$s >= 0) && ($i+$s < $x) &&
       ($j+$t >= 0) && ($j+$t < $y) ) {
      push @neighbors, $i+$s;
      push @neighbors, $j+$t;
    }
  }

  # create the closure that iterates on the neighbors...
  my $i_ = 0;
  my $j_ = 1;
  sub { return unless($i_ < @neighbors);
        my $x_ = $neighbors[$i_]; $i_ += 2;
        my $y_ = $neighbors[$j_]; $j_ += 2;
        return ($x_, $y_);
  }
}

sub UncoverAllMines {
  my $all = AllPairs([0..$x-1], [0..$y-1]);
  while(my ($i, $j) = $all->()) {
    if($values{$i}{$j} == -1) {
      UncoverTile($i, $j, $mineChar);
    }
  }
}

sub Check {
  my ($i, $j) = @_;

  my $value = $values{$i}{$j};

  # you found a mine!
  if($value == -1) {
    UncoverAllMines();              # show all mines
    UncoverTile($i, $j, $boomChar); # make one boom!

    my $answer = $mw->messageBox(-title => 'BOOOOOOOOOOM!',
                                 -message => "A nuclear blast whiped you from the face of earth...\nPlay again?",
                                 -type => 'yesno', -icon => 'error', -default => 'yes');
    if ($answer eq 'Yes') {
      InitGame();
    }
    else {
      exit;
    }
  }
  # it is a int cell
  elsif($value > 0) {
    UncoverTile($i,$j);
  }
  # it is a empty cell
  else {
    Percolate($i,$j);
  }
}