Forum > Games

[SOLVED] Peg Solitaire example problem

(1/2) > >>

YiannisKam:
Maybe the peg solitaire doesn't work anymore in the newer version of Lazarus. I'm sure it was ok the last time I experimented with this example on a previous version. Or maybe it's my fault, although I followed the code step by step, I don't know, I can't find the reason why it's not working. Maybe someone else can help.
This is the example from the wiki: https://wiki.freepascal.org/Peg_Solitaire_tutorial
And here is my code in case I'm completely wrong

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit ufrmMain; {$mode objfpc}{$H+} interface uses  PegDatastructures, PegSolPainter,  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Menus; type   { TForm1 }   TForm1 = class(TForm)    MainMenu1: TMainMenu;    MenuItem1: TMenuItem;    MenuItem2: TMenuItem;    MenuItem3: TMenuItem;    MenuItem4: TMenuItem;    OpenDialog1: TOpenDialog;    pbPeg: TPaintBox;    procedure FormCreate(Sender: TObject);    procedure MenuItem2Click(Sender: TObject);    procedure MenuItem4Click(Sender: TObject);    procedure pbPegMouseDown(Sender: TObject; Button: TMouseButton;      Shift: TShiftState; X, Y: Integer);    procedure pbPegMouseUp(Sender: TObject; Button: TMouseButton;      Shift: TShiftState; X, Y: Integer);    procedure pbPegPaint(Sender: TObject);  private    pegsol  : TPegSolitaire;    pegpaint: TPegSolPainter;    FromCell: TCellPosition;     procedure StartNewGame;  public   end; var  Form1 : TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.pbPegPaint(Sender: TObject);begin  // And paint the board  pegpaint.Repaint(pbPeg.Width, pbPeg.Height);end; procedure TForm1.FormCreate(Sender: TObject);begin  StartNewGame;end; procedure TForm1.MenuItem2Click(Sender: TObject);begin  Close;end; procedure TForm1.MenuItem4Click(Sender: TObject);begin  // Open the pop up dialog  if OpenDialog1.Execute then  begin    // Start with a new empty board    StartNewGame;     // Dynamically create a stringlist to load the board layout    with TStringList.Create do    begin      // Load the board layout from the textfile      LoadFromFile(OpenDialog1.FileName);       // Initialize the board with the file's contents      pegsol.InitializeBoard(Text);       // Clean up the stringlist      Free    end;     // After loading the new board update the paintbox    pbPeg.Repaint;  end;end; procedure TForm1.pbPegMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);begin  FromCell := pegpaint.CanvasXYtoCell(X,Y);end; procedure TForm1.pbPegMouseUp(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);begin  pegsol.Leap(FromCell, pegpaint.CanvasXYtoCell(X,Y));  pbPeg.Repaint;end; procedure TForm1.StartNewGame;begin  // Clean up the previous game  pegpaint.Free;  pegsol.Free;   // Start with a new game  pegsol := TPegSolitaire.Create(7);  pegpaint := TPegSolPainter.Create(pegsol, pbPeg.Canvas);   // Initialize the cells to the classic game   pegsol.InitializeBoard( '  ooo  ' + LineEnding +                           '  ooo  ' + LineEnding +                           'ooooooo' + LineEnding +                           'ooo.ooo' + LineEnding +                           'ooooooo' + LineEnding +                           '  ooo  ' + LineEnding +                           '  ooo  ' );end; end.  
--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit PegDatastructures; {$mode ObjFPC}{$H+} interface uses  Classes, SysUtils; const  C_MAX = 7;        // max board size 7x7 type  TCellNums = 1..C_MAX;  TCellType = (ctNoAccess, ctEmpty, ctPeg);  TPegCells = array[TCellNums, TCellNums] of TCellType;   TCellPosition = record    Row: TCellNums;    Col: TCellNums;  end;   { TPegSolitaire }   TPegSolitaire = class  private    FSize    : TCellNums;    PegCells: TPegCells;    function  GetCell(const ARow, ACol: TCellNums): TCellType;    procedure SetCell(const ARow, ACol: TCellNums; AValue: TCellType);    function  GetCell(const APosition: TCellPosition): TCellType;  public    constructor Create(const ASize: TCellNums);    procedure   InitializeBoard(const ABoard: Ansistring);    procedure   Leap(const AFromCell, AToCell: TCellPosition);     property Cell[const ARow, ACol: TCellNums]: TCellType read GetCell write SetCell;    property Size: TCellNums read FSize;  end; implementation { TPegSolitaire } function TPegSolitaire.GetCell(const ARow, ACol: TCellNums): TCellType;begin  Result := PegCells[ARow, ACol];end; procedure TPegSolitaire.SetCell(const ARow, ACol: TCellNums; AValue: TCellType);begin  PegCells[ARow, ACol] := AValue;end; function TPegSolitaire.GetCell(const APosition: TCellPosition): TCellType;begin  Result := Cell[APosition.Col, APosition.Row];end; constructor TPegSolitaire.Create(const ASize: TCellNums);var  iRow, iCol: Integer;begin  // Store the size of the board locally  FSize := ASize;   // Initialize all cells to 'not accessible'  for iRow := 1 to Size do    for iCol := 1 to Size do      Cell[iRow, iCol] := ctNoAccess;end; procedure TPegSolitaire.InitializeBoard(const ABoard: Ansistring);var  Lst       : TStringList;  iRow, iCol: Integer;  s         : String;begin  // Create a list with the board text in it. This will split all lines  // into individual lines, because of the LineEnding 'splitter'.  Lst      := TStringList.Create;  Lst.Text := ABoard;   // Process all lines one at a time  for iRow := 0 to Lst.Count - 1 do begin    if iRow < Size then begin // make sure there is no overflow in the rows      // Process a single line of text      s := Lst[iRow];      for iCol := 1 to Length(s) do begin        if iCol <= Size then begin  // check overflow in the cols          case s[iCol] of            ' ': Cell[iRow + 1, iCol] := ctNoAccess;            '.': Cell[iRow + 1, iCol] := ctEmpty;            'o': Cell[iRow + 1, iCol] := ctPeg;          end;        end;      end;    end;  end;  // Clean up the list  FreeAndNil(Lst);end; procedure TPegSolitaire.Leap(const AFromCell, AToCell: TCellPosition);var dx, dy: integer;    JumpedCell: TCellPosition;begin  // Verify that the start cell is occupied and the target cell is empty  // If not, leave the procedure via the EXIT.  if (GetCell(AFromCell) <> ctPeg) or (GetCell(AToCell) <> ctEmpty) then EXIT;   // Calculate the horizontal and vertical distance between the cells  dx := abs(AFromCell.Col - AToCell.Col);  dy := abs(AFromCell.Row - AToCell.Row);   // A valid move has one direction equal to zero and the other equal to 2  if ((dx = 2) and (dy = 0)) or ((dx = 0) and (dy = 2)) then  begin    // Determine the position of the jumped cell; it's in the middle    JumpedCell.Col := (AFromCell.Col + AToCell.Col) div 2;    JumpedCell.Row := (AFromCell.Row + AToCell.Row) div 2;     // Final check: is there a peg in the jumped cell?    if GetCell(JumpedCell) = ctPeg then    begin      // Jump: clear the FromCell, empty the jumped cell and populate the ToCell      Cell[AFromCell.Row, AFromCell.Col]   := ctEmpty;      Cell[JumpedCell.Row, JumpedCell.Col] := ctEmpty;      Cell[AToCell.Row, AToCell.Col]       := ctPeg;    end;  end;end; end.
--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit PegSolPainter; {$mode ObjFPC}{$H+} interface uses  PegDatastructures, Graphics,  Classes, SysUtils; type   { TPegSolPainter }   TPegSolPainter = class  private    PegSol    : TPegSolitaire;    Canvas    : TCanvas;    CellWidth : Integer;    CellHeight: Integer;  public    constructor Create(APegSol: TPegSolitaire; ACanvas: TCanvas);    procedure   Repaint(const ACanvasWidth, ACanvasHeight: Integer);    function    CanvasXYtoCell(const AX, AY: Integer): TCellPosition;  end; implementation { TPegSolPainter } constructor TPegSolPainter.Create(APegSol: TPegSolitaire; ACanvas: TCanvas);begin  PegSol := APegSol;  Canvas := ACanvas;end; procedure TPegSolPainter.Repaint(const ACanvasWidth, ACanvasHeight: Integer);var  iRow, iCol: TCellNums;  CellArea: TRect;begin  // calculate the width/height of each cell in the paintbox  CellWidth  := ACanvasWidth div PegSol.Size;  CellHeight := ACanvasHeight div PegSol.Size;   // draw boxes for all cells  for iRow := 1 to PegSol.Size do    for iCol := 1 to PegSol.Size do begin      // calculate the position of the cell in the paintbox      CellArea.Top    := (iRow - 1) * CellHeight;      CellArea.Left   := (iCol - 1) * CellWidth;      CellArea.Right  := CellArea.Left + CellWidth;      CellArea.Bottom := CellArea.Top + CellHeight;      // and now draw the cell based on the cell's content      case PegSol.Cell[iRow, iCol] of        ctNoAccess: // Draw cells that are not accessible          begin            Canvas.Brush.Color := clGray;            Canvas.Rectangle(CellArea);          end;         ctEmpty: // Draw cells that are currently empty          begin            Canvas.Brush.Color := clBlue;            Canvas.Rectangle(CellArea);          end;         ctPeg:  // Draw cells that are occupied          begin            Canvas.Brush.Color := clBlue;            Canvas.Rectangle(CellArea); // Erase the background first            Canvas.Brush.Color := clGreen;            Canvas.Ellipse(CellArea);          end;      end;    end;end; function TPegSolPainter.CanvasXYtoCell(const AX, AY: Integer): TCellPosition;begin  Result.Col := (AX div CellWidth) + 1;  Result.Row := (AY div CellHeight) + 1;end; end. 

eny:

--- Quote from: YiannisKam on December 26, 2023, 12:36:23 am ---Maybe the peg solitaire doesn't work anymore in the newer version of Lazarus.
--- End quote ---
Do you mean the latest 3.0 version?
What problem(s) do you encounter?

I did a rough comparison of your sourcecode with the original and at a glance did not see major discrepancies.

I also tried to recompile with the 3.0 version.
It seems to compile and run fine.

But there is a backwards compatibility problem with the latest version: when running the program from the IDE, the IDE no longer switches to the executable folder.
It runs the program from the project root, which obviously is not correct.
It should however run fine, just not with the fancy images.

YiannisKam:
The problem is that I can only leap once and that's it, no progress after that.

eny:
Can you post a (compilable) version of your project? (no binaries...)

YiannisKam:
I don't have the previous version now, if that is what you are asking. But it was running with no problems.

Navigation

[0] Message Index

[#] Next page

Go to full version