|
|
'--------------------------------------------
' 山地射击 - 一个 TrueVision 样板
'--------------------------------------------
'
' - 一些东西可以继续改进增强:
' - 当 'Barney' 被枪射击时, 他将会倒在地上然后旋转.
' - 'Inp' 对象仍然被作为新的对象来声明.
Option Explicit
Private TV As TVEngine
Private Scene As TVScene
Private Inp As New TVInputEngine
Private Scr As TVScreen2DImmediate
Private Land As TVLandscape
Private TexFactory As TVTextureFactory
Private MatFactory As TVMaterialFactory
Private ScreenText As TVScreen2DText
Private Atmosphere As TVAtmosphere
Private Effects As TVGraphicEffect
Private mSoundEngine As TVSoundEngine
Private mSounds As TVSounds
Private Weapon As TVActor
Private Barney As TVActor
Private BarneyPos As D3DVECTOR
Private BarneyDir As D3DVECTOR
Private BarneyDest As D3DVECTOR
Private BarneyWalk As Boolean
Private BarneyHealth As Long
Private PosX As Single, PosY As Single, PosZ As Single
Private ang As Single
Private Fin As Integer
Private CamPosX As Single, CamPosZ As Single
Private ang2 As Single, ang3 As Single
Private posy1 As Single, posy2 As Single
Private dying As Boolean, tested As Boolean, angy As Single
Private b1 As Integer
Private OldStep As Long
Private Walk As Boolean
Private OldAI As Long
Private Flash As TVMesh
Private OldWeapon As Long
Private mWidth As Long
Private mHeight As Long
Private Change As Boolean
Private angle As Single
Private Sub UpdateBarney()
'当Barney思考如何应对射击前停顿几秒
Change = False '先设定Barney为不需要逃跑
If BarneyHealth < 0 Then '当Barney生命值为0后
If OldAI < TV.TickCount - 900 Then
Barney.SetAnimationName "lying_on_back" 'Barney这个mdl的动画改为"lying_on_back"(mdl文件预设的)
End If
Else
If OldAI < TV.TickCount - 500 Then '停顿过了,Barney开始思考是否需要以及怎样逃跑
OldAI = TV.TickCount '把这一次的停顿记录下来以便确定下一次停顿
Dim Dist As Single
Dist = VModulus(VSubtract(Vector(PosX, PosY, PosZ), BarneyPos)) '计算Barney和Actor的距离
If Dist < 40 Then '如果距离太小，那么......
'Barney寻找另一个离Actor远的地方
BarneyDest = Vector(Rnd * 1024, 0, Rnd * 1024) '这个地方随机生成(x,y,z中只用确定x,z平面坐标即可)
Change = True '将Barney设为需要逃跑
End If
'确认如果玩家可以看到Barney，那么
Scene.SetCollisionPrecision Dist
If Scene.Collide(Vector(BarneyPos.x, BarneyPos.y + 50, BarneyPos.z), Vector(PosX, PosY + 50, PosZ), TV_TESTTYPE_BOUNDINGBOX) = False Then
'Barney还是要寻找另一个离Actor远的地方
BarneyDest = Vector(Rnd * 2048, 0, Rnd * 2048)
Change = True
End If
If Change Then '经过前面的确认，如果Barney要逃跑，就这样逃
BarneyDir = VNormalize(VSubtract(BarneyDest, BarneyPos)) '先确认Barney逃跑的方向
If BarneyDir.z > 0 Then
angle = Rad2Deg(Atn(BarneyDir.x / BarneyDir.z))
Else
angle = Rad2Deg(Atn(BarneyDir.x / BarneyDir.z)) + 180
End If
Barney.SetRotation 0, 90 + angle, 0
BarneyWalk = True 'Barney改为需要移动
Barney.SetAnimationName "run" 'Barney这个mdl的动画改为"run"
End If
End If
If BarneyWalk Then
Dim p As D3DVECTOR
p = VAdd(BarneyPos, VScale(BarneyDir, TV.TimeElapsed * 0.09))
BarneyPos = Vector(p.x, 0, p.z)
If Int(p.x / 10) = Int(BarneyDest.x / 10) And Int(p.z / 10) = Int(BarneyDest.z / 10) Then
'如果Barney移动到了它需要到的地方，那么停止移动
BarneyWalk = False
Barney.SetAnimationName "idle" 'Barney这个mdl的动画改为"idle"
End If
End If
BarneyPos.y = Land.GetHeight(BarneyPos.x, BarneyPos.z) '计算Barney移动后所在的地面高度
Barney.SetPosition BarneyPos.x, BarneyPos.y, BarneyPos.z '地图是凹凸不平的,Barney必须保持在地面上
End If
End Sub
Private Sub MainLoop() '程序主循环
Dim mx As Long
Dim my As Long
Dim step As Integer
Dim testfont As Long
testfont = ScreenText.TextureFont_Create("font", "arial", 16, True) '设置屏幕字体
Do
TV.Clear '清屏
Atmosphere.Skybox_Render
' 渲染对象. 请注意渲染的顺序(渲染就是把需要显示的东西确定好以便显示在屏幕上)!
'Scene.RenderSky
Land.Render '渲染地形
Barney.Render '渲染Barney
Atmosphere.SkyBox_Enable False
Atmosphere.Atmosphere_Render
Atmosphere.SkyBox_Enable True
'Cancel the fog for drawing the sky
'TV.Start2D
Scene.RenderAllMeshes
Weapon.Render
ScreenText.TextureFont_DrawBillboardText "BARNEY", BarneyPos.x, BarneyPos.y + 100, BarneyPos.z, &HFFFF0000, testfont, 5, 5
'在Barney的头上标明BARNEY
Walk = False
'ScreenShot Taking takes a few seconds. TV has to convert the color format
'BackBuffer formats supported : R5G6B5 & X8R8G8B8 & A8R8G8B8
'other formats can give strange results !
If Inp.IsKeyPressed(TV_KEY_S) Then '按s键时截取屏幕
TV.ScreenShot App.Path & "\ScreenShot.bmp"
End If
If Inp.IsKeyPressed(TV_KEY_1) Then '将渲染的对象设置为用线来表示
Scene.SetRenderMode TV_LINE
End If
If Inp.IsKeyPressed(TV_KEY_2) Then '将渲染的对象设置为用点来表示
Scene.SetRenderMode TV_POINT
End If
If Inp.IsKeyPressed(TV_KEY_3) Then '将渲染的对象设置为用实体来表示
Scene.SetRenderMode TV_SOLID
End If
If Inp.IsKeyPressed(TV_KEY_UP) Then '按上键前进 (这个TimeElapsed是按键的长短,以便判断要走多久或转多少角度)
Walk = True
PosX = PosX + Cos(ang) * TV.TimeElapsed * 0.09
PosZ = PosZ + Sin(ang) * TV.TimeElapsed * 0.09
End If
If Inp.IsKeyPressed(TV_KEY_DOWN) Then '按下键后退
Walk = True
PosX = PosX - Cos(ang) * TV.TimeElapsed * 0.09
PosZ = PosZ - Sin(ang) * TV.TimeElapsed * 0.09
End If
If Inp.IsKeyPressed(TV_KEY_LEFT) Then '按左键向左转
ang = ang + TV.TimeElapsed * 0.005
End If
If Inp.IsKeyPressed(TV_KEY_RIGHT) Then '按右键向右转
ang = ang - TV.TimeElapsed * 0.005
End If
If Inp.IsKeyPressed(TV_KEY_SUBTRACT) Then
PosY = PosY + TV.TimeElapsed * 0.05
End If
If Inp.IsKeyPressed(TV_KEY_ADD) Then
PosY = PosY - TV.TimeElapsed * 0.05
End If
'更新鼠标移动带来的视角改变
Inp.GetMouseState mx, my, b1
If Abs(mx) > 1 Then
ang = ang - TV.TimeElapsed * 0.001 * mx
End If
' 如果玩家在行走，那么播放行走时的声音。
' 每400ms放一段
If Walk Then
If OldStep < TV.TickCount - 400 Then
OldStep = TV.TickCount
step = Int(Rnd * 4) + 1
mSounds("step" + CStr(step)).Play
End If
End If
If Abs(my) > 1 Then
angy = angy - TV.TimeElapsed * 0.001 * my
If Abs(angy) > 1.52 Then
angy = Sgn(angy) * 1.52
End If
End If
PosY = Land.GetHeight(PosX, PosZ) + 60
UpdateWeapon '更新武器的信息
Scene.SetCamera PosX, PosY, PosZ, PosX + Cos(ang), PosY + Sin(angy), PosZ + Sin(ang) '改变视角
'在屏幕中央画出准星
Scr.DRAW_Texture GetTex("Cross"), mWidth / 2 - 35, mHeight / 2 - 35, mWidth / 2 + 35, mHeight / 2 + 35, , , , , 0.2, 0#, 0.4, 0.2
'将渲染的显示在屏幕上
TV.RenderToScreen
'随着地形高度的改变而改变高度
PosY = Land.GetHeight(PosX, PosZ) + 3
UpdateBarney '确定一下Barney这时要做的行动
Loop Until Inp.IsKeyPressed(TV_KEY_ESCAPE) = True
End
End Sub
Private Sub UpdateWeapon()
Static Shot As Boolean
Dim arcc As Single
Dim bonestr As String
'将武器设置在玩家的眼前，FPS应有的设置
Weapon.SetScale 0.2, 0.2, 0.4 '设置武器的比例
Weapon.SetPosition PosX, PosY, PosZ '设置武器的位置
If angy <> 0 Then
arcc = Atn(Sin(angy))
End If
Weapon.SetRotation 0, 180 - ang * 180 / 3.14, -arcc * 180 / 3.14
' 如果按了鼠标左按键那么就射击,
' 播放射击时的声音, 显示火花,改变枪的动画为"上膛".
If b1 <> 0 And Not Shot Then
Dim FP As D3DVECTOR
mSounds("Shot").Stop_
mSounds("Shot").Play
mSounds("Ammo").Play
FP = VAdd(Vector(PosX, PosY, PosZ), VScale(Vector(Cos(ang), -1, Sin(ang)), 5))
Flash.SetPosition FP.x, FP.y, FP.z
Flash.SetDeathTime 70
Flash.Enable True
Weapon.SetAnimation 1
OldWeapon = TV.TickCount
Shot = True
End If
If Shot And TV.TickCount - OldWeapon > 300 And Not tested Then
' mSounds("Reload").Play
tested = True
' 确定是否Barney被打中. 当他没死时要执行下面的操作.
' Check if he is hit by getting the number of the bone that was hit. If the
' number is larger than zero, a bone of the character's model was hit.
If Not dying Then
Dim bone As Integer
'the 2000 number is the range distance of the weapon
Barney.Collide Vector(PosX, PosY, PosZ), Vector(PosX + Cos(ang) * 2000, PosY + Sin(angy) * 2000, Sin(ang) * 2000 + PosZ), TV_TESTTYPE_MDL_HITBOXES, bone
If bone <> 0 Then
mSounds(" ain").Play
bonestr = Barney.GetBoneNameFromID(bone)
' 被打中的Barney生命值减少. 如果被打中的是头, 那么减少得更多
If InStr(bonestr, "Head") Then
BarneyHealth = BarneyHealth - (30 * Rnd + 80)
Else
BarneyHealth = BarneyHealth - Rnd * 50
End If
' 如果Barney的生命值低于0，那么它就要死了
' 如果Barney的生命值低于-20,他就要死态很惨, 否则仅仅是简单的死态.
' 这些死态都是mdl文件预设的,可以用查看mdl的工具看,TV3D里有
' 如果想自己创建模型,那么3DSMAX+一些插件或MilkShape3D
If BarneyHealth < 0 And Not dying Then
If BarneyHealth < -20 Then
Barney.SetAnimationName "dieviolent"
Else
Barney.SetAnimationName "diesimple"
End If
dying = True '将Barney设为已经死亡
OldAI = TV.TickCount
End If
End If
End If
End If
If Shot And TV.TickCount - OldWeapon > 900 Then
Weapon.SetAnimationName "idle"
Shot = False
tested = False
If BarneyHealth > 0 Then
Barney.SetAnimationName IIf(BarneyWalk = True, "run", "idle")
End If
End If
End Sub
Private Sub Form_Load()
Dim i As Integer
' 载入所有的对象
Set TV = New TVEngine
Set Scene = New TVScene
Set Scr = New TVScreen2DImmediate
Set Land = New TVLandscape
Set TexFactory = New TVTextureFactory
Set MatFactory = New TVMaterialFactory
Set Effects = New TVGraphicEffect
Set mSoundEngine = New TVSoundEngine
Set Weapon = New TVActor
Set Barney = New TVActor
Set ScreenText = New TVScreen2DText
TV.SetAngleSystem TV_ANGLE_DEGREE
TV.SetSearchDirectory App.Path + "\..\..\..\Media\" ' 设置默认的目录，这里是TV3D6.2的共享媒体目录
Set mSounds = mSoundEngine.CreateSounds
mSoundEngine.Init Me.hWnd
' 载入所有的声音在mSound里以调用
For i = 1 To 4
mSounds.AddFile "step" + CStr(i) + ".wav", "Step" + CStr(i)
Next
mSounds.AddFile "shot.wav", "Shot"
mSounds.AddFile "ammo.wav", "Ammo"
mSounds.AddFile "reload.wav", "Reload"
mSounds.AddFile "pain.wav", "Pain"
Me.Show
TV.ShowDriverDialog ' 打开"显示设置对话框
TV.DisplayFPS = True ' 开启显示FPS.
TV.Initialize Me.hWnd ' 在当前窗体载入3D引擎.
TV.GetVideoMode mWidth, mHeight, 0 ' 获得所选的分辨率.
Set Atmosphere = New TVAtmosphere
' 场景的基本设定.
Scene.SetSceneBackGround 0, 0, 0
Scene.SetViewFrustum 90, 2048
'读取贴图. 注 TrueVision 可以读取DDS贴图.
' 你可以用DirectX8 SDK里的 Dxtex delivered 创建DDS贴图.
With TexFactory
.LoadTexture "snow.bmp", "terrain" '地形贴图
.LoadTexture "Sky\Winter\Down.jpg", "Up"
.LoadTexture "Sky\Winter\Left.jpg", "Left"
.LoadTexture "Sky\Winter\Up.jpg", "Down"
.LoadTexture "Sky\Winter\Right.jpg", "Right"
.LoadTexture "Sky\Winter\Front.jpg", "Front"
.LoadTexture "Sky\Winter\Back.jpg", "Back"
.LoadTexture "crosshair.bmp", "Cross", , , TV_COLORKEY_BLACK '准星贴图
.LoadTexture "snowpar.bmp", "Snow", , , TV_COLORKEY_BLACK '雪花贴图
End With
'创建树的贴图
Dim treeTex(2) As Long
treeTex(1) = TexFactory.LoadTexture("tree1_n.dds", , 256, 256, &HFF000000)
treeTex(2) = TexFactory.LoadTexture("tree3c_n.dds", , 256, 256, &HFF000000)
' 将天空加入到所显示的景物里.
Atmosphere.SkyBox_SetTexture GetTex("Front"), GetTex("Back"), GetTex("Left"), GetTex("Right"), GetTex("down"), GetTex("up")
Atmosphere.SkyBox_SetDistance 5
Atmosphere.SkyBox_Enable True
'Scene.SetSkyTexture GetTex("Front"), GetTex("Back"), GetTex("Left"), GetTex("Right"), GetTex("up"), GetTex("down")
'LANSCAPE CREATION
'New function from TrueVision8
'You can load any heightmap (any size)
'and you choose the position and the size of the heightmap in the landscape
'Note that there is a great AffineTerrain function that makes the terrain more curved.
'I use here 4x4 terrains (1024x1024) but you can try numbers like 8 or 16 (4096x4096 !)
'On My computer 4x4 runs at 60FPS and 16x16 runs at 40 FPS !
'The heightmap has values from 0 to 255. You can scale them with this SetFactorY method.
Land.SetFactorY 2
Land.GenerateHugeTerrain "height.jpg", TV_PRECISION_AVERAGE, 8, 8, 0, 0, True
'Create a material and set its properties.
MatFactory.CreateMaterial "terrain"
MatFactory.SetAmbient GetMat("terrain"), 0.2, 0.2, 0.2, 1
MatFactory.SetDiffuse GetMat("terrain"), 1, 1, 1, 1
MatFactory.SetEmissive GetMat("terrain"), 0, 0, 0, 1
' 使用光源引擎创建光源.
Dim L As New TVLightEngine
' L.CreatePointLight Vector(512, 200, 512), 1500, 5, 5, 5, 1
Dim light As D3DLIGHT8
light.Ambient = DXColor(0.8, 1, 1, 1) '光的形态
light.diffuse = DXColor(0.8, 1, 1, 1) '光的传播
light.Direction = Vector(-1, -1, 1) '光的方向
light.Attenuation0 = 0.01 '光的衰减
light.Attenuation1 = 0
light.Type = D3DLIGHT_DIRECTIONAL
L.CreateLight light
' 改变贴图.
Land.SetTextureScale 2, 2
Land.SetTexture GetTex("Terrain")
Land.SetMaterial GetMat("terrain")
' 在地图上随机创建60个板以便载入要创建的树.
Dim x As Single
Dim y As Single
Dim z As Single
Dim Trees(60) As TVMesh
'在地图上创建一些树.
For i = 1 To 60
x = Rnd * 2048
z = Rnd * 2048
y = Land.GetHeight(x, z) + 5
'将每棵树的坐标值计算好后生成,其中x,z坐标是随机的
Set Trees(i) = Scene.CreateBillboard(treeTex(Int(Rnd * 2) + 1), x, y, z, 90, -120)
Trees(i).SetPosition x, y + 35 * 3, z
Trees(i).ComputeSphere
Next
'设置线性地图模式
Scene.SetTextureFilter TV_FILTER_TRILINEAR
' 载入短枪模型
Weapon.Load "v_shotgun.MDL"
Weapon.SetAnimationName "idle"
Weapon.SetSpeed 1
' 载入Barney模型
BarneyHealth = 100
BarneyPos = Vector(500, 200, 500)
With Barney
.Load "barney.mdl"
.SetAnimationName "idle"
.SetScale 1, 1, 1
.SetSpeed 1
.SetPosition BarneyPos.x, BarneyPos.y, BarneyPos.z
.SetRotation -90, 0, 0
End With
' Create a billboard mesh for the flash effect when the gun fires.
Set Flash = Scene.CreateBillboard(TexFactory.LoadTexture("flash.bmp", , , , TV_COLORKEY_BLACK), 0, 0, 0, 10, 10, "Flash", True, D3DBLEND_SRCALPHA, D3DBLEND_ONE)
' 将万家放在地形中央
PosX = 500
PosZ = 500
' 淡化效果. 在3000毫秒内淡入效果
Effects.FadeIn 3000
' 为地形设置雾化效果
Atmosphere.Fog_Enable True
Atmosphere.Fog_SetType TV_FOG_EXP, TV_FOGTYPE_PIXEL
Atmosphere.Fog_SetParameters , , 0.001
Atmosphere.Fog_SetColor 0.3, 0.4, 0.5, 1
'Effects.SetFog True, 0.5, 0.5, 0.5, 1, 100, 1000
Atmosphere.Rain_Init 100, GetTex("Snow"), -4, 0, 0, 2, 30, 4, 100, 5
Atmosphere.Rain_Enable True
' 所有的东西都载入了,现在开始游戏的主循环
MainLoop
End Sub
Private Sub Form_Unload(Cancel As Integer)
' 结束所有的对象
Set Scene = Nothing
Set Scr = Nothing
Set Land = Nothing
Set TexFactory = Nothing
Set MatFactory = Nothing
Set Effects = Nothing
Set mSounds = Nothing
Set mSoundEngine = Nothing
Set Weapon = Nothing
Set Barney = Nothing
Set TV = Nothing
End Sub
|
|
发表于 2006-7-6 14:39:00
楼主
