#!/usr/pkg/bin/perl -w

# makes one of those Puzzle Squares (9x9)
# and helps to solve or create squares for solving.

# Aparently Japan refers to these as 'su doku', and without knowing
# specificially what kind of poetic reference that is, so do some American
# newspapers.
# And lets not get into the fact that German puzzle publications alaways
# carried pages of these thing, no name required, puzzlers know the rules.
# [think of the format as being akin to the pulpy reader's digest and comming
# out weekly for commuters and such]

my ($e, $up, $down, $right, $left, $store, $restore, $cline) =
   ("\e[", 'A', 'B', 'C', 'D', 's', 'u', '0K');
my ($cx, $cy);  # curson position.
my @history;    # of human input to determine squares.
my @queue;      # of determined squares to be set
my @square;     # wether something is a posibility.
my @map_row;    # curser position at digit 1 of a row
my @map_col;    # curser position at digit 1 of a column
my @map_3x3;    # for the neighbors to be set
my $solved = 0;

# check if arguments were used
if($#ARGV>=0) {
  if($ARGV[0] =~ m/^-?-?[Ee]/) { example_input(); }
  else {
    if($ARGV[0] =~ m/^-?-?[Hh?]/) { print "\n$0 [--help | --example]\n\n"; }
    else { start(); }
  }
} else { start(); }
exit(0);
# end of program... rest is functions.

sub start
{
  initialize();
  draw_screen();
  $cx = 0;  $cy = 0;
  while ($solved < 81)
  {
    get_input();
    process_queue();
  }
  move_cursor(59, 22);
  $| = 1; #hot flust pipe
  print $e.$cline.'solved.';
  $cx += 7;
  sleep(5);
  move_cursor(0,23);
  show_history();
  show_solution();
}

sub draw_screen
{
  while (<DATA>) { print; }
  print $e.'23'.$up;
  print $e.$store;
}
sub initialize
{
  # wether something is a posibility.
  @square = (
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ] ,
  [ [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],
    [1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1] ]
  );
  # curser position at digit 1 of a row and column
  @map_col = ( 1, 7, 13, 20, 26, 32, 39, 45, 51 );
  @map_row = ( 1, 3, 5, 8, 10, 12, 15, 17, 19 );
  # for the neighbors to be set
  @map_3x3 = (
    [
      [ [ 1, 1], [ 2, 1], [ 1, 2], [ 2, 2] ], # at 0,0
      [ [ 1,-1], [ 2,-1], [ 1, 1], [ 2, 1] ], # at 0,1
      [ [ 1,-2], [ 2,-2], [ 1,-1], [ 2,-1] ]  # at 0,2
    ],[
      [ [-1, 1], [-1, 2], [ 1, 1], [ 1, 2] ], # at 1,0
      [ [-1,-1], [ 1,-1], [-1, 1], [ 1, 1] ], # at 1,1
      [ [-1,-2], [-1,-1], [ 1,-2], [ 1,-1] ]  # at 1,2
    ],[
      [ [-2, 1], [-1, 1], [-2, 2], [-1, 1] ], # at 2,0
      [ [-2,-1], [-1,-1], [-2, 1], [-1, 1] ], # at 2,1
      [ [-2,-2], [-1,-2], [-2,-1], [-1,-1] ]  # at 2,2
    ] );
}

sub print_history
{
  #output history:
  move_cursor( 59, 1);
  my $x = $#history - 19;
  if($x < 0){ $x = 0; }
  for(; $x <= $#history; $x++)
  {
    print $e.$cline.$history[$x]."\n".$e.'59'.$right;
    $cy++;
  }
  $cx=59;
}

sub get_input
{
  print_history();
  print "input: ";
  my $noin = 1;
  while ($noin)
  {
    print $e.$cline;
    my $input = <STDIN>;
    if (!defined($input)) { $cx+=7; move_cursor(0,23); exit(0); }
    # check input
    my @in = split /\D+/, $input;
    if(  $#in == 2
      && $in[0] >= 1 && $in[0] <= 9
      && $in[1] >= 1 && $in[1] <= 9
      && $in[2] >= 1 && $in[2] <= 9)
    {
      # input is in range but is it possible on this square
      if ($square[$in[0]-1][$in[1]-1][$in[2]-1] == 1)
      {
        $noin=0;
        push @queue, [ int($in[0]), int($in[1]), int($in[2]) ];
        push @history, int($in[0]).' , '.int($in[1]).' = '.int($in[2]);
      } else {
        # ask again
        print $e.'59'.$right.$e.'1'.$up.'can\'t: ';
      }
    } else {
      # ask again
      print $e.'59'.$right.$e.'1'.$up.'error: ';
    }
  }
  # update cursor position
  $cy++; $cx=0;
}

sub process_queue
{
  my ($set, $col, $row, $val);
  while ( defined($set = pop(@queue)) )
  {
    ($col, $row, $val) = ($set->[0],$set->[1],$set->[2]);
    $col--;$row--;$val--;
    # set our spot
    for (my $i=0; $i<9; $i++)
    {
      if($i!=$val){$square[$col][$row][$i] = 0;}
    }
    $square[$col][$row][$val] = 2;
    $solved++;
    # update display
    move_cursor($map_col[$col], $map_row[$row]);
    if ($val < 5)
    {
      print ((" "x$val).$e.'1'.$right);
      if ($val < 4) {print " "x(4-$val);}
      print $e.'5'.$left.$e.'1'.$down.'____';
    } else {
      print "     ".$e.'5'.$left.$e.'1'.$down.("_"x($val-5)).$e.'1'.$right;
      if($val < 8) {print "_"x(8-$val);}
    }
    $cx += 4; $cy += 1;

    # calc inner offset of val
    my $dx = ($val<5) ? $val : $val - 5;
    my $dy = ($val<5) ? 0 : 1;
    my $blank = ($val<5) ? " " : "_";

    #reduce col
    for( my $i = 0; $i < 9; $i++ )
    {
      if ($i != $row && $square[$col][$i][$val] == 1)
      {
        $square[$col][$i][$val] = 0;
        move_cursor($map_col[$col]+$dx, $map_row[$i]+$dy);
        print $blank;
        $cx++;
        check_square($col,$i);
      }
    }
    #reduce row 
    for( my $i = 0; $i < 9; $i++ )
    {
      if ($i != $col && $square[$i][$row][$val] == 1)
      {
        $square[$i][$row][$val] = 0;
        move_cursor($map_col[$i]+$dx, $map_row[$row]+$dy);
        print $blank;
        $cx++;
        check_square($i,$row);
      }
    }
    #reduce 3x3
    my $t = $map_3x3[$col%3][$row%3];
    for ( my $i =0; $i < 4; $i++ )
    {
      if( $square[$col + $t->[$i][0] ][$row + $t->[$i][1] ][$val] == 1)
      {
        $square[$col + $t->[$i][0] ][$row + $t->[$i][1] ][$val] = 0;
        move_cursor(
          $map_col[$col+$t->[$i][0]]+$dx,
          $map_row[$row+$t->[$i][1]]+$dy);
        print $blank;
        $cx++;
        check_square($col+$t->[$i][0], $row+$t->[$i][1]);
      }
    }
    #check other reduced 3x3s
    my ($c3,$r3) = ($col%3,$row%3);
    for (my $i = 0; $i < 3; $i++)
    {
      if($i!=$r3){ check_3x3($c3,$i,$val); }
      if($i!=$c3){ check_3x3($i,$r3,$val); }
    }
  }
}

sub check_square
{
  my ($col, $row) = (shift @_, shift @_);
  my $c = 0;
  my $val = 0;
  for (my $i=0; $i<9; $i++)
  {
    $c += $square[$col][$row][$i];
    if($square[$col][$row][$i] == 1)
    {
      $val = $i;
    }
  }
  if ($c == 1)
  {
    # theres only one value remaining set.
    push @queue, [$col+1, $row+1, $val+1];
    push @history, '->'. ($col+1) .','. ($row+1) .' =>'. ($val+1);
  }
}

sub check_3x3
{
  # check if there's only one remaining posibility for val in a 3x3 block
  # recieves ($col, $row, $val) where col and row are 0..2 representing the
  # 3x3 block to search.
  my ($col, $row) = ((shift @_) * 3 , (shift @_) * 3 );
  my ($val, $tot, $clast, $rlast) = (shift @_, 0, 0, 0 );
  for (my $j=$row; $j<$row+3; $j++)
  {
    for (my $i=$col; $i<$col+3; $i++)
    {
      if($square[$i][$j][$val] == 1){ $tot++; $clast=$i; $rlast=$j; }
    }
  }
  if($tot == 1)
  {
    push @queue, [$clast+1, $rlast+1, $val+1];
    push @history, '->'. ($clast+1) .','. ($rlast+1) .' =>'. ($val+1);
  }
}
sub move_cursor
{
  my ($tx, $ty) = (int(shift @_), int(shift @_));
  my ($dx, $dy) = ($tx - $cx, $ty - $cy);
  my $move = '';
  if($dx != 0)
  {
    if($dx < 0)
    {
      $move = $e.abs($dx).$left;
    } else {
      $move = $e.abs($dx).$right;
    }
  }
  if($dy != 0)
  {
    if($dy < 0)
    {
      $move .= $e.abs($dy).$up;
    } else {
      $move .= $e.abs($dy).$down;
    }
  }
  print $move;
  $cx = $tx;
  $cy = $ty;
}

sub show_history
{
  print "\n";
  print join "\t ", @history;
}

sub show_solution
{
  print "\n";
  for(my $i=0; $i<9; $i++)
  {
    if($i%3 == 0)
    { print "++===+===+===++===+===+===++===+===+-==++\n"; }
    else
    { print "++---+---+---++---+---+---++---+---+---++\n"; }
    for(my $j=0; $j<9; $j++)
    {
      for(my $k=0; $k<9; $k++)
      {
        if($square[$j][$i][$k] == 2)
        {
          if($j%3 == 0) { print '|| '.($k+1).' '; }
          else          { print '| '.($k+1).' '; }
        }
      }
    }
    print "||\n";
  }
  print "++===+===+===++===+===+===++===+===+===++\n";
}

sub example_input
{
# this is example input for a solution
  no warnings;
  my @example = qw/
  1,5=8 1,7=4 1,8=5 1,9=6 2,2=9 2,3=4 2,6=5 2,7=7 3,1=5
  3,2=8 3,5=1 3,6=7 4,1=6 4,2=5 4,6=2 4,8=4 5,1=7 5,4=3
  5,6=6 5,9=8 6,2=1 6,4=5 6,8=9 6,9=2 7,4=9 7,5=6 7,8=2
  7,9=3 8,3=2 8,4=8 8,7=9 8,8=7 9,1=9 9,2=4 9,3=1 9,5=2
  /;
  use warnings;
  # do a loop through the input without checking it for correctness
  initialize();
  draw_screen();
  $cx = 0;  $cy = 0;
  foreach $examp (@example)
  {
    print_history();
    my @in = split /\D+/, $examp;
    push @queue, [ int($in[0]), int($in[1]), int($in[2]) ];
    push @history, int($in[0]).' , '.int($in[1]).' = '.int($in[2]);
    process_queue();
  }
  while ($solved < 81)
  {
    get_input();
    process_queue();
  }
  move_cursor(59, 22);
  $| = 1; #hot flust pipe
  print $e.$cline.'solved.';
  $cx += 7;
  sleep(5);
  move_cursor(0,23);
  show_history();
  show_solution();
}
__DATA__
+-----------------+------------------+------------------+  Col Row Val(choices)
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
+-----------------+------------------+------------------+
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
+-----------------+------------------+------------------+
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
|12345|12345|12345||12345|12345|12345||12345|12345|12345|
|6789__6789__6789_|_6789__6789__6789_|_6789__6789__6789_|
+-----------------+------------------+------------------+