Sudoku: implement a scratchpad for Sudoku's that aren't completely solved.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7242 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/sudoku/scratchpad.lfm

@@ -0,0 +1,40 @@
+object ScratchForm: TScratchForm
+  Left = 755
+  Height = 545
+  Top = 113
+  Width = 799
+  Caption = 'ScratchPad'
+  ClientHeight = 545
+  ClientWidth = 799
+  OnActivate = FormActivate
+  OnCreate = FormCreate
+  LCLVersion = '2.1.0.0'
+  object ScratchGrid: TStringGrid
+    Left = 16
+    Height = 283
+    Top = 13
+    Width = 736
+    ColCount = 9
+    DefaultColWidth = 80
+    DefaultRowHeight = 30
+    FixedCols = 0
+    FixedRows = 0
+    RowCount = 9
+    ScrollBars = ssNone
+    TabOrder = 0
+  end
+  object btnCopy: TButton
+    AnchorSideLeft.Control = ScratchGrid
+    AnchorSideTop.Control = ScratchGrid
+    AnchorSideTop.Side = asrBottom
+    Left = 16
+    Height = 25
+    Top = 306
+    Width = 253
+    AutoSize = True
+    BorderSpacing.Top = 10
+    Caption = 'Copy values back and close the ScratchPad'
+    OnClick = btnCopyClick
+    TabOrder = 1
+  end
+end

applications/sudoku/scratchpad.pas

@@ -0,0 +1,145 @@
+unit ScratchPad;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls,
+  SudokuType;
+
+type
+
+  { TScratchForm }
+
+  TCopyValuesEvent = procedure(Sender: TObject; Values: TValues) of Object;
+
+  TScratchForm = class(TForm)
+    btnCopy: TButton;
+    ScratchGrid: TStringGrid;
+    procedure btnCopyClick(Sender: TObject);
+    procedure FormActivate(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    FRawData: TRawGrid;
+    FOnCopyValues: TCopyValuesEvent;
+    procedure SetRawData(Data: TRawGrid);
+    procedure GridToValues(out Values: TValues);
+    procedure KeepInView;
+  public
+    property RawData: TRawGrid write SetRawData;
+    property OnCopyValues: TCopyValuesEvent read FOnCopyValues write FOnCopyValues;
+  end;
+
+var
+  ScratchForm: TScratchForm;
+
+implementation
+
+{$R *.lfm}
+
+function DbgS( ASet: TDigitSet): String; overload;
+var
+  D: TDigits;
+begin
+  Result := '[';
+  for D in ASet do
+  begin
+    Result := Result + IntToStr(D) + ',';
+  end;
+  if (Result[Length(Result)] = ',') then System.Delete(Result, Length(Result), 1);
+  Result := Result + ']';
+end;
+
+function DbgS(ASquare: TSquare): String; overload;
+const
+  BoolStr: Array[Boolean] of String = ('False','True');
+begin
+  Result := '[Value: ' + IntToStr(ASquare.Value) + ', ';
+  Result := Result + 'Locked: ' + BoolStr[ASquare.Locked] + ', ';
+  Result := Result + 'DigitsPossible: ' + DbgS(ASquare.DigitsPossible) + ']';
+end;
+
+{ TScratchForm }
+
+procedure TScratchForm.FormActivate(Sender: TObject);
+begin
+  Self.OnActivate := nil;
+  ScratchGrid.ClientWidth := 9 * ScratchGrid.DefaultColWidth;
+  ScratchGrid.ClientHeight := 9 * ScratchGrid.DefaultRowHeight;
+  ClientWidth := 2 * ScratchGrid.Left + ScratchGrid.Width;
+  ClientHeight := btnCopy.Top + btnCopy.Height + 10;
+  KeepInView;
+end;
+
+procedure TScratchForm.btnCopyClick(Sender: TObject);
+var
+  Values: TValues;
+begin
+  if not Assigned(FOnCopyValues) then Exit;
+  GridToValues(Values);
+  FOnCopyValues(Self, Values);
+  Close;
+end;
+
+procedure TScratchForm.FormCreate(Sender: TObject);
+begin
+  ScratchGrid.DefaultColWidth := ScratchGrid.Canvas.TextWidth(' [1,2,3,4,5,6,7,8,9] ') + 8;
+end;
+
+procedure TScratchForm.SetRawData(Data: TRawGrid);
+var
+  Row, Col: Integer;
+  S: String;
+begin
+  FRawData := Data;
+  for Col := 1 to 9 do
+  begin
+    for Row := 1 to 9 do
+    begin
+      //writeln('Col: ',Col,', Row: ',Row,', Square: ',DbgS(Data[Col,Row]));
+      if Data[Col,Row].Locked then
+        S := IntToStr(Data[Col,Row].Value)
+      else
+        S := DbgS(Data[Col,Row].DigitsPossible);
+      ScratchGrid.Cells[Col-1,Row-1] := S;
+    end;
+  end;
+end;
+
+procedure TScratchForm.GridToValues(out Values: TValues);
+var
+  Col, Row: Integer;
+  AValue: Longint;
+  S: String;
+begin
+  Values := Default(TValues);
+  for Col := 0 to 8 do
+  begin
+    for Row := 0 to 8 do
+    begin
+      S := ScratchGrid.Cells[Col, Row];
+      if Length(S) >= 1 then
+      begin
+        if TryStrToInt(S, AValue) then
+          Values[Col + 1, Row + 1] := AValue;
+      end;
+    end;
+  end;
+end;
+
+procedure TScratchForm.KeepInView;
+var
+  SW, FR, Diff, FL: Integer;
+begin
+  SW := Screen.Width;
+  FR := Left + Width + 8;
+  FL := Left;
+  Diff := FR - SW;
+  if (Diff > 0) then FL := Left - Diff;
+  if (FL < 0) then FL := 0;
+  Left := FL;
+end;
+
+end.
+

applications/sudoku/sudoku.lpi

@@ -60,7 +60,7 @@
         <PackageName Value="LCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="4">
       <Unit0>
         <Filename Value="sudoku.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -77,15 +77,17 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="SudokuType"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="scratchpad.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="ScratchForm"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="ScratchPad"/>
+      </Unit3>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
-    <Parsing>
-      <SyntaxOptions>
-        <UseAnsiStrings Value="False"/>
-      </SyntaxOptions>
-    </Parsing>
     <Linking>
       <Options>
         <Win32>

applications/sudoku/sudoku.lpr

@@ -27,11 +27,12 @@ program sudoku;
 uses
   Interfaces, // this includes the LCL widgetset
   Forms
-  { add your units here }, sudokumain;
+  { add your units here }, sudokumain, scratchpad;
 
 begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
+  Application.CreateForm(TScratchForm, ScratchForm);
   Application.Run;
 end.
 

applications/sudoku/sudokumain.pas

@@ -31,7 +31,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
-  Buttons, StdCtrls, SudokuType;
+  Buttons, StdCtrls, SudokuType, ScratchPad;
 
 type
 
@@ -60,9 +60,12 @@ type
       var Editor: TWinControl);
   private
     { private declarations }
-    theValues: TValues;
+    //theValues: TValues;
-    function SolveSudoku: Boolean;
+    procedure OnCopyBackValues(Sender: TObject; Values: TValues);
-    procedure ShowSolution;
+    function SolveSudoku(out Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
+    procedure GridToValues(out Values: TValues);
+    procedure ValuesToGrid(const Values: TValues);
+    procedure ShowScratchPad(RawData: TRawGrid);
     procedure LoadSudokuFromFile(const Fn: String);
     procedure SaveSudokuToFile(const Fn: String);
     function IsValidSudokuFile(Lines: TStrings): Boolean;
@@ -121,10 +124,22 @@ begin
 end;
 
 procedure TForm1.btnSolveClick(Sender: TObject);
+var
+  Res: Boolean;
+  RawData: TRawGrid;
+  Values: TValues;
+  Steps: Integer;
 begin
   SGrid.Options := SGrid.Options - [goEditing];
-  SolveSudoku;
+  Res := SolveSudoku(Values, RawData, Steps);
-  ShowSolution;
+  ValuesToGrid(Values);
+  if Res then
+    ShowMessage(Format('Sudoku solved in %d steps.', [Steps]))
+  else
+  begin
+    ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
+    ShowScratchPad(RawData);
+  end;
 end;
 
 procedure TForm1.EditorKeyPress(Sender: TObject; var Key: char);
@@ -193,35 +208,45 @@ begin
 end;
 
 
-function TForm1.SolveSudoku: Boolean;
+function TForm1.SolveSudoku(out Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
 var
   aSudoku: TSudoku;
-  Col, Row: Integer;
-  Steps, AValue: Integer;
 begin
-  theValues := Default(TValues); //initialize all to zero
+  GridToValues(Values);
+  RawData := Default(TRawGrid);
+  aSudoku := TSudoku.Create;
+  Result := aSudoku.GiveSolution(Values, RawData, Steps);
+  aSudoku.Free;
+end;
+
+procedure TForm1.GridToValues(out Values: TValues);
+var
+  Col, Row: Integer;
+  S: String;
+  AValue: Longint;
+begin
+  Values := Default(TValues); //initialize all to zero
   for Col := 0 to 8 do
   begin
     for Row := 0 to 8 do
     begin
-      if Length(SGrid.Cells[Col, Row]) >= 1 then
+      S := Trim(SGrid.Cells[Col, Row]);
+      if Length(S) = 1 then
       begin
-        if TryStrToInt(SGrid.Cells[Col, Row][1], AValue) then
+        if TryStrToInt(S, AValue) then
-          theValues[Col + 1, Row + 1] := AValue;
+          Values[Col + 1, Row + 1] := AValue;
       end;
     end;
   end;
-  aSudoku := TSudoku.Create;
+end;
-  Result := aSudoku.GiveSolution(theValues, Steps);
+
-  aSudoku.Free;
+procedure TForm1.OnCopyBackValues(Sender: TObject; Values: TValues);
-  if Result then
+begin
-    ShowMessage(Format('Sudoku solved in %d steps.', [Steps]))
+  ValuesToGrid(Values);
-  else
-    ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
 end;
 
 
-procedure TForm1.ShowSolution;
+procedure TForm1.ValuesToGrid(const Values: TValues);
 var
   Col, Row: Integer;
   Ch: Char;
@@ -230,7 +255,7 @@ begin
   begin
     for Row := 0 to 8 do
     begin
-      Ch := IntToStr(theValues[Col + 1, Row + 1])[1];
+      Ch := IntToStr(Values[Col + 1, Row + 1])[1];
       if Ch = '0' then
         Ch := VisualEmptyChar;
       SGrid.Cells[Col, Row] := Ch;
@@ -238,6 +263,15 @@ begin
   end;
 end;
 
+procedure TForm1.ShowScratchPad(RawData: TRawGrid);
+begin
+  ScratchForm.OnCopyValues := @OnCopyBackValues;
+  ScratchForm.RawData := RawData;
+  ScratchForm.ScratchGrid.Options := SGrid.Options + [goEditing];
+  ScratchForm.ScratchGrid.OnPrepareCanvas := @Self.SGridPrepareCanvas;
+  ScratchForm.Show;
+end;
+
 procedure TForm1.LoadSudokuFromFile(const Fn: String);
 var
   SL: TStringList;

applications/sudoku/sudokutype.pas

@@ -43,7 +43,7 @@ type
   { TSudoku }
 
   TSudoku = class(TObject)
-    function GiveSolution(var Values: TValues; out Steps: Integer): Boolean;
+    function GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
   private
     Grid: TRawGrid;
     procedure CalculateValues(out IsSolved: Boolean);
@@ -132,7 +132,7 @@ begin
   until Result or (Steps > 50);
 end;
 
-function TSudoku.GiveSolution(var Values: TValues; out Steps: Integer): Boolean;
+function TSudoku.GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
 var
   c, r: Integer;
 begin
@@ -145,6 +145,7 @@ begin
       Values[c, r] := Grid[c, r].Value;
     end;
   end;
+  RawData := Grid;
 end;
 
 procedure TSudoku.CalculateValues(out IsSolved: Boolean);