Code archives/3D Graphics - Mesh/Meshes, surfaces, vertices, triangles

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

Download source code

Meshes, surfaces, vertices, triangles by Graythe2003
Hi. I needed hollow half spheres for my `game thang` that would act just like the real BB generated spheres. I elected to try to make one using BB because I'm even worse at modelling than I am at programming. Whaddya know? I succeeded.
[code]
;Hollowed half sphere function by Graythe@2003

;What the hell - some constants
Const One%=1,Two%=2
;Pre-declare vertex array
Dim VertArray(False)

;Initialise Blitz display
Graphics3D 640,480,32,2:SetBuffer BackBuffer()
;Create a camera and some light
Camera=CreateCamera(): Light=CreateLight(Camera)

;Set up a pivot (something to attach entities to - you don't really neeeeed this but pivots are handy and require few resources)
SpherePivot=CreatePivot()





;I want to create a half of a sphere - so to start create a whole one
Sphere=CreateSphere(64,SpherePivot)


;Copy 50% of the triangles in our sphere as though it were bisected 
Copied_Sphere=AdjustTriangles(Sphere,0.5,False)
;Now create the inside of the sphere by doing the same thing again
Internal_Sphere=AdjustTriangles(Sphere,0.5,True)
;Flip the second creation (inside out) to finish the `inside effect`
FlipMesh Internal_Sphere

;Plop that in front of the camera
PositionEntity SpherePivot,False,False,2.5


;Repeat until escape key is pressed
While Not KeyDown(One)

	;Make our hollowed - half sphere rotate
	TurnEntity SpherePivot,One,False,False

	;Tell Blitz to paint the awesome scene
	RenderWorld

	;Update the display
	Flip

Wend


;Program ends here
End






Function AdjustTriangles%(EntityNo%,Triangles#,FreeSource%=True,FX%=False)

;The arguments passed are
	;EntityNo% A handle to the source entity that we will alter
	;Triangle# A ratio (0.0 to 1.0) of the existing triangles that this function will process
	;FreeSource A binary switch to indicate wether or not to delete the source mesh when finished
	;FX an bitmask of affects to the appearence of objects

;Conjur virgin mesh
Copied=CreateMesh(GetParent(EntityNo))

;Iterate surfaces of supplied mesh
For SurfLoop=One To CountSurfaces(EntityNo)
	
	;Add a surface to our new mesh
	NewSurface=CreateSurface(Copied)
	;Establish handle to source surface
	OldSurface=GetSurface(EntityNo,SurfLoop)
	;Determine number of vertices in source surface
	NoVertices=CountVertices(OldSurface)-One

	;Calculate new triangle total
	TotTriangles=Int(CountTriangles(OldSurface)*Triangles)-One
	
	;Determine relevent vertices by creating an array of all vertices and tipping to true those that are connected to an included triangle
	Dim VertArray%(NoVertices)
	;Iterate the triangles that we are interested in
	For TriLoop=False To TotTriangles
		;Iterate the three vertices of this triangle
		For CornerLoop=False To Two
			;Tip the array ident calculated by the vertex number of this corner the triangle
			VertArray(TriangleVertex(OldSurface,TriLoop,CornerLoop))=True
		Next
	Next
	
	;Iterate vertices
	For VertLoop = False To NoVertices
		;If the array ident for this vertex number was tipped
		If VertArray(VertLoop) Then
			;Copy this vertex from the old surface to the new surface
			NewVertex=AddVertex(NewSurface,VertexX(OldSurface,VertLoop),VertexY(OldSurface,VertLoop),VertexZ(OldSurface,VertLoop),VertexU(OldSurface,VertLoop),VertexV(OldSurface,VertLoop),VertexW(OldSurface,VertLoop))
		End If
	Next		
		
	;Add Triangles
	For TriLoop=False To TotTriangles
		AddTriangle NewSurface, TriangleVertex(OldSurface,TriLoop,False),TriangleVertex(OldSurface,TriLoop,One),TriangleVertex(OldSurface,TriLoop,Two)
	Next	

Next
;Release (most) space allocated the array
Dim VertArray(0)
;Update vertex normals
UpdateNormals Copied
;Apply EntityFX
If FX Then EntityFX Copied,FX
;Free source entity?
If FreeSource Then FreeEntity EntityNo

;Return new mesh handle
Return Copied

End Function
[/code]

Comments

None.

Code Archives Forum