Hey IPete, took the libery of expanding this a bit and adding in a slow motion mode, looks pretty good. Stick this in the same folder again. Hit 'm' to start slow motion, plus and minus on the numpad effects the speed of the slow motion:
; TOKAMAK TERRAIN DEMO V4
; Bill Radford
; uses TOKAMAK PHYSICS www.tokamakphysics.com
; Thanks to Sweenie for his excellent Tokamak wrapper
; requires tokamak wrapper v.02
; Also thanks to Arkon for motion Blur code from the
; code arcs.
; BulletTime added 24.1.2004 by IPete2
; SlowMo added 24.1.2004 by AL
Graphics3D 800,600,32
HidePointer
WireFrame False
; CONSTANTS
Const FPS=50
Const w=17, s=31, a=30, d=32, space=57
Const ENTS=400
Const ANIM_BODS = 1
Const GRAV_X# = 0
Const GRAV_Y# = -11
Const GRAV_Z# = 0
; ARRAYS
Dim obj(ENTS)
Dim rb(ENTS)
; GLOBALS
Global TOKS,shot_timer,force#,tokcounter
Global midw = GraphicsWidth()/2
Global midh =GraphicsHeight()/2
Global latspeed#,speed#,MX#,MY#
Global pictentity,pnx#,pny#,pnz#
; set up centre point for bullet time focussing and hide it
Global centrepoint=CreateCube()
EntityAlpha centrepoint,0
PositionEntity centrepoint,0,40,0
Global BulletTime = 0 ; begins off
Global slowmo# = 0.2
Global slowmo_enabled = 0
; SETUP 3D SCENE
Global camera = CreateCamera()
PositionEntity camera,3,38,-17
createblurimage
light=CreateLight()
AmbientLight 210,210,212
PositionEntity light,0,20,0
;PointEntity light,Camera
;CREATE TOKAMAK SIMULATION
TOKSIM_CreateSimulator(ENTS,ANIM_BODS,GRAV_X#,GRAV_Y#,GRAV_Z#)
; LOAD and CREATE 3d assets and textures
world = LoadMesh("tokatest4c.b3d")
maketokcollider(world)
cubetex = create_cube_texture()
spheretex = create_sphere_texture()
cyltex = create_cyl_texture()
SeedRnd MilliSecs()
rot#=0
period=1000/FPS
time=MilliSecs()-period
imptime=MilliSecs()
; MainLoop
While Not KeyHit(1)
Repeat
elapsed=MilliSecs()-time
Until elapsed
ticks=elapsed/period
tween#=Float(elapsed Mod period)/Float(period)
For k=1 To ticks
time=time+period
If k=ticks Then CaptureWorld
If BulletTime = 0 Then
If slowmo_enabled = 0 Then
TOKSIM_Advance(1.5/FPS)
Else
TOKSIM_Advance(slowmo/FPS)
End If
End If
; Time the release of new RIGID BODIES
spawn_counter=spawn_counter+1
If spawn_counter=20 ; every n ticks
spawn_counter=0
xplace# = Rnd(1.1,26.1)
yplace# = Rnd(80.1,90.1)
zplace# = Rnd(9.1,40.1)
rb_type = Rnd(1,3)
Select rb_type
Case 1 ; create a ball
size# = Rnd(2.0,4.1)/2
;create_TOK_BALL(segs=12,sc#=2,xp#=0,yp#=5,zp#=0,angdamp#=0.02,lindamp#=0.001,mass#=2,IT1#=2,IT2#=2,texture)
create_TOK_BALL(8,size#,xplace#,yplace#,zplace#,0.02,0.001,size#,size#,size#*.75,spheretex)
Case 2 ; create a cylinder
;create_TOK_CYL(segs=9,height#=2,radius#=2,xp#=0,yp#=16,zp#=0,angdamp#=0.02,lindamp#=0.001,mass#=2,ITh#=2.0,ITd#=2.0,itm#=2.0,texture)
create_TOK_CYL(8,1,1,xplace#,yplace#,zplace#,0.02,0.001,1,2,2,2,cyltex)
Case 3 ; create a box
size# = Rnd(2.0,4.1)/2
szx#=size# szy#=size# szz#=size#
lin_damp# = 0.002 ang_damp# = 0.02 mass#= Rnd(1.5,3.5)
ITWidth#=size# ITheight#=size# ITdepth#=size# ITMass#=mass#
; create_TOK_CYL(segs=12,height#=2,radius#=2,xp#=0,yp#=16,zp#=0,angdamp#=0.02,lindamp#=0.001,mass#=2,IT1#=2.0,IT2#=2.0,IT3#=2.0,texture=cubetex)
create_TOK_BOX(szx#,szy#,szz#,xplace#,yplace#,zplace#,ang_damp#,lin_damp,mass#,ITWidth#,ITheight#,ITdepth#,ITMass#,cubetex)
End Select
EndIf
move_camera()
UpdateWorld
Next
If KeyHit(48) Then BulletTime = 1 - BulletTime
If KeyHit(50) Then slowmo_enabled = 1 - slowmo_enabled
If KeyHit(78) And slowmo < 1.5 Then
slowmo = slowmo + 0.01
Else If KeyHit(74) And slowmo > 0.1
slowmo = slowmo - 0.01
End If
If BulletTime = 1 Then
Goto bulletEnd
Else
; only do stuff to ENTS that have been spawned...> TOKS...
For i=1 To TOKS
;If TOKRB_IsIdle(rb(i)) Then
;EntityAlpha obj(i),0.5
;Else
EntityAlpha obj(i),1.0
;EndIf
PositionEntity obj(i),TOKRB_GetX#(rb(i)),TOKRB_GetY#(rb(i)),TOKRB_GetZ#(rb(i))
RotateEntity obj(i),TOKRB_GetPitch#(rb(i)),TOKRB_GetYaw#(rb(i)),TOKRB_GetRoll#(rb(i)),False
Next
If MouseDown(2) = 1
campick()
shoot_cannon()
EndIf
If MouseDown(1)=1 Then fire_rigid_body(cubetex)
If KeyHit(57) Then
; i=Rnd(1,ENTS)
For i=1 To toks
TOKRB_ApplyImpulse rb(i),Rnd(-3.0,3.0),Rnd(15,30),Rnd(-3.0,3.0)
;TOKRB_ApplyImpulse2 rb(i),Rnd(-15.0,15.0),30.0,Rnd(-15.0,15.0),TOKRB_GetX#(rb(i))+0.5,TOKRB_GetY#(rb(i))-0.5,TOKRB_GetZ#(rb(i))+0.5
; TOKRB_ApplyTwist rb(i),40,0,0
;TOKRB_SetTorque rb(i),7,0,0
; TOKRB_SetForce rb(i),0,0,-2
; TOKRB_SetForce2 rb(i),0,0,-10,TOKRB_GetX#(rb(i))+0.5,TOKRB_GetY#(rb(i))-1.5,TOKRB_GetZ#(rb(i))+0.5
; TOKRB_SetTorque rb(i),30,30,30
Next
EndIf
EndIf
.bulletEnd
If bullettime=1 Then
EntityParent camera,centrepoint
If KeyHit(2) Then PointEntity camera,centrepoint
TurnEntity centrepoint,0,-.25,0
EndIf
RenderWorld tween
updateblur .5
If KeyHit(59) Then f1 = 1 -f1
If f1 = 0
Text 0,0,"Physics Time:"+TOKSIM_GetPhysicsTime()*1000.0+ " milliseconds"
Text 0,16,"Render Time:"+Str(elapsed)+ " milliseconds"
Text 0,32,"TOTAL RIGID BODIES = "+TOKS
Text 0,48,"camera X : "+EntityX(camera)+" Y : "+EntityY(camera)+" Z : "+EntityZ(camera)
;Text 0,64,"cam pitch : "+EntityPitch(camera)+" Yaw : "+EntityYaw(camera)+" roll : "+EntityRoll(camera)
Text 0,80,"Left Mouse = FIRE! RIGHT MOUSE= PUSH Rigid Body"
Text 0,112," F1 to TOGGLE INFO"
Text 0,140, "Hit B for bullet time : "+bullettime
Text 0,150, "Hit M to enable slow mo, +/- to alter Slow Mo : " + slowmo + " (enabled = " + slowmo_enabled + ")"
EndIf
Color 225,225,255
Plot midw,midh
Flip False
Wend
TOKSIM_DestroySimulator()
End
;==================================================================================
Function campick()
pictentity = 0
CameraPick(camera,midw,midh)
pictentity = PickedEntity()
If Pictentity<>0
EntityAlpha pictentity,.5
pnx# = PickedNX#()
pny# = PickedNY#()
pnz# = PickedNZ#()
EndIf
End Function
;==================================================================================
Function shoot_cannon()
campick()
For n = 1 To toks
If pictentity = obj(n)
i = n
TOKRB_ApplyImpulse rb(i),-pnx#,pny#*2,-pnz#
EndIf
Next
End Function
;==================================================================================
Function create_cube_texture()
tex = CreateTexture(128,128)
SetBuffer TextureBuffer(tex)
Color 255,255,0
Rect 0,0,128,128
Color 0,0,255
Rect 0,0,64,64
Rect 64,64,128,128
SetBuffer BackBuffer()
Return tex
End Function
;==================================================================================
Function create_sphere_texture()
tex = CreateTexture(128,128)
SetBuffer TextureBuffer(tex)
Color 0,200,0
Rect 0,0,128,128
Color 255,255,0
Rect 0,0,64,64
Rect 64,64,128,128
SetBuffer BackBuffer()
Return tex
End Function
;==================================================================================
Function create_cyl_texture()
tex = CreateTexture(128,128)
SetBuffer TextureBuffer(tex)
Color 0,0,0
Rect 0,0,128,128
Color 255,0,0
Rect 0,0,64,64
Rect 64,64,128,128
SetBuffer BackBuffer()
Color 255,255,0 ; YELLOW
Return tex
End Function
;==================================================================================
Function CurveValue#(newvalue#,oldvalue#,increments# )
If increments>1 Then oldvalue#=oldvalue#-(oldvalue#-newvalue#)/increments
If increments<=1 Then oldvalue=newvalue
Return oldvalue#
End Function
;==================================================================================
Function move_camera()
; Movement controls
If KeyDown(w)=1 Then speed# = speed#+.03
If KeyDown(a)=1 Then latspeed# = latspeed# - .02
If KeyDown(s)=1 Then speed# = speed# -.03
If KeyDown(d)=1 Then latspeed# = latspeed# + .02
latspeed#=latspeed#*.98
speed#=speed#*.98
MY#=CurveValue#(MouseYSpeed(),MY#,3 )
MX#=CurveValue#(MouseXSpeed(),MX#,3 )
TurnEntity camera,MY#,-MX#,0 ; turn camera up and down
;TurnEntity campiv,0,-MX#,0 ; turn nnn left --right
RotateEntity camera,EntityPitch(camera),EntityYaw(camera),0
MoveMouse 100,100
MoveEntity camera,latspeed#,0,speed#
End Function
Function create_TOK_BOX(xs#,ys#,zs#,xp#,yp#,zp#,lin_damp#,ang_damp#,mass#,ITw#=2.0,ITh#=2.0,ITd#=2.0,ITm#=2.0,texture)
TOKS = TOKS+1
If TOKS>ENTS
TOKS = ENTS
Return
EndIf
obj(TOKS) = CreateCube()
ScaleEntity obj(TOKS),xs#/2,ys#/2,zs#/2
EntityPickMode obj(TOKS),2
EntityTexture obj(TOKS),texture
rb(TOKS) = TOKRB_Create()
TOKRB_AddBox rb(TOKS),xs#,ys#,zs#
TOKRB_SetPosition(rb(TOKS),xp#,yp#,zp#)
TOKRB_SetLinearDamping rb(TOKS),damp#
TOKRB_SetAngularDamping rb(TOKS),angdamp#
TOKRB_SetMass rb(TOKS),mass#
TOKRB_SetBoxInertiaTensor rb(TOKS),ITw#,ITh#,ITd#,ITm#
End Function
;==================================================================================
Function create_TOK_BALL(segs=12,sc#=2,xp#=0,yp#=5,zp#=0,angdamp#=0.02,lindamp#=0.001,mass#=2,ITd#=2,ITm#=2,texture)
TOKS = TOKS+1
If TOKS>ENTS
TOKS = ENTS
Return
EndIf
obj(TOKS) = CreateSphere(segs)
ScaleEntity obj(TOKS),sc#/2,sc#/2,sc#/2
EntityPickMode obj(TOKS),2
EntityTexture obj(TOKS),texture
rb(TOKS) = TOKRB_Create()
TOKRB_AddSphere rb(TOKS),sc#
TOKRB_SetPosition(rb(TOKS),xp#,yp#,zp#)
TOKRB_SetAngularDamping rb(TOKS),angdamp#
TOKRB_SetLinearDamping rb(TOKS),lindamp#
TOKRB_SetMass rb(TOKS),mass#
TOKRB_SetSphereInertiaTensor rb(TOKS),ITd#,ITm#
End Function
;==================================================================================
Function create_TOK_CYL(segs=9,height#=2,radius#=2,xp#=0,yp#=16,zp#=0,angdamp#=0.02,lindamp#=0.001,mass#=2,ITh#=2.0,ITd#=2.0,itm#=2.0,texture)
TOKS = TOKS+1
If TOKS>ENTS
TOKS = ENTS
Return
EndIf
obj(TOKS) = CreateCylinder(segs)
EntityPickMode obj(TOKS),2
EntityTexture obj(TOKS),texture
rb(TOKS) = TOKRB_Create()
TOKRB_AddCylinder rb(TOKS),height#,radius#
ScaleEntity obj(TOKS),radius#/1.95,height#,radius#/1.95
TOKRB_SetPosition(rb(TOKS),xp#,yp#,zp#)
TOKRB_SetAngularDamping rb(TOKS),angdamp#
TOKRB_SetLinearDamping rb(TOKS),lindamp#
TOKRB_SetMass rb(TOKS),mass#
TOKRB_SetCylinderInertiaTensor rb(TOKS),ITh#,ITd#,ITm#
End Function
;==================================================================================
Function fire_rigid_body(texture)
shot_timer = shot_timer+1
If shot_timer>20
force# = Rnd(20,80)
shot_timer=1
xplace# = EntityX(camera)
yplace# = EntityY(camera)
zplace# = EntityZ(camera)
size# = 2
szx#=size# szy#=size# szz#=size#
lin_damp# = 0.002 ang_damp# = 0.02 mass#= Rnd(1.5,3.5)
ITWidth#=size# ITheight#=size# ITdepth#=size# ITMass#=mass#
; create_TOK_CYL(segs=12,height#=2,radius#=2,xp#=0,yp#=16,zp#=0,angdamp#=0.02,lindamp#=0.001,mass#=2,IT1#=2.0,IT2#=2.0,IT3#=2.0,texture=cubetex)
If TOKS<ENTS
create_TOK_BOX(szx#,szy#,szz#,xplace#,yplace#,zplace#,ang_damp#,lin_damp,mass#,ITWidth#,ITheight#,ITdepth#,ITMass#,texture)
TOKRB_ApplyImpulse rb(TOKS),-(Sin(EntityYaw(camera))*force#),-(Sin(EntityPitch(camera))*force#),Cos(EntityYaw(camera))*force#
TOKRB_ApplyTwist rb(TOKS),Rnd(-40.0,40.0),Rnd(-40.0,40.0),Rnd(-40.0,40.0)
Else
tokcounter = tokcounter + 1
If tokcounter = ENTS Then tokcounter = 1
TOKRB_SetPosition rb(tokcounter),xplace#,yplace#,zplace#
TOKRB_ApplyImpulse rb(tokcounter),-(Sin(EntityYaw(camera))*force#),-(Sin(EntityPitch(camera))*force#),Cos(EntityYaw(camera))*force#
TOKRB_ApplyTwist rb(tokcounter),Rnd(-40.0,40.0),Rnd(-40.0,40.0),Rnd(-40.0,40.0)
EndIf
EndIf
End Function
; shot timer
Function MakeTokCollider(mesh)
scount=CountSurfaces(mesh)
For ind=1 To scount
surface=GetSurface(mesh,ind)
ttltris=ttltris+CountTriangles(surface)
ttlvert=ttlvert+CountVertices(surface)
Next
vertices=CreateBank(16*ttlvert)
triangles=CreateBank(24*ttltris)
offsetv=0
offsett=0
For ind=1 To scount
surface = GetSurface(mesh,ind)
ctr=CountTriangles(surface)
tric=tric+cvt
cvt=CountVertices(surface)
;fill bank with vertices
For v=0 To cvt-1
PokeFloat vertices,offsetv,VertexX#(surface,v)
PokeFloat vertices,offsetv+4,VertexY#(surface,v)
PokeFloat vertices,offsetv+8,VertexZ#(surface,v)
PokeFloat vertices,offsetv+12,0.0
offsetv=offsetv+16
Next
;fill bank with triangles
For v=0 To ctr-1
PokeInt triangles,offsett,tric+TriangleVertex(surface,v,0)
PokeInt triangles,offsett+4,tric+TriangleVertex(surface,v,1)
PokeInt triangles,offsett+8,tric+TriangleVertex(surface,v,2)
PokeInt triangles,offsett+12,0
PokeInt triangles,offsett+16,0
PokeInt triangles,offsett+20,0
offsett=offsett+24
Next
Next
;Hand over the terrain data to Tokamak
TOKSIM_SetTerrainMesh vertices,ttlvert,triangles,ttltris
; Now we can free the banks as Tokamak has copied all data
FreeBank vertices
FreeBank triangles
End Function
Global ark_blur_image, ark_blur_texture, ark_sw, ark_sh
Function CreateBlurImage()
ark_sw = GraphicsWidth()
ark_sh = GraphicsHeight()
;Create sprite
Local spr = CreateMesh(camera)
Local sf = CreateSurface(spr)
AddVertex sf, -1, 1, 0, 0, 0
AddVertex sf, 1, 1, 0, 1, 0
AddVertex sf, -1, -1, 0, 0, 1
AddVertex sf, 1, -1, 0, 1, 1
AddTriangle sf, 0, 1, 2
AddTriangle sf, 3, 2, 1
EntityFX spr, 17
ScaleEntity spr, 1024.0 / Float(ark_sw), 1024.0 / Float(ark_sw), 1
PositionEntity spr, 0, 0, 1.0001
EntityOrder spr, -100000
EntityBlend spr, 1
ark_blur_image = spr
;Create blur texture
ark_blur_texture = CreateTexture(1024, 1024, 256)
EntityTexture spr, ark_blur_texture
End Function
Function UpdateBlur(power#)
EntityAlpha ark_blur_image, power#
CopyRect ark_sw / 2 - 512, ark_sh / 2 - 512, 1024, 1024, 0, 0, BackBuffer(), TextureBuffer(ark_blur_texture)
End Function
|