在Lazarus下的Free Pascal编程教程——打造有智慧的人机交互界面

0.前言

我想通过编写一个完整的游戏程序方式引导读者体验程序设计的全过程。我将采用多种方式编写具有相同效果的应用程序，并通过不同方式形成的代码和实现方法的对比来理解程序开发更深层的知识。

了解我编写教程的思路，请参阅体现我最初想法的那篇文章中的“1.编程计划”和“2.已经编写完成的文章（目录）”：

学习编程从游戏开始——编程计划（目录） - lexyao - 博客园

我已经在下面这篇文章中介绍了使用LCL和FCL组件构建一个项目（pTetris）的过程，后续的使用Lazarus的文章中使用的例子都是以向这个项目添加新功能的方式表述的：

在Lazarus下的Free Pascal编程教程——用向导创建一个使用LCL和FCL组件的项目（pTetris） - lexyao - 博客园

这是一篇专题文章，我们将通过一个编写pTetris项目方块移动相关过程的核心部分的代码编写体验打造有智慧的人机交互界面的方法。

俄罗斯方块游戏中核心活动是移动方块，在得到移动方块之要对方块进行一系列的操作，在这篇文章中要介绍的就是操作移动方块的过程。

在这篇文章里，我主要讲述以下几个方面的内容：

pTetris人机交互程序设计概述
打造有智慧的人机交互界面移动盒子的代码设计构想
移动盒子的代码设计实现
在移动盒子的代码中添加判断
结束语

1.pTetris人机交互程序设计概述

在下面网址链接的文章中我们已经将pTetris与方块移动相关的过程进行了模块划分和模块功能规划，并为每一个模块确定了类的名字。

在Lazarus下的Free Pascal编程教程——按数据流程规划程序结构 - lexyao - 博客园

在pTetrisUnit单元中添加以下定义类的代码：

  //为每一个模块定义一个类
  cxBox=class;            //单个方块
  cxBoxs=class;           //一组方块，也就是将方块打包的盒子
  cxBoxQueue=class;       //方块队列，也就是在提示区显示的下一个进入移动去的盒子
  cxBoxMove=class;        //正在移动的盒子
  cxBoxHeap=class;        //堆积的方块
  cxBoxDestroy=class;     //销毁方块

我们下一步的任务就是为这些类编写代码。

一个应用程序归根结底是由人来使用的，人就是应用程序的用户。用户发出指令，应用程序按着用户的指令启动对应的程序段，完成这段程序所能做的活动。用户在使用应用程序的时候发出指令的场所被称为人机交互界面，意思是说这是人与应用程序交流的接触面。人可以发出指令，而应用程序能干什么，怎么做，这就不是用户能决定的了。应用程序时按着程序员编写的程序执行的。在有些简单的游戏程序，当用户发出往前走的指令的时候，游戏中的小人“往前走”，撞了南墙也不回头，还在向前做出迈步的动作，直到用户改变指令为止。在有些大型游戏中，用户用鼠标点击一个目的地，游戏中的小人会寻找合适的路线到达目的地，路途中发生危险还懂得规避，这就是应用程序的智慧，而这些智慧其实是在程序员编写的代码中通过多重判断实现的。我们也希望我们编写的应用程序具有智慧。
下面我们就给pTetris项目编写具有智慧的人机交互界面的代码。

2.打造有智慧的人机交互界面移动盒子的代码设计构想

游戏的核心是移动盛满了方块的盒子，所以核心模块是cxBoxMove。
取得盒子后要移动盒子，就要给用户提供下达操作盒子的指令的界面，这个工作在界面布局中已经完成了，主要是六个按钮，除此之外还有让盒子自动下落的计时器。

取得盒子后计时器推动盒子下落，在落地之前用户可以操作盒子移动或旋转。按着这个需求，我们考虑当前要编写的代码：

开始游戏：没有游戏的时候开始游戏，正在游戏中可以重新开始游戏（重新开始不计名次？）
旋转：以5x5网格的中心为基点旋转，只能按一个方向旋转，每次旋转90°
- 判断周围空间是否能够满足旋转的需要，会不会受到阻挡
左移/右移：向左/向右移动一格
- 判断是否到边或者有方块阻挡
下落：向下移动一格
- 判断是否到底或者有方块阻挡
跌落：直接向下移动到底部或者有方块阻挡的位置
- 判断底部或者阻挡下落的方块的位置
- 允许击穿时判断是否存在可以容纳方块的空间（底部优先）
暂停/恢复：暂停移动，恢复后可继续移动
- 操作应该判断是否处于暂停状态
其他事项：
- 暂停时计时器不动作
  - 如果暂停计入游戏时间，则需要记录暂停时间
- 没有方块时
  - 计时器获得一个新的方块盒子
  - 其他操作判断是否有可以操作的盒子，没有盒子就不动作
    - 没有盒子时的操作是否计入操作次数

3.移动盒子的代码设计实现

现在添加操作盒子移动的代码，不过在这里只添加基本的操作，没有智慧，该怎么运动让用户去决定。

3.1 计时器让盒子下落

在前面的文章中已经编写了计时器让盒子在移动区内移动的代码，不过那是斜着移动，遇到边反弹。现在要换一个版本的移动方式：垂直向下移动，遇到底部停止。
参照原来DoTimerV3的代码，编写成为新的函数DoTimerV4，并在Timer1Timer中用DoTimerV4代替DoTimerV3。DoTimerV4的代码如下：

procedure TfrmMain.DoTimerV4;
var
  mr: integer;
  cr: TPoint;
  bxs: cxBoxs;
begin
  bxs := boxMove.CurrentBoxs;
  if bxs = nil then Exit;

  cr := bxs.Base;
  mr := grdBox.Rows;

  if cr.Y <mr-1 then
  begin
    //还没有到达底部，继续向下移动
    grdBox.BoxsTo(bxs, cr.X, cr.Y + 1);
  end
  else
  Begin
    //已经到达底部，销毁盒子，放出方块
    bxs.Free;
  end;
end;

编译运行pTetris项目，会看到移动区顶部出现一个盒子，不断下落，到达底部后方块在移动区底部堆积，然后提示区的第一个盒子在移动区上方出现并向下移动，提示区的盒子上移，最下边出现一个新的盒子补位。
存在的问题是移动区下部堆积的方块都在底部，下落的方块没有受到堆积的盒子的阻挡。

3.2 暂停/恢复移动

暂停按钮的代码在以前的测试中已经编写了，现在直接使用就行，暂时不做改动。

3.3 用户让盒子下落

用户让盒子下落跟计时器让盒子下落是一样的道理，区别只是动作的发起者不同，还有一个约定的差别：

计时器一定会对盒子进行操作，没有盒子就取来一个新的盒子，盒子到底就释放盒子
用户操作仅对正在移动的盒子起作用，没有盒子就什么也不做

在窗体编辑器中双击按钮“下落”，在代码编辑区为btnDownClick函数添加以下代码：

procedure TfrmMain.btnDownClick(Sender: TObject);
var
  mr: integer;
  cr: TPoint;
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  cr := bxs.Base;
  mr := grdBox.Rows;

  if cr.Y <mr-1 then
  begin
    //还没有到达底部，继续向下移动
    grdBox.BoxsTo(bxs, cr.X, cr.Y + 1);
  end;
end;

编译运行pTetris项目，会看到移动区顶部出现的盒子在计时器的推动下向下移动。下面测试“下落”按钮的效果：

每点击一次“下落”按钮，盒子向下移动一格，按钮移动和计时器移动同时存在，互不干扰
点击“暂停”按钮，盒子停止移动，点击“下落”按钮，盒子还会向下移动一格，这说明“下落”按钮没有考虑暂停状态。

3.4 用户让盒子跌落

用户让盒子跌落跟下落是一样的道理，区别只是移动的距离不同：

下落每操作一次向下移动一格
跌落只需要一次操作，盒子直接移动到底部

“跌落”的事件处理函数btnDownedClick已经在以前的测试中添加了，现在要废除原有的代码，重新编写新的代码。以下是btnDownedClick改写后的代码：

procedure TfrmMain.btnDownedClick(Sender: TObject);
var
  mr: integer;
  cr: TPoint;
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  cr := bxs.Base;
  mr := grdBox.Rows;

  //直接到达底部
  grdBox.BoxsTo(bxs, cr.X, mr - 1);
end;

编译运行pTetris项目，会看到移动区顶部出现的盒子在计时器的推动下向下移动。下面测试“跌落”按钮的效果：

点击“跌落”按钮，盒子向下移动到移动区底部
存在一部分方块到了边界之外的情况，这说明停止移动的条件设置考虑的还不够周全

3.5 用户让盒子左右移动

用户让盒子向左/向右移动使用的按钮是“左移”/“右移”。向左和向右的道理跟下落是一样的，只是方向有差别，考虑的边界有差别罢了。
参照下落的代码，添加“左移”/“右移”的事件处理函数如下：

procedure TfrmMain.btnRightClick(Sender: TObject);
var
  mc: integer;
  cr: TPoint;
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  cr := bxs.Base;
  mc := grdBox.Cols;

  if cr.X < mc - 1 then
  begin
    //还没有到达底部，继续向右移动
    grdBox.BoxsTo(bxs, cr.X + 1, cr.Y);
  end;
end;

procedure TfrmMain.btnLeftClick(Sender: TObject);
var
  cr: TPoint;
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  cr := bxs.Base;

  if cr.X > 0 then
  begin
    //还没有到达底部，继续向左移动
    grdBox.BoxsTo(bxs, cr.X - 1, cr.Y);
  end;
end;

编译运行pTetris项目，会看到移动区顶部出现的盒子在计时器的推动下向下移动。下面测试“左移”/“右移”按钮的效果：

每点击一次“左移”/“右移”按钮，盒子向左和向右移动一格，按钮移动和计时器移动同时存在，互不干扰
快速连续点击按钮，在两次下落的动作间隔时间内可以多次左右移动
移动到边界会有一部分方块到了边界之外，这说明停止移动的条件设置考虑的还不够周全
点击“暂停”按钮，盒子停止移动，点击“左移”/“右移”按钮，盒子还会向左/向右移动一格，这说明“左移”/“右移”按钮没有考虑暂停状态。

3.6 用户让盒子旋转

让盒子旋转跟让盒子移动的差别有些大。我们设计了一个5x5的方格网作为盒子在放置方块，旋转是以中心点转动90°，除了中心点的方块，其他的方块在盒子中的位置都要移动。左右移动和下落的动作中，方块在盒子内的坐标是不动的，移动的是盒子。
转动的代码设计关键是坐标转换。我们编写的代码要做的工作包括以下几个内容：

设置一个缓冲区保存盒子中的方块指针及其在盒子中的坐标
以坐标变换的方式获得旋转90°后方块在盒子中的新坐标
按新的坐标将方块放入盒子中

我们把盒子旋转的代码放置到盒子对象里，也就是作为cxBoxs的成员，添加cxBoxs.Rotate、cxBoxs.RotateBack函数代码如下：

{盒子以基点为中心旋转：Rotate逆时针旋转，RotateBack顺时针旋转}
procedure cxBoxs.Rotate;
var
  oBox: array of cxBox;
  pBox: array of TPoint;
  xyc, xyn: TPoint;
  bxc: cxBox;
  x, y, cnt, i: integer;
begin
  SetLength(oBox, BoxCount);
  SetLength(pBox, BoxCount);

  //将方块移入缓冲区
  cnt := 0;
  for x := LowX to HighX do
  begin
    for y := LowY to HighY do
    begin
      bxc := Boxs[x, y];
      if bxc <> nil then
      begin
        oBox[cnt] := bxc;
        xyc.X := x;
        xyc.Y := y;
        pBox[cnt] := xyc;
        Inc(cnt);
        Boxs[x, y] := nil;
      end;
    end;
  end;
  //重新计算方块的坐标后放入盒子中
  for i := 0 to cnt - 1 do
  begin
    bxc := oBox[i];
    xyc := pBox[i];
    xyn.X := xyc.Y;
    xyn.Y := -xyc.X;
    Boxs[xyn.X, xyn.Y] := bxc;
  end;
end;

procedure cxBoxs.RotateBack;
var
  oBox: array of cxBox;
  pBox: array of TPoint;
  xyc, xyn: TPoint;
  bxc: cxBox;
  x, y, cnt, i: integer;
begin
  SetLength(oBox, BoxCount);
  SetLength(pBox, BoxCount);

  //将方块移入缓冲区
  cnt := 0;
  for x := LowX to HighX do
  begin
    for y := LowY to HighY do
    begin
      bxc := Boxs[x, y];
      if bxc <> nil then
      begin
        oBox[cnt] := bxc;
        xyc.X := x;
        xyc.Y := y;
        pBox[cnt] := xyc;
        Inc(cnt);
        Boxs[x, y] := nil;
      end;
    end;
  end;
  //重新计算方块的坐标后放入盒子中
  for i := 0 to cnt - 1 do
  begin
    bxc := oBox[i];
    xyc := pBox[i];
    xyn.X := -xyc.Y;
    xyn.Y := xyc.X;
    Boxs[xyn.X, xyn.Y] := bxc;
  end;
end;

添加“旋转”按钮的事件处理函数如下：

procedure TfrmMain.btnRotateClick(Sender: TObject);
var
  cr: TPoint;
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  cr := bxs.Base;

  bxs.Rotate;
  grdBox.BoxsTo(bxs, cr.X, cr.Y);
end;

编译运行pTetris项目，会看到移动区顶部出现的盒子在计时器的推动下向下移动。下面测试“旋转”按钮的效果：

每点击一次“旋转”按钮，盒子中的方块组合逆时针旋转90°，按钮移动和计时器移动同时存在，互不干扰
快速连续点击按钮，在两次下落的动作间隔时间内可以多次旋转
移动到边界旋转会有一部分方块到了边界之外，这说明停止旋转的条件设置考虑的还不够周全
点击“暂停”按钮，盒子停止移动，点击“旋转”按钮，盒子还会旋转，这说明“旋转”按钮没有考虑暂停状态。

3.7 用户让游戏开始/重新开始

自从我们给pTetris项目添加了计时器之后，每次运行pTetris项目时计时器一直是在工作状态的，开始是那个红色小方块在跳动，现在是一个盒子在下落。对于一个游戏来说这是不正常的。一个游戏应该是在运行程序之后，用户发出开始游戏的指令后游戏才开始有动作。现在我们就让pTetris项目的计时器回到正常状态。
游戏的开始意味着一切都是新的，否则跟暂停/恢复就没有差别了。在pTetris项目中，开始游戏至少应该做以下几项工作：

清空方块提示区中的方块
清空方块移动区中的方块
按着难度设置的要求重置移动的速度和移动区域内残留的方块
计时计分从头开始
计时器启动

由于现在后续的代码还没有编写，现在我们先把能做的工作做了，其他的以后在补充进来。
首先，在属性列表内把计时器的Enable设置为false。

然后添加“开始游戏”按钮的事件处理函数btnStartClick代码如下：

procedure TfrmMain.btnStartClick(Sender: TObject);  
var
  i: Integer;
begin
  Randomize;
  //暂停计时器的操作
  Timer1.Enabled := False;
  //销毁提示列表中的盒子
  for i := boxQueue.BoxCount-1 downto 0 do
  begin
    boxQueue.Boxs(i).Free;
  end;
  //销毁提示区的方块   
  for i := grdNext.ControlCount-1 downto 0 do
  begin
    grdNext.Controls[i].Free;
  end;
  //销毁当前移动的盒子
  if boxMove.BoxCount>0 then
  begin
    boxMove.Boxs(0).Free;
  end;
  //销毁移动区的方块 
  for i := grdBox.ControlCount-1 downto 0 do
  begin
    grdBox.Controls[i].Free;
  end;
  //今后需要添加的操作
  { #todo : 销毁移动区的行容器 }
  { #todo : 设置移动区的初始方块 }
  { #todo : 计时计分归零 }
  { #todo : 计时器恢复默认的开始速度 }
  //恢复计时器的操作
  Timer1.Enabled := True;  
end;

编译运行pTetris项目，会看到移动区顶部不再出现向下移动的盒子。下面测试“开始游戏”按钮的效果：

运行程序后初次点击“开始游戏”按钮，提示区出现提示的盒子队列，移动区出现向下移动的盒子，应用程序接到指令后开始游戏了
游戏进行中点击“开始游戏”按钮，提示区队列被刷新，移动区正在移动的和下部堆积的方块消失，一个新的盒子开始向下移动。

做到这些，btnStartClick函数现在能做的事情都做了，应该可以了吧？可是我们在分析一下这些代码，就会发现一些问题：

boxQueue和boxMove销毁盒子使用的都是Boxs(i).Free，而他们都是继承了cxBoxBase类，那么我们为什么不合并在一起呢？再说，盒子是他们内部的事情，对盒子的处理应该封装在内部解决而不是在外部，所以，可以添加一个cxBoxBase.BoxsClear函数销毁盒子，boxQueue和boxMove调用基类的BoxsClear就可以了
grdNext和grdBox销毁方块的代码都是Controls[i].Free，而他们都是cxGrid类，那么我们为什么不合并在一起呢？添加一个cxGrid.BoxClear就行了。
- 提示：在这里使用Controls[i].Free销毁的是以cxGrid为Parent的TControl而不是以cxGrid为Owner的组件

cxBoxBase.BoxsClear的代码如下：

procedure cxBoxBase.BoxsClear;
var
  i: integer;
begin
  for i := BoxCount - 1 downto 0 do
    Boxs(i).Free;
end;

cxGrid.BoxClear的代码如下：

procedure cxGrid.BoxClear;
var
  i: integer;
begin
  for i := ControlCount - 1 downto 0 do
  begin
    Controls[i].Free;
  end;
end;

经过以上修改，btnStartClick修改后的代码如下：

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  Randomize;
  //暂停计时器的操作
  Timer1.Enabled := False;
  //销毁提示列表中的盒子
  boxQueue.BoxsClear;
  //销毁提示区的方块
  grdNext.BoxClear;
  //销毁当前移动的盒子
  boxMove.BoxsClear;
  //销毁移动区的方块
  grdBox.BoxClear;
  //今后需要添加的操作
  { #todo : 销毁移动区的行容器 }
  { #todo : 设置移动区的初始方块 }
  { #todo : 计时计分归零 }
  { #todo : 计时器恢复默认的开始速度 }
  //恢复计时器的操作
  Timer1.Enabled := True;
end;

编译运行pTetris项目，会看到修改前后的运行效果是一样的。而从代码的编写来看，修改后的代码更符合面向对象的程序设计中封装的要求，看上去也更加简洁。

4.在移动盒子的代码中添加判断

在上面编写的代码中都有一个共同的缺陷：方块移动到移动区边缘时会有方块移动到区域边线之外，这说明对于边界阻挡的计算考虑不周。现在我们添加更多的判断来修正这个问题。

4.1 给盒子添加确定范围的成员函数

在前面的代码中移动盒子时是以盒子的基点计算的，没有考虑盒子的尺寸，这也是有一部分方块溢出边界的原因。现在我们给cxBoxs类添加几个成员，用来确定盒子中方块占据的范围，有了这些成员，盒子就有了四至的尺寸了，再计算移动位置时就可以考虑得更细致一些。
BoxInCol、BoxInRow检查指定列/行内是否有方块，BoxLeft、BoxRight、BoxTop、BoxBottom指示四个方向上与基点最远的方块的坐标值，cxBoxs添加的代码如下：

function cxBoxs.BoxLeft: Integer;
begin
  if BoxInCol(LowX) then
    Result := LowX
  else if BoxInCol(LowX + 1) then
    Result := LowX + 1
  else
    Result := 0;
end;

function cxBoxs.BoxRight: Integer;
begin
  if BoxInCol(HighX) then
    Result := HighX
  else if BoxInCol(HighX - 1) then
    Result := HighX - 1
  else
    Result := 0;
end;

function cxBoxs.BoxTop: Integer;
begin
  if BoxInRow(LowY) then
    Result := LowY
  else if BoxInRow(LowY + 1) then
    Result := LowY + 1
  else
    Result := 0;
end;

function cxBoxs.BoxBottom: Integer;
begin
  if BoxInRow(HighY) then
    Result := HighY
  else if BoxInRow(HighY - 1) then
    Result := HighY - 1
  else
    Result := 0;
end;

function cxBoxs.BoxInCol(ACol: integer): boolean;
var
  y: integer;
begin
  for y := LowY to HighY do
  begin
    Result := Boxs[ACol, y] <> nil;
    if Result then Break;
  end;
end;

function cxBoxs.BoxInRow(ARow: Integer): Boolean;
var
  x: integer;
begin
  for x := LowX to HighX do
  begin
    Result := Boxs[x,ARow ] <> nil;
    if Result then Break;
  end;
end;

使用了cxBoxs的四至函数后TfrmMain各项操作的代码修改如下：

procedure TfrmMain.DoTimerV4;
......
begin
  ......
  my := mr - 1 - bxs.BoxBottom;
  if cr.Y < my then
  ......
end;  

procedure TfrmMain.btnDownClick(Sender: TObject);
......
begin
  ......
  my := mr - 1 - bxs.BoxBottom;
  if cr.Y < my then
  ......
end;  

procedure TfrmMain.btnDownedClick(Sender: TObject);
......
begin
  ......
  my := mr - 1 - bxs.BoxBottom;
  //直接到达底部
  grdBox.BoxsTo(bxs, cr.X, my);
end; 

procedure TfrmMain.btnLeftClick(Sender: TObject);
......
begin
  ......
  mx := -bxs.BoxLeft;
  if cr.X > mx then
  ......
end; 

procedure TfrmMain.btnRightClick(Sender: TObject);
......
begin
  ......
  mx := mc - 1 - bxs.BoxRight;
  if cr.X < mx then
  ......
end;

经过以上修改后，编译运行pTetris，无论怎么移动盒子，都不会有方块溢出边界了。
当然，这些修改只考虑了移动区的边界，没有考虑已经堆积的方块的阻碍。之所以没有考虑，是因为到目前位置堆积的方块属于无序状态，就像是交货时没有收货人，把货物随便丢在地上堆积起来。
在下一篇文章中将会编写方块落地后的管理，到那个时候堆积的方块有序管理，就可以考虑堆积的方块对移动的影响了。