Changeset 7

Timestamp:

Nov 22, 2012, 7:09:17 AM (12 years ago)

Author:

chronos

Message:

• Added: Allow terminate solving process.
• Fixed: Disable actions which can change maze during solving.

Location:

trunk

Files:

• . (modified) (1 prop)
• Forms/ufrmmain1.lfm (modified) (6 diffs)
• Forms/ufrmmain1.pas (modified) (8 diffs)
• Lazes.lpi (modified) (2 diffs)
• class/maze.pas (modified) (2 diffs)
• class/mazepainter.pas (modified) (3 diffs)

trunk

@@ -3 +3 @@
 Lazes.lps
 Lazes.dbg
+Lazes

@@ -3 +3 @@
 Lazes.lps
 Lazes.dbg
+Lazes

trunk/Forms/ufrmmain1.lfm

@@ -5 +5 @@
   Width = 459
   Caption = 'Lazes - Lazarus Mazes'
-  ClientHeight = 370
+  ClientHeight = 366
   ClientWidth = 459
   Constraints.MinHeight = 300
   Constraints.MinWidth = 300
   Menu = MainMenu1
+  OnClose = FormClose
   OnCreate = FormCreate
   OnDestroy = FormDestroy
@@ -3337 +3338 @@
     }
     Stretch = True
-    Visible = False
   end
   object pbMaze: TPaintBox
@@ -3356 +3356 @@
       Caption = '&File'
       object MenuItem2: TMenuItem
-        Action = FileExit1
+        Action = AFileExit
       end
     end
@@ -3362 +3362 @@
       Caption = '&Maze'
       object MenuItem7: TMenuItem
-        Action = acNewMaze
+        Action = AMazeNew
       end
       object MenuItem4: TMenuItem
-        Action = actMetricsPopUp
+        Action = AMetricsPopUp
+      end
+      object MenuItem9: TMenuItem
+        Action = AMazeEnlarge
+      end
+      object MenuItem10: TMenuItem
+        Action = AMazeShrink
       end
       object MenuItem5: TMenuItem
@@ -3371 +3377 @@
       end
       object MenuItem6: TMenuItem
-        Action = acSolve
+        Action = AMazeSolve
+      end
+      object MenuItem8: TMenuItem
+        Action = ATerminate
       end
     end
   end
   object ActionList1: TActionList
-    left = 88
+    left = 96
     top = 8
-    object FileExit1: TFileExit
+    object AFileExit: TFileExit
       Category = 'File'
       Caption = 'E&xit'
       Hint = 'Exit'
     end
-    object actMetricsPopUp: TAction
+    object AMetricsPopUp: TAction
       Category = 'Maze'
       Caption = '&Change maze metrics'
-      OnExecute = actMetricsPopUpExecute
+      OnExecute = AMetricsPopUpExecute
       ShortCut = 113
     end
-    object acSolve: TAction
+    object AMazeSolve: TAction
       Category = 'Maze'
       Caption = '&Solve maze'
-      OnExecute = acSolveExecute
+      OnExecute = AMazeSolveExecute
       ShortCut = 112
     end
-    object acNewMaze: TAction
+    object AMazeNew: TAction
       Category = 'Maze'
       Caption = '&Generate new maze'
-      OnExecute = acNewMazeExecute
+      OnExecute = AMazeNewExecute
       ShortCut = 116
+    end
+    object AMazeEnlarge: TAction
+      Category = 'Maze'
+      Caption = '&Enlarge'
+      OnExecute = AMazeEnlargeExecute
+      ShortCut = 114
+    end
+    object AMazeShrink: TAction
+      Category = 'Maze'
+      Caption = '&Shrink'
+      OnExecute = AMazeShrinkExecute
+      ShortCut = 115
+    end
+    object ATerminate: TAction
+      Category = 'Maze'
+      Caption = 'Terminate'
+      OnExecute = ATerminateExecute
+      ShortCut = 27
     end
   end
@@ -3405 +3432 @@
     Interval = 10
     OnTimer = TimerDrawTimer
-    left = 152
+    left = 176
     top = 8
   end

trunk/Forms/ufrmmain1.pas

@@ -31 +31 @@
 
   TfrmMain1 = class(TForm)
-    acSolve: TAction;
-    acNewMaze: TAction;
-    actMetricsPopUp: TAction;
+    ATerminate: TAction;
+    AMazeEnlarge: TAction;
+    AMazeShrink: TAction;
+    AMazeSolve: TAction;
+    AMazeNew: TAction;
+    AMetricsPopUp: TAction;
     ActionList1: TActionList;
-    FileExit1: TFileExit;
+    AFileExit: TFileExit;
     imgBackground: TImage;
     MainMenu1: TMainMenu;
     MenuItem1: TMenuItem;
+    MenuItem10: TMenuItem;
     MenuItem2: TMenuItem;
     MenuItem3: TMenuItem;
@@ -45 +49 @@
     MenuItem6: TMenuItem;
     MenuItem7: TMenuItem;
+    MenuItem8: TMenuItem;
+    MenuItem9: TMenuItem;
     pbMaze: TPaintBox;
     TimerDraw: TTimer;
 
-    procedure acNewMazeExecute(Sender: TObject);
-    procedure acSolveExecute(Sender: TObject);
-    procedure actMetricsPopUpExecute(Sender: TObject);
+    procedure AMazeEnlargeExecute(Sender: TObject);
+    procedure AMazeNewExecute(Sender: TObject);
+    procedure AMazeShrinkExecute(Sender: TObject);
+    procedure AMazeSolveExecute(Sender: TObject);
+    procedure AMetricsPopUpExecute(Sender: TObject);
+    procedure ATerminateExecute(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
@@ -64 +74 @@
     MazeIsSolved: boolean;
     RedrawPending: Boolean;
+    DisableActions: Boolean;
+    Solved: boolean;
+    TerminateAction: Boolean;
     procedure GenerateNewMaze;
     procedure ResizeMaze(const pdx, pdy: integer);
     procedure SetMazeMetrics(AValue: TMazeUpdateInfo);
+    procedure TravelMaze(CurPos: TCellPoint);
+    procedure TryMove(const pFrom: TCellPoint; const pDirection: TDirection);
   public
     property MazeMetrics: TMazeUpdateInfo read FMazeMetrics write SetMazeMetrics;
     procedure Redraw;
+    procedure UpdateInterface;
   end;
 
@@ -104 +120 @@
   // And generate a demo maze
   GenerateNewMaze;
+
+  UpdateInterface;
 end;
 
@@ -114 +132 @@
 procedure TfrmMain1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
 begin
-  ResizeMaze(-1,-1);
+  AMazeShrink.Execute;
 end;
 
 procedure TfrmMain1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
 begin
-  ResizeMaze(1,1);
-end;
-
-procedure TfrmMain1.acSolveExecute(Sender: TObject);
-
-var Solved: boolean;
-
-  procedure TravelMaze(CurPos: TCellPoint);
-
-    procedure TryMove(const pFrom: TCellPoint; const pDirection: TDirection);
-    const DirMoves: array[TDirection] of TPoint = ((x: 0; y:-1),  // North
-                                                   (x: 0; y:+1),  // South
-                                                   (x:+1; y:0 ),  // East
-                                                   (x:-1; y:0 )); // West
-    var NewPos: TCellPoint;
+  AMazeEnlarge.Execute;
+end;
+
+procedure TfrmMain1.TryMove(const pFrom: TCellPoint; const pDirection: TDirection);
+const
+  DirMoves: array[TDirection] of TPoint =
+    ((x: 0; y:-1),  // North
+    (x: 0; y:+1),  // South
+    (x:+1; y:0 ),  // East
+    (x:-1; y:0 )); // West
+var
+  NewPos: TCellPoint;
+begin
+  if TerminateAction then Exit;
+
+  // Direction at all possible?
+  with Maze.GetCell(pFrom) do
+    if not CanGo[pDirection] then Exit;
+
+  // Movement is possible!
+  NewPos.Row := pFrom.Row + DirMoves[pDirection].y;
+  NewPos.Col := pFrom.Col + DirMoves[pDirection].x;
+
+  // Check if the next cell is not visited before.
+  with Maze.GetCell(NewPos) do
+    if State = csExit then
+      begin
+        Solved := true;
+        Exit;
+      end
+    else if State = csVisited then
+      Exit
+  else
     begin
-      // Direction at all possible?
-      with Maze.GetCell(pFrom) do
-        if not CanGo[pDirection] then EXIT;
-
-      // Movement is possible!
-      NewPos.Row := pFrom.Row + DirMoves[pDirection].y;
-      NewPos.Col := pFrom.Col + DirMoves[pDirection].x;
-
-      // Check if the next cell is not visited before.
-      with Maze.GetCell(NewPos) do
-        if State = csExit then
+      State := csVisited;     // Been here
+      // Tag := 1;               // Visited
+          // State := csStart;
+          MazePainter.IsDirty := true; // Force repaint with new cell populated
+          Redraw;
+          Application.ProcessMessages;
+          Sleep(10);
+
+          // Start travelling from here
+          if not Solved then
+            TravelMaze(NewPos);
+
+          if TerminateAction then Exit;
+
+          // If still not solved, backtrack
+          if not Solved then
           begin
-            Solved := true;
-            Exit
-          end
-        else if State = csVisited then
-          Exit
-      else
-        begin
-          State := csVisited;     // Been here
-          // Tag := 1;               // Visited
-              // State := csStart;
-              MazePainter.IsDirty := true; // Force repaint with new cell populated
-              Redraw;
-              Application.ProcessMessages;
-              Sleep(10);
-
-              // Start travelling from here
-              if not Solved then
-                TravelMaze(NewPos);
-
-              // If still not solved, backtrack
-              if not Solved then
-              begin
-                State := csEmpty;
-                // Tag := 0;
-                MazePainter.IsDirty := true; // Force repaint with new cell populated
-                Redraw;
-                Application.ProcessMessages;
-                Sleep(10);
-              end;
-        end;
+            State := csEmpty;
+            // Tag := 0;
+            MazePainter.IsDirty := true; // Force repaint with new cell populated
+            Redraw;
+            Application.ProcessMessages;
+            Sleep(10);
+          end;
     end;
-
-  begin
-    // Check all 4 directions for possible moves
-    if not Solved then TryMove(CurPos, dirEast);
-    if not Solved then TryMove(CurPos, dirSouth);
-    if not Solved then TryMove(CurPos, dirWest);
-    if not Solved then TryMove(CurPos, dirNorth);
-  end;
-
+end;
+
+procedure TfrmMain1.TravelMaze(CurPos: TCellPoint);
+begin
+  // Check all 4 directions for possible moves
+  if not Solved then TryMove(CurPos, dirEast);
+  if not Solved then TryMove(CurPos, dirSouth);
+  if not Solved then TryMove(CurPos, dirWest);
+  if not Solved then TryMove(CurPos, dirNorth);
+end;
+
+procedure TfrmMain1.AMazeSolveExecute(Sender: TObject);
 begin
   // If the maze was already solved, dont do it again
@@ -195 +216 @@
   end;
 
-  // Reset the tags, they will be used for backtracking
-  Maze.ResetTags;
-
-  // Not done yet...
-  Solved := false;
-
-  // Travel all cells until the end is found
-  TravelMaze(Maze.GetStartPosition);
-  MazeIsSolved := true;
-
-  // Found, so give a victorious message!
-  MessageDlg('Hurrah! Found the exit!!!!', mtInformation, [mbOK], 0);
-end;
-
-procedure TfrmMain1.acNewMazeExecute(Sender: TObject);
+  try
+    DisableActions := True;
+    TerminateAction := False;
+    UpdateInterface;
+
+    Maze.SetStartCell(0, 0);
+
+    // Reset the tags, they will be used for backtracking
+    Maze.ResetTags;
+    Maze.ResetState;
+
+    // Not done yet...
+    Solved := false;
+
+    // Travel all cells until the end is found
+    TravelMaze(Maze.GetStartPosition);
+    if not TerminateAction then begin
+      MazeIsSolved := true;
+
+      // Found, so give a victorious message!
+      MessageDlg('Hurrah! Found the exit!!!!', mtInformation, [mbOK], 0);
+    end;
+  finally
+    DisableActions := False;
+    UpdateInterface;
+  end;
+end;
+
+procedure TfrmMain1.AMazeNewExecute(Sender: TObject);
 begin
   GenerateNewMaze;
 end;
 
-procedure TfrmMain1.actMetricsPopUpExecute(Sender: TObject);
+procedure TfrmMain1.AMazeShrinkExecute(Sender: TObject);
+begin
+  ResizeMaze(-1,-1);
+end;
+
+procedure TfrmMain1.AMazeEnlargeExecute(Sender: TObject);
+begin
+  ResizeMaze(1,1);
+end;
+
+procedure TfrmMain1.AMetricsPopUpExecute(Sender: TObject);
 begin
   frmScaling.Show;
+end;
+
+procedure TfrmMain1.ATerminateExecute(Sender: TObject);
+begin
+  TerminateAction := True;
+end;
+
+procedure TfrmMain1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  ATerminate.Execute;
 end;
 
@@ -254 +309 @@
 
   // Set lower right hand corner as exit (top left is start by default)
-  Maze.Cell[ Maze.Height-1, Maze.Width-1 ].State := csExit;
+  Maze.Cell[Maze.Height - 1, Maze.Width - 1].State := csExit;
 
   // Paint the maze
@@ -295 +350 @@
 end;
 
+procedure TfrmMain1.UpdateInterface;
+begin
+  AMazeNew.Enabled := not DisableActions;
+  AMazeSolve.Enabled := not DisableActions;
+  AMetricsPopUp.Enabled := not DisableActions;
+  if DisableActions then frmScaling.Hide;
+  AMazeEnlarge.Enabled := not DisableActions;
+  AMazeShrink.Enabled := not DisableActions;
+  ATerminate.Enabled := DisableActions;
+end;
+
 end.
 

trunk/Lazes.lpi

@@ -81 +81 @@
       <local>
         <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
@@ -107 +108 @@
         <IsPartOfProject Value="True"/>
         <HasResources Value="True"/>
-        <UnitName Value="ufrmscaling"/>
+        <UnitName Value="ufrmScaling"/>
       </Unit2>
       <Unit3>

trunk/class/maze.pas

@@ -83 +83 @@
 
     procedure ResetTags(const pValue: integer = 0);
+    procedure ResetState;
     function  GetCell(const pPosition: TCellPoint): TMazeCell;
     function  StartCell: TMazeCell;
@@ -211 +212 @@
 
 procedure TMaze.ResetTags(const pValue: integer);
-var row,col: integer;
+var
+  row,col: integer;
 begin
   for row := 0 to Height-1 do
     for col := 0 to Width-1 do
-      FMaze[row][col].Tag := pValue
+      FMaze[row][col].Tag := pValue;
+end;
+
+procedure TMaze.ResetState;
+var
+  row,col: integer;
+begin
+  for row := 0 to Height - 1 do
+    for col := 0 to Width - 1 do
+      FMaze[row, col].State := csEmpty;
 end;
 

trunk/class/mazepainter.pas

@@ -70 +70 @@
 constructor TMazePainter.Create(const pMaze: TMaze; pCanvas: TCanvas);
 begin
+  Bmp := TBitMap.Create;
+
   // Init the default drawing width and height
   FCellDrawWidth := 15;
@@ -91 +93 @@
 destructor TMazePainter.Destroy;
 begin
-  bmp.Free;
+  FreeAndNil(Bmp);
   inherited Destroy;
 end;
@@ -122 +124 @@
   if isDirty then
   begin
-    //FreeAndNil(bmp);
-    //bmp := TBitMap.Create;
     bmp.SetSize(Width + 1, Height + 1);
     Canvas := bmp.Canvas;

@@ -3 +3 @@
 Lazes.lps
 Lazes.dbg
+Lazes