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

[offtop]ИЗВЕНИТЕ [code]dom=LoadMesh("dom.b3d")
PositionEntity dom,0,-253,0
EntityType player, T_player
EntityType dom,T_dom
EntityType terrain, T_terrain
PositionEntity terrain ,-300,-500,-300
While Not KeyDown(1)
mxspd#=MouseXSpeed()*0.25
myspd#=MouseYSpeed()*0.25
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2  
campitch#=EntityPitch(player)+myspd#
If campitch#<-85 Then campitch#=-85
If campitch#>85 Then campitch#=85
RotateEntity player,campitch#,EntityYaw(player)-mxspd#,EntityRoll(player)
If KeyDown(17) MoveEntity player,0,0,.2
If KeyHit(57) Then Animate player,1,3
If KeyDown(31) MoveEntity player,0,0,-.2
If KeyDown(32) MoveEntity player,.2,0,0
If KeyDown(30) MoveEntity player,-.2,0,0
If KeyDown(42) speed#=speed#+.1  
If Not KeyDown(42)speed#=0
If speed#>2 speed#=2  
If speed#>3 speed#=3
MoveEntity player,0,0,speed#  

RenderWorld

UpdateWorld
Flip
CameraRange Camera,0.1,10000  
Wend
End

BACK=CreateImage(64,64)
SetBuffer ImageBuffer(BACK)
Color 255,255,255
Oval 0,0,64,64

Color 0,0,255
For i=0 To 359 Step 15
  Line 32,32,32+Cos(i)*30,32+Sin(i)*30
Next

Color 255,255,255
Oval 32-20,32-20,40,40

Color 255,0,0
Oval 32-2,32-2,4,4
SaveBuffer(ImageBuffer(BACK),"back.bmp")
FreeImage BACK
;=====================================
BACK=CreateImage(64,64)
SetBuffer ImageBuffer(BACK)
Rect 31,2,3,30
SaveBuffer(ImageBuffer(BACK),"back2.bmp")
FreeImage BACK
;=====================================
Graphics3D 800,600,32,2
SetBuffer BackBuffer()
camera=CreateCamera()
light=CreateLight()

SP0=LoadSprite("back.bmp",4,camera)
SP1=LoadSprite("back2.bmp",4,SP0)

Entity Order SP0,0
EntityFX SP0,1

EntityOrder SP1,-1
EntityFX SP1,1

PositionEntity SP0,-4,2.7,5
;=
cube=CreateCube()
PositionEntity cube,-3,2,6.5
SetBuffer BackBuffer()

While Not KeyHit(1)
  RotateSprite SP1,-MilliSecs()*0.01
  RenderWorld()
  Flip
Wend
End

; ID: 254
; Author: Rhodan
; Date: 2002-02-28 08:47:14
; Title: Relative Radar example
; Description: Plots a 2D radar from a 3D scene

;======================================
; Relative Radar (2D coords)
; Mostly resolution independant except
; scope circle will be ovalish at some
; resolutions
;
; The AngleFinder entity is there to let
; me find the relative angle between the
; emitter heading and target position.
; There's likely a math method of figuring
; this out but, I'm lazy =)

; See my Sin()/Cos() demo in the code
; archives if you don't understand
; what they do.

Graphics3D 1024,768
SetBuffer BackBuffer()

Global mycountry=0,radarrange,contactcount
; screen size dependant stuff
Global radarscoperadius=GraphicsWidth()*0.1
Global radarscopecenterx=GraphicsWidth()*0.88
Global radarscopecentery=GraphicsHeight()*0.15
; plotting a single pixel at 1280x1024 is a TAD small so
Global radardotsize=GraphicsWidth()/300

; Make a radar emitter object and angle-finding pivot
Global Emitter=CreateCube()
ScaleEntity emitter ,1,1,3

Global AngleFinder=CreatePivot(Emitter)

; Make some contacts, random placement and countries
Type t_contacts
  Field country
  Field entity
End Type

SeedRnd(MilliSecs())
For i = 0 To 9
  x#=Rand(-100,100)
  z#=Rand(-100,100)
  contact.t_contacts=New t_contacts
  contact\country=Rand(0,2)
  contact\entity=CreateCube()
  PositionEntity contact\entity,x#,0,Z#
  Select contact\country
   Case 0  
    EntityColor contact\entity,255,0,0
   Case 1
    EntityColor contact\entity,0,255,0
   Case 2
    EntityColor contact\entity,0,0,255
  End Select
Next
; although the X/Z difference is only 100, radar range
; of 100 won't necessarily catch them all. Straight
; line distance to 100,100 is MORE than 100 away.

camera=CreateCamera()
PositionEntity camera, 0,-150,0
RotateEntity camera,-90,0,0

light=CreateLight()
AmbientLight 100,100,100

; variable radar ranges, why not?
Dim radarranges(2)
  radarranges(0)=100
  radarranges(1)=50
  radarranges(2)=20
   
Repeat
  UpdateWorld
  RenderWorld
  If KeyHit(200) Then radarindex=radarindex+1
  If KeyHit(208) Then radarindex=radarindex-1
  If radarindex>2 Then radarindex=0
  If radarindex<0 Then radarindex=2
  radarrange=radarranges(radarindex)
  If KeyDown(203) Then TurnEntity emitter, 0,-10,0
  If KeyDown(205) Then TurnEntity emitter, 0,10,0

  Radar()

  Color 255,255,255
  Text 20,10,"Heading:"+Int(EntityYaw(emitter))+" Radar Range:"+radarrange+" Contacts:"+contactcount
  Delay 100
  Flip
Until KeyHit(1)
End

Function Radar()

  contactcount=0
  Color 255,255,255
  Oval radarscopecenterx-radarscoperadius,radarscopecentery-radarscoperadius,radarscoperadius*2,radarscoperadius*2,False
  Plot radarscopecenterx,radarscopecentery
  radarrangeratio#=Float radarscoperadius/Float radarrange
  For c.t_contacts=Each t_contacts
   If EntityDistance(emitter,c\entity)<radarrange
    PointEntity AngleFinder,c\entity
    radarpointx=Sin(EntityYaw(AngleFinder))*radarrangeratio#*EntityDistance(emitter,c\entity)
    radarpointz=Cos(Entit yYaw(AngleFinder))*radarrangeratio#*EntityDistance(emitter,c\entity)
    Select c\country
     Case 0  
      Color 255,0,0
     Case 1
      Color 0,255,0
     Case 2
      Color 0,0,255
    End Select
    Oval radarscopecenterx-radarpointx,radarscopecentery+radarpointz,radardotsize,radardotsize,True
    contactcount=contactcount+1
   EndIf
  Next
E nd Function

   Collisions TypePlayer,TypeWalls,2,2
    Collisions TypePlayer,TypeTarget,2,2

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,1

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()
  Plac=CreateCone(8)
  RotateMesh Plac,90,0,0  
  ScaleMesh Plac,1,1,1.2  
  PositionMesh Plac,-1.5,0,0
  Player=LoadMesh( "car.3DS" )
  AddMesh Plac,Player
  EntityType Player, TypePlayer
  EntityColor Player,255,255,255
  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