unit2.pas

3d snake 游戏编程源码

unit Unit2; //系统核心单元

interface
uses Windows, OpenGL, Graphics, SysUtils, Dialogs, Math, ExtCtrls, Classes,
   Menus, Controls, Unit3;

type
   ObjNames = (obj_Wall, obj_Block, obj_GridLine, obj_AidLine, obj_HighlightedAidLine, obj_SnakeBody, obj_SnakeHead, obj_IncApple, obj_DecApple, obj_Exit);
   BlockStates = (bs_Empty, bs_Wall, bs_Obstacle, bs_SnakeBody, bs_IncApple, bs_DecApple, bs_Exit);
   BlockType = (bt_Block, bt_AntiBlock);
   GameOptionColors = array[obj_Wall..obj_Exit] of TColor;
   SnakeExtraState = (se_None, se_IncApple, se_DecApple, se_Exit);

const
   AppleToBlockState: array[obj_IncApple..obj_DecApple] of BlockStates = (bs_IncApple, bs_DecApple);

type
   TGameOption = record
      Colors: GameOptionColors; //
      ColorsRGB: array[obj_Wall..obj_Exit, 1..3] of Byte;
      WallColor: array[1..6, 1..3] of Byte;
      WallAlpha: Byte;
      ShowGrid: Boolean;
      ShowAidLine: Boolean;
      LightOn: Boolean;
   end;

   TMapCtrl = class
      MapDir: string;
      MapCount: Byte;
      MapsName: array of string[20];

      AFile: TextFile;
      GeneratedMapScript: TStringList;

      constructor Create;
      destructor Destroy; override;

      function MapFileName(idx: Byte): string;
      procedure LoadMaps;
   end;

   TMapProperty = record
      MapName: string;
      MapDescription: string;
      Ori_SnakeHead, OriSnakeTail: T3DPointB;
      MapValue: Byte;
      AppleCount: Byte;
      SnakeSpeed: Byte;
      AppleList: string;
      UseEngineVersion: Byte;
   end;

   PTSnakeBody = ^TSnakeBody;
   TSnakeBody = record
      Pre, Next: PTSnakeBody; //分别存储上一块和下一个身体
      OriPos: T3DPointB; //记录这个球所在的方块
      CenterPos: T3DPoint; //记录球心的位置
      qObj: gluQuadricObj;
   end;

   TBlock = record
      _Type: BlockType;
      LeftBackBottom, RightFrontTop: T3DPointB; //左后下顶点和右上前顶点
   end;

   TApple = record
      _Interval: Byte;
      _Type: ObjNames; //只有 obj_IncApple, obj_DecApple
      OriPos: T3DPointB;
      CenterPos: T3DPoint;
      qObj: gluQuadricObj;
      Moveable: Boolean;
      MoveTickCount: Byte;
   end;

   PTDrawEngine = ^TDrawEngine;
   PTGameCtrl = ^TGameCtrl;

   TDrawEngine = class //绘图引擎
      _GameCtrl: PTGameCtrl;
      AppleMoveTimer: TTimer; //控制苹果移动的时钟控件

      DrawDC: HDC;
      HRC: HGLRC;
      ViewWidth, ViewHeight: Word;
      ViewAngleH: EyePos;
      ViewAngleV: EyeHeight;
      ViewAngleVMoveUp: Boolean;
      ViewDistance: Byte;
      ViewDistanceMoveUp: Boolean;

      MapScript: TStringList; //地图脚本
      MapFileName: string;
      MapProperty: TMapProperty; //地图的一些属性
      MapSize: T3DPointB; //经常使用，把它从MapProperty中提出来
      BoxCenter: T3DPoint; //场景中心

      SnakeHead, SnakeTail: PTSnakeBody; //用链表存储蛇身，这样蛇的移动就可以转化为把蛇尾的方块移到蛇头，速度很快
      SnakeDirection: Directions;
      SnakeLength: Byte;

      Blocks: array of TBlock;
      BlockCount: Byte;

      WallLists: array[1..6] of GLuint; //绘制墙壁的glList

      //将场景中的每个方块的状态记录下来，可以完成碰撞检测
      BlockState: packed array[-1..MaxLength, -1..MaxLength, -1..MaxLength] of BlockStates;

      NowApple: TApple;
      EatAppleCount: Byte;

      ExitShow: Boolean;
      ExitPos: T3DPointB;

      ///////OpenGl
      procedure IniOpenGl;
      procedure IniLighting;
      procedure IniScene; //场景初始化
      procedure FreeOpenGl;
      procedure DrawCube(p1, p2: T3DPointB; _Type: Integer = GL_QUADS); //绘制以p1为左后下顶点，p2为右前上顶点的长方体
      procedure DrawSphere(Part: PTSnakeBody); //实际为绘制蛇身的一节一节
      procedure SetGLColor(idx: ObjNames); //设置绘图颜色
      procedure SetEye; //设置眼睛的位置
      procedure NextViewAngelV; //转换水平视角
      procedure NextViewAngelH; //转换垂直视角
      procedure ChangeFarNear;

      ////////////////////////////
      procedure CloseMap;
      procedure SnakeTurn(Turn: TurnDirection); //蛇转向
      procedure SnakeMove; //蛇移动控制过程
      procedure ReadScript; //读取脚本
      procedure LoadBlocks; //读取障碍物的位置
      procedure MakeWallDrawLists; //生成绘制墙壁的glList
      procedure DrawGridLine; //绘制网格线，围绕蛇头的，以便玩家观察是否接近障碍物
      procedure DrawAidLine(posi: T3DPointB); //绘制辅助观察线
      procedure DrawWall; //绘制墙壁
      procedure CreateApple; //生成一个苹果
      procedure DrawApple; //绘制当前苹果
      procedure CreateExit; //生成出口
      procedure DrawExit; //绘制出口
      procedure IniBlockState; //初始化每个方块的状态
      procedure PrepareSnake; //准备蛇的各个身体组成方块，同时计算出蛇的初始方向
      procedure DrawScene; //游戏中实时刷新场景
      procedure PickApple; //吃到增长苹果
      procedure AppleMoveTimerTick(Sender: TObject);

      function ReturnAnEmptyBlock: T3DPointB; //返回一个空的格子

      procedure OutputGameProperties; //输出游戏属性到MainForm.MemoMap
      procedure ShowSnakePosLengthInLabel; //输出蛇的位置和长度信息
      procedure ShowApplePos; //显示苹果的位置
      procedure SetAppleTimeLableVisible(b: Boolean); //设置苹果时间的Lable是否可见
      procedure ShowKeyDirectors; //显示方向键提示信息

      constructor Create(hnd: THandle; aW, aH: Word);
      destructor Destroy; override;
   end;

   TGameCtrl = class
      _Engine: PTDrawEngine; //绘图引擎

      MoveTimer: TTimer; //控制蛇移动的Timer

      NowLevelIdx: Byte;

      AMapLoaded: Boolean;
      GameEnd: Boolean;
      GameStarted: Boolean;
      GamePaused: Boolean;

      /////////GameCtrl
      procedure NewGame(FileName: string);
      procedure Game_Start(Turn: TurnDirection);
      procedure Game_End; //游戏结束
      procedure Game_Pause; //游戏暂停
      procedure Game_Resume; //恢复暂停的游戏
      procedure Game_Restart; //重新开始游戏
      procedure CloseMap;
      procedure LevelPassed; //本关通过
      procedure StartNextLevel; //开启下一关
      procedure MoveTimerTick(Sender: TObject);
      procedure SnakeCollision(t: SnakeCollisionType); //蛇碰障碍物了
      function AskIfGameEnd: Boolean; //讯问是否结束游戏
      function AskNextStep(msg: string): Boolean; //讯问游戏结束后怎么办


      constructor Create;
      destructor Destroy; override;

   end;

function Make_3DPointB(x, y, z: Byte): T3DPointB;
procedure RGBGameColors;
procedure LoadWallColors;
procedure MakeItToSphereCenter(var P: T3DPoint);
procedure _3DPointB_To_3DPoint(var _3DPoint: T3DPoint; _3DPointB: T3DPointB);

implementation
uses Unit1;

procedure LoadWallColors;
begin
   fillChar(GameOption.WallColor, sizeof(GameOption.WallColor), 0);
   GameOption.WallColor[1, 1] := 255;
   GameOption.WallColor[2, 1] := 255;

   GameOption.WallColor[3, 2] := 255;
   GameOption.WallColor[4, 2] := 255;

   GameOption.WallColor[5, 3] := 255;
   GameOption.WallColor[6, 3] := 255;
end;

function Make_3DPointB(x, y, z: Byte): T3DPointB;
begin
   Result[1] := x;
   Result[2] := y;
   Result[3] := z;
end;

procedure _3DPointB_To_3DPoint(var _3DPoint: T3DPoint; _3DPointB: T3DPointB);
begin
   _3DPoint[1] := _3DPointB[1];
   _3DPoint[2] := _3DPointB[2];
   _3DPoint[3] := _3DPointB[3];
end;

procedure RGBGameColors;
var i: ObjNames;
begin
   with GameOption do
      for i := obj_Wall to obj_Exit do begin
         ColorsRGB[i, 1] := GetRValue(Colors[i]);
         ColorsRGB[i, 2] := GetGValue(Colors[i]);
         ColorsRGB[i, 3] := GetBValue(Colors[i]);
      end;
end;

procedure MakeItToSphereCenter(var P: T3DPoint);
begin
   P[1] := P[1] + 0.5;
   P[2] := P[2] + 0.5;
   P[3] := P[3] + 0.5;
end;

/////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////

constructor TMapCtrl.Create;
begin
   GeneratedMapScript := TStringList.Create;
end;

destructor TMapCtrl.Destroy;
begin
   GeneratedMapScript.Free;
end;

procedure TMapCtrl.LoadMaps;
var i: Byte; fn: string; s: string;
   Item: TMenuItem;
begin
   SetLength(MapsName, MapCount);
   for i := 0 to MapCount - 1 do begin
      fn := 'Map' + IntToStr(i + 1) + '.map';
      AssignFile(AFile, MapDir + fn);
      Reset(AFile);
      Readln(AFile, s);
      Readln(AFile, s);
      MapsName[i] := ReadSpaceSection(s);
      CloseFile(AFile);
      Item := TMenuItem.Create(nil);
      Item.Caption := MapsName[i] + ' @ ' + fn;
      Item.Tag := i + 1;
      Item.OnClick := MainForm.MapClick;
      Item.AutoCheck := True;
      Item.RadioItem := True;
      MainForm.MenuOpenGame.Add(Item);
   end;
end;

function TMapCtrl.MapFileName(idx: Byte): string;
begin
   Result := MapDir + 'Map' + IntToStr(idx) + '.map';
end;

////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////

constructor TDrawEngine.Create(hnd: THandle; aW, aH: Word);
begin
   DrawDC := GetDC(hnd);
   ViewWidth := aW;
   ViewHeight := aH;
   MapScript := TStringList.Create;
   AppleMoveTimer := TTimer.Create(nil);
   AppleMoveTimer.Enabled := False;
   AppleMoveTimer.Interval := 1000;
   AppleMoveTimer.OnTimer := AppleMoveTimerTick;
   IniOpenGl;
end;

destructor TDrawEngine.Destroy;
begin
   MapScript.Free;
end;

procedure TDrawEngine.IniOpenGl;
var pfd: TPIXELFORMATDESCRIPTOR; pixelFormat: Integer;
begin
   with pfd do
   begin
      nSize := sizeof(TPIXELFORMATDESCRIPTOR); // 此结构尺寸
      nVersion := 1;
      dwFlags := PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW or PFD_DOUBLEBUFFER; // 使用双缓冲区
      iPixelType := PFD_TYPE_RGBA; //使用RGBA颜色空间
      cColorBits := 16;
      cRedBits := 0;
      cRedShift := 0;
      cGreenBits := 0;
      cGreenShift := 0;
      cBlueBits := 0;
      cBlueShift := 0;
      cAlphaBits := 0;
      cAlphaShift := 0;
      cAccumBits := 0;
      cAccumRedBits := 0;
      cAccumGreenBits := 0;
      cAccumBlueBits := 0;
      cAccumAlphaBits := 0;
      cDepthBits := 16;
      cStencilBits := 0;
      cAuxBuffers := 0;
      iLayerType := PFD_MAIN_PLANE;
      bReserved := 0;
      dwLayerMask := 0;
      dwVisibleMask := 0;
      dwDamageMask := 0;
   end;
   pixelFormat := ChoosePixelFormat(DrawDC, @pfd);
   SetPixelFormat(DrawDC, pixelFormat, @pfd);
   HRC := wglCreateContext(DrawDC);
   wglMakeCurrent(DrawDC, HRC);
end;

procedure TDrawEngine.FreeOpenGl;
begin

end;

procedure TDrawEngine.CloseMap;
begin
   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
   glLoadIdentity;
   glClearColor(0, 0, 0, 1);
   SwapBuffers(DrawDC);
end;

procedure TDrawEngine.IniScene;
begin
   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
   glLoadIdentity;
   glClearColor(0, 0, 0, 1);

   glViewPort(0, 0, ViewWidth, ViewHeight); //指定OpenGL在此区域内绘图。

   glEnable(GL_CULL_FACE);
   glCullFace(GL_BACK);
   glEnable(GL_DEPTH_TEST); //无论绘制的先后，让距离远的物体总在距离近的物体后面。

   ViewAngleH := ep_Front; //正面
   ViewAngleV := eh_Middle; //中间
   ViewAngleVMoveUp := True; //视角先向上移动
   ViewDistance := 2;
   ViewDistanceMoveUp := False;

   SetEye;
end;

procedure TDrawEngine.IniLighting;
var
   MaterialAmbient: array[1..4] of GLfloat;
   MaterialDiffuse: array[1..4] of GLfloat;
   MaterialSpecular: array[1..4] of GLfloat;
   AmbientLightPosition: array[1..4] of GLfloat;
   LightAmbient: array[1..4] of GLfloat;
   MaterialShininess: GLfloat;
begin
   MaterialAmbient[1] := 0.5;
   MaterialAmbient[2] := 0.8;
   MaterialAmbient[3] := 0.2;
   MaterialAmbient[4] := 1.0;

   MaterialDiffuse[1] := 0.4;
   MaterialDiffuse[2] := 0.8;
   MaterialDiffuse[3] := 0.1;
   MaterialDiffuse[4] := 1.0;

   MaterialSpecular[1] := 1.0;
   MaterialSpecular[2] := 0.5;
   MaterialSpecular[3] := 0.1;
   MaterialSpecular[4] := 1.0;

   MaterialShininess := 40; //可设置

   AmbientLightPosition[1] := 0.5;
   AmbientLightPosition[2] := 1.0;
   AmbientLightPosition[3] := 0;
   AmbientLightPosition[4] := 0.0;

   LightAmbient[1] := 0.4;
   LightAmbient[2] := 0.2;
   LightAmbient[3] := 0.2;
   LightAmbient[4] := 1.0;