#!/usr/bin/perl -w
use strict;
#binmode STDOUT, ":utf8";

############################  LICENCE  INFORMATION  ############################
#
#  This program is released into the Public Domain 2014 by Julie Montoya
#  <jmontoya@earthshod.co.uk>
#
#  In the event that anyone attemps to assert copyright over any derivative
#  work they may have made based on this program, the author is prepared to
#  affirm in a Court of Law that any allegedly plagiarised derivative work
#  is in fact based on this original work, with her blessing.
#
####################################  ENDS  ####################################

use Term::ReadKey;
use Time::HiRes qw(sleep time);

my @sudoku;
foreach (0 .. 80) {
    $sudoku[$_] = 0;
};

my @undo_stack;

my @subgrids = (0, 3, 6, 27, 30, 33, 54, 57, 60);

my ($row, $col, $grp, $r, $c, $g, $i, $j, $n, @search, %banned);
my ($outer_r, $outer_c, $inner_r, $inner_c);
my ($subgrid, $offset);
my (%maybe, $r1, $c1, $done, $must_be, $must_be_pos, $possibilities);
my ($must_be_row, $must_be_col, $unsolv);
my ($digit, $digit_row, $key, $auto, $filename, $sep, $data);
my ($width, $height, $w_pixels, $h_pixels);
my ($note_x, $note_y, $array_ref, $colour, $colour_mode, $cn);

my ($L, $U, $S) = ("\xe2\x96\x84", "\xe2\x96\x80", "\xe2\x96\x88");
my ($W, $G, $B) = ("\xe2\x96\x91", "\xe2\x96\x92", "\xe2\x96\x93");
my $G4 = $G x 4;
my $B4 = $B x 4;
my $S40 = " " x 40;

my @digits = (["    ", "    ", "    "],               # 0
              [" $L$S ","  $S ", "  $U "],            # 1
              ["$U$U$U$S", "$S$U$U$U", "$U$U$U$U"],   # 2
              ["$U$U$U$S", " $U$U$S", "$U$U$U$U"],    # 3
              ["$L $S ", "$S$L$S$L", "  $U "],        # 4
              ["$S$U$U$U", "$U$U$U$S", "$U$U$U$U"],   # 5
              ["$S$U$U$U", "$S$U$U$S", "$U$U$U$U"],   # 6
              ["$U$U$U$S", "   $S", "   $U"],         # 7
              ["$S$U$U$S", "$S$U$U$S", "$U$U$U$U"],   # 8
              ["$S$U$U$S", "$U$U$U$S", "$U$U$U$U"]);  # 9

my @colours = ("\e[m", "\e[38;5;1m", "\e[38;5;2m", "\e[38;5;3m",
               "\e[38;5;4m", "\e[38;5;5m", "\e[38;5;6m", "\e[38;5;59m",
               "\e[38;5;102m", "\e[38;5;208m", "\e[38;5;118m", "\e[38;5;33m",
               "\e[38;5;48m", "\e[38;5;198m", "\e[38;5;93m", "\e[38;5;187m");

my $delay = .5;
my $notes = $colours[0];
#            ....... ....... ....... .......
my @help = ("===========  DESIGN ===========",
            "H, J, K, L = directions",
            "",
            "1-9 = place digit",
            "",
            "0 or SPACE = erase digit",
            "",
            "R = auto step Right after digit",
            "D = auto step Down after digit",
            "",
            "===========  HINTS  ===========",
            "p = show Possible digits for",
            "    current square",
            "P = show Possible digits for",
            "    all squares",
            "C = Clear possibilities",
            "",
            "==========   SAVING  ==========",
            "S = Save file",
            "O = Open file",
            "",
            "==========   COLOUR  ==========",
            "M = toggle changing colour",
            "    after placing each digit",
            "",
            "=======   BACKTRACKING  =======",
            "> = save state of grid so far",
            "< = backtrack to last save",
            "",
            "==========  SOLVING  ==========",
            "T = select Time delay between",
            "    placing digits",
            "RETURN = begin solving puzzle!");

#########################  BEGIN FUNCTION DEFINITIONS  #########################

sub cls {
    print "\e[H\e[J";
};

sub place_digit {
    my ($r1, $digit_row, $c1);
    my $r = shift;
    my $c = shift;
    my $digit = shift;
    $r1 = $r * 4 + 2;
    $c1 = $c * 5 + 2;
    for ($digit_row = 0; $digit_row < 3; ++$digit_row) {
        print "\e[${r1};${c1}H";
        print $digits[$digit][$digit_row];
        ++$r1;
    };
};

sub same_row {
    my (@ans, $col);
    my $pos = shift;
    my $row = int ($pos / 9);
    for ($col = 0; $col < 9; ++$col) {
        push @ans, 9 * $row + $col;
    };
    @ans;
};

sub same_col {
    my (@ans, $row);
    my $pos = shift;
    my $col = $pos % 9;
    for ($row = 0; $row < 9; ++$row) {
        push @ans, 9 * $row + $col;
    };
    @ans;
};

sub same_subgrid {
    my (@ans, $inner_r, $inner_c);
    my $pos = shift;
    my $row = int ($pos / 9);
    my $col = $pos % 9;
    my $outer_r = int ($row / 3);
    my $outer_c = int ($col / 3);
    for ($inner_r = 0; $inner_r < 3; ++$inner_r) {
        for ($inner_c = 0; $inner_c < 3; ++$inner_c) {
            push @ans, 3 * 9 * $outer_r + 3 * $outer_c + 9 * $inner_r + $inner_c;
        };
    };
    @ans;
};

sub read_file {
    my $filename = shift;
    my $data = "";
    my @sudoku;
    open FH, "<$filename" or die "Could not open $filename: $!";
    while ($_ = <FH>) {
        $data .= $_;
    };
    close FH;
    $data =~ s/^\D*//;              # strip any leading non-digits
    @sudoku = split /\D+/, $data;   # now it's all numbers
    foreach (@sudoku) {
        $_ = 0 if ($_ < 1 || $_ > 9);
    };
    while (@sudoku < 81) {
        push @sudoku, 0;
    };
    @sudoku;
};

sub show_possibilities {
    my ($i, $digit, %banned, @search, $n,
        $row, $col, $r1, $c1);

    if (@_ > 1) {       #  2 arguments = $row, $col
        $row = shift;
        $col = shift;
        $i = $row * 9 + $col;
    }
    else {              #  1 argument = $pos
        $i = shift || 0;
    };
    
    $digit = $sudoku[$i];
    if ($digit) {
    }
    else {
        %banned = ();
        #  Cross off digits found in same row
        @search = same_row $i;
        foreach (@search) {
            unless ($_ == $i) {
                if ($n = $sudoku[$_]) {
                    ++$banned{$n};
                };
            };
        };
        #  Cross off digits found in same column
        @search = same_col $i;
        foreach (@search) {
            unless ($_ == $i) {
                if ($n = $sudoku[$_]) {
                    ++$banned{$n};
                };
            };
        };
        #  Cross off digits found in same subgrid
        @search = same_subgrid $i;
        foreach (@search) {
            unless ($_ == $i) {
                if ($n = $sudoku[$_]) {
                    ++$banned{$n};
                };
            };
        };

        foreach (1 .. 9) {
            $row = int ($i / 9);
            $col = $i % 9;
            $r1 = $row * 4 + (int (($_ - 1) / 3)) + 2;
            $c1 = $col * 5 + (($_ - 1) % 3) + 2;
            print "\e[${r1};${c1}H";
            print $banned{$_} ? " " : $_;
        };
    };
};

sub fill_numbers {
    my ($row, $col, $n);
    foreach $row (0 .. 8) {
        foreach $col (0 .. 8) {
            if ($n =  $sudoku[$row * 9 + $col]) {
                place_digit $row, $col, $n;
            };
        };
    };
};

sub clear_possibilities {
    my ($i, $col, $row);
    foreach $i (0 .. 80) {
        unless ($sudoku[$i]) {
            $col = $i % 9;
            $row = int($i / 9);
            place_digit $row, $col, 0;
        };                
    };
};

sub clear_grid {
    my ($row, $col);
    foreach $row (0 .. 8) {
        foreach $col (0 .. 8) {
            place_digit $row, $col, 0;
        };                
    };
};

sub clear_notes {
    my $row;
    foreach $row (1 .. 36) {
        print "\e[${row};48H";
        print " " x ($width - 49);
    }
};

sub restore_notes {
    print "\e[1;48H$notes";
};

##########################  END FUNCTION DEFINITIONS  ##########################

cls;
($width, $height, $w_pixels, $h_pixels) = GetTerminalSize;
if ($width < 80) {
    die "Terminal is too narrow; width needs to be at least 80!";
};
if ($height < 39) {
    die "Terminal is not tall enough; height needs to be at least 39!";
};

if (@ARGV >= 1) {
    $filename = shift;
    @sudoku = read_file $filename;
};

for ($row = 0; $row < 9; ++$row) {
    print "$B$B4" x 9, "$B\n"               unless $row % 3;
    print "$B$G4$G$G4$G$G4" x 3, "$B\n"     if $row % 3;
    
    for ($digit_row = 0; $digit_row < 3; ++$digit_row) {
        for ($col = 0; $col < 9; ++$col) {
            $i = 9 * $row + $col;
            print $col % 3 ? "$G" : "$B";
            if ($digit = $sudoku[$i]) {
                print $digits[$digit][$digit_row];
            }
            else {
                print "    ";
            };
       };
        print "$B\n";
    };
};
print "$B$B4" x 9, "$B\n";

$note_x = 48;
$note_y = 2;
$cn = 52;

$done = "";
while (!$done) {
    $unsolv = "";
    print "\e[38HDESIGN MODE\n";
    $row = $col = 0;
    $auto = "";
    ReadMode 4;
    while (!$done) {
        $r1 = $row * 4 + 4;
        $c1 = $col * 5 + 4;
        print "\e[${r1};${c1}H";
        while (!defined ($key = ReadKey(-1))) {
        };
        if ($key =~ /h/ && $col > 0) {
            --$col;
        }
        elsif ($key =~ /j/i && $row < 8) {
            ++$row;
        }
        elsif ($key =~ /k/i && $row > 0) {
            --$row;
        }
        elsif ($key =~ /l/i && $col < 8) {
            ++$col;
        }
        elsif ($key =~ /r/i) {
            if ($auto =~ /r/i) {
                $auto = "";
                print "\e[38;15H ";
            }
            else {
                $auto = "r";
                print "\e[38;15HR";
            };
        }
        elsif ($key =~ /d/i) {
            if ($auto =~ /d/i) {
                $auto = "";
                print "\e[38;15H ";
            }
            else {
                $auto = "d";
                print "\e[38;15HD";
            };
        }
        elsif ($key =~ /s/i) {
            ReadMode 0;
            print "\e[38H$S40\e[38HFilename:";
            $filename = <>;
            $filename =~ tr/\r\n//d;
            open FH, ">$filename" or die "Could not open $filename: $!";
            foreach $row(0 .. 8) {
                $sep = "";
                foreach $col(0 .. 8) {
                    print FH $sep;
                    printf FH "%d", $sudoku[$row * 9 + $col];
                    $sep = ",";
                };
                print FH "\n";
            };
            close FH;
            ReadMode 4;
            print "\e[38H$S40\e[38H";
        }
        elsif ($key =~ /o/i) {
            ReadMode 0;
            print "\e[38H$S40\e[38HFilename:";
            $filename = <>;
            $filename =~ tr/\r\n//d;
            @sudoku = read_file $filename;
            fill_numbers;
            ReadMode 4;
            print "\e[38H$S40\e[38H";
        }
        elsif ($key =~ /t/i) {
            ReadMode 0;
            print "\e[38H$S40\e[38HTime delay (sec) :";
            $delay = <>;
            $delay =~ s/\s//g;
            unless ($delay =~ /^\d*(\.\d*)?$/ && $delay !~ /^\.?$/) {
                $delay = 0;
            };
            ReadMode 4;
            print "\e[38H$S40\e[38H";
        }
        elsif ($key =~ /\n/) {
            $done = 1;
            print "\e[38H$S40\e[38H";
        }
        elsif ($key =~ /\d/ || $key =~ /\s/) {
            $key = "0" unless $key =~ /\d/;
            $sudoku[$row * 9 + $col] = $key;
            place_digit $row, $col, $key;
            if ($auto =~ /d/i) {
                ++$row;
                if ($row > 8) {
                    ++$col;
                    $row = 0;
                    $col = 0 if $col > 8;
                };
            }
            elsif ($auto =~ /r/i) {
                ++$col;
                if ($col > 8) {
                    ++$row;
                    $col = 0;
                    $row = 0 if $row > 8;
                };
            };
        }
        elsif ($key =~ /p/i) {
            if ($key =~ /P/) {
                foreach $i (0 .. 80) {
                    show_possibilities $i unless $sudoku[$i];
                };
            }
            else {
                show_possibilities $row, $col;
            };
        }
        elsif ($key =~ /c/i) {
            clear_possibilities;
        }
        elsif ($key =~ /w/i) {
            clear_grid;
        }
        elsif ($key =~ />/i) {
            push @undo_stack, [@sudoku];
            print $colours[scalar @undo_stack % scalar @colours];
            $notes .= $colours[scalar @undo_stack % scalar @colours];
            printf "\e[37;%dH$S", 48 + @undo_stack;
        }
        elsif ($key =~ /</i) {
                if (@undo_stack) {
                print "\e[${note_y};${note_x}H*BACK* ";
                $notes .= "\e[${note_y};${note_x}H*BACK* ";
                $note_x += 8;
                if ($note_x > $width - 7) {
                    $note_x = 48;
                    ++$note_y;
                };
            
                clear_grid;
                for ($i = (scalar @undo_stack) - 1; $i >= 0; --$i) {
                    print $colours[$i % @colours];
                    $array_ref = $undo_stack[$i];
                    @sudoku = @$array_ref;
                    printf "\e[38HColour %d of %d ... : ", $i, scalar @undo_stack;
                    print $colours[$i % @colours];
                    fill_numbers;
                    print "\e[38H$S40\e[38H";
                };
                printf "\e[37;%dH ", 48 + @undo_stack;
                $array_ref = pop @undo_stack;
                print $colours[scalar @undo_stack % scalar @colours];
                @sudoku = @$array_ref;
            };
        }
        elsif ($key =~ /m/i) {
            $colour_mode = !$colour_mode;
            print "\e[37;47H";
            print $colour_mode ? "M" : " ";
        }
        elsif ($key =~ /Q/) {
            $done = 1;
            clear_notes;
            print "\e[m";
            $r1 = 3;
            foreach (@help) {
                print "\e[${r1};48H$_";
                ++$r1;
            };
            ReadMode 0;
            print "\e[38;1H$S40\e[38;1H\e[m";
            exit 1;
        }
        elsif ($key =~ /\?/i) {
            clear_notes;
            print "\e[m";
            $r1 = 3;
            foreach (@help) {
                print "\e[${r1};48H$_";
                ++$r1;
            };
            print "\e[38H$S40\e[38HPress RETURN :";
            ReadMode 0;
            $_ = <>;
            print "\e[38H$S40\e[38H";
            if (/q/i) {
                ReadMode 0;
                print "\e[38;1H$S40\e[38;1H\e[m";
                exit 1;
            };
            clear_notes;
            restore_notes;
            ReadMode 4;
        }
        elsif ($key =~ /\|/) {
            ReadMode 0;
            print "\e[38;1H$S40\e[38;1H\e[m";
            exit 1;
        };
    };
    ReadMode 0;

    $done = "";
    while (!$done) {
        undef $must_be;
        undef %maybe;
        for ($i = 0; $i < 81; ++$i) {
            $possibilities = 0;
            $digit = $sudoku[$i];
            if ($digit) {
            }
            else {
                %banned = ();
                #  Cross off digits found in same row
                @search = same_row $i;
                foreach (@search) {
                    unless ($_ == $i) {
                        if ($n = $sudoku[$_]) {
                            ++$banned{$n};
                        };
                    };
                };
                #  Cross off digits found in same column
                @search = same_col $i;
                foreach (@search) {
                    unless ($_ == $i) {
                        if ($n = $sudoku[$_]) {
                            ++$banned{$n};
                        };
                    };
                };
                #  Cross off digits found in same subgid
                @search = same_subgrid $i;
                foreach (@search) {
                    unless ($_ == $i) {
                        if ($n = $sudoku[$_]) {
                            ++$banned{$n};
                        };
                    };
                };
                    
                foreach (1 .. 9) {
                    $row = int ($i / 9);
                    $col = $i % 9;
                    $r1 = $row * 4 + (int (($_ - 1) / 3)) + 2;
                    $c1 = $col * 5 + (($_ - 1) % 3) + 2;
                    print "\e[${r1};${c1}H";
                    if ($banned{$_}) {
                       print " ";
                    }
                    else {
                        print;
                        ++$maybe{$i}{$_};
                        ++$possibilities;
                    };
                };
                unless (defined $must_be) {
                    if ($possibilities == 1) {
                        foreach (1 .. 9) {
                            unless ($banned{$_}) {
                                $must_be = $_;
                                $must_be_pos = $i;
                            };
                        };
                    }
                    elsif ($possibilities == 0) {
                        print "\e[38H$S40\e[38H";
                        print "\e[38H* UNSOLVEABLE * press RETURN :";
                        $_= <>;
                        print "\e[38H$S40\e[38H";
                        #  Drop to design mode
                        $unsolv = 1;
                        last;
                    };
                };
            };
        };

        print "\e[38;1H$S40\e[38;1H";
        
        if (defined $must_be) {
            $must_be_row = int ($must_be_pos / 9);
            $must_be_col = $must_be_pos % 9;
            print "Row $must_be_row, Col $must_be_col must be $must_be\n";
            $sudoku[$must_be_pos] = $must_be;
        };
        
        if (!$unsolv && !defined $must_be) {
            foreach $digit (1 .. 9) {
                #  In each row, see if we can place $digit once
                foreach $row (0 .. 8) {
                    $possibilities = 0;
                    foreach $col (0 .. 8) {
                        if ($maybe{$row * 9 + $col}{$digit}) {
                            ++$possibilities;
                        };
                    };
                    if ($possibilities == 1) {
                        foreach $col (0 .. 8) {
                            if ($maybe{$row * 9 + $col}{$digit}) {
                                $must_be = $digit;
                                $must_be_row = $row;
                                $must_be_col = $col;
                                print "$must_be in row $must_be_row must be at col $must_be_col\n";
                                last;
                            };
                        };                    
                    };
                    last if $must_be;
                };
                last if $must_be;
            };
        };
            
        if (!$unsolv && !defined $must_be) {
            foreach $digit(1 .. 9) {
                #  In each column, see if we can place $digit once
                foreach $col(0 .. 8) {
                    $possibilities = 0;
                    foreach $row(0 .. 8) {
                        if ($maybe{$row * 9 + $col}{$digit}) {
                            ++$possibilities;
                        };
                    };
                    if ($possibilities == 1) {
                        foreach $row(0 .. 8) {
                            if ($maybe{$row * 9 + $col}{$digit}) {
                                $must_be = $digit;
                                $must_be_row = $row;
                                $must_be_col = $col;
                                print "$must_be in col $must_be_col must be at row $must_be_row\n";
                                last;
                            };
                        };                    
                    last if $must_be;
                    };
                };
                last if $must_be;
            };
        };

        if (!$unsolv && !defined $must_be) {
            foreach $digit(1 .. 9) {
                #  In each subgrid, see if we can place $digit once
                foreach $subgrid (@subgrids) {
                    $possibilities = 0;
                    foreach $i (same_subgrid $subgrid) {
                        if ($maybe{$i}{$digit}) {
                            ++$possibilities;
                        };
                    };
                    if ($possibilities == 1) {
                        foreach $i (same_subgrid $subgrid) {
                            if ($maybe{$i}{$digit}) {
                                $must_be = $digit;
                                $must_be_pos = $i;
                                $must_be_row = int ($i / 9);
                                $must_be_col = $i % 9;
                                print "$digit in subgrid $subgrid must be at $i\n";
                                last;
                            };
                        };
                    };
                    last if $must_be;
                };
                last if $must_be;
            };
        };
        
        $done = 1;
        foreach (@sudoku) {
            $done = 0 unless $_;
        };
        
        if ($must_be) {
            sleep $delay;
            if ($colour_mode) {
                print "\e[38;5;${cn}m";
                $notes .= "\e[38;5;${cn}m";
                ++$cn;
            };
            print "\e[${note_y};${note_x}HR${must_be_row},C${must_be_col}=$must_be";
            $notes .= "\e[${note_y};${note_x}HR${must_be_row},C${must_be_col}=$must_be";
            $note_x += 8;
            if ($note_x > $width - 7) {
                $note_x = 48;
                ++$note_y;
            };
            
            place_digit $must_be_row, $must_be_col, $must_be;
            $must_be_pos = $must_be_row * 9 + $must_be_col;
            $sudoku[$must_be_pos] = $must_be;

            if ($colour_mode) {
                print "\e[m";
            };
        }
        elsif (!$done) {
            #  Drop to design mode
            last;
        };
    };
};

print "\e[38;1H\e[m";

exit;