unit sudoku;

{This is the user interface part of the Soduku Solver program by Dave Glover.
It presents the form and controls, manages the user input, saves and retrives puzzles,
and calls the solvepuzzle procedure to calculate the Sudoku result.
The solvepuzzle module is in the solver module, and uses a calling parameter
of the selected puzzle.}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, solver;

type

  { TFormSudokuSolver }

  TFormSudokuSolver = class(TForm)
    Label2: TLabel;
    Label3: TLabel;
    Statistics: TLabel;
    Timetaken: TLabel;
    puzzlelistbox: TComboBox;
    Solve: TButton;
    Save: TButton;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure puzzlelistboxChange(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure puzzlelistboxKeyPress(Sender: TObject; var Key: char);
    procedure SaveClick(Sender: TObject);
    procedure SolveClick(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
      aRect: TRect; aState: TGridDrawState);
    procedure StringGrid1ValidateEntry(sender: TObject; aCol, aRow: Integer;
      const OldValue: string; var NewValue: String);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  FormSudokuSolver: TFormSudokuSolver;
  i,x,y,z : integer;
  list1 : Tstringlist;
  PF, TF : textfile;
  puzzlearray, resultarray: array[0..81] of integer;

  Puzzlestring, filename : string;
const
  easylist = 'Example,,,9,,,8,4,1,,' +
             ',,,5,3,,9,,,' +
             '5,,,,1,,2,6,,' +
             ',,,3,,7,1,,,' +
             ',,,,6,,,,,' +
             ',,6,8,,1,,,,' +
             ',9,5,,2,,,,4,' +
             ',,2,,8,5,,,,' +
             ',8,3,9,,,5,,,';

  emptylist =  ',,,,,,,,,' +
               ',,,,,,,,,' +
               ',,,,,,,,,' +
               ',,,,,,,,,' +
               ',,,,,,,,,' +
               ',,,,,,,,,' +
               ',,,,,,,,,' +
               ',,,,,,,,,' +
               ',,,,,,,,,';


implementation

{$R *.lfm}

{ TFormSudokuSolver }

procedure TFormSudokuSolver.puzzlelistboxChange(Sender: TObject);
var
  selectedlist : string;
  begin
  //when a puzzle is chosen from the drop down, populate the grid with
  //that puzzle from the file, otherwise clear the grid
  selectedlist := 'Clear' + emptylist;
  filename := 'Sudoku.txt';
  assignfile (PF, filename);
  Reset (PF);
  // read the puzzle file to find the puzzle that matches the selected puzzle
  while not eof (PF) do
  begin
    readln (PF, puzzlestring);
    if puzzlelistbox.text = leftstr(puzzlestring, length(puzzlelistbox.text)) then
         selectedlist := puzzlestring;
  end;
  closefile (PF);
  //populate the grid with the selected puzzle
  timetaken.Color := clForm;
  z := 0;
  timetaken.caption := '';
  list1 := TStringList.Create;
  list1.Delimiter := ',';
  list1.DelimitedText := selectedlist;
  for y:=0 to StringGrid1.RowCount-1 do begin
    for x:=0 to StringGrid1.ColCount-1 do begin
      inc (z);
      StringGrid1.Cells[x,y]:=list1[z];
    end;
  end;
  list1.free;
end;
procedure TFormSudokuSolver.puzzlelistboxKeyPress(Sender: TObject; var Key: char);
begin
  //when new grid name is chosen, set up a blank grid in the puzzle file.
  if key = chr(13) then
     if (puzzlelistbox.text <> '')
        and (puzzlelistbox.items.Indexof (puzzlelistbox.text) < 0) then
     begin
        filename := 'Sudoku.txt';
        assignfile (PF, filename);
        Append (PF);
        writeln (pf, puzzlelistbox.text + emptylist);
        closefile (PF);
     end;
end;

procedure TFormSudokuSolver.SaveClick(Sender: TObject);
var
  thispuzzle, looppuzzle : string;
  namelength : integer;
  newrecord : boolean;
begin
  //save the current grid to the current named item. or saved grid if nothing selected
  if (puzzlelistbox.text =  'Clear Grid') or
     (puzzlelistbox.text =  '') then
     thispuzzle := 'savedgrid'
  else
      thispuzzle := puzzlelistbox.text;
  // create a string with the grid contents and the puzzle name
  namelength := length (thispuzzle);
   for y:=0 to StringGrid1.RowCount-1 do begin
    for x:=0 to StringGrid1.ColCount-1 do begin
      thispuzzle := thispuzzle + ',' + StringGrid1.Cells[x,y]
    end;
  end;
   //copy the puzzle file to a temp file, modifying only the selcted puzzle record
    filename := 'Sudoku.txt';
    assignfile (PF, filename);
    assignfile (TF, 'temp.txt');
    Reset (PF);
    Rewrite (TF);
    newrecord := True;
    while not eof (PF) do
    begin
          readln (PF,looppuzzle);
          if leftstr(looppuzzle,namelength) = leftstr(thispuzzle,namelength) then
          begin
              writeln (TF, thispuzzle);
              newrecord := False;
          end
          else
              writeln (TF, looppuzzle);
    end;
   if newrecord then
      writeln (TF, thispuzzle);
   closefile (PF);
   closefile (TF);
 //copy the temp file to the puzzle file
   filename := 'Sudoku.txt';
    assignfile (PF, filename);
    assignfile (TF, 'temp.txt');
    Reset (TF);
    Rewrite (PF);
    while not eof (TF) do
    begin
          readln (TF,looppuzzle);
          writeln (PF, looppuzzle);
    end;
   closefile (PF);
   closefile (TF);

 //erase the temp file

   assignfile (TF, 'temp.txt');
   erase (TF);

end;

procedure TFormSudokuSolver.SolveClick(Sender: TObject);
var showpuzzle: string;
  starttime, endtime: Ttimestamp;
  duration : integer;

begin
  //solve the puzzle in the grid

  //extract the grid into an array of integers
  z:=0;
  showpuzzle := '';
  for y:=0 to StringGrid1.RowCount-1 do begin
    for x:=0 to StringGrid1.ColCount-1 do begin
      inc (z);
      if StringGrid1.Cells[x,y] = '' then
         puzzlearray[z] := 0
      else
         val(StringGrid1.Cells[x,y],puzzlearray[z]);
      showpuzzle := showpuzzle + (inttostr(puzzlearray[z]) + ' ');

    end;
  end;
//  showmessage ('puzzle string ' + showpuzzle);
  //call the solving module - results are in another array of integers
  levelcount := 0;
  highestlevelcount := 0;
  recursioncount := 0;
  starttime := DateTimeToTimeStamp(Now);
  resultarray := solvepuzzle (puzzlearray);
  endtime:= DateTimeToTimeStamp(Now);
  //populate the array with the results matrix
  duration := endtime.time - starttime.time;

  if duration = 0 then
     timetaken.caption := 'Time taken < 1 millisecond'
  else
      timetaken.caption := 'Time taken ' + inttostr(duration) + ' milliseconds';
  z:= 0;
  //check to see if puzzle was actually solved!
  if resultarray[0] > 0 then
     begin
     timetaken.caption := 'No Solution to this puzzle';
     timetaken.Color := clred;
     end;
  for y:=0 to StringGrid1.RowCount-1 do begin
    for x:=0 to StringGrid1.ColCount-1 do begin
      inc (z);
      StringGrid1.Cells[x,y] := inttostr(resultarray[z]);
    end;
  end;
  statistics.caption := 'Recursions: Depth ' + inttostr(highestlevelcount) +
                        ' Total ' + inttostr(recursioncount);

end;

procedure TFormSudokuSolver.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
begin
  //colour the three by three boes in contrasting colours
  with (Sender as TStringGrid) do
  begin
  if ((arow in [0,1,2,6,7,8]) and (acol in [0,1,2,6,7,8]))
     or ((arow in [3,4,5]) and (acol in [3,4,5])) then
        Canvas.Brush.Color := $00E1FFF9
       else
        Canvas.Brush.Color := clBtnFace;

    canvas.FillRect(arect);
    Canvas.TextRect(aRect, aRect.Left + 6, aRect.Top, cells[acol, arow]);
  end
  end;

procedure TFormSudokuSolver.StringGrid1ValidateEntry(sender: TObject; aCol, aRow: Integer;
  const OldValue: string; var NewValue: String);
var
  thisvalue : string;
begin
  //validate each entry as being a space or a single digit between 1 and 9
      ThisValue := trim(StringGrid1.Cells[aCol,aRow]);
      if ((Length(Thisvalue) > 0) and (ThisValue < '1') or (ThisValue >'9'))
         or (Length(Thisvalue) > 1) then
        begin
            NewValue := OldValue;
            showmessage ('Only 1 through 9 allowed');
          end
          else
          begin
            NewValue := Thisvalue;
        end;
end;

procedure TFormSudokuSolver.FormCreate(Sender: TObject);
var
  y: integer;
  x: integer;
begin
  // fill the grid StringGrid1.

  for x:=0 to StringGrid1.colCount-1 do begin
    for y:=0 to StringGrid1.RowCount-1 do begin
      StringGrid1.Cells[x,y]:=' ';
    end;
  end;

end;

procedure TFormSudokuSolver.FormPaint(Sender: TObject);

  begin
    {populate combo box}
    filename := 'Sudoku.txt';
    puzzlelistbox.items.add('Clear Grid');
    //if puzzle file does not exist, then create it and add the example puzzle
    if not fileexists(filename) then
    begin
        assignfile (PF, filename);
        Rewrite (PF);
        Writeln (PF, easylist);
        closefile (PF);
    end;

    //when puzzle file exists read the fle, extract the name from each line
    //and populate combo box
    assignfile (PF, filename);
    Reset (PF);
    while not eof (PF) do
    begin
      readln (PF, puzzlestring);
      list1 := TStringList.Create;
      list1.Delimiter := ',';
      list1.DelimitedText := puzzlestring;
      puzzlelistbox.items.add(list1[0]);
      list1.free;
    end;
    closefile (PF);
  end;



end.