Code archives/3D Graphics - Mesh/CreateMySphere
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
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