Anonymous user
Draw a sphere: Difference between revisions
→{{header|Liberty BASIC}}
Line 331:
end
</lang>
==={{header|PureBasic}}===
3D Sphere animation.
<lang PureBasic>; Original by Comtois @ 28/03/06
;
; Updated/Formated by Fluid Byte @ March.24,2009
;
; http://www.purebasic.fr/english/viewtopic.php?p=281258#p281258
Declare CreateSphere(M,P)
Declare UpdateMesh()
#_SIZEVERT = 36
#_SIZETRIS = 6
#FULLSCREEN = 0
Structure VECTOR
X.f
Y.f
Z.f
EndStructure
Structure VERTEX
X.f
Y.f
Z.f
NX.f
NY.f
NZ.f
Color.l
U.f
V.f
EndStructure
Structure TRIANGLE
V1.w
V2.w
V3.w
EndStructure
Macro CALC_NORMALS
*PtrV\NX = *PtrV\X
*PtrV\NY = *PtrV\Y
*PtrV\NZ = *PtrV\Z
EndMacro
Global *VBuffer, *IBuffer
Global Meridian = 50, Parallele = 50, PasLength = 4, Length
Define EventID, i, NbSommet, CameraMode, Angle.f, Pas.f = 0.5
InitEngine3D() : InitSprite() : InitKeyboard()
Add3DArchive(GetTemporaryDirectory(),#PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "Examples\Sources\Data\",#PB_3DArchive_FileSystem)
If #FULLSCREEN
OpenScreen(800,600,32,"Sphere 3D")
Else
OpenWindow(0,0,0,800,600,"Sphere 3D",#PB_Window_SystemMenu | 1)
OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0)
EndIf
;-Texture
CreateImage(0,128,128)
StartDrawing(ImageOutput(0))
For i = 0 To 127 Step 4
Box(0,i,ImageWidth(0),2,RGB(255,255,255))
Box(0,i + 2,ImageWidth(0),2,RGB(0,0,155))
Next i
StopDrawing()
SaveImage(0,GetTemporaryDirectory() + "temp.bmp") : FreeImage(0)
;-Material
CreateMaterial(0,LoadTexture(0,"temp.bmp"))
RotateMaterial(0,0.1,#PB_Material_Animated)
;-Mesh
CreateSphere(Meridian,Parallele)
;-Entity
CreateEntity(0,MeshID(0),MaterialID(0))
ScaleEntity(0,60,60,60)
;-Camera
CreateCamera(0,0,0,100,100)
MoveCamera(0,0,0,-200)
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))
;-Light
AmbientColor(RGB(105, 105, 105))
CreateLight(0, RGB(255, 255, 55), EntityX(0) + 150, EntityY(0) , EntityZ(0))
CreateLight(1, RGB( 55, 255, 255), EntityX(0) - 150, EntityY(0) , EntityZ(0))
CreateLight(2, RGB( 55, 55, 255), EntityX(0) , EntityY(0) + 150, EntityZ(0))
CreateLight(3, RGB(255, 55, 255), EntityX(0) , EntityY(0) - 150, EntityZ(0))
; ----------------------------------------------------------------------------------------------------
; MAINLOOP
; ----------------------------------------------------------------------------------------------------
Repeat
If #FULLSCREEN = 0
Repeat
EventID = WindowEvent()
Select EventID
Case #PB_Event_CloseWindow : End
EndSelect
Until EventID = 0
EndIf
Angle + Pas
RotateEntity(0, Angle, Angle,Angle)
If PasLength > 0 : UpdateMesh() : EndIf
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1)
CameraMode = 1 - CameraMode
CameraRenderMode(0, CameraMode)
EndIf
EndIf
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
; ----------------------------------------------------------------------------------------------------
; FUNCTIONS
; ----------------------------------------------------------------------------------------------------
Procedure CreateSphere(M,P)
; M = Meridian
; P = Parallele
; The radius is 1. Front to remove it later, it's just for the demo.
If M < 3 Or P < 2 : ProcedureReturn 0 : EndIf
Protected Normale.VECTOR, NbSommet, i, j, Theta.f, cTheta.f, sTheta.f
Protected Alpha.f, cAlpha.f, sAlpha.f, *PtrV.VERTEX, *PtrF.TRIANGLE, NbTriangle
NbSommet = 2 + ((M + 1) * P)
*VBuffer = AllocateMemory(#_SIZEVERT * Nbsommet)
For i = 0 To M
Theta = i * #PI * 2.0 / M
cTheta = Cos(theta)
sTheta = Sin(theta)
For j = 1 To P
Alpha = j * #PI / (P + 1)
cAlpha = Cos(Alpha)
sAlpha = Sin(Alpha)
*PtrV = *VBuffer + #_SIZEVERT * ((i * P) + (j - 1))
*PtrV\X = sAlpha * cTheta
*PtrV\Y = sAlpha * sTheta
*PtrV\Z = cAlpha
*PtrV\U = Theta / (2.0 * #PI)
*PtrV\V = Alpha / #PI
CALC_NORMALS
Next j
Next i
; Southpole
*PtrV = *VBuffer + #_SIZEVERT * ((M + 1) * P)
*PtrV\X = 0
*PtrV\Y = 0
*PtrV\Z = -1
*PtrV\U = 0
*PtrV\V = 0
CALC_NORMALS
; Northpole
*PtrV + #_SIZEVERT
*PtrV\X = 0
*PtrV\Y = 0
*PtrV\Z = 1
*PtrV\U = 0
*PtrV\V = 0
CALC_NORMALS
; Les facettes
NbTriangle = 4 * M * P
*IBuffer = AllocateMemory(#_SIZETRIS * NbTriangle)
*PtrF = *IBuffer
For i = 0 To M - 1
For j = 1 To P - 1
*PtrF\V1 = ((i + 1) * P) + j
*PtrF\V2 = ((i + 1) * P) + (j - 1)
*PtrF\V3 = (i * P) + (j - 1)
*PtrF + #_SIZETRIS
*PtrF\V3 = ((i + 1) * P) + j ;Recto
*PtrF\V2 = ((i + 1) * P) + (j - 1) ;Recto
*PtrF\V1 = (i * P) + (j - 1) ;Recto
*PtrF + #_SIZETRIS
*PtrF\V1 = i * P + j
*PtrF\V2 = ((i + 1) * P) + j
*PtrF\V3 = (i * P) + (j - 1)
*PtrF + #_SIZETRIS
*PtrF\V3 = i * P + j ;Recto
*PtrF\V2 = ((i + 1) * P) + j ;Recto
*PtrF\V1 = (i * P) + (j - 1) ;Recto
*PtrF + #_SIZETRIS
Next j
Next i
; The Poles
For i = 0 To M - 1
*PtrF\V3 = (M + 1) * P + 1
*PtrF\V2 = (i + 1) * P
*PtrF\V1 = i * P
*PtrF + #_SIZETRIS
*PtrF\V1 = (M + 1) * P + 1 ;Recto
*PtrF\V2 = (i + 1) * P ;Recto
*PtrF\V3 = i * P ;Recto
*PtrF + #_SIZETRIS
Next i
For i = 0 To M - 1
*PtrF\V3 = (M + 1) * P
*PtrF\V2 = i * P + (P - 1)
*PtrF\V1 = (i + 1) * P + (P - 1)
*PtrF + #_SIZETRIS
*PtrF\V1 = (M + 1) * P ;Recto
*PtrF\V2 = i * P + (P - 1) ;Recto
*PtrF\V3 = (i + 1) * P + (P - 1) ;Recto
*PtrF + #_SIZETRIS
Next i
If CreateMesh(0,100)
Protected Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
SetMeshData(0,Flag,*VBuffer,NbSommet)
SetMeshData(0,#PB_Mesh_Face,*IBuffer,NbTriangle)
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Procedure UpdateMesh()
Protected NbTriangle = 4 * Meridian * Parallele
Length + PasLength
If Length >= NbTriangle
PasLength = 0
Length = Nbtriangle
EndIf
SetMeshData(0,#PB_Mesh_Face,*IBuffer,Length)
EndProcedure</lang>
[[image:PB_Animated_sphere.png]]
===[[QBasic]]===
| |||