さめがめを作る(その 4）

いよいよ大詰めです。このページがラストです。ここでは以下のことについて考察します。

• セルが消去された後、残りのセルをつめる（そして再描画する）。
• ゲーム終了の判定、すなわち、消去できるセルが一つもないことをどうやって判断するか。

まず、完成後のプログラムを示します。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Unit2, Contnrs, Types;

const
  MAX_COL_COUNT = 10;
  MAX_ROW_COUNT = 7;
  MAX_CELL_COUNT = MAX_COL_COUNT*MAX_ROW_COUNT;

  DOES_NOT_EXIST_CELL = -1;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
  private
    { Private 宣言 }
    FCells: array[1..MAX_CELL_COUNT] of TCell;
    FCurrentColCount: Integer;
    function GetEastIndex(x: Integer): Integer;
    function GetWestIndex(x: Integer): Integer;
    function GetNorthIndex(x: Integer): Integer;
    function GetSouthIndex(x: Integer): Integer;
    procedure InitializeCell;
    procedure SearchSameValue(CellIndex, FindValue: Integer);
    procedure SearchCell;
    procedure CompactCell;
    procedure DisplayCell;
    procedure DeleteCell;
    procedure CompactRow;
    procedure CompactCol;
    function ExistCell(Idx: Integer): Boolean;
    function  IsGameOver: Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


{ TForm1 }

function TForm1.GetEastIndex(x: Integer): Integer;
begin
  if (x mod MAX_COL_COUNT) = 0 then
    Result := DOES_NOT_EXIST_CELL
  else
    Result := x+1;
end;

function TForm1.GetWestIndex(x: Integer): Integer;
begin
  if (x mod MAX_COL_COUNT) = 1 then
    Result := DOES_NOT_EXIST_CELL
  else
    Result := x-1;
end;

function TForm1.GetNorthIndex(x: Integer): Integer;
begin
  if (x-MAX_COL_COUNT) < 1 then
    Result := DOES_NOT_EXIST_CELL
  else
    Result := x-MAX_COL_COUNT;
end;

function TForm1.GetSouthIndex(x: Integer): Integer;
begin
  if (x+MAX_COL_COUNT) > MAX_CELL_COUNT then
    Result := DOES_NOT_EXIST_CELL
  else
    Result := x+MAX_COL_COUNT;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  Randomize;
  FCurrentColCount := MAX_COL_COUNT;

  for i := Low(FCells) to High(FCells) do
    FCells[i] := TCell.Create(Random(3));

  DisplayCell;
  Button1.Caption := 'ReStart';
end;

procedure TForm1.InitializeCell;
var
  i: Integer;
begin
  for i := Low(FCells) to High(FCells) do
    FCells[i].Num := Random(3);
  FCurrentColCount := MAX_COL_COUNT;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i := Low(FCells) to High(FCells) do
    FCells[i].Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  StringGrid1.Enabled := true;
  InitializeCell;
  DisplayCell;
end;

procedure TForm1.SearchSameValue(CellIndex, FindValue: Integer);

  function IsSameValue(Idx: Integer): Boolean;
  begin
    Result := (Idx <> DOES_NOT_EXIST_CELL) and (FCells[Idx].Num = FindValue);
  end;

  function NotYetKnowingCell(Idx: Integer): Boolean;
  begin
    Result := false;
    if not FCells[Idx].DeleteMe then begin
      Result := true;
      FCells[Idx].DeleteMe := true;
    end;
  end;

var
  Idx: Integer;
begin
  // 隣のセルが自分のセルの値と同じかどうかをしらべる。
  
  Idx := GetWestIndex(CellIndex);
  if IsSameValue(Idx) and NotYetKnowingCell(Idx) then
    SearchSameValue(Idx, FindValue);

  Idx := GetNorthIndex(CellIndex);
  if IsSameValue(Idx) and NotYetKnowingCell(Idx) then
    SearchSameValue(Idx, FindValue);

  Idx := GetEastIndex(CellIndex);
  if IsSameValue(Idx) and NotYetKnowingCell(Idx) then
    SearchSameValue(Idx, FindValue);

  Idx := GetSouthIndex(CellIndex);
  if IsSameValue(Idx) and NotYetKnowingCell(Idx) then
    SearchSameValue(Idx, FindValue);
end;

procedure TForm1.SearchCell;

  function GetCellIndex(Row, Col: Integer): Integer;
  begin
    Result := (Col+1) + MAX_COL_COUNT*Row;
  end;

var
  Idx: Integer;
begin
  Idx := GetCellIndex(StringGrid1.Row, StringGrid1.Col);
  SearchSameValue(Idx, FCells[Idx].Num);
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
begin
  SearchCell;
  DeleteCell;
  CompactCell;
  DisplayCell;

  if IsGameOver then begin
    ShowMessage('Game Over');
    StringGrid1.Enabled := false;
  end;  
end;

procedure TForm1.DisplayCell;
var
  i, j, Idx: Integer;
  s: string;
begin
  for i := 1 to MAX_COL_COUNT do begin
    for j := 1 to MAX_ROW_COUNT do begin
      Idx := i + MAX_COL_COUNT*(j-1);
      if ExistCell(Idx) then
        s := IntToStr(FCells[Idx].Num)
      else
        s := '';
      StringGrid1.Cells[i-1, j-1] := s;
    end;
  end;
end;

procedure TForm1.CompactRow;
var
  i, j, Num: Integer;
  Stack: TStack;
  Idx: Integer;
begin
  Stack := TStack.Create;
  try
    for i := 1 to MAX_COL_COUNT do begin

      // 縦の列に対して、残っているセルを Stack に集める
      for j := 1 to MAX_ROW_COUNT do begin
        Idx := i + MAX_COL_COUNT*(j-1);
        if ExistCell(Idx) then Stack.Push(FCells[Idx]);
      end;

      // セルをつめる
      for j := MAX_ROW_COUNT downto 1 do begin
        if Stack.Count > 0 then
          Num := TCell(Stack.Pop).Num
        else
          Num := DOES_NOT_EXIST_CELL;
        Fcells[i+MAX_COL_COUNT*(j-1)].Num := Num;
      end;
    end;
  finally
    Stack.Free;
  end;
end;

procedure TForm1.DeleteCell;
var
  i: Integer;
begin
  for i := 1 to MAX_CELL_COUNT do
    if FCells[i].DeleteMe then begin
      FCells[i].Num := DOES_NOT_EXIST_CELL;
      FCells[i].DeleteMe := false;
    end;
end;

procedure TForm1.CompactCol;

  procedure DoCompactCol(EmptyList: TIntList);
  var
    i, j, n, LineCount: Integer;
  begin
    LineCount := 1;
    for i := 1 to FCurrentColCount do begin
      if EmptyList.IsInclude(i) then begin
        for j := 1 to MAX_ROW_COUNT do begin
          n := MAX_COL_COUNT*(j-1);
          FCells[LineCount+n].Num := FCells[i+n].Num;
        end;
        Inc(LineCount);
      end;
    end;

    for i := LineCount to FCurrentColCount do
      for j := 1 to MAX_ROW_COUNT do
        FCells[i+MAX_COL_COUNT*(j-1)].Num := DOES_NOT_EXIST_CELL;

    FCurrentColCount := LineCount-1; // 列をつめたので、Col が短くなります。
  end;

  procedure CollectAliveCol(const IntList: TIntList);
  var
    i, j: Integer;
  begin
    for i := 1 to FCurrentColCount do
      for j := 1 to MAX_ROW_COUNT do
        if ExistCell(i+MAX_COL_COUNT*(j-1)) then begin
          IntList.Add(i);
          break;
        end;
  end;

var
  ColList: TIntList;
begin
  ColList := TIntList.Create;
  try
    CollectAliveCol(ColList);
    if FCurrentColCount <> ColList.Count then
      DoCompactCol(ColList); // 実際につめる
  finally
    ColList.Free;
  end;
end;

function TForm1.IsGameOver: Boolean;

  function ExistSameValue: Boolean;
  var
    i: Integer;
  begin
    Result := false;
    for i := 1 to MAX_CELL_COUNT do
      if FCells[i].DeleteMe then begin
        Result := true;
        exit;
      end;
  end;

var
  i, j, Idx: Integer;
begin
  Result := true;
  try
    for i := 1 to FCurrentColCount do
      for j := 1 to MAX_ROW_COUNT do begin
        Idx := i + MAX_COL_COUNT*(j-1);
        if ExistCell(Idx) then begin
          SearchSameValue(Idx, FCells[Idx].Num);
          if ExistSameValue then begin
            Result := false;
            exit;
          end;
        end;
      end;
  finally
    for i := 1 to MAX_CELL_COUNT do
      FCells[i].DeleteMe := false;
  end;
end;

procedure TForm1.CompactCell;
begin
  CompactRow;
  CompactCol;
end;

function TForm1.ExistCell(Idx: Integer): Boolean;
begin
  Result := FCells[Idx].Num <> DOES_NOT_EXIST_CELL;
end;

end.

Unit2

unit Unit2;

interface

type
  TCell = class
  private
    FNum: Integer;
    FDeleteMe: Boolean;
  public
    constructor Create(Num: Integer);
    property Num: Integer read FNum write FNum;
    property DeleteMe: Boolean read FDeleteMe write FDeleteMe;
  end;


  TIntList = class
  private
    FIntAry: array of Integer;
    FCount: Integer;
    FCapacity: Integer;
    procedure Grow;
  public
    constructor Create;
    procedure Add(Num: Integer);
    function IsInclude(Num: Integer): Boolean;
    property Count: Integer read FCount;
  end;

implementation

{ TCell }

constructor TCell.Create(Num: Integer);
begin
  Fnum := Num;
end;

{ TIntList }

procedure TIntList.Add(Num: Integer);
begin
  Inc(FCount);
  if FCount >= FCapacity then Grow;
  FIntAry[FCount-1] := Num;
end;

constructor TIntList.Create;
begin
  FCapacity := 5;
  FCount    := 0;

  SetLength(FIntAry, FCapacity);
end;

procedure TIntList.Grow;
begin
  Inc(FCapacity, FCapacity*2);
  SetLength(FIntAry, FCapacity);
end;

function TIntList.IsInclude(Num: Integer): Boolean;
var
  i: Integer;
begin
  Result := false;
  for i := 0 to FCount-1 do
    if FIntAry[i] = Num then begin
      Result := true;
      break;
    end;
end;

end.

少し長いですが、半分以上が今まで作成したコードです。新しく作成した関数は主に、TStringGrid をクリックした時に呼び出されます。

procedure TForm1.StringGrid1Click(Sender: TObject);
begin
  SearchCell;
  DeleteCell;
  CompactCell;
  DisplayCell;

  if IsGameOver then begin
    ShowMessage('Game Over');
    StringGrid1.Enabled := false;
  end;  
end;

TStringGrid がクリックされた時、次の処理を行います。

• 消去できるセルを検索する(SearchCell)
• 消去できるセルには、「消去された」という印づけを行う(DeleteCell)
• 残されたセルをつめる(CompactCell)
• セルの再表示(DisplayCell)
• もう消去できるセルがないか。ないならゲーム終了(IsGameOver)

SearchCell は前回と全く同様のものです。DeleteCell は SearchCell 関数を呼び出した後に、DeleteMe プロパティが true になっているセルを消去します（実際には, 消去されたセルであるという目印の為に DOES_NOT_EXIST_CELL をセットします）

セル消去後、CompactCell 関数を呼び出して残されたセルをつめるわけですが、このとき、

• 縦につめる
• 横につめる

という 2 つの作業があります。まず最初に縦に積めてから、その後で横につめるというようにように、それぞれ作業を分割して考えます。

CompactCell 関数は、縦方向にセルをつめるために CompactRow 関数を呼び出し、横方向のセルをつめるのに CompactCol 関数を呼び出します。

縦一列のセルをつめる様子を示したのが下図です。

消去されたセルを、その上に乗っているセルが押しつぶすような感じですね。CompactRow 関数の中身を見ていきましょう。

procedure TForm1.CompactRow;
var
  i, j, Num: Integer;
  Stack: TStack;
  Idx: Integer;
begin
  Stack := TStack.Create;
  try
    for i := 1 to MAX_COL_COUNT do begin

      // 縦の列に対して、残っているセルを Stack に集める
      for j := 1 to MAX_ROW_COUNT do begin
        Idx := i + MAX_COL_COUNT*(j-1);
        if ExistCell(Idx) then Stack.Push(FCells[Idx]);
      end;

      // セルをつめる
      for j := MAX_ROW_COUNT downto 1 do begin
        if Stack.Count > 0 then
          Num := TCell(Stack.Pop).Num
        else
          Num := DOES_NOT_EXIST_CELL;
        Fcells[i+MAX_COL_COUNT*(j-1)].Num := Num;
      end;
    end;
  finally
    Stack.Free;
  end;
end;

それぞれの（縦の）列の中にある（消去されていない）セルを、一旦 Stack の中に集めます。集め終わったら、後は順番に Stack から値をポップしながら、セルをつめていきます（※注意：Stack にプッシュしているのは、そのインデックスに対応した TCell のインスタンスの参照です。そして、ここでの「つめる作業」という意味は、実際には Stack からポップされた、TCell のインスタンスが保持している Num プロパティを、セルをつめるべき箇所に位置する TCell のインスタンスの Num プロパティにコピーするということ意味します）。

次に CompactCol で空行になっている列（縦方向のライン）があるかを調べ、存在すれば、その列をつめます。

基本的には、縦につめるときと同様です（上の図を時計回りに、ごろんと転がしたら、縦の場合といっしょになりますよね。まるっきり同じというわけではありませんが）。

procedure TForm1.CompactCol;

  procedure DoCompactCol(EmptyList: TIntList);
  var
    i, j, n, LineCount: Integer;
  begin
    LineCount := 1;
    for i := 1 to FCurrentColCount do begin
      if EmptyList.IsInclude(i) then begin
        for j := 1 to MAX_ROW_COUNT do begin
          n := MAX_COL_COUNT*(j-1);
          FCells[LineCount+n].Num := FCells[i+n].Num;
        end;
        Inc(LineCount);
      end;
    end;

    for i := LineCount to FCurrentColCount do
      for j := 1 to MAX_ROW_COUNT do
        FCells[i+MAX_COL_COUNT*(j-1)].Num := DOES_NOT_EXIST_CELL;

    FCurrentColCount := LineCount-1; // 列をつめたので、Col が短くなります。
  end;

  procedure CollectAliveCol(const IntList: TIntList);
  var
    i, j: Integer;
  begin
    for i := 1 to FCurrentColCount do
      for j := 1 to MAX_ROW_COUNT do
        if ExistCell(i+MAX_COL_COUNT*(j-1)) then begin
          IntList.Add(i);
          break;
        end;
  end;

var
  ColList: TIntList;
begin
  ColList := TIntList.Create;
  try
    CollectAliveCol(ColList);
    if FCurrentColCount <> ColList.Count then
      DoCompactCol(ColList); // 実際につめる
  finally
    ColList.Free;
  end;
end;

FCurrentColLine がセルがつめられた後の ColCount を保持します。TIntList クラスは、空でない縦の列を保持させるのに作成したクラスです。

TIntList クラスは Add メソッドと IsInclude メソッドを持ちます。Add メソッドで整数を追加し、IsInclude メソッドに渡された整数が、それまでにAdd で追加された整数かどうかを Boolean で返します。ここでの、このクラスの役割は、空の列でない列番号を保持させるのに使用しています。セル消去後に、生きているセルを縦に跨いだ空列があるなら、DoCompactCol を呼び出して、実際にセルをつめます。

いよいよ、最後の作業です。最後はゲーム終了の判定を行う IsGameOver 関数です。この関数は、もう消去できるセルがないかどうかの判断を、残っているセルに対して一つずつ愚直にSearchSameValue 関数を呼び出して調べ上げています。もし一つでも消去できる関数が見つかったなら、この関数は false を返します。true が返されるなら、そこでゲームを終了させます。

function TForm1.IsGameOver: Boolean;

  function ExistSameValue: Boolean;
  var
    i: Integer;
  begin
    Result := false;
    for i := 1 to MAX_CELL_COUNT do
      if FCells[i].DeleteMe then begin
        Result := true;
        exit;
      end;
  end;

var
  i, j, Idx: Integer;
begin
  Result := true;
  try
    for i := 1 to FCurrentColCount do
      for j := 1 to MAX_ROW_COUNT do begin
        Idx := i + MAX_COL_COUNT*(j-1);
        if ExistCell(Idx) then begin
          SearchSameValue(Idx, FCells[Idx].Num);
          if ExistSameValue then begin
            Result := false;
            exit;
          end;
        end;
      end;
  finally
    for i := 1 to MAX_CELL_COUNT do
      FCells[i].DeleteMe := false;
  end;
end;

おつかれさまでした。以上でさめがめの完成です。

up next
Last update: 2004/5/1