I was bored...

Community Forums/Showcase/I was bored...

Rob Farley

(Posted 2007) [#1]

Graphics3D 1680,1050,32,1


SetBuffer BackBuffer()


Type Cubes
	Field Mesh
	Field Phys
End Type


Function NewCube()
	C.Cubes = New Cubes
	C\Mesh = CreateCube()
	EntityColor C\Mesh,Rand(100,255),Rand(100,255),Rand(100,255)
	C\Phys = CreatePivot()
	PositionEntity C\Phys,Rnd(-1,1),Rnd(2,5),Rnd(-1,1)
	TurnEntity c\phys,Rnd(-10,10),Rnd(-10,10),Rnd(-10,10)
	EntityShininess c\mesh,1
End Function

Function UpdateCubes()

	count = 0
	For c.Cubes = Each Cubes
		TranslateEntity c\Mesh,EntityX(c\phys),EntityY(c\phys),EntityZ(c\phys)
		TurnEntity c\mesh,EntityPitch(c\phys),EntityYaw(c\phys),EntityRoll(c\phys)
		
		TranslateEntity c\phys,0,-.01,0
		
		If EntityY(c\mesh)<0 Then
			If Abs(EntityY(c\phys))<.05 Then
				FreeEntity c\mesh
				FreeEntity c\phys
				Delete c
			Else
				PositionEntity c\mesh,EntityX(c\mesh),0,EntityZ(c\mesh)
				TranslateEntity c\phys,0,-EntityY(c\phys)*1.5,0			
			EndIf
		EndIf
		count = count + 1
	Next
	
	Return count
End Function

Ground = CreatePlane()
i = CreateImage(2,2)
SetBuffer(ImageBuffer(i))
Color 0,0,255:Plot 0,0:Plot 1,0:Plot 1,1
Color 255,255,255:Plot 0,1
t = CreateTexture(2,2)
CopyRect 0,0,2,2,0,0,ImageBuffer(i),TextureBuffer(t)
ScaleTexture t,50,50
EntityTexture ground,t
EntityAlpha ground,.9

m = CreateMirror()
PositionEntity m,0,-.1,0

SetBuffer BackBuffer()

piv = CreatePivot()
Camera = CreateCamera(piv)
light = CreateLight()
TurnEntity light,45,45,0
PositionEntity camera,0,30,-200

frame = 0
t=MilliSecs()
fps# = 0

Repeat
	Newcube()
	Count = updateCubes()
	TurnEntity piv,0,.1,0
	RenderWorld
	frame = frame + 1
	If frame = 10 Then
		fps = (10.0 / (MilliSecs() - t)) * 1000
		frame = 0
		t=MilliSecs()
	EndIf
	
	Text 0,0,"Cubes: " + count
	Text 0,20," FPS: " + fps
	Flip False
	
Until KeyHit(1)

John Blackledge

(Posted 2007) [#2]

Love it to bits! <Grab>

Xzider

(Posted 2007) [#3]

Thats pretty cool for so little code:)

Rob Farley

(Posted 2007) [#4]

Slight variation on a theme...

Graphics3D 1680,1050,32,1




Ground = CreatePlane()
i = CreateImage(64,64)
SetBuffer(ImageBuffer(i))
Color 0,0,255:Rect 0,0,32,32:Rect 32,32,32,32
Color 0,100,255:Rect 32,0,32,32:Rect 0,32,32,32
checker = CreateTexture(64,64)
CopyRect 0,0,64,64,0,0,ImageBuffer(i),TextureBuffer(checker )
FreeImage i
ScaleTexture checker ,50,50
EntityTexture ground,checker 
EntityAlpha ground,.9

i = CreateImage(256,256)
SetBuffer(ImageBuffer(i))
Color 150,150,150:Rect 0,0,256,256
For n=0 To 3
Color 255,0,0:Rect 0,n*64,256,16
Next
Color 255,255,255
Global balltex = CreateTexture(256,256)
CopyRect 0,0,256,256,0,0,ImageBuffer(i),TextureBuffer(balltex )
FreeImage i



SetBuffer BackBuffer()

Type Cubes
	Field Mesh
	Field Phys
End Type


Function NewCube()
	C.Cubes = New Cubes
	C\Mesh = CreateSphere(6)
	C\Phys = CreatePivot()
	PositionEntity C\Phys,Rnd(-1,1),Rnd(1,2),Rnd(-1,1)
	TurnEntity c\mesh,Rnd(0,360),Rnd(0,360),Rnd(0,360)
	EntityShininess c\mesh,1
	EntityTexture c\mesh,balltex
End Function

Function UpdateCubes()

	count = 0
	For c.Cubes = Each Cubes
		TranslateEntity c\Mesh,EntityX(c\phys),EntityY(c\phys),EntityZ(c\phys)
		
		
		XAngleAdjust# = EntityX(c\phys) * (180.0/Pi) 
		YAngleAdjust# = EntityZ(c\phys) * (180.0/Pi)
		TurnEntity c\mesh,YAngleAdjust#,0,-XAngleAdjust#,True
		
		TurnEntity c\mesh,EntityPitch(c\phys),EntityYaw(c\phys),EntityRoll(c\phys)
		
		TranslateEntity c\phys,0,-.01,0
		
		If EntityY(c\mesh)<1 Then
			If Abs(EntityY(c\phys))<.05 And EntityInView(c\mesh,camera)=False Then
				FreeEntity c\mesh
				FreeEntity c\phys
				Delete c
			Else
				PositionEntity c\mesh,EntityX(c\mesh),1,EntityZ(c\mesh)
				TranslateEntity c\phys,0,-EntityY(c\phys)*1.5,0			
			EndIf
		EndIf
		count = count + 1
	Next
	
	Return count
End Function



m = CreateMirror()
PositionEntity m,0,-.1,0

piv = CreatePivot()
Global Camera = CreateCamera(piv)
light = CreateLight()
TurnEntity light,45,45,0
PositionEntity camera,0,30,-200

frame = 0
t=MilliSecs()
fps# = 0

Repeat
	Newcube()
	Count = updateCubes()
	TurnEntity piv,0,.1,0
	RenderWorld
	frame = frame + 1
	If frame = 10 Then
		fps = (10.0 / (MilliSecs() - t)) * 1000
		frame = 0
		t=MilliSecs()
	EndIf
	
	Text 0,0,"Cubes: " + count
	Text 0,20," FPS: " + fps
	Flip False
	
Until KeyHit(1)

Fuller

(Posted 2007) [#5]

man! talk about a stress test!
leave it on for an hour and tell me what FPS you get...

LineOf7s

(Posted 2007) [#6]

Very nice. :o)

You lose points for not making those balls the classic Amiga one, though. ;o)

Rob Farley

(Posted 2007) [#7]

leave it on for an hour and tell me what FPS you get...

It cleans itself up... It's house trained! It'll reach a point where it's deleting as fast as it creates.

You lose points for not making those balls the classic Amiga one, though. ;o)

I was considering it actually!

Rob Farley

(Posted 2007) [#8]

And here's your stress test and amiga balls!

It keeps the FPS around 30 fps.

Graphics3D 1680,1050,32,1

Ground = CreatePlane()
i = CreateImage(64,64)
SetBuffer(ImageBuffer(i))
Color 0,0,255:Rect 0,0,32,32:Rect 32,32,32,32
Color 0,100,255:Rect 32,0,32,32:Rect 0,32,32,32
checker = CreateTexture(64,64)
CopyRect 0,0,64,64,0,0,ImageBuffer(i),TextureBuffer(checker )
FreeImage i
ScaleTexture checker ,50,50
EntityTexture ground,checker 
;EntityAlpha ground,.9

i = CreateImage(256,256)
SetBuffer(ImageBuffer(i))
Color 250,250,250:Rect 0,0,256,256

For y=0 To 3
For x=0 To 3

Color 255,0,0
Rect x*64,y*64,32,32
Rect x*64+32,y*64+32,32,32


Next
Next

;SetBuffer FrontBuffer():DrawBlock i,0,0:WaitKey:End

Color 255,255,255
Global balltex = CreateTexture(256,256)
CopyRect 0,0,256,256,0,0,ImageBuffer(i),TextureBuffer(balltex )
FreeImage i



SetBuffer BackBuffer()

Type Cubes
	Field Mesh
	Field Phys
End Type


Function NewCube()
	C.Cubes = New Cubes
	C\Mesh = CreateSphere(6)
	C\Phys = CreatePivot()
	PositionEntity C\Phys,Rnd(-1,1),Rnd(1,2),Rnd(-1,1)
	TurnEntity c\mesh,Rnd(0,360),Rnd(0,360),Rnd(0,360)
	EntityShininess c\mesh,1
	EntityTexture c\mesh,balltex
End Function

Function UpdateCubes()

	count = 0
	For c.Cubes = Each Cubes
		TranslateEntity c\Mesh,EntityX(c\phys),EntityY(c\phys),EntityZ(c\phys)
		
		
		XAngleAdjust# = EntityX(c\phys) * (180.0/Pi) 
		YAngleAdjust# = EntityZ(c\phys) * (180.0/Pi)
		TurnEntity c\mesh,YAngleAdjust#,0,-XAngleAdjust#,True
		
		TurnEntity c\mesh,EntityPitch(c\phys),EntityYaw(c\phys),EntityRoll(c\phys)
		
		TranslateEntity c\phys,0,-.01,0
		
		If EntityY(c\mesh)<1 Then
			If EntityInView(c\mesh,camera)=False Then
				FreeEntity c\mesh
				FreeEntity c\phys
				Delete c
			Else
				PositionEntity c\mesh,EntityX(c\mesh),1,EntityZ(c\mesh)
				TranslateEntity c\phys,0,-EntityY(c\phys)*1.5,0			
			EndIf
		EndIf
		count = count + 1
	Next
	
	Return count
End Function



;m = CreateMirror()
;PositionEntity m,0,-.1,0

piv = CreatePivot()
Global Camera = CreateCamera(piv)
light = CreateLight()
TurnEntity light,45,45,0
PositionEntity camera,0,30,-200

frame = 0
t=MilliSecs()
fps# = 100

flow = 1
peak = 0
tripeak = 0



Repeat

	If fps > 30 Then flow = flow + 1
	If fps <= 30 Then flow = 0
	
	For n=1 To flow
		newcube()
	Next


	Count = updateCubes()
	
	If count > peak Then peak = count
	If TrisRendered() > tripeak Then tripeak = TrisRendered()
	
	TurnEntity piv,0,.1,0
	RenderWorld
	frame = frame + 1
	If frame = 10 Then
		fps = (10.0 / (MilliSecs() - t)) * 1000
		frame = 0
		t=MilliSecs()
	EndIf
	

	Text 0,000," Entities: " + count
	Text 0,020,"     Peak: " + peak
	Text 0,050,"Triangles: " + TrisRendered()
	Text 0,070,"     Peak: " + tripeak
	Text 0,100,"      FPS: " + fps
	Text 0,120,"     Flow: " + flow
	Flip False
	
Until KeyHit(1)

Nice_But_Dim

(Posted 2007) [#9]

Nice stress test for Blitz
very good Rob.

Be Well

John Blackledge

(Posted 2007) [#10]

Please keep on being bored.

puki	(Posted 2007) [#11]

Heh, I know what is going on here.

AJirenius

(Posted 2007) [#12]

I have my suspicions as well :D

John Blackledge

(Posted 2007) [#13]

Puki/Andreas - enlighten us.

big10p

(Posted 2007) [#14]

I think they're talking about GrahamK converting these stress tests to Cobra, over on Syntax Bomb, in order to see how it compares to B3D.

AJirenius

(Posted 2007) [#15]

oh, I wouldn't blame GrahamK for anything like that. He has really been a gentleman treating everything even nearly concerning B3D with utterly respect. I'm impressed with his humble approuch and concerns about letting noone even try to bashing down on anyone elses engine.
But I do sense some competetive awareness among other people. (do that even make sense grammatically?)

Sledge

(Posted 2007) [#16]

This kind of test wouldn't convince me of anything. Pretty though.