|
Apparently I left out one small piece of code. Here it is.
procedure Rule3; (* Is the cell the only blank one in the current block? *)
var
i,j : integer;
CheckThisBlock : integer;
NumberSolvedInBlock : integer;
StringBeingReduced : string;
ImpossibleCharacters : string;
OnlyRemainingCharacter : char;
begin
NumberSolvedInBlock := 0;
StringBeingReduced := '123456789';
CheckThisBlock:= GridInfo{Currentpos_x}{Currentpos_y}.BlockNumber;
for i := 1 to 9 do
begin
for j := 1 to 9 do
begin
if GridInfo{i}{j}.BlockNumber = CheckThisBlock then
begin
if GridInfo{i}{j}.IsSolved = TRUE then
begin
NumberSolvedInBlock := NumberSolvedInBlock + 1;
StringBeingReduced := EliminateCharacter(StringBeingReduced,GridInfo{i}{j}.DisplayValue);
(* Eliminate from the Possibilities this Solution which was found elswhere in the block. *)
GridInfo{Currentpos_x}{Currentpos_y}.Possibilities
:= EliminateCharacter(GridInfo{Currentpos_x}{Currentpos_y}.Possibilities,
GridInfo{i}{j}.DisplayValue);
end;
end;
end; (* for j *)
end; (* for i *)
(* gotoxy(45,19);
write('**',NumberSolvedInBlock,'***'); *)
if NumberSolvedInBlock = 8 then (* ... then the cell we're checking is the only blank one in the block *)
ProcessSolution(Currentpos_x,Currentpos_y,StringBeingReduced,'Last blank cell in the block. (Rule 3)');
if GridInfo{Currentpos_x}{Currentpos_y}.IsSolved = FALSE then
begin
if length(GridInfo{Currentpos_x}{Currentpos_y}.Possibilities) = 1 then
ProcessSolution(Currentpos_x,Currentpos_y,GridInfo{Currentpos_x}{Currentpos_y}.Possibilities,
'Column, row and block solutions leave just one possibility. (Rule 4.3)');
end;
end; (* procedure Rule3. Note that there is no procedure called 'Rule4'. *)
Gold is $1,581/oz today. When it hits $2,000, it will be up 26.5%. Let's see how long that takes. - De 3/11/2013 - ANSWER: 7 Years, 5 Months
» You can also:
- - - - -
The above is a reply to the following message:
Re: Lazarus (Pascal) - Code part 5 of 5
By: Decomposed
in
POPE IV
Mon, 20 Nov 17 10:56 PM
|
Msg. 38939 of
47202
|
procedure ExecuteRules();
begin
if GridInfo{Currentpos_x}{Currentpos_y}.IsSolved = FALSE then
Rule1; (* Is it the last blank cell in the column? *)
if GridInfo{Currentpos_x}{Currentpos_y}.IsSolved = FALSE then
Rule2; (* Is it the last blank cell in the row? *)
if GridInfo{Currentpos_x}{Currentpos_y}.IsSolved = FALSE then
Rule3; (* Is it the last blank cell in the block? *)
(* Rule4 is embbedded in rules 1 2 and 3, so don't re-use that number *)
if GridInfo{Currentpos_x}{Currentpos_y}.IsSolved = FALSE then
Rule5; (* Is one of the cell's Possibilities not possible on any other cell in the column? *)
if GridInfo{Currentpos_x}{Currentpos_y}.IsSolved = FALSE then
Rule6; (* Is one of the cell's Possibilities not possible on any other cell in the row? *)
if GridInfo{Currentpos_x}{Currentpos_y}.IsSolved = FALSE then
Rule7; (* Is one of the cell's Possibilities not possible on any other cell in the block? *)
if (not AutoMovement) or (AutoMovement and (not GridInfo{Currentpos_x}{Currentpos_y}.IsSolved)) then
ExamineCell(Currentpos_x,Currentpos_y,Currentpos_x,Currentpos_y);
end; (* procedure ExecuteRules(); *)
procedure MoveDirection(direction:string);
var
Oldpos_x, Oldpos_y : integer;
begin
(* Moves us around based on direction and global vars Currentpos_x,Currentpos_y *)
Oldpos_x := Currentpos_x;
Oldpos_y := Currentpos_y;
if direction 'Auto' then
begin
case direction of
'Up' :
begin
if Currentpos_y > 1 then
begin
Currentpos_y := Currentpos_y-1;
end;
end;
'Down' :
begin
if Currentpos_y < 9 then
begin
Currentpos_y := Currentpos_y+1;
end;
end;
'Left' :
begin
if Currentpos_x > 1 then
begin
Currentpos_x := Currentpos_x-1;
end;
end; (* Left *)
'Right' :
begin
if Currentpos_x < 9 then
Currentpos_x := Currentpos_x+1;
end; (* Right *)
end; (* case statement *)
end (* if direction 'Auto' *)
else (* else the direction IS 'Auto' *)
begin
if Currentpos_x < 9 then
Currentpos_x := Currentpos_x+1
else (* if .. else Currentpos_x = 9 *)
begin
Currentpos_x := 1;
if Currentpos_y < 9 then
Currentpos_y := Currentpos_y + 1 (* if Currrentpos_y < 9 *)
else (* if .. else Currentpos_y IS 9 *)
begin
Currentpos_y := 1;
PassesSinceLastSolution := PassesSinceLastSolution + 1;
if PassesSinceLastSolution = 5 then
Unsolveable := TRUE;
end;
end; (* if .. else Currentpos_x = 9 *)
end; (* if .. else the direction IS 'Auto' *)
ExecuteRules;
ExamineCell(Oldpos_x,Oldpos_y,Currentpos_x,Currentpos_y);
end; (* procedure MoveDirection *)
procedure drawborders;
begin
clrscr;
drawline_h(1,1,79,'0');
drawline_h(1,23,79,'0');
drawline_v(1,2,22,'0');
drawline_v(79,2,22,'0');
end; (* procedure drawborders; *)
procedure draw_initial_screen;
var
i,j : integer;
ExtraSpace,NumWrites : integer;
gridlinechar_v, gridlinechar_h : char;
begin
drawborders;
gotoxy(18,24);
write(' to Quit. Arrow keys to move.');
gotoxy(23,25);
write('Or Press ''A'' for Auto Mode');
gridlinechar_v:=chr(222);
gridlinechar_h:=chr(220);
ExtraSpace := 0;
NumWrites:=0;
drawline_v(GRID_XBASE+12,GRID_YBASE+3,11,gridlinechar_v);
drawline_v(GRID_XBASE+24,GRID_YBASE+3,11,gridlinechar_v);
drawline_h(GRID_XBASE+2,GRID_YBASE+6,33,gridlinechar_h);
drawline_h(GRID_XBASE+2,GRID_YBASE+10,33,gridlinechar_h);
drawline_v(38,2,14,gridlinechar_v);
drawline_h(3,15,36,gridlinechar_h);
for j := 1 to 9 do
begin
if j=4 then ExtraSpace := 1;
if j=7 then ExtraSpace := 2;
for i := 1 to 9 do
begin
gotoxy(GRID_XBASE+2+((i-1)*4),GRID_YBASE+2+j+ExtraSpace);
write (GridInfo{i}{j}.displayvalue);
gotoxy(40,10);
end; (* for i *)
end; (* for j *)
end; (* procedure draw_initial_screen; *)
begin
cursoroff;
LoadPuzzle('415');
draw_initial_screen;
Currentpos_x:=1; (* Values ranging from 1 to 9 that say which cell we begin *)
Currentpos_y:=1;
AutoMovement := FALSE;
TotalCellsSolved := 0;
PassesSinceLastSolution := 0;
Unsolveable := FALSE;
for i := 1 to 9 do
for j := 1 to 9 do
if GridInfo{i}{j}.IsSolved then
TotalCellsSolved := TotalCellsSolved+1;
(* Start by clearing brackets that aren't present, then drawing brackets *)
(* at the cell we're going to examine. Later, the old position and new *)
(* positions are what we'll pass to ExamineCell. *)
ExecuteRules;
repeat
ExamineCell(Currentpos_x,Currentpos_y,Currentpos_x,Currentpos_y);
ch:=ReadKey;
case ch of
#0 : begin
ch:=ReadKey; {Read ScanCode}
case ch of
#72 : MoveDirection('Up');
#75 : MoveDirection('Left');
#77 : MoveDirection('Right');
#80 : MoveDirection('Down');
else
;
end;
end;
#65,#97 : begin
AutoMovement := TRUE; (* A or a (for auto movement) *)
MoveDirection('Auto');
end;
#27 : ; (* An ESC was pressed, so quit. *)
end;
until (ch=#27) or AutoMovement; (* Esc *);
if AutoMovement then
begin
gotoxy(18,24);
write(' Automatic Mode. Please wait.');
gotoxy(18,25);
write(' ');
repeat
MoveDirection('Auto');
until (TotalCellsSolved = 81) or Unsolveable;
if Unsolveable then
DisplayMessage(18,25,'** Could not solve this puzzle. **');
AutoMovement := FALSE;
gotoxy(18,24);
write(' Press to Quit. ');
gotoxy(18,24);
write(' to Quit. Arrow keys to move.');
repeat
ExamineCell(Currentpos_x,Currentpos_y,Currentpos_x,Currentpos_y);
ch:=ReadKey;
case ch of
#0 : begin
ch:=ReadKey; {Read ScanCode}
case ch of
#72 : MoveDirection('Up');
#75 : MoveDirection('Left');
#77 : MoveDirection('Right');
#80 : MoveDirection('Down');
else
;
end;
end;
#27 : ; (* An ESC was pressed, so quit. *)
end; (* case *)
until (ch=#27); (* Esc *);
end; (* if AutoMovement *)
cursoron;
end.
|
|
|
|
|
| 
