Tokamak Physics

Blitz3D Forums/Blitz3D Programming/Tokamak Physics

The forum is locked. These are the original blitzbasic.com forums, kept so they can still be read. No new topics, replies or edits can be made here. To join in, head over to the Blitz3D+ forums.

bradford6
 #1
heres another before I go to bed:

WASD to move around
mouselook

click on an entity to push it.
it uses pick normals so it will move away from the camera.

;# TOKAMAK DEMO v4 (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




Const FPS=50
Const w=17, s=31, a=30, d=32, space=57

Global latspeed#,speed#,MX#,MY#

Graphics3D 800,600,0,2
Global midw = GraphicsWidth()/2
Global midh =GraphicsHeight()/2
SetBuffer BackBuffer()
HidePointer 
WireFrame False

Const ENTS=60

Global campiv = CreatePivot()
Global camera = CreateCamera(campiv)
Global pictentity,pnx#,pny#,pnz#
CameraClsColor(camera,20,20,205)


CreateSimulator(ENTS,5,0,-10,0)



ground = CreateCube()
EntityColor ground,55,55,55 
ScaleEntity ground,50,5,50 
PositionEntity ground,0,-5,0
abground = CreateAB()
ABAddBox(abground,100.0,10.0,100.0)
ABSetPosition(abground,0.0,-5.0,0.0)

wall1 = CreateCube()
EntityColor wall1,25,25,55 
ScaleEntity wall1,2,10,50 
PositionEntity wall1,50,0,0
abwall1 = CreateAB()
ABAddBox(abwall1,4.0,20.0,100.0)
ABSetPosition(abwall1,50.0,0,0.0)

wall2 = CreateCube()
EntityColor wall2,25,25,55 
ScaleEntity wall2,2,10,50 
PositionEntity wall2,-50,0,0
abwall2 = CreateAB()
ABAddBox(abwall2,4.0,20.0,100.0)
ABSetPosition(abwall2,-50.0,0,0.0)

wall3 = CreateCube()
EntityColor wall3,25,25,55 
ScaleEntity wall3,50,10,2 
PositionEntity wall3,0,0,-50
abwall3 = CreateAB()
ABAddBox(abwall3,100.0,20.0,4.0)
ABSetPosition(abwall3,0.0,0,-50.0)

wall4 = CreateCube()
EntityColor wall4,25,25,55 
ScaleEntity wall4,50,10,2 
PositionEntity wall4,0,0,50
abwall4 = CreateAB()
ABAddBox(abwall4,100.0,20.0,4.0)
ABSetPosition(abwall4,0.0,0,50.0)


Dim obj(ENTS)
Dim rb(ENTS)

SeedRnd MilliSecs()  

; go and create a generic checkerboard texture to apply to the objects
cubetex = create_cube_texture()
spheretex = create_sphere_texture()
cyltex = create_cyl_texture()

; add--------------------------------------------------------------------------
entcount = 0
height_var#=1.5
For i=1 To ENTS
	count = count + 1
			
	zpos# = count*2
	If count>10
		height_var# = height_var# + 2
		count = 0
	EndIf
	nr=Rnd(1,3)		
 	If nr=1 Then
	 		obj(i) = CreateCube()
			EntityPickMode obj(i),2
			EntityTexture obj(i),cubetex
			rb(i) = CreateRB()
			RBAddBox rb(i),2.0,2.0,2.0
			RBSetPosition(rb(i),x#,height_var#,zpos#)
			RBSetLinearDamping rb(i),0.001
			RBSetMass rb(i),2.0
			RBSetBoxInertiaTensor rb(i),2.0,2.0,2.0,2.0 
	ElseIf nr=2 ; CREATE Sphere objects
  			  obj(i) = CreateSphere()
			  EntityPickMode obj(i),2

			  EntityTexture obj(i),spheretex
			  rb(i) = CreateRB()
			  RBAddSphere rb(i),1.8
			  RBSetPosition(rb(i),x#,height_var#,zpos#)
			  RBSetAngularDamping rb(i),0.02 
			  RBSetLinearDamping rb(i),0.001 
			  RBSetMass rb(i),2.0
			  RBSetSphereInertiaTensor rb(i),2.0,1.8  
	 ElseIf nr=3 ; CREATE CYLINDERS actually Capsules or elongated spheres
			  obj(i) = CreateCylinder()
   			 EntityPickMode obj(i),2
  			 EntityTexture obj(i),cyltex
			  rb(i) = CreateRB()
			  RBAddCylinder rb(i),2.0,1.0
			  RBSetPosition(rb(i),x#,height_var#,zpos#)
			  RBSetAngularDamping rb(i),0.02 
			  RBSetLinearDamping rb(i),0.001 
			  RBSetMass rb(i),2.0
			  RBSetCylinderInertiaTensor rb(i),2.0,1.0,2.0  
	EndIf
	 
	
	
	 
Next

; add--------------------------------------------------------------------------

Centerpivot = CreatePivot()

light=CreateLight()
PositionEntity light,7,15,-5
PointEntity light,Centerpivot

rot#=0

period=1000/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

		Advance(1.5/FPS)

move_camera()

	UpdateWorld

	Next

; Not sure wether to put this here or inside the for/next above...
For i=1 To ENTS
 If RBIsIdle(rb(i)) Then
  ;aEntityAlpha obj(i),0.2
 Else
  EntityAlpha obj(i),1.0
 EndIf

 PositionEntity obj(i),RBGetX#(rb(i)),RBGetY#(rb(i)),RBGetZ#(rb(i)) 
 RotateEntity obj(i),RBGetPitch#(rb(i)),RBGetYaw#(rb(i)),RBGetRoll#(rb(i)),False
Next



If MouseDown(1) Then shoot_cannon()

RenderWorld tween
Color 255,255,255
Text 0,0,"Physics Time:"+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,"Render Time:"+Str(elapsed)+ " milliseconds"
;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 ==


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

MoveMouse 100,100

MoveEntity campiv,latspeed#,0,speed#
	


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 campick()
	pictentity = 0
	CameraPick(camera,midw,midh)
	pictentity = PickedEntity() 
	If Pictentity<>0
		
		EntityAlpha pictentity,.7	
		pnx# = PickedNX#()
		pny# = PickedNY#()
		pnz# = PickedNZ#()	
	
	EndIf
	

End Function
;==================================================================================

Function shoot_cannon()
		
		campick()
	 	For n = 1 To ENTS
			If pictentity = obj(n)
				i = n
				RBApplyImpulse rb(i),-pnx#,pny#,-pnz#
			EndIf
		Next
		
 		
	
		
End Function