paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Sudoku: make it possible to preserve the RawData from the ScratchPad and use it in the solving process.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7263 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart 2020-01-10 11:11:56 +00:00
parent 32ff846113
commit 8d57550d02
4 changed files with 170 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
applications/sudoku/scratchpad.lfm
View File

@ -3,6 +3,7 @@ object ScratchForm: TScratchForm
Height = 545
Top = 113
Width = 799
BorderIcons = [biSystemMenu]
Caption = 'ScratchPad'
ClientHeight = 545
ClientWidth = 799
@ -29,14 +30,30 @@ object ScratchForm: TScratchForm
AnchorSideLeft.Control = ScratchGrid
AnchorSideTop.Control = ScratchGrid
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnCopyRaw
AnchorSideRight.Side = asrBottom
Left = 16
Height = 25
Top = 306
Width = 253
Width = 279
AutoSize = True
BorderSpacing.Top = 10
Caption = 'Copy values back and close the ScratchPad'
Caption = 'Copy only values back and close the ScratchPad'
OnClick = btnCopyClick
TabOrder = 1
end
object btnCopyRaw: TButton
AnchorSideLeft.Control = btnCopy
AnchorSideTop.Control = btnCopy
AnchorSideTop.Side = asrBottom
Left = 16
Height = 25
Top = 341
Width = 354
AutoSize = True
BorderSpacing.Top = 10
Caption = 'Copy values and possible digits back and close the ScratchPad'
OnClick = btnCopyRawClick
TabOrder = 2
end
end

63
applications/sudoku/scratchpad.pas
View File

@ -14,11 +14,14 @@ type
{ TScratchForm }
TCopyValuesEvent = procedure(Sender: TObject; Values: TValues) of Object;
TCopyRawDataEvent = procedure(Sender: TObject; RawData: TRawGrid) of Object;
TScratchForm = class(TForm)
btnCopy: TButton;
btnCopyRaw: TButton;
ScratchGrid: TStringGrid;
procedure btnCopyClick(Sender: TObject);
procedure btnCopyRawClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ScratchGridClick(Sender: TObject);
@ -27,6 +30,8 @@ type
private
FRawData: TRawGrid;
FOnCopyValues: TCopyValuesEvent;
FOnCopyRawData: TCopyRawDataEvent;
procedure GridToRawData(out RawData: TRawGrid);
procedure SetRawData(Data: TRawGrid);
procedure GridToValues(out Values: TValues);
procedure KeepInView;
@ -34,6 +39,7 @@ type
public
property RawData: TRawGrid write SetRawData;
property OnCopyValues: TCopyValuesEvent read FOnCopyValues write FOnCopyValues;
property OnCopyRawData: TCopyRawDataEvent read FOnCopyRawData write FOnCopyRawData;
end;
var
@ -101,7 +107,9 @@ begin
Self.ReAlign;
//ClientHeight := btnCopy.Top + btnCopy.Height + 10;
//Above doesn't work: at this time btnCopy.Top still holds designtime value, even when it's top is anchored to the grid
ClientHeight := ScratchGrid.Top + ScratchGrid.Height + 10 + btnCopy.Height + 10;
ClientHeight := ScratchGrid.Top + ScratchGrid.Height + 10 + btnCopy.Height + 10 + btnCopyRaw.Height + 10;
btnCopy.AutoSize := False;
btnCopy.Width := btnCopyRaw.Width;
//writeln(format('ClientHeight: %d',[ClientHeight]));
KeepInView;
end;
@ -110,10 +118,26 @@ procedure TScratchForm.btnCopyClick(Sender: TObject);
var
Values: TValues;
begin
if not Assigned(FOnCopyValues) then Exit;
GridToValues(Values);
FOnCopyValues(Self, Values);
Close;
if Assigned(FOnCopyValues) then
begin
GridToValues(Values);
FOnCopyValues(Self, Values);
ModalResult := mrOk;
//Close;
end;
end;
procedure TScratchForm.btnCopyRawClick(Sender: TObject);
var
ARawData: TRawGrid;
begin
if Assigned(FOnCopyRawData) then
begin
GridToRawData(ARawData);
FOnCopyRawData(Self, ARawData);
ModalResult := mrOk;
//Close;
end;
end;
procedure TScratchForm.FormCreate(Sender: TObject);
@ -188,6 +212,35 @@ begin
end;
end;
procedure TScratchForm.GridToRawData(out RawData: TRawGrid);
var
Col, Row: Integer;
ADigit: TDigits;
DigitSet: TDigitSet;
S: String;
begin
for Col := 0 to 8 do
begin
for Row := 0 to 8 do
begin
S := ScratchGrid.Cells[Col, Row];
if TryCellTextToDigit(S, ADigit) then
begin
RawData[Col+1,Row+1].Value := ADigit;
RawData[Col+1,Row+1].DigitsPossible := [];
RawData[Col+1,Row+1].Locked := True;
end
else
begin
DigitSet := StrToDigitSet(S);
RawData[Col+1,Row+1].Value := 0;
RawData[Col+1,Row+1].DigitsPossible := DigitSet;
RawData[Col+1,Row+1].Locked := False;
end;
end;
end;
end;
procedure TScratchForm.GridToValues(out Values: TValues);
var
Col, Row: Integer;

87
applications/sudoku/sudokumain.pas
View File

@ -62,19 +62,29 @@ type
{ private declarations }
const
MaxSteps = 50;
private
//theValues: TValues;
FSolveUsesRawData: Boolean;
FRawData: TRawGrid;
procedure OnCopyBackValues(Sender: TObject; Values: TValues);
procedure OnCopyBackRawData(Sender: TObject; RawData: TRawGrid);
procedure SetSolveUsesRawData(AValue: Boolean);
function SolveSudoku(out Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
function SolveSudoku(var RawData: TRawGrid; out Values: TValues; out Steps: Integer): Boolean;
procedure GridToValues(out Values: TValues);
procedure ValuesToGrid(const Values: TValues);
procedure RawDataToGrid(const RawData: TRawGrid);
procedure ShowScratchPad(RawData: TRawGrid);
procedure LoadSudokuFromFile(const Fn: String);
procedure SaveSudokuToFile(const Fn: String);
function IsValidSudokuFile(Lines: TStrings): Boolean;
procedure LinesToGrid(Lines: TStrings);
procedure GridToLines(Lines: TStrings);
procedure EnableEdit;
procedure DisableEdit;
public
{ public declarations }
property SolveUsesRawData: Boolean read FSolveUsesRawData write SetSolveUsesRawData default False;
end;
ESudokuFile = Class(Exception);
@ -96,7 +106,7 @@ const
procedure TForm1.btnEditClick(Sender: TObject);
begin
SGrid.Options := SGrid.Options + [goEditing];
EnableEdit;
SGrid.SetFocus;
end;
@ -105,6 +115,7 @@ begin
if OpenDialog.Execute then
try
LoadSudokuFromFile(OpenDialog.Filename);
SolveUsesRawData := False;
except
on E: Exception do ShowMessage(E.Message);
end;
@ -128,13 +139,15 @@ end;
procedure TForm1.btnSolveClick(Sender: TObject);
var
Res: Boolean;
RawData: TRawGrid;
Values: TValues;
Steps: Integer;
begin
SGrid.Options := SGrid.Options - [goEditing];
DisableEdit;
try
Res := SolveSudoku(Values, RawData, Steps);
if not FSolveUsesRawData then
Res := SolveSudoku(Values, FRawData, Steps)
else
Res := SolveSudoku(FRawData, Values, Steps);
ValuesToGrid(Values);
if Res then
ShowMessage(Format('Sudoku solved in %d steps.', [Steps]))
@ -144,7 +157,7 @@ begin
ShowMessage(Format('Unable to solve sudoku (no progress after step %d).',[Steps-1]))
else
ShowMessage(Format('Unable to completely solve sudoku (tried %d steps).',[Steps]));
ShowScratchPad(RawData);
ShowScratchPad(FRawData);
end;
except
on E: ESudoku do ShowMessage(E.Message);
@ -174,6 +187,7 @@ end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SolveUsesRawData := False;
OpenDialog.Filter := SudokuFileFilter;
SaveDialog.Filter := SudokuFileFilter;
end;
@ -231,6 +245,18 @@ begin
end;
end;
function TForm1.SolveSudoku(var RawData: TRawGrid; out Values: TValues; out Steps: Integer): Boolean;
var
aSudoku: TSudoku;
begin
aSudoku := TSudoku.Create;
try
Result := aSudoku.GiveSolution(RawData, Values, Steps);
finally
aSudoku.Free;
end;
end;
procedure TForm1.GridToValues(out Values: TValues);
var
Col, Row: Integer;
@ -255,6 +281,26 @@ end;
procedure TForm1.OnCopyBackValues(Sender: TObject; Values: TValues);
begin
ValuesToGrid(Values);
SolveUsesRawData := False;
end;
procedure TForm1.OnCopyBackRawData(Sender: TObject; RawData: TRawGrid);
begin
FRawData := RawData;
RawDataToGrid(RawData);
SolveUsesRawData := True;
end;
procedure TForm1.SetSolveUsesRawData(AValue: Boolean);
begin
if FSolveUsesRawData = AValue then Exit;
FSolveUsesRawData := AValue;
if FSolveUsesRawData then
DisableEdit
else
EnableEdit;
btnEdit.Enabled := not FSolveUsesRawData;
btnClear.Enabled := not FSolveUsesRawData;
end;
@ -275,13 +321,32 @@ begin
end;
end;
procedure TForm1.RawDataToGrid(const RawData: TRawGrid);
var
Col, Row: Integer;
Ch: Char;
begin
for Col := 0 to 8 do
begin
for Row := 0 to 8 do
begin
Ch := IntToStr(RawData[Col + 1, Row + 1].Value)[1];
if Ch = '0' then
Ch := VisualEmptyChar;
SGrid.Cells[Col, Row] := Ch;
end;
end;
end;
procedure TForm1.ShowScratchPad(RawData: TRawGrid);
begin
ScratchForm.OnCopyValues := @OnCopyBackValues;
ScratchForm.OnCopyRawData := @OnCopyBackRawData;
ScratchForm.RawData := RawData;
ScratchForm.ScratchGrid.Options := SGrid.Options - [goEditing];
ScratchForm.Left := Left + Width + 10;
ScratchForm.Show;
if (ScratchForm.ShowModal <> mrOK) then
SolveUsesRawData := False;
end;
procedure TForm1.LoadSudokuFromFile(const Fn: String);
@ -396,5 +461,15 @@ begin
end;
end;
procedure TForm1.EnableEdit;
begin
SGrid.Options := SGrid.Options + [goEditing];
end;
procedure TForm1.DisableEdit;
begin
SGrid.Options := SGrid.Options - [goEditing];
end;
end.

12
applications/sudoku/sudokutype.pas
View File

@ -58,6 +58,7 @@ type
public
constructor Create;
function GiveSolution(var Values: TValues; out RawData: TRawGrid; out Steps: Integer): Boolean;
function GiveSolution(var RawData: TRawGrid; out Values: TValues; out Steps: Integer): Boolean;
property MaxSteps: Integer read FMaxSteps write FMaxSteps default 50;
end;
@ -219,6 +220,17 @@ begin
RawData := Grid;
end;
{
Note: no sanity check on RawData is performed!
}
function TSudoku.GiveSolution(var RawData: TRawGrid; out Values: TValues; out Steps: Integer): Boolean;
begin
Grid := RawData;
Result := Solve(Steps);
RawData := Grid;
Values := GridToValues;
end;
procedure TSudoku.CalculateValues(out IsSolved: Boolean);
var
c, r: Integer;