#!usr/bin/perl
#
# Sudoku Show
# 03/02/2006
#
# build_window subroutine based on demo code by Steve Lidie, April 1999, on the PerlTK.org website
# http://www.perltk.org/index.php?option=com_content&task=view&id=15&Itemid=28
#
# randomize subroutine is from the O'Reilly Perl Cookbook
#
# USAGE: perl SudokuShow.pl [-t] <Seed file>
# [-t]: include this switch to activate testing mode, where tests will be run and their results displayed.
# [Seed file]: the name of the file containing the seed sudokus.  If omitted, it defaults to "Seeds.txt".
# The seed file must be organized as follows:
#	The file must be at least 84 lines long.  Any lines past 84 will be ignored.
#	The file is organized in 4 blocks of 21 lines.
#	Each block represents a Sudoku/Answer combination of increasing difficulty.  The first block is designated easy, then medium, hard, and very hard.
#	The first, second, and twelfth line of each block are reserved for comments or headers and are ignored.
#	The rest of the lines in each block must each contain 9 numbers between 0 and 9, separated by a single space.
#	Lines 3 through 11 represent the puzzle, with 0 signifying a blank.
#	Lines 13 through 21 represent the solution, with no 0s.

package SudokuShow;
use Tk;
use Tk::widgets qw/Dialog/;
use Text::ParseWords;
# use Algorithm::Permute;   # commented out by Jim in class
use strict;
use warnings;

our ($DEBUG, $SudokuShow, $VERSION, $difficulty, @Sudoku, @Answer, $works, @testArray);

if ($ARGV[0] eq '-t') { shift; $DEBUG = 1; } else { $DEBUG = 0; }			# For $DEBUG, 0 means don't run the tests, 1 means do run them.
$VERSION = '1.0.1'; 							# What version I'm on
$difficulty = 1;								# Difficulty of the starting puzzle
my $seedFile = shift;
$seedFile = "Seeds.txt" unless (defined $seedFile);							# This line sets the default location of the seed file.
my @seeds;
my $line;
my @tokens;
open (INPUT, $seedFile) or die "\nCan't open $seedFile : $!";
for my $i (0..3) {								# These loops load the seed file into the seed matrix.
    $line = <INPUT>;
    for my $j (0..1) {
        $line = <INPUT>;
        for my $k (0..8) {
            $line = <INPUT>;
            @tokens = quotewords(" ",0,$line);
            for my $l (0..8) {
                $seeds[$i][$j][$k][$l] = $tokens[$l];
            }
        }
    }
}
close INPUT;
$SudokuShow = MainWindow->new;
# BEGIN TEST BLOCK
if ($DEBUG) {
    use Test::More 'no_plan';

    $works = 1;
    @testArray = (1..9);
    randomize(\@testArray);
    @testArray = sort {$a <=> $b} @testArray;
    for (1..9){ if ($testArray[$_-1] != $_) { $works = 0; } }
    ok($works, "Randomize works for size 9 arrays");

    $works = 1;
    @testArray = (0..2);
    randomize(\@testArray);
    @testArray = sort {$a <=> $b} @testArray;
    for (0..2){ if ($testArray[$_] != $_) { $works = 0; } }
    ok($works, "Randomize works for size 3 arrays");
}
# END TEST BLOCK
build_window(); 
MainLoop; 
                        # This subroutine builds the window, and calls the other routines.  Everything other than reading from the seed files happens below this point.
sub build_window {		# Usage: build_window().  It extracts a sudoku from the seed matrix based on the global difficulty, then sets up the window and calls for the buttons and the menubar.
    for my $i (0..8) {
        for my $j (0..8) {
            $Sudoku[$i][$j] = $seeds[$difficulty][0][$i][$j];
            $Answer[$i][$j] = $seeds[$difficulty][1][$i][$j];		
        }
    }
    my $SS = MainWindow->new;					# These 3 lines are so that when this routine is recalled to replace the current sudoku, I can kill the existing one without ending the program.
    $SudokuShow->destroy;
    $SudokuShow = $SS;

    $SudokuShow->title("Sudoku Show"); 
    $SudokuShow->iconname('S'); 
    my $bmp = $SudokuShow->Photo(-file => "s.bmp", -format => 'bmp');		# A nifty little corner-icon thingy
    $SudokuShow->Icon(-image => $bmp);

    shuffle();									# This takes the seed sudoku and permutes it.
#	BEGIN TEST BLOCK
    if ($DEBUG) {
        $works = 1;
        for (0..8) { $testArray[$_]=$Answer[$_][0]; }
        @testArray = sort {$a <=> $b} @testArray;
        for (1..9){ if ($testArray[$_-1] != $_) { $works = 0; } }
        ok($works, "The top row is valid.");
        
        $works = 1;
        for (0..8) { $testArray[$_]=$Answer[0][$_]; }
        @testArray = sort {$a <=> $b} @testArray;
        for (1..9){ if ($testArray[$_-1] != $_) { $works = 0; } }
        ok($works, "The leftmost column is valid.");
        
        $works = 1;
        for (0..2) { $testArray[$_]=$Answer[$_][0]; $testArray[3+$_]=$Answer[$_][1]; $testArray[6+$_]=$Answer[$_][2]; }
        @testArray = sort {$a <=> $b} @testArray;
        for (1..9){ if ($testArray[$_-1] != $_) { $works = 0; } }
        ok($works, "The upper left box is valid.");
        
        $works = 1;
        for my $i (0..8) { for my $j (0..8) { if ($Sudoku[$i][$j]) { unless ($Sudoku[$i][$j] == $Answer[$i][$j]) { $works = 0; } } } }
        ok($works, "The puzzle matches the answer.");
        
        $works = 1;
        my $testStore = $Sudoku[3][3];
        alter(10,3,3);
        unless ($Sudoku[3][3] == 10) { $works = 0; }
        alter($testStore,3,3);
        unless ($Sudoku[3][3] == $testStore) { $works = 0; }
        ok($works, "The alter() method works.");
    }
#	END TEST BLOCK
    for my $i (0..$#Sudoku) {					# This chunk builds the boxes for each element.  They are added at build time.
        for my $j (0..$#{$Sudoku[$i]}) {
            my $val = $Sudoku[$i][$j];
            build_box($val,$i,$j);
        }
    }
    build_menubar(); 
}
                        # Creates a label widget for the numbers, or a button widget for the blanks, and places them in the grid.
sub build_box {			# Usage: build_box(Display value, position y, position x).  Creates a button displaying the value, or blank and editable if value is zero, then attaches it to the grid at [y][x].
    my ($num,$yPos,$xPos) = @_;
    my $box = $SudokuShow->Button(	-text => $num,
                                    -background => 'light blue',		# The fixed numbers are surrounded by light blue, as opposed to the user-entered white buttons.
                                    -relief => 'groove',				# The border of the boxes
                                    -height => 5,
                                    -width => 10,
                                    -default => 'disabled',
                                    -overrelief => 'raised');			# Size of the boxes
    if ($num == 0) {							# If the number is blank, the label is overwritten by a button.
        our $change_dialog = $SudokuShow->Dialog(-title   => 'Edit',	# This dialog lets the user choose the new value.
                                                -text    => 'Select a new value for this square.',
                                                -default_button => '0',
                                                -buttons => [qw/1 2 3 4 5 6 7 8 9/]); 
        $box = $SudokuShow->Button(	-text => "",
                                    -background => 'white',	
                                    -relief => 'groove',				# The border of the boxes
                                    -height => 5,
                                    -width => 10,
                                    -command => sub{my $change = $change_dialog -> Show;
                                                    $box->configure(-text => $change);
                                                    alter($change,$yPos,$xPos);});				# The program didn't want to edit the @Sudoku array here, so I made it a seperate subroutine and it was happy.
    }
    $box->grid(	-column => $xPos,				# Positional Data
                -row => $yPos,
                -ipadx => 1,					# I'm trying to put a border on the boxes here, but groove did it better
                -ipady => 1);
}
                        # It builds the menu bar, and links the options to their dialogs and subroutines.
sub build_menubar {		# Usage: build_menubar().  It assembles a help and file menu and attaches them to the SudokuShow window.
    my $menubar = $SudokuShow->Menu; 
    $SudokuShow->configure(-menu => $menubar); 
    my $file = $menubar->cascade(-label => '~File', -tearoff => 0);		# I don't care for the tearoff option.  It's ugly.
    my $help = $menubar->cascade(-label => '~Help', -tearoff => 0); 
    
    $file->command(-label => 'Generate', -command => sub{generate()});	# Asks for the new difficulty then makes a new Sudoku.
    $file->command(-label => 'Check', -command => sub{check()});		# Checks the answer and displays the correctness.
    $file->command(-label => 'Quit', -command => \&exit);				# In case somebody doesn't want to use the corner x.

    $help->command(-label => 'Version');		# Version info
    $help->separator; 
    $help->command(-label => 'About');			# What it does

    my $version_dialog =   $SudokuShow->Dialog(-title   => 'SudokuShow Version', 
                                -text    => "SudokuShow\n\nVersion $VERSION",		#Reads the version info and displays it
                                -buttons => ['OK'], 
                                -bitmap  => 'info'); 
    my $about_dialog = $SudokuShow->Dialog(-title   => 'About SudokuShow', 
                                -text    => 'This program creates and displays Sudoku puzzles, and allows the user to fill in the puzzle and to check the solution.',
                                -buttons => ['OK']); 
    my $menu = $help->cget('-menu'); 
    $menu->entryconfigure('Version', -command => [$version_dialog   => 'Show']); 
    $menu->entryconfigure('About',   -command => [$about_dialog => 'Show']); 
}
                        # This subroutine checks the sudoku as displayed with the answer matrix.
sub check {				# Usage: check().  Checks the global Sudoku matrix against the global Answer matrix, and informs the player of the result.
    my $error = 0;
    my $complete = 1;
    for my $i (0..8) { for my $j (0..8) {	if ($Sudoku[$i][$j]!=$Answer[$i][$j]) {	$error = 1; };
                                            if ($Sudoku[$i][$j]==0) { $complete = 0; } } }
    if ($complete == 0) {						# If any cells of the sudoku remain unfilled, this case points it out.
        my $check_dialog = $SudokuShow->Dialog(	-title   => 'Whoops!', 
                                                -text    => 'The puzzle isn\'t yet complete!',
                                                -buttons => ['OK']); 
        $check_dialog -> Show;
    }
    elsif ($error == 1) {						# If any of the cells have the wrong value, this case points it out.
        my $check_dialog = $SudokuShow->Dialog(	-title   => 'Answer', 
                                                -text    => 'Sorry, that isn\'t the correct answer.',
                                                -buttons => ['OK']); 
        $check_dialog -> Show;
    }
    elsif ($error == 0) {						# If the Sudoku is complete and correct, this message congratulates the player.
        my $check_dialog = $SudokuShow->Dialog(	-title   => 'Answer', 
                                                -text    => 'Congratulations!  That\'s the correct answer!',
                                                -buttons => ['OK']); 
        $check_dialog -> Show;
    }
}	
                        # Altering the elements of the @Sudoku array seems to work better as part of a subroutine than as part of the button command.
sub alter {				# Usage: alter(New value, index i, index j).  Replaces the [i][j] element of the Sudoku global matrix with the provided value.
    my ($newVal, $y, $x) = @_;
    $Sudoku[$y][$x] = $newVal;
}
                        # This subroutine queries the user as to what difficulty to make a new Sudoku, and restarts the creation process..
sub generate {			# Usage: generate().  Queries the user for the difficulty level of the new puzzle and then creates that puzzle, deleting the current one.
    my $diff_dialog = $SudokuShow->Dialog(	-title	=> 'New Sudoku',
                                            -text	=> 'Select a new difficulty:',
                                            -default_button	=> 'Cancel',
                                            -buttons=> ["Easy", "Medium", "Hard", "Very Hard", "Cancel"]);
    my $diffiText = $diff_dialog -> Show;
    if ($diffiText eq 'Cancel') {return 0;}		# If the user selects cancel, the routine exits back to the main window without doing anything.
    elsif ($diffiText eq 'Easy')				# The rest of this if-block turns the button pressed into a value of the difficulty global.
    {
        $difficulty = 0;
    }
    elsif ($diffiText eq 'Medium')
    {
        $difficulty = 1;
    }
    elsif ($diffiText eq 'Hard')
    {
        $difficulty = 2;
    }
    elsif ($diffiText eq 'Very Hard')
    {
        $difficulty = 3;
    }
    build_window();						# And this call restarts everything except the initial fileread and some basic setup.  It never exits the MainLoop.
}
                        # This subroutine rearranges the columns, the rows, and it permutes the numbers themselves.  In theory, it can generate up to 13,063,680 puzzles from any valid seed puzzle.
sub shuffle {			# Usage: shuffle().  Randomly permutes the global Sudoku and answer matrixes in unison to produce a valid new puzzle.
    my @randoms = (1..9);
    randomize(\@randoms);						# This sets the table for relabeling the numbers in the puzzle.
    my @cols = (0..2);
    randomize(\@cols);							# This sets the table for permuting the columns of 3x3 blocks.
    my @rows = (0..2);
    randomize(\@rows);							# This sets the table for permuting the rows of 3x3 blocks.
    my (@newdoku, @newans);
    for my $i (0..8) {							# This set of loops relabels the numbers.
        for my $j (0..8) {
            $newans[$i][$j] = $randoms[$Answer[$i][$j]-1];
            if ($Sudoku[$i][$j] != 0) {
                $newdoku[$i][$j] = $randoms[$Sudoku[$i][$j]-1];
            }
            else {
                $newdoku[$i][$j] = 0;
            }
        }
    }
    for my $i (0..8) {for my $j (0..8) {$Sudoku[$i][$j]=$newdoku[$i][$j]; $Answer[$i][$j]=$newans[$i][$j];}}
                                                # ^Copies the new Sudoku over the old.
    for my $i (0..8) {							# This set of loops shuffles the columns.
        for my $j (0..2) {
            for my $k (0..2) {
                $newdoku[3*$cols[$j]+$k][$i] = $Sudoku[3*$j+$k][$i];
                $newans[3*$cols[$j]+$k][$i] = $Answer[3*$j+$k][$i];
            }
        }
    }
    for my $i (0..8) {for my $j (0..8) {$Sudoku[$i][$j]=$newdoku[$i][$j]; $Answer[$i][$j]=$newans[$i][$j];}}
                                                # ^Copies the new Sudoku over the old.
    for my $i (0..8) {							# This set of loops shuffles the rows.
        for my $j (0..2) {
            for my $k (0..2) {
                $newdoku[$i][3*$cols[$j]+$k] = $Sudoku[$i][3*$j+$k];
                $newans[$i][3*$cols[$j]+$k] = $Answer[$i][3*$j+$k];
            }
        }
    }
    for my $i (0..8) {for my $j (0..8) {$Sudoku[$i][$j]=$newdoku[$i][$j]; $Answer[$i][$j]=$newans[$i][$j];}}
                                                # ^Copies the new Sudoku over the old.
}
                        # An example of the Fisher-Yates shuffle algorithm, from the O'Reilly Perl Cookbook (Recipie 4.17)
sub randomize {			# Usage: randomize(Array reference).  Randomly permutes the passed array in its current location.
    my $array = shift;
    my $i;
    for ($i = @$array; --$i;) {
        my $j = int rand ($i+1);
        next if $i == $j;
        @$array[$i,$j] = @$array[$j,$i];
    }
}
