#!/usr/bin/perl

# Copyright (C) 2005 by Flavio Poletti
# Same licensing terms as Perl itself, v. 5.8.6
# NO WARRANTY AT ALL, USE IT AT YOUR RISK

# ChangeLog:
#
# Changed from 'readonly' to 'disabled' to support older versions of
# Tk. Also changed -disableforeground to give the same look-and-feel.
#
# Removed dumb error left from a previos test. Turned check messages
# into english. Changed relief for fixed cells.
#
# Added support for "starter" status, i.e. elements that are 
# there from the start. Fixed residual bug in push/pop
# mechanism. Added version thanks to dree

use strict;
use warnings;

use Tk;
use Tk::Dialog;

######## GLOBAL VARIABLES ###########################################
# Version
my $VERSION = 0.03;

# File name used for load and save
my $filename = shift;

# Main Window
my $mw = MainWindow->new();

# Font size
my $size = int(-32 * 32 / 48);

# Different options for fixed cells (disabled) and normal ones
# These are the different visualisations for the two states of a
# cell: normal (editable) and disabled (i.e. "fixed").
my %opts = (
   'normal' => {
      -font    => 'normal',    # Will create this font later
      -justify => 'left',
      -relief => 'sunken',
      -state  => 'normal',
   },
   'fixed' => {
      -font    => 'fixed',    # Will create this font later
      -justify => 'center',
      -relief => 'groove',
      -state  => 'disabled',
   },
   'starter' => {
      -font    => 'starter',    # Will create this font later
      -justify => 'center',
      -relief => 'groove',
      -state  => 'disabled',
   },
);

# Map of game info
my @map;

# Commands for undo support
my @commands;

# Frames for different 3x3 subframes
my @chunks;

# Signal if we're inside an undo sequence, just to avoid having
# the undo commands be re-pushed inside the command stack.
my $undoing;

#####################################################################
# Define fonts for normal and disabled view
$mw->fontCreate(
   'normal',
   -family => 'courier',
   -weight => 'normal',
   -size   => $size,
);
$mw->fontCreate(
   'fixed',
   -family => 'courier',
   -weight => 'bold',
   -size   => $size,
);
$mw->fontCreate(
   'starter',
   -family => 'courier',
   -weight => 'bold',
   -size   => $size,
);

# Initialise frames, isolating 3x3 subwindows. This allows to
# separate 3x3 subwindows for a clearer view of the game table.
for my $i (0 .. 2) {
   my $outer = $mw->Frame();
   $outer->pack(-side => 'top');
   for my $j (0 .. 2) {
      my $inner = $outer->Frame(-borderwidth => 4);
      $inner->pack(-side => 'left');
      for my $k (0 .. 2) {
         $chunks[$i][$j][$k] = $inner->Frame( );
         $chunks[$i][$j][$k]->pack(-side => 'top');
      }
   } ## end for my $j (0 .. 2)
} ## end for my $i (0 .. 2)

# Initialise the 81 cells in the game
for my $i (0 .. 8) {
   for my $j (0 .. 8) {

      # Each element is compound of three items: the contents of the
      # Entry widget, the state (normal = editable, disabled = fixed),
      # and a reference to the cell itself for later modifications.
      $map[$i][$j] = ['', 'normal', undef];
      my $cell = $chunks[$i / 3][$j / 3][$i % 3]->Entry(
         -width              => 4,
         -textvariable       => \$map[$i][$j][0],
         -validate           => 'key',
         -validatecommand    => [\&validate, $i, $j],
         -font               => 'normal',
         -disabledforeground => 'blue',
      );
      $map[$i][$j][2] = $cell;

      # Clicking with the right mouse button toggles state if applicab
+le
      # You cannot fix cells that are empty or contain more than one
      # character, of course.
      $cell->bind(
         "<Button-3>",
         sub {
            my $cstate = $map[$i][$j][1];
            return if $cstate eq 'starter';

            # Invert the state only if cell contains a single digit
            $cstate = ($cstate eq 'normal' ? 'fixed' : 'normal')
              if (defined $map[$i][$j][0] && $map[$i][$j][0] =~ /^\d$/
+);

            # Call ad-hoc function, refactored code
            set_state($i, $j, $cstate);
         }
      );
      $cell->pack(-side => 'left');
   } ## end for my $j (0 .. 8)
} ## end for my $i (0 .. 8)

# Load filename, if it can be done, and initialise cells
$filename && load($filename);

# Dialog window to show when the check button is pressed.
my $checkLabel;
my $checkDialog = $mw->Dialog(
   -title        => 'Check result',
   -buttons      => ['OK'],
   -bitmap       => 'warning',
   -textvariable => \$checkLabel
);

# Bottom frame, containing all the action buttons.
my $bottom = $mw->Frame();
$bottom->pack();

# Undo handling. Push pushes a marker into the command stack, which
# will be the stopping point for a canned sequence of later pops.
$bottom->Button(-text => 'Push', -command => sub { push @commands, 0 }
+)
  ->pack(-side => 'left');

# Pop inhibits the re-push of the commands signaling via the
# $undoing variable. It pops commands and undoes them until
# the queue is empty or it finds a marker pushed by the user.
$bottom->Button(
   -text    => 'Pop',
   -command => sub {
      $undoing = 1;
      while (my $aref = pop @commands) {
         my ($i, $j, $type, $v) = @$aref;
         if ($type eq 'value') {
            $map[$i][$j][0] = $v;
         }
         else {
            set_state($i, $j, $v);
         }
      }
      $undoing = 0;
   }
)->pack(-side => 'left');

# Check calls the check method to see if the fixed elements collide.
# It displays the $checkDialog dialog window with an appropriate
# message.
$bottom->Button(
   -text    => 'Check',
   -command => sub {
      $checkLabel = (check() ? "All ok!" : "Check out errors!");
      $checkDialog->Show();
   }
)->pack(-side => 'left');

# If a filename was provided, saves the board into that file.
$bottom->Button(-text => 'Save', -command => sub { save($filename) })
  ->pack(-side => 'left');

# Exit from the game. No "are you sure" messages are shown :)
$bottom->Button(-text => 'Exit', -command => sub { exit 0 })
  ->pack(-side => 'left');

# Avoid resizing of the window - it would have no meaning.
$mw->resizable(0, 0);

# Fire!
MainLoop();

# Set the state of a cell. It is expected to receive the coordinates
# of the element, and the state to set, which can be 'disabled' or
# 'normal'.
sub set_state {
   my ($i, $j, $cstate) = @_;
   my $cell = $map[$i][$j][2];
   $cell->configure($_ => $opts{$cstate}{$_}) for keys %{$opts{$cstate
+}};
   $cell->configure( -disabledforeground => 'darkred') if $cstate eq '
+starter';
   push @commands, [$i, $j, state => $map[$i][$j][1]] unless $undoing;
   $map[$i][$j][1] = $cstate;
} ## end sub set_state

# Validate input. Accept only digits between 1 and 9. If ok, push a
# command inside the queue.
sub validate {
   my ($i, $j, $current, $key, $old) = @_;
   return 1 unless defined $key;        # No key is good enough
   return 0 unless $key =~ /^[1-9]$/;

   # Accept the command, and push it into the undo queue
   push @commands, [$i, $j, value => $old] unless $undoing;
   return 1;
} ## end sub validate

# Check an element. Receives two array references: the first pointing
# to the data of the cell to check, the other to an array that keeps
# track of seen positions. If a position is seen twice, an error is
# returned. Only fixed cells are analysed, of course.
sub check_it {
   my ($v, $aref) = @_;
   return 1 if $v->[1] eq 'normal';
   $v = $v->[0];
   return 1 unless defined $v;
   return 1 unless $v =~ /^(\d)(\D)?/;
   return 0 if $aref->[$1];
   $aref->[$1] = 1;
   return 1;
} ## end sub check_it

# Check the game board.
sub check {
   for my $i (0 .. 8) {
      my (@pv, @ph, @pc);
      for my $j (0 .. 8) {

         # Horizontal check
         return 0 unless check_it($map[$i][$j], \@ph);

         # Vertical check
         return 0 unless check_it($map[$j][$i], \@pv);

         # 3x3 subtable check
         return 0
           unless check_it(
            $map[(int($i / 3) * 3 + ($j % 3))]
              [(3 * ($i % 3) + int($j / 3))],
            \@pc
           );
      } ## end for my $j (0 .. 8)
   } ## end for my $i (0 .. 8)
   1;
} ## end sub check

# Save board to file, input is filename
sub save {
   my $filename = shift;
   local $, = ":";
   local $\ = "\n";
   if (open my $fh, ">", $filename) {
      for my $i (0 .. 8) {
         for my $j (0 .. 8) {
            print $fh @{$map[$i][$j]};
         }
      }
   } ## end if (open my $fh, ">", ...
   else {
      warn("open($filename): $!");
   }
} ## end sub save

# Load board from file, input is filename.
sub load {
   my $filename = shift;
   -e $filename or return;
   if (open my $fh, "<", $filename) {
      while (<$fh>) {
         chomp;
         my $i = $. - 1;

         # Split into two parts, the value and the state
         my ($f, $s) = split /:/, $_;
         $map[$i / 9][$i % 9][0] = $f;
         set_state($i / 9, $i % 9, $s);
      } ## end while (<$fh>)
   } ## end if (open my $fh, "<", ...
   else {
      warn "open($filename): $!";
   }
} ## end sub load
[download]