I was bored...

Miscellaneous Forums/Blitz Showcase/I was bored...

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

Love it to bits! <Grab>

Xzider

Thats pretty cool for so little code:)

Rob Farley

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

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

LineOf7s

Very nice. :o)

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

Rob Farley

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

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

Nice stress test for Blitz
very good Rob.

Be Well

John Blackledge

#10

Please keep on being bored.

puki

#11

Heh, I know what is going on here.

AJirenius

#12

I have my suspicions as well :D

John Blackledge

#13

Puki/Andreas - enlighten us.

big10p

#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

#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

#16

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