Sample FlipFlop game

{ Author Iliya Popov date create 09.12.2020 }
unit GameFlipFlop;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls;

type
  TFlipFlopFrm = class(TForm)
    DgMatrix: TDrawGrid;
    sbtTesting: TButton;
    sbtCreateList: TButton;
    ListPositions: TListBox;
    SaveMovementDlg: TSaveDialog;
    SaveBtn: TButton;
    sbtPerehod: TButton;
    procedure DgMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure DgMatrixMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure sbtTestingClick(Sender: TObject);
    procedure sbtCreateListClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure sbtPerehodClick(Sender: TObject);

  private
    procedure loadGridSettings;
    procedure ShowPole(w: word);
    procedure Solution0(w0, w1: word; nStep: Integer);
    procedure Solution(w0, w1: word; nStep: Integer);
  public
    { Public declarations }
  end;

var
  FlipFlopFrm: TFlipFlopFrm;

const

  matrixCol = 4;
  matrixRol = 4;

  AllCells = matrixCol * matrixRol - 1;


type
  TStatus = Record
    Range: Integer;

    Hod: TPoint;
    Pred: word;
  end;

var
  // масив на полето(Матрица)
  masPole: array [0 .. matrixCol - 1, 0 .. matrixRol - 1] of byte;
  Status: array [word] of TStatus;

  AllPos: cardinal;

implementation

{$R *.dfm}
{ TFlipFlopFrm }

procedure TFlipFlopFrm.DgMatrixDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i, j, n: Integer;
begin

  case masPole[ACol, ARow] of
    0:
      self.DgMatrix.Canvas.Brush.Color := clWhite;
  else
    self.DgMatrix.Canvas.Brush.Color := clRed;
  end;
  self.DgMatrix.Canvas.FillRect(Rect);
  // нечетен ред
  n := 0;
  for j := 0 to matrixRol - 1 do
    for i := 0 to matrixCol - 1 do
      if (i = ACol) or (j = ARow) then
      begin
        n := n + masPole[i, j];
      end;
  if odd(n) then
    with Rect, self.DgMatrix.Canvas do
      textrect(Rect, left + (right - left - textwidth('+')) div 2,
        top + (bottom - top - textheight('+')) div 2, '+');
end;

procedure TFlipFlopFrm.DgMatrixMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Integer;
  i, j: Integer;
begin

  self.DgMatrix.MouseToCell(X, Y, ACol, ARow);
  if ssRight in Shift then
    if masPole[ACol, ARow] = 1 then
      masPole[ACol, ARow] := 0
    else
      masPole[ACol, ARow] := 1
  else if ssLeft in Shift then

  begin
    for j := 0 to matrixRol - 1 do
      for i := 0 to matrixCol - 1 do
        if (i = ACol) or (j = ARow) then

          masPole[i, j] := abs(masPole[i, j] - 1)
  end;
  self.DgMatrix.Invalidate;
end;

procedure TFlipFlopFrm.FormCreate(Sender: TObject);
var
  i, j: Integer;
begin
  for j := 0 to matrixRol - 1 do
    for i := 0 to matrixCol - 1 do

      masPole[i, j] := 0;
end;

procedure TFlipFlopFrm.FormPaint(Sender: TObject);
begin
  loadGridSettings;
end;

procedure TFlipFlopFrm.loadGridSettings;
begin
  //
  self.DgMatrix.ColCount := matrixCol;
  self.DgMatrix.RowCount := matrixRol;
  self.DgMatrix.DefaultDrawing := False;
  self.DgMatrix.FixedCols := 0;
  self.DgMatrix.FixedRows := 0;
end;

procedure TFlipFlopFrm.SaveBtnClick(Sender: TObject);
var
  F: textfile;
  fn, s: string;
  i, j: Integer;
  w: word;
begin

  SaveMovementDlg.DefaultExt := 'txt';

  SaveMovementDlg.Filter := 'Данни (*.txt)|*.TXT';

  SaveMovementDlg.FilterIndex := 1;
  s := extractfilepath(application.exename) + 'res\';

  SaveMovementDlg.InitialDir := s;
  SaveMovementDlg.Title := 'Записване на данните върху диска!';
  SaveMovementDlg.filename := 'temp.txt';
  if not SaveMovementDlg.Execute then
    exit;
  fn := SaveMovementDlg.filename;
  assignfile(F, fn);
  rewrite(F);

  for i := 0 to 65535 do
  begin
    s := '';
    w := i;
    for j := 0 to 15 do
    begin

      if j mod 4 = 0 then
        s := s + ' ';
      if w and $8000 <> 0 then
        s := s + '1'
      else
        s := s + '0';
      w := w shl 1;
    end;
    s := inttostr(i) + '/' + s + '. Range= ' + inttostr(Status[i].Range) +
      ' Ход= ' + inttostr(Status[i].Hod.X) + ' ' + inttostr(Status[i].Hod.Y) +
      ' Pred= ' + inttostr(Status[i].Pred);
    if Status[i].Range <> -1 then
      writeln(F, s);
  end;

  closefile(F);

  messagebeep(0)

end;


procedure TFlipFlopFrm.ShowPole(w: word);

var
  i, j: Integer;
begin

  for j := 0 to matrixRol - 1 do
    for i := 0 to matrixCol - 1 do
    begin
      if w and $8000 <> 0 then // клетка на фигурата
        masPole[i, j] := 1
      else
        masPole[i, j] := 0; // фон на клетката
      w := w shl 1;
    end;

  self.DgMatrix.Invalidate;
end;


function XorBits(X, Y: byte; w: word): word;
var
  i, j: Integer;
begin
  Result := w;
  for j := 0 to matrixRol - 1 do
    for i := 0 to matrixCol - 1 do
      if (i = X) or (j = Y) then
      begin
        masPole[i, j] := abs(masPole[i, j] - 1);
        Result := Result xor (1 shl (AllCells - matrixCol * j - i));
      end;
end;

procedure TFlipFlopFrm.sbtCreateListClick(Sender: TObject);
var
  Hod: Integer;
  flg: boolean;
  i, j, k, w: word;
begin
  Hod := 0;
  for i := 0 to 65535 do
    Status[i].Range := -1;
  Status[0].Range := 0;
  AllPos := 1;
  repeat
    flg := False;
    inc(Hod);
    self.ListPositions.Items.add(inttostr(Hod));
    for k := 0 to 65535 do
      if Status[k].Range = Hod - 1 then
      begin
        for j := 0 to matrixRol - 1 do
          for i := 0 to matrixCol - 1 do
          begin
            w := XorBits(i, j, k);
            if Status[w].Range = -1 then
            begin
              flg := True;
              Status[w].Range := Hod;
              Status[w].Hod.X := i;
              Status[w].Hod.Y := j;
              Status[w].Pred := k;
              inc(AllPos);
            end;
          end;
      end;
  until flg = False;
  Showmessage('hod= ' + inttostr(Hod));
  Showmessage('AllPos= ' + inttostr(AllPos));
end;

procedure TFlipFlopFrm.sbtPerehodClick(Sender: TObject);
begin
  Solution(63897, 112, 5);
end;

procedure TFlipFlopFrm.Solution0(w0, w1: word; nStep: Integer);
label
  nextHod, nextCell;
var
  Hod: Integer;
  nCells: Integer;
  nCell: array [0 .. 99] of Integer;
  Pos: array [0 .. 99] of word;
  Move: array [0 .. 99] of Integer;
  X, Y: byte;
  w: word;
  variant: Integer;

  procedure SavePos;
  var
    w: word;
    i, j: Integer;
    X, Y: Integer;
    s: string;
  begin
    for i := 1 to Hod do
    begin
      s := '';
      w := Pos[i];
      for j := 0 to 15 do
      begin
        if w and $8000 <> 0 then
          s := s + '1'
        else
          s := s + '0';
        w := w shl 1;
      end;
      self.ListPositions.Items.add('Hod= ' + inttostr(i) + ' Pos= ' + s);
      X := Move[i] mod 4;
      Y := Move[i] div 4;
      self.ListPositions.Items.add('Move= ' + inttostr(X) + ' ' + inttostr(Y));
    end;
  end;

begin
  variant := 0;
  nCells := 16;
  Hod := 0;
  Pos[0] := w0;
  Move[0] := -1;
nextHod:
  inc(Hod);
  nCell[Hod] := -1;
  Pos[Hod] := Pos[Hod - 1];
nextCell:
  inc(nCell[Hod]);
  if nCell[Hod] > nCells then
  begin
    dec(Hod);
    if Hod < 0 then
    begin
      Showmessage('OK');
      exit;
    end;
    Goto nextCell
  end;
  if nCell[Hod] <> Move[Hod - 1] then
  begin
    X := nCell[Hod] mod 4;
    Y := nCell[Hod] div 4;
    w := XorBits(X, Y, Pos[Hod - 1]);
    Pos[Hod] := w;
    Move[Hod] := nCell[Hod];
    if w = w1 then
    begin // намерен!
      inc(variant);
      self.ListPositions.Items.add('намерени варианти= ' + inttostr(variant));
      self.ListPositions.Items.add('Hod= ' + inttostr(Hod) + ' x= ' +
        inttostr(X) + ' y= ' + inttostr(Y) + ' Pos[Hod]= ' +
        inttostr(Pos[Hod]));
      SavePos;
    end;
  end;

  if Hod < nStep then
    goto nextHod;
  goto nextCell
end;

procedure TFlipFlopFrm.Solution(w0, w1: word; nStep: Integer);
label
  nextHod, nextCell;
var
  Hod: Integer;
  nCells: Integer;
  nCell: array [0 .. 99] of Integer;
  Pos: array [0 .. 99] of word;
  Move: array [0 .. 99] of Integer;
  X, Y: byte;
  w: word;

  procedure SavePos;
  var
    w: word;
    i, j: Integer;
    X, Y: Integer;
    s: string;
  begin
    for i := 1 to Hod do
    begin
      s := '';
      w := Pos[i];
      for j := 0 to 15 do
      begin
        if w and $8000 <> 0 then
          s := s + '1'
        else
          s := s + '0';
        w := w shl 1;
      end;
      self.ListPositions.Items.add('Hod= ' + inttostr(i) + ' Pos= ' + s);
      X := Move[i] mod 4;
      Y := Move[i] div 4;
      self.ListPositions.Items.add('Move= ' + inttostr(X) + ' ' + inttostr(Y));
      self.ListPositions.Items.add('');
    end;
  end;

begin
  nCells := 16;
  Hod := 0;
  Pos[0] := w0;
  nCell[0] := -1;
  Move[0] := -1;
nextHod:
  inc(Hod);
  nCell[Hod] := nCell[Hod - 1];
  Pos[Hod] := Pos[Hod - 1];
nextCell:
  inc(nCell[Hod]);
  if nCell[Hod] > nCells then
  begin
    dec(Hod);
    if Hod < 0 then
    begin
      Showmessage('OK');
      exit;
    end;
    Goto nextCell
  end;
  X := nCell[Hod] mod 4;
  Y := nCell[Hod] div 4;
  w := XorBits(X, Y, Pos[Hod - 1]);
  Pos[Hod] := w;
  Move[Hod] := nCell[Hod];
  if w = w1 then
  begin
    SavePos;
    ShowPole(w);
    exit;
  end;
  if Hod < nStep then
    goto nextHod;
  goto nextCell
end;

procedure TFlipFlopFrm.sbtTestingClick(Sender: TObject);
var
  i, j: Integer;
  w: word;
begin
  for j := 0 to matrixRol - 1 do
    for i := 0 to matrixCol - 1 do
    begin
      w := XorBits(i, j, 0);
      ShowPole(w);
      Showmessage(inttostr(w));
    end;
end;

end.