Code archives/3D Graphics - Mesh/CreateMySphere

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

Download source code

CreateMySphere by Pepsi2003
a CreateSphere blitz-like function. Does the Same thing. Just wanted to do this to see how to actaully create a sphere with the addvertex/addtriangle commands. Just thought I would share.
; CreateMySphere Example
; ----------------------
; By: Todd Riggins 12-21-2003
;
; a CreateSphere blitz-like function. Does the Same thing. Just wanted to do
; this to see how to actaully create a sphere with the addvertex/addtriangle
; commands. Just thought I would share.
;
; 12-22-2003 Fix: North & South Pole UV coords


; Left sphere is created by the CreateMySphere function.
; Right sphere is created by blitz's CreateSphere command.
;
; Controls:
; - Use mouse to rotate the spheres
; - wireframe toggle 
; - Esc key to escape


Graphics3D 640,480
SetBuffer BackBuffer()

camera=CreateCamera()

light=CreateLight()
RotateEntity light,90,0,0

;earth=LoadTexture("earth.bmp",9)

; enter how many segments the sphere has
segs=24

; Create Blitz Sphere
sphere=CreateSphere(segs)
PositionEntity sphere,1,0,4
;EntityTexture sphere,earth

; Create Sphere manually
mysphere=CreateMySphere(segs)
PositionEntity mysphere,-1,0,4
;EntityTexture mysphere,earth

; key helper
wkey=0

MoveMouse GraphicsWidth()/2,GraphicsHeight()/2

While Not KeyDown( 1 )

	mspx#=MouseXSpeed()
	mspy#=MouseYSpeed()

	If KeyDown(17) And wkey=0
		wkey=1
	EndIf

	If KeyDown(17)=False And wkey=1
		wkey=0
		If wframe=0
			wframe=1
		Else
			wframe=0
		EndIf
		If wframe=0 WireFrame False
		If wframe=1 WireFrame True
	EndIf


	MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
	TurnEntity sphere,0,0,mspx#
	TurnEntity sphere,mspy#,0,0

	TurnEntity mysphere,0,0,mspx#
	TurnEntity mysphere,mspy#,0,0

	RenderWorld
	Flip
Wend

End

; ---------------------------------------------------------
Function CreateMySphere(segments,parent=0)

	If segments<2 Or segments>100 Then Return 0
	
	thissphere=CreateMesh(parent)
	thissurf=CreateSurface(thissphere)

	div#=Float(360.0/(segments*2))
	height#=1.0
	upos#=1.0
	udiv#=Float(1.0/(segments*2))
	vdiv#=Float(1.0/segments)
	RotAngle#=90	

	If segments=2 ; diamond shape - no center strips
	
		For i=1 To (segments*2)
			np=AddVertex(thissurf,0.0,height,0.0,upos#-(udiv#/2.0),0);northpole
			sp=AddVertex(thissurf,0.0,-height,0.0,upos#-(udiv#/2.0),1);southpole
			XPos#=-Cos(RotAngle#)
			ZPos#=Sin(RotAngle#)
			v0=AddVertex(thissurf,XPos#,0,ZPos#,upos#,0.5)
			RotAngle#=RotAngle#+div#
			If RotAngle#>=360.0 Then RotAngle#=RotAngle#-360.0
			XPos#=-Cos(RotAngle#)
			ZPos#=Sin(RotAngle#)
			upos#=upos#-udiv#
			v1=AddVertex(thissurf,XPos#,0,ZPos#,upos#,0.5)
			AddTriangle(thissurf,np,v0,v1)
			AddTriangle(thissurf,v1,v0,sp)	
		Next
		
	Else ; have center strips now
	
		; poles first
		For i=1 To (segments*2)
		
			np=AddVertex(thissurf,0.0,height,0.0,upos#-(udiv#/2.0),0);northpole
			sp=AddVertex(thissurf,0.0,-height,0.0,upos#-(udiv#/2.0),1);southpole
			
			YPos#=Cos(div#)
			
			XPos#=-Cos(RotAngle#)*(Sin(div#))
			ZPos#=Sin(RotAngle#)*(Sin(div#))
			
			v0t=AddVertex(thissurf,XPos#,YPos#,ZPos#,upos#,vdiv#)
			v0b=AddVertex(thissurf,XPos#,-YPos#,ZPos#,upos#,1-vdiv#)
			
			RotAngle#=RotAngle#+div#
			
			XPos#=-Cos(RotAngle#)*(Sin(div#))
			ZPos#=Sin(RotAngle#)*(Sin(div#))
			
			upos#=upos#-udiv#

			v1t=AddVertex(thissurf,XPos#,YPos#,ZPos#,upos#,vdiv#)
			v1b=AddVertex(thissurf,XPos#,-YPos#,ZPos#,upos#,1-vdiv#)
			
			AddTriangle(thissurf,np,v0t,v1t)
			AddTriangle(thissurf,v1b,v0b,sp)	
			
		Next
		
		; then center strips

		upos#=1.0
		RotAngle#=90
		For i=1 To (segments*2)
		
			mult#=1
			YPos#=Cos(div#*(mult#))
			YPos2#=Cos(div#*(mult#+1.0))
			Thisvdiv#=vdiv#
			For j=1 To (segments-2)

				
				XPos#=-Cos(RotAngle#)*(Sin(div#*(mult#)))
				ZPos#=Sin(RotAngle#)*(Sin(div#*(mult#)))

				XPos2#=-Cos(RotAngle#)*(Sin(div#*(mult#+1.0)))
				ZPos2#=Sin(RotAngle#)*(Sin(div#*(mult#+1.0)))
							
				v0t=AddVertex(thissurf,XPos#,YPos#,ZPos#,upos#,Thisvdiv#)
				v0b=AddVertex(thissurf,XPos2#,YPos2#,ZPos2#,upos#,Thisvdiv#+vdiv#)
			
				tempRotAngle#=RotAngle#+div#
			
				XPos#=-Cos(tempRotAngle#)*(Sin(div#*(mult#)))
				ZPos#=Sin(tempRotAngle#)*(Sin(div#*(mult#)))
				
				XPos2#=-Cos(tempRotAngle#)*(Sin(div#*(mult#+1.0)))
				ZPos2#=Sin(tempRotAngle#)*(Sin(div#*(mult#+1.0)))				
			
				temp_upos#=upos#-udiv#

				v1t=AddVertex(thissurf,XPos#,YPos#,ZPos#,temp_upos#,Thisvdiv#)
				v1b=AddVertex(thissurf,XPos2#,YPos2#,ZPos2#,temp_upos#,Thisvdiv#+vdiv#)
				
				AddTriangle(thissurf,v1t,v0t,v0b)
				AddTriangle(thissurf,v1b,v1t,v0b)
				
				Thisvdiv#=Thisvdiv#+vdiv#			
				mult#=mult#+1
				YPos#=Cos(div#*(mult#))
				YPos2#=Cos(div#*(mult#+1.0))
			
			Next
			upos#=upos#-udiv#
			RotAngle#=RotAngle#+div#
		Next

	EndIf

	UpdateNormals thissphere 
	Return thissphere 
End Function

Comments

None.

Code Archives Forum