Code archives/3D Graphics - Effects/Simple Bounding Cubes

This code has been declared by its author to be Public Domain code.

Download source code

Simple Bounding Cubes by N2004
Short description is enough
; ID: 1089
; Author: Noel R. Cower
; Date: 2004-06-17 16:06:49
; Title: Simple Bounding Cubes
; Description: 3D and 2D functions for drawing cubes similar to the bounding boxes in 3ds around entities

Graphics3D 800,600,32,2

C = CreateCamera()
M = CreateCube()
Box = BoundEntity3D(M)
MoveEntity C,-6,5.2,4
PointEntity C,M

L = CreateLight(2)
PositionEntity L,32,32,32
LightRange L,24
LightColor L,200,200,200
CameraClsMode C,0,0
AmbientLight 32,32,32
Repeat
	TurnEntity M,-.5,-.6,-.7
	ScaleEntity M,Abs Sin(Float(MilliSecs())/40)*2,Abs Sin(Float(MilliSecs())/80)*2,Abs Cos(Float(MilliSecs())/160)*2
	PositionEntity M,Sin(Float(MilliSecs())/40)*3,0,Cos(Float(MilliSecs())/40)*5
	
	If KeyHit(57) Then
		Mode = Not Mode
		If Mode = 0 Then
			ShowEntity Box
		Else
			HideEntity Box
		EndIf
	EndIf
	
	If Mode = 0 Then BoundEntity3D M,Box,.2
	UpdateWorld
	Cls
	WireFrame False
	AmbientLight 32,32,32
	CameraClsMode C,0,1
	RenderWorld
	CameraClsMode C,0,0
	WireFrame True
	AmbientLight 255,255,255
	HideEntity Box
	RenderWorld
	If Mode = 0 Then ShowEntity Box
	If Mode = 1 Then BoundEntity2D M,C
	Flip
Until KeyHit(1)

Function BoundEntity3D(Entity,Box = 0,Outline#=.15)
	If Entity = 0 Then Return False
	EClass$ = EntityClass(Entity)
	If Lower(EClass$) <> "mesh" Then Return False

	If Box = 0 Then
		Box = CreateCube()
		EntityFX Box,1+16
		T = CreateTexture(256,256,1+16+32)
		SetBuffer(TextureBuffer(T))
		Color 32,32,32
		Rect 0,0,256,256,1
		Color 0,0,0
		Rect 6,6,256-12,256-12,True
		
		Color 255,255,255
		
		Line 0,0,0,32
		Line 0,255-32,0,255
		
		Line 256,0,256,32
		Line 255,255-32,255,255
		
		Line 0,0,32,0
		Line 255-32,0,255,0
		
		Line 0,255,32,255
		Line 255-32,255,255,255
		
		SetBuffer(BackBuffer())
		EntityTexture Box,T,0,0
		EntityBlend Box,3
		FreeTexture T
	EndIf
	
	Local X#,Y#,Z#,BX#,BY#,BZ#
	X = -999999
	Y = -999999
	Z = -999999
	BX = 999999
	BY = 999999
	BZ = 999999
	
	For Surface = 1 To CountSurfaces(Entity)
		S = GetSurface(Entity,Surface)
		For N = 0 To CountVertices(S)-1
			TFormPoint VertexX(S,N),VertexY(S,N),VertexZ(S,N),Entity,0
			If TFormedX() > X Then
				X = TFormedX()
			ElseIf TFormedX() < BX Then
				BX = TFormedX()
			EndIf
			
			If TFormedY() > Y Then
				Y = TFormedY()
			ElseIf TFormedY() < BY Then
				BY = TFormedY()
			EndIf
			
			If TFormedZ() > Z Then
				Z = TFormedZ()
			ElseIf TFormedZ() < BZ Then
				BZ = TFormedZ()
			EndIf
		Next
	Next
	
	FitMesh Box,X+Outline,Y+Outline,Z+Outline,BX-X-Outline*2,BY-Y-Outline*2,BZ-Z-Outline*2,0
	Return Box
End Function

Function BoundEntity2D(Entity,Camera,Outline=16)
	If Entity = 0 Or Camera = 0 Then Return False
	EClass$ = EntityClass(Entity)
	If Lower(EClass$) <> "mesh" Then Return False

	Local X,Y,BX,BY
	BX = GraphicsWidth()
	BY = GraphicsHeight()
	For Surface = 1 To CountSurfaces(Entity)
		S = GetSurface(Entity,Surface)
		For N = 0 To CountVertices(S)-1
			TFormPoint VertexX(S,N),VertexY(S,N),VertexZ(S,N),Entity,0
			
			CameraProject Camera,TFormedX(),TFormedY(),TFormedZ()
			
			PX = ProjectedX()
			PY = ProjectedY()
			
			If PX > X X = PX
			If PX < BX
				BX = PX
			EndIf
			
			If PY > Y Y = PY
			If PY < BY
				BY = PY
			EndIf
		Next
	Next
	
	X = X + Outline
	Y = Y + Outline
	BX = BX - Outline
	BY = BY - Outline
	
	Line X,Y,X-32,Y
	Line X,Y,X,Y-32
	
	Line BX,BY,BX+32,BY
	Line BX,BY,BX,BY+32
	
	Line BX,Y,BX+32,Y
	Line BX,Y,BX,Y-32
	
	Line X,BY,X-32,BY
	Line X,BY,X,BY+32
End Function

Comments

Neochrome2004
Nice!!! cool for sharing!


Code Archives Forum