Игростроение - Создание игр

SeedRnd MilliSecs()

   

Global GameScr=0

Global Quit=False

   

Type Walls

  Field model

End Type

   

Const TypePlayer=1,TypeWalls=2,TypeTarget=3

   

Global Speed#=.1,Score=0

   

Global Player

Global Target

Global cam

Global lit

   

Graphics3D 640,480,16,0

SetBuffer BackBuffer()

   

Global fontB=LoadFont("Verdana",72)

Global FontM=LoadFont("Verdana",32)

   

;*******************

;Main Cycle

;*******************

   

Repeat

   

  Select GameScr

  Case 0

   

  UpdateStartScreen()

   

  Case 6

   

  Cls

  Flip

  Cls

  SetFont fontB

  Color 255,0,0

  Text 320,240,"Game Over",True,True

  Flip

  Delay 1000

  FlushKeys

  GameScr = 0  

   

  Case 9

   

  UpdateGame()

   

  End Select

   

  Flip

   

Until Quit

   

End

   

;*******************
;Functions
;*******************  
Function CreateWalls(tn)  
  For i=0 To tn  w.Walls = New Walls
   w\model=CreateCube()
   Repeat   
    PositionEntity w\model,Rnd(-40,40),0,Rnd(-40,40)
   Until Abs(EntityX(w\model))>10 Or Abs(EntityZ(w\model))>10
   EntityType w\model, TypeWalls
   EntityColor w\model,255,0,0
  Next

   

  w.Walls = New Walls

   w\model=CreateCube()

   EntityColor w\model,100,20,0

   EntityType w\model,TypeWalls

  PositionEntity w\model,-50,0,0

   FitMesh w\model,-1,-1,-50,2,3,100

   

  w.Walls = New Walls

   w\model=CreateCube()

   EntityColor w\model,100,20,0

   EntityType w\model,TypeWalls

  PositionEntity w\model,50,0,0

   FitMesh w\model,-1,-1,-50,2,3,100

   

  w.Walls = New Walls

   w\model=CreateCube()

   EntityColor w\model,100,20,0

   EntityType w\model,TypeWalls

  PositionEntity w\model,0,0,-50

   FitMesh w\model,-50,-1,-1,100,3,2

   

  w.Walls = New Walls

   w\model=CreateCube()

   EntityColor w\model,100,20,0

   EntityType w\model,TypeWalls

  PositionEntity w\model,0,0,50

   FitMesh w\model,-50,-1,-1,100,3,2

   

End Function

   

Function PositionTarget()

   

  Repeat  

   inter=False

   PositionEntity Target,Rnd(-40,40),0,Rnd(-40,40)

   For w.Walls = Each Walls

    If MeshesIntersect(Target, w\model) inter=True

   Next

  Until inter=False

   

End Function  

   

Function CreatePlayer()

   

  Player=CreateSphere()

   

  Plac=CreateCone(8)

  RotateMesh Plac,-90,0,0  

  ScaleMesh Plac,1,1,1.2

  PositionMesh Plac,0,0,-1.5

  AddMesh Plac,Player

  EntityType Player, TypePlayer

  EntityColor Player,0,255,0

   

  FreeEntity Plac

   

End Function

   

Function CreateTarget()

   

  Target=CreateCylinder()

  PositionTarget()

  EntityColor Target,255,215,0

   

  EntityType Target,TypeTarget

   

End Function

   

Function CreateEnv()

   

  cam=CreateCamera()

  PositionEntity cam,0,40,0

  TurnEntity cam,90,0,0

   

  lit=CreateLight()

  TurnEntity lit,70,70,0

   

End Function

   

Function UpdateGame()

   

  MoveEntity Player,0,0,Speed#

  If KeyDown(203) TurnEntity Player,0,3,0

  If KeyDown(205) TurnEntity Player,0,-3,0

   

  PointEntity cam,Player  

   

  If EntityCollided (Player,TypeTarget)

   PositionTarget()

   UpdateWorld

   Score=Score+1  

   Speed=Speed+.01

  EndIf

   

  If EntityCollided (Player,TypeWalls) Or KeyDown(1)

   GameScr=6

   FreeGame()

  EndIf

    

   

  UpdateWorld

  RenderWorld

   

  Color 255,215,0

  Text 320,10,"Score : "+Score,True,True

   

End Function

   

Function UpdateStartScreen()

   

  tShift=0

  If RectsOverlap(MouseX(),MouseY(),2,2,320-50,240-12,100,32) tShift=1

  If RectsOverlap(MouseX(),MouseY(),2,2,320-50,280-12,100,32) tShift=2

   

  Cls

  SetFont FontB

  Color 255,0,0

  Text 320,150,"First Game",True,True

  SetFont FontM

  If tShift=1 Color 0,255,0 Else Color 255,0,0

  Text 320,240, "Start",True,True

  If tShift=2 Color 0,255,0 Else Color 255,0,0

  Text 320,280, "Quit",True,True

   

  Color 250,200,0

  Text MouseX(),MouseY(),"*",True,True

   

  If MouseHit(1)

   Select tShift

   Case 1

    CreatePlayer()

    CreateWalls(29)

    CreateTarget()

    CreateEnv()

     

    Collisions TypePlayer,TypeWalls,2,2

    Collisions TypePlayer,TypeTarget,2,2

   

    GameScr=9

   Case 2

    Quit=True

   End Select  

  EndIf

  If KeyHit(1) Quit=True

   

End Function

   

Function FreeGame()

   

ClearCollisions

   

  FreeEntity cam

  FreeEntity lit

  FreeEntity Player

  FreeEntity Target

   

  For w.Walls=Each Walls

   FreeEntity w\model

   Delete w

  Next

   

  Speed#=.1

  Score=0

   

End Function