#!/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
In reply to SuDoTKu
by polettix
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.