Tokamak Physics

Blitz3D Forums/Blitz3D Programming/Tokamak Physics

bradford6
 #1
here is another one

WASD to move
mouselook

mousedown to 'shoot' cubes in your crosshair

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

Text 0,0,"Physics Time:"+GetPhysicsTime()*1000.0+ " milliseconds"
Text 0,10,"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()
	CameraPick(camera,midw,midh)
	If PickedEntity()<>0
	pictentity = PickedEntity() 
	EntityAlpha pictentity,.7	
		
	
	EndIf
	

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

Function shoot_cannon()
		
		campick()
	 	For n = 1 To ENTS
			If pictentity = obj(n)
				i = n
			EndIf
		Next
		
 		RBApplyImpulse rb(i),Rnd(0.1,-6.0),Rnd(2,8),Rnd(-1.1,-5.1) 
	

End Function