unit2.pas

3d snake 游戏编程源码

               Pre := SnakeTail;
               OriPos := oldTailPos;
               _3DPointB_To_3DPoint(CenterPos, OriPos);
               MakeItToSphereCenter(CenterPos);
               Next := nil;
               BlockState[OriPos[1], OriPos[2], OriPos[3]] := bs_SnakeBody;
            end;
            SnakeTail := SnakeTail^.Next;
            inc(SnakeLength);
         end;
      se_DecApple: begin //在尾部减少一节身体
            BlockState[SnakeTail^.OriPos[1], SnakeTail^.OriPos[2], SnakeTail^.OriPos[3]] := bs_Empty;
            Old := SnakeTail.Pre;
            Dispose(SnakeTail);
            SnakeTail := Old;
            SnakeTail^.Next := nil;
            Dec(SnakeLength);
         end;
      se_Exit: begin
            _GameCtrl^.LevelPassed;
            Exit;
         end;
   end;

   ShowSnakePosLengthInLabel;
   DrawScene; //重新绘制场景
end;

procedure TDrawEngine.CreateApple;
var i: Byte; tmps: string;
begin
   with NowApple do begin
      OriPos := ReturnAnEmptyBlock();
      _3DPointB_To_3DPoint(CenterPos, OriPos);
      MakeItToSphereCenter(CenterPos);

      i := pos(')', MapProperty.AppleList);
      tmps := Copy(MapProperty.AppleList, 2, i - 2);
      Delete(MapProperty.AppleList, 1, i);

      i := pos(',', tmps);
      if StrToInt(Copy(tmps, 1, i - 1)) = 1 then
         _Type := obj_IncApple
      else
         _Type := obj_DecApple;

      Delete(tmps, 1, i);
      _Interval := StrToInt(tmps);

      BlockState[OriPos[1], OriPos[2], OriPos[3]] := AppleToBlockState[_Type];
      if _Interval <> 0 then begin //此苹果可以移动
         Moveable := True;
         AppleMoveTimer.Enabled := True;
         MoveTickCount := 0;
         SetAppleTimeLableVisible(True);
      end else
         SetAppleTimeLableVisible(False);

      ShowApplePos;
   end;
end;

procedure TDrawEngine.PickApple;
begin
   inc(EatAppleCount);
   if MapProperty.AppleList = '' then begin
      AppleMoveTimer.Enabled := False;
      SetAppleTimeLableVisible(False);
      CreateExit;
   end else begin
      AppleMoveTimer.Enabled := False;
      CreateApple;
   end;
end;

procedure TDrawEngine.DrawApple;
begin
   with NowApple do begin
      SetGLColor(_Type);
      gluDeleteQuadric(qObj);
      qObj := gluNewQuadric;
      gluQuadricDrawStyle(qObj, GLU_FILL);
      gluQuadricNormals(qObj, GLU_SMOOTH);
      glPushMatrix;
      glTranslate(CenterPos[1], CenterPos[2], CenterPos[3]); //在这一点画球
      gluSphere(qObj, 0.5, 10, 10);
      glPopMatrix;
   end;
end;

procedure TDrawEngine.AppleMoveTimerTick(Sender: TObject);
begin
   inc(NowApple.MoveTickCount);
   if NowApple.MoveTickCount = NowApple._Interval + 1 then
      with NowApple do begin
         MoveTickCount := 0;
         BlockState[OriPos[1], OriPos[2], OriPos[3]] := bs_Empty;
         OriPos := ReturnAnEmptyBlock();
         _3DPointB_To_3DPoint(CenterPos, OriPos);
         MakeItToSphereCenter(CenterPos);
         BlockState[OriPos[1], OriPos[2], OriPos[3]] := AppleToBlockState[_Type];
         ShowApplePos;
      end;
   MainForm.lblShowTime.Caption := IntToStr(NowApple._Interval - NowApple.MoveTickCount) + '秒';
   DrawScene;
end;

procedure TDrawEngine.CreateExit;
begin
   ExitShow := True;
   ExitPos := ReturnAnEmptyBlock();
   BlockState[ExitPos[1], ExitPos[2], ExitPos[3]] := bs_Exit;
end;

procedure TDrawEngine.DrawExit;
begin
   SetGLColor(obj_Exit);
   DrawCube(ExitPos, ExitPos, gl_Line_Loop);
end;

procedure TDrawEngine.DrawScene; //游戏中实时刷新场景
var i: Byte; tmp: PTSnakeBody;
begin
   if GameOption.LightOn = True then
      glEnable(GL_LIGHTING)
   else
      glDisable(GL_LIGHTING);

   glEnable(GL_DEPTH_TEST); //打开深度探测
   glDepthFunc(GL_LEQUAL);
   glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); //清空
   glLoadIdentity;
   glClearColor(0, 0, 0, 1); //背景为黑色

   //绘制障碍物
   if BlockCount <> 0 then //?? 偶觉得不用这句也可以，不知为什么为出错
      for i := 0 to BlockCount - 1 do
         with Blocks[i] do begin
            if _Type = bt_Block then
               SetGLColor(obj_Block)
            else
               glColor3ub(0, 0, 0);
            DrawCube(Blocks[i].LeftBackBottom, Blocks[i].RightFrontTop);
         end;

   if ExitShow then begin
      DrawExit; //绘制出口
      if GameOption.ShowAidLine then
         DrawAidLine(ExitPos);
   end else begin
      DrawApple; //绘制苹果
      if GameOption.ShowAidLine then
         DrawAidLine(NowApple.OriPos); //绘制苹果辅助线
   end;

   //绘制蛇身
   SetGLColor(obj_SnakeHead); //先绘制蛇头
   DrawSphere(SnakeHead);
   SetGLColor(obj_SnakeBody);
   tmp := SnakeHead^.Next;
   while tmp <> nil do begin
      DrawSphere(tmp);
      tmp := tmp^.Next;
   end;

   //绘制网格线，辅助观察
   if GameOption.ShowGrid then
      DrawGridLine;

   //绘制围墙，实现半透明效果
   DrawWall;

   //将绘制的图形投射到窗体上
   SwapBuffers(DrawDC);
end;

procedure TDrawEngine.NextViewAngelV;
begin
   case ViewAngleV of
      eh_High: begin
            ViewAngleV := eh_Middle;
            ViewAngleVMoveUp := False;
         end;
      eh_Low: begin
            ViewAngleV := eh_Middle;
            ViewAngleVMoveUp := True;
         end;
      eh_Middle: begin
            if ViewAngleVMoveUp then
               ViewAngleV := eh_High
            else
               ViewAngleV := eh_Low
         end;
   end;
   SetEye;
   DrawScene;
   ShowKeyDirectors;
end;

procedure TDrawEngine.NextViewAngelH;
begin
   if ViewAngleH = ep_Left then
      ViewAngleH := ep_Front
   else
      ViewAngleH := Succ(ViewAngleH); //求后继
   SetEye;
   DrawScene;
   ShowKeyDirectors;
end;

procedure TDrawEngine.ChangeFarNear;
begin
   case ViewDistance of
      3: begin
            ViewDistanceMoveUp := False;
            ViewDistance := 2;
         end;
      1: begin
            ViewDistanceMoveUp := True;
            ViewDistance := 2;
         end;
      2: begin
            if ViewDistanceMoveUp = True then
               ViewDistance := 3
            else
               ViewDistance := 1;
         end;
   end;
   SetEye;
   DrawScene;
end;

procedure TDrawEngine.OutputGameProperties;
begin
   with MainForm.MemoMap.Lines do
      with MapProperty do begin
         Clear;
         Add(str_DrawEngine + IntToStr(UseEngineVersion));
         Add(str_MapName + MapName);
         Add(str_MapAppleCount + IntToStr(AppleCount));
         Add(str_SnakeSpeed + IntToStr(SnakeSpeed) + '格/秒');
         Add('');
         Add(MapDescription);
      end;
end;

procedure TDrawEngine.ShowSnakePosLengthInLabel;
begin
   with SnakeHead^ do begin
      MainForm.lblSnakeHead.Caption := str_SnakeHeadPos + IntToStr(OriPos[1]) + ',' + IntToStr(OriPos[2]) + ',' + IntToStr(OriPos[3]);
      MainForm.lblSnakeLength.Caption := str_SnakeLength + IntToStr(SnakeLength);
   end;
end;

procedure TDrawEngine.ShowApplePos;
begin
   with NowApple do begin
      MainForm.lblApplePos.Caption := str_ApplePos + IntToStr(OriPos[1]) + ',' + IntToStr(OriPos[2]) + ',' + IntToStr(OriPos[3]);
      MainForm.lblAppleCount.Caption := Format(str_AppleRemains, [MapProperty.AppleCount - EatAppleCount]);
   end;
end;

procedure TDrawEngine.ShowKeyDirectors;
begin
   with MainForm do begin
      lblUp.Caption := KeyDirectorStr[ViewDirection[ViewAngleH, SnakeDirection, td_Up]];
      lblDown.Caption := KeyDirectorStr[ViewDirection[ViewAngleH, SnakeDirection, td_Down]];
      lblLeft.Caption := KeyDirectorStr[ViewDirection[ViewAngleH, SnakeDirection, td_Left]];
      lblRight.Caption := KeyDirectorStr[ViewDirection[ViewAngleH, SnakeDirection, td_Right]];
   end;
end;

procedure TDrawEngine.SetAppleTimeLableVisible(b: Boolean);
begin
   MainForm.Label2.Visible := b;
   MainForm.Label3.Visible := b;
   MainForm.lblShowTime.Visible := b;
end;

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

constructor TGameCtrl.Create;
begin
   MoveTimer := TTimer.Create(nil);
   MoveTimer.Enabled := False;
   MoveTimer.OnTimer := MoveTimerTick;

   AMapLoaded := False;
end;

destructor TGameCtrl.Destroy;
begin
   MoveTimer.Free;
end;

procedure TGameCtrl.NewGame(FileName: string);
begin
   if FileExists(FileName) = False then begin
      MessageDlg(msg_FileMissing + ': ' + FileName, mtError, [mbOK], 0);
      Exit;
   end;
   with _Engine^ do begin
      SetAppleTimeLableVisible(False);
      MapFileName := FileName;
      MapScript.Clear;
      MapScript.LoadFromFile(FileName);
      ReadScript;
      DrawScene;
      MoveTimer.Interval := 1000 div MapProperty.SnakeSpeed;
   end;
   AMapLoaded := True;
   GameEnd := False;
   GameStarted := False;
   GamePaused := False;
end;

procedure TGameCtrl.Game_Start(Turn: TurnDirection);
begin
   _Engine^.SnakeTurn(Turn);
   MoveTimer.Enabled := True;
   GameStarted := True;
end;

procedure TGameCtrl.Game_Pause;
begin
   GamePaused := True;
   MoveTimer.Enabled := False;
   _Engine^.AppleMoveTimer.Enabled := False;
end;

procedure TGameCtrl.Game_Restart; //实际就是重新装载一下地图
begin
   NewGame(_Engine^.MapFileName);
end;

procedure TGameCtrl.Game_Resume;
begin
   GamePaused := False;
   MoveTimer.Enabled := True;
   if _Engine^.NowApple._Interval <> 0 then
      _Engine^.AppleMoveTimer.Enabled := True;
end;

function TGameCtrl.AskIfGameEnd: Boolean;
begin
   if (AMapLoaded = False) or (GameEnd = True) then begin
      Result := True;
      Exit;
   end;
   Game_Pause;
   Result := False;
   if MessageDlg(msg_WantEndNowGame, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      Result := True;
      Exit;
   end;
end;

procedure TGameCtrl.Game_End;
begin
   MoveTimer.Enabled := False;
   _Engine^.AppleMoveTimer.Enabled := False;

   GameEnd := True;
   //_Engine^.GameEndFreeMem;
end;

procedure TGameCtrl.MoveTimerTick(Sender: TObject);
begin
   _Engine^.SnakeMove;
end;

function TGameCtrl.AskNextStep(msg: string): Boolean;
begin
   if MessageDlg(msg, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      Result := True
   else
      Result := False;
end;

procedure TGameCtrl.SnakeCollision(t: SnakeCollisionType);
begin
   Game_End;
   if AskNextStep(msg_SnakeCollision[t] + msg_GameEnd + Chr10Chr13 + msg_GameEngToDo + msg_IfPlayAgain) = True then
      Game_Restart;
end;

procedure TGameCtrl.StartNextLevel;
begin
   if NowLevelIdx = MapCtrl.MapCount then begin
      if AskNextStep(msg_NoLevelToBeNext) = True then
         Game_Restart;
   end else begin
      inc(NowLevelIdx);
      NewGame(MapCtrl.MapFileName(NowLevelIdx));
      MainForm.MenuOpenGame.Items[NowLevelIdx - 1].Checked := True;
   end;
end;

procedure TGameCtrl.LevelPassed;
begin
   Game_End;
   if AskNextStep(msg_LevelPassed + Chr10Chr13 + msg_IfStartNextGame) = True then
      StartNextLevel;
end;

procedure TGameCtrl.CloseMap;
begin
   Game_End;
   _Engine^.CloseMap;
   AMapLoaded := False;
end;


end.