Category: | Fun Stuff |
Author/Contact Info | Flavio Poletti frodo72 |
Description: | Enhanced version SuDoTKu - version 2
A small Tk application that will help you playing SuDoKu. You can display up to 5 characters in any cell, to register possible values, and you can freeze a cell by right-clicking. Of course, you can only fix cells containing one digit. During the game, you can check the board status with the "Check" button. This will check only fixed cells, so your guesses will not interphere. If you're going to make guesses, you can "Push" the current status over a stack, and you can undo to that status with the "Pop" button. Yes, this is a macro undo. If you provide a filename on the command line, the application will try to load it upon startup. You can click "Save" to save the current status, of course. Exit will not ask you for confirmation, so "Save" before :) How I use it: put the initial setup and freeze the cells, "Push" and start putting elements. When an element fits directly, I freeze it immediately, otherwise I put the different choiches inside the entry. From time to time I hit "Check" just to be sure I'm on the correct track. The file format is simple. Cells are saved one element per file line, by row. Each element has two parts: the value inside the cell, and the status, which can be "starter", for fixed cells that form the starter grid, "fixed" and "normal", with obvious meaning (ok, the first is for fixed cells, the second for those cells you can edit). Update: modified the readonly into disabled as per jbrugger's suggestion. The look-and-feel should be the same anyway - a fixed entry is blue and bold. Update: removed silly bug, changed relief for fixed cells, translated check messages into english. Update: removed bug with push/pop. Added support for "starter". Added file format. |
#!/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 |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: SuDoTKu
by jbrugger (Parson) on Jul 25, 2005 at 04:33 UTC | |
by polettix (Vicar) on Jul 25, 2005 at 10:02 UTC | |
by zentara (Archbishop) on Jul 25, 2005 at 11:31 UTC |