rmb = place rigid body
lmb = apply force
lmb + ctrl = apply lots of force
wasd + mouselook t 'fly'
lmb = apply force
lmb + ctrl = apply lots of force
wasd + mouselook t 'fly'
;# TOKAMAK DEMO v7 (bradford6) ; Credits: ; SWEENIE for creating the TOKAMAK WRAPPER ; www.tokamakphysics.com to get SDK ; note: ; you must put TOKAMAK.DLL (from SDK) in system32 ; must put sweenies tokamak files in blitz3d/userlibs directory ; thanks to fredborg for the maketokcollider func Graphics3D 800,600,0,2 Global midw = GraphicsWidth()/2 Global midh =GraphicsHeight()/2 SetBuffer BackBuffer() HidePointer WireFrame False Const ENTS=100 ; TOTAL NUMBER OF TOKAMAKPHYSICS ENTITIES Const FPS=50 Const w=17, s=31, a=30, d=32, space=57 Global campiv = CreatePivot() Global camera = CreateCamera(campiv) Global pickmarker = CreateSphere(4) EntityAlpha pickmarker,.75 Global pictentity,pnx#,pny#,pnz#,pcx#,pcy#,pcz# Global latspeed#,speed#,MX#,MY# Global TOKS CameraClsColor(camera,20,20,205) TOKSIM_CreateSimulator(ENTS,1,0,-10,0) ; go and create a generic checkerboard texture to apply to the objects cubetex = create_cube_texture() spheretex = create_sphere_texture() cyltex = create_cyl_texture() worldtex = create_world_texture() world = CreateCube() EntityPickMode world,2 sc# = 50 ScaleMesh world,sc#,sc#,sc# PositionMesh world,0,sc#,0 FlipMesh world EntityTexture world,worldtex maketokcollider(world) Dim obj(ENTS) Dim rb(ENTS) SeedRnd MilliSecs() ; add-------------------------------------------------------------------------- ;create_TOK_BOX(xs#,ys#,zs#,xp#,yp#,zp#,damp#,angdamp#,mass#,iw#,ih#,id#,imass#, texture) ;create_TOK_BOX(8,1,8,0,5,0,0.0025,.125,4,cubetex) xs#=32 iw#=xs# ys#=1 ih#=ys# zs#=8 id#=zs# mass# = 2 imass# = mass# create_TOK_BOX(xs#,ys#,zs#,0,6,0,0.001,0.002,mass#,8,3,8,imass#,cubetex,"box") ;create_TOK_BALL(segs,sc#,xp#,yp#,zp#,angdamp#,lindamp#,mass#,IT1#,IT2#) ; # create tokamak sphere create_TOK_BALL(7,4,0,4,-4,0.002,0.001,2.0,1.0,.5,spheretex,"ball") create_TOK_BALL(7,4,0,4,4,0.002,0.001,2.0,1.0,.5,spheretex,"ball2") ;TOKRB_SetTorque(rb(toks),5,0,0) joint1 = TOKJOINT_Create(2,rb(toks-2),rb(toks-1)) TOKJOINT_SetType(joint1,1) TOKJOINT_SetPositionWorld(joint1,0,4,-4) TOKJOINT_Enable(joint1,True) joint2 = TOKJOINT_Create(2,rb(toks-2),rb(toks)) TOKJOINT_SetType(joint2,1) TOKJOINT_SetPositionWorld(joint2,0,4,4) TOKJOINT_Enable(joint2,True) ;joint3 = TOKJOINT_Create(1,rb(toks),0) ;TOKJOINT_SetType(joint3,1) ;TOKJOINT_SetPositionWorld(joint3,0,0,8) ;TOKJOINT_Enable(joint3,True) ;joint4 = TOKJOINT_Create(1,rb(toks-1),0) ;TOKJOINT_SetType(joint4,1) ;TOKJOINT_SetPositionWorld(joint4,0,0,-8) ;TOKJOINT_Enable(joint4,True) ;create_TOK_CYL(segs,,height#,radius#,xp#,yp#,zp#,angdamp#,lindamp#,mass#,IT1#,IT2#,IT3#,texture) create_TOK_BALL(12,4,0,6,0,0.002,0.001,2.0,1.0,.5,spheretex,"ball3") create_TOK_BOX(4,2,4,0,8,0,0.001,0.002,2,2,2,2,imass#,cubetex,"box2") create_TOK_BOX(2,2,2,0,8,-4,0.01,0.0002,2,2,2,2,imass#,cubetex,"box3") ; add-------------------------------------------------------------------------- Centerpivot = CreatePivot() light=CreateLight() PositionEntity light,7,15,-5 PointEntity light,Centerpivot rot#=0 period=600/FPS time=MilliSecs()-period imptime=MilliSecs() camx#=Cos(rot#)*50 camz#=Sin(rot#)*50 ;rot#=rot#+0.05 If rot#>360 Then rot#=0 PositionEntity campiv,camx#,40,camz# PointEntity campiv,centerpivot ; +++ MAIN LOOP START ++++++ MAIN LOOP START ++++++ MAIN LOOP START ++++++ MAIN LOOP START +++ 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 TOKSIM_Advance(1.75/FPS) move_camera() UpdateWorld Next ; Not sure wether to put this here or inside the for/next above... For i=1 To TOKS If TOKRB_IsIdle(rb(i)) Then EntityAlpha obj(i),0.5 Else EntityAlpha obj(i),1.0 TOKRB_Active(rb(i),True) EndIf If EntityName(obj(i)) = "ball" ; do stuff EndIf If EntityName(obj(i)) = "box" ;If MouseDown(2) = 1 Then TOKRB_ApplyTwist(rb(i),0,150,0) EndIf If MouseDown(2) = 1 Then place_rb(cubetex) 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(1)=1 Then push_rigid_body() RenderWorld tween Color 255,255,255 Text 0,0,"Physics Time:"+TOKSIM_GetPhysicsTime()*1000.0+ " milliseconds" Text 0,10,"Render Time:"+Str(elapsed)+ " milliseconds" Text 0,20,"pnx"+pnx#+" pny "+pny#+" pnz "+pnz# ;Text 0,30,"Render Time:"+Str(elapsed)+ " milliseconds" Text 0,40,"pitch:"+EntityPitch(campiv) ;Text 0,50,"Render Time:"+Str(elapsed)+ " milliseconds" Color 255,0,0 Rect midw-4,midh-4,8,8,0 Flip False Wend ; == MAIN LOOP END ==== MAIN LOOP End ==== MAIN LOOP End ==== MAIN LOOP End ==== MAIN LOOP End == TOKSIM_DestroySimulator() End ;================================================================================== 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 campiv,MY#,-MX#,0 ; turn camera up and down ;TurnEntity campiv,0,-MX#,0 ; turn nnn left --right RotateEntity campiv,EntityPitch(campiv),EntityYaw(campiv),0 If EntityPitch(campiv)>88 Then RotateEntity campiv,88,EntityYaw(campiv),EntityRoll(campiv) If EntityPitch(campiv)<-88 Then RotateEntity campiv,-88,EntityYaw(campiv),EntityRoll(campiv) MoveMouse 100,100 MoveEntity campiv,latspeed#,0,speed# End Function ;================================================================================== Function create_cube_texture() tex = CreateTexture(64,64) ScaleTexture tex,.5,.5 SetBuffer TextureBuffer(tex) Color 20,20,200 Rect 0,0,64,64 Color 255,255,255 Rect 0,0,32,32 Rect 32,32,64,64 Color 0,0,0 Rect 0,0,64,64,0 SetBuffer BackBuffer() Return tex End Function Function create_world_texture() tex = CreateTexture(128,128) ScaleTexture tex,.25,.25 SetBuffer TextureBuffer(tex) Color 100,100,100 Rect 0,0,128,128 Color 50,50,50 Rect 0,0,64,64 Rect 64,64,128,128 Color 200,200,0 Rect 0,0,128,128,0 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 Color 0,0,0 Rect 0,0,64,64,0 Color 0,0,0 Rect 64,64,128,128,0 Color 0,0,0 Rect 0,0,128,128,0 ScaleTexture tex,.5,.5 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 campick() pictentity = 0 CameraPick(camera,midw,midh) pictentity = PickedEntity() If Pictentity<>0 ;EntityAlpha pictentity,.7 pnx# = PickedNX#() pny# = PickedNY#() pnz# = PickedNZ#() pcx# = PickedX#() pcy# = PickedY#() pcz# = PickedZ#() EndIf End Function Function create_TOK_BOX(xs#,ys#,zs#,xp#,yp#,zp#,damp#,angdamp#,mass#,iw#,ih#,id#,imass#,texture,name$) TOKS = TOKS+1 If TOKS>ENTS TOKS = ENTS Return EndIf obj(TOKS) = CreateCube() NameEntity obj(toks),name$ ScaleEntity obj(TOKS),xs#/2,ys#/2,zs#/2 EntityPickMode obj(TOKS),2 EntityTexture obj(TOKS),texture rb(TOKS) = TOKRB_Create() TOKRB_SetSleepingParameter(rb(TOKS),-100) 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),iw#,ih#,id#,imass# End Function Function create_TOK_BALL(segs,sc#,xp#,yp#,zp#,angdamp#,lindamp#,mass#,IT1#,IT2#,texture,name$) TOKS = TOKS+1 If TOKS>ENTS TOKS = ENTS Return EndIf obj(TOKS) = CreateSphere(segs) NameEntity obj(toks),name$ 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),IT1#,IT2# End Function Function create_TOK_CYL(segs,height#,radius#,xp#,yp#,zp#,angdamp#,lindamp#,mass#,IT1#,IT2#,IT3#,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),IT1#,IT2#,IT3# End Function ;================================================================================== Function place_rb(tex) campick() If pictentity>0 PositionEntity pickmarker,pcx#,pcy#,pcz# ;create_TOK_BOX(xs#,ys#,zs#,xp#,yp#,zp#,damp#,angdamp#,mass#,iw#,ih#,id#,imass#,texture,name$) create_TOK_BOX(4,4,4,pcx#,pcy#+2,pcz#,0.001,0.002,2,4,4,4,2,tex,"foo") Repeat : Until MouseDown(2) = 0 EndIf End Function ;================================================================================== ;================================================================================== Function push_rigid_body() campick() For n = 1 To TOKS If pictentity = obj(n) i = n If KeyDown(29) Or KeyDown(157) TOKRB_ApplyImpulse2 rb(i),-pnx#*15,-pny#*15,-pnz#*15,pcx#,pcy#,pcz# Else TOKRB_ApplyImpulse2 rb(i),-pnx#,-pny#,-pnz#,pcx#,pcy#,pcz# ;TOKRB_ApplyImpulse rb(i),-pnx#,pny#,-pnz# EndIf EndIf Next End Function ;================================================================================== 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