Code: Select all
;Comtois 28/03/06
;PB4.0 Beta 7
Resultat = MessageRequester("Sphere 3D","Full Screen ?",#PB_MessageRequester_YesNo)
If Resultat = #PB_MessageRequester_Yes
FullScreen = 1
Else
FullScreen = 0
EndIf
;- Initialisation
If InitEngine3D() = 0
MessageRequester("Erreur" , "Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll", 0)
End
ElseIf InitSprite() = 0 Or InitKeyboard() = 0
MessageRequester("Erreur", "Impossible d'initialiser DirectX 7 Ou plus", 0)
End
EndIf
If Fullscreen
OpenScreen(800, 600, 32, "Sphere 3D")
Else
OpenWindow(0, 0, 0, 800, 600, "Sphere 3D")
OpenWindowedScreen(WindowID(0), 0, 0, 800, 600, 0, 0, 0)
EndIf
Global Angle.f,Pas.f, CameraMode.l
Global *VBuffer,*IBuffer
Global meridien.l,Parallele.l ,PasMorceau.l,Morceau.l
meridien=50
Parallele=50
Pas=0.5
PasMorceau=4
Morceau=0
Structure Vecteur
x.f
y.f
z.f
EndStructure
Structure Vertex
px.f
py.f
pz.f
nx.f
ny.f
nz.f
Couleur.l
U.f
V.f
EndStructure
Structure FTriangle
f1.w
f2.w
f3.w
EndStructure
Macro CALCUL_NORMALE
*PtrV\nx = *PtrV\px
*PtrV\ny = *PtrV\py
*PtrV\nz = *PtrV\pz
EndMacro
Procedure CreateMeshSphere(m,p)
;m = méridien
;p = parallèle
;Le rayon est égal à 1 .
;Recto à supprimer par la suite ,c'est juste pour la démo.
If m<3 Or p<2
ProcedureReturn 0
EndIf
Protected Normale.Vecteur
NbSommet = 2 + ((m + 1) * p)
*VBuffer=AllocateMemory(SizeOf(Vertex) * Nbsommet)
For i = 0 To m
theta.f = i * #PI * 2.0 / m
ctheta.f = Cos(theta)
stheta.f = Sin(theta)
For j = 1 To p
alpha.f = j * #PI / (p + 1)
calpha.f = Cos(alpha)
salpha.f =Sin(alpha)
*PtrV.Vertex = *VBuffer + SizeOf(Vertex) * ((i * p) + (j - 1))
*PtrV\px = salpha * ctheta
*PtrV\py = salpha * stheta
*PtrV\pz = calpha
*PtrV\u = Theta / (2.0 * #PI)
*PtrV\v = alpha / #PI
CALCUL_NORMALE
Next j
Next i
*PtrV.Vertex = *VBuffer + SizeOf(Vertex) * ((m + 1) * p)
;Pole sud
*PtrV\px = 0
*PtrV\py = 0
*PtrV\pz = -1
*PtrV\u = 0
*PtrV\v = 0
CALCUL_NORMALE
*PtrV + SizeOf(Vertex)
;Pole nord
*PtrV\px = 0
*PtrV\py = 0
*PtrV\pz = 1
*PtrV\u = 0
*PtrV\v = 0
CALCUL_NORMALE
;Les facettes
NbTriangle = 4 * m * p
*IBuffer = AllocateMemory(SizeOf(FTriangle) * NbTriangle)
*PtrF.FTriangle = *IBuffer
For i = 0 To m - 1
For j = 1 To p - 1
*PtrF\f1=((i + 1) * p) + j
*PtrF\f2=((i + 1) * p) + (j - 1)
*PtrF\f3=(i * p) + (j - 1)
*PtrF + SizeOf(FTriangle)
*PtrF\f3=((i + 1) * p) + j ;Recto
*PtrF\f2=((i + 1) * p) + (j - 1) ;Recto
*PtrF\f1=(i * p) + (j - 1) ;Recto
*PtrF + SizeOf(FTriangle)
*PtrF\f1=i * p + j
*PtrF\f2=((i + 1) * p) + j
*PtrF\f3=(i * p) + (j - 1)
*PtrF + SizeOf(FTriangle)
*PtrF\f3=i * p + j ;Recto
*PtrF\f2=((i + 1) * p) + j ;Recto
*PtrF\f1=(i * p) + (j - 1) ;Recto
*PtrF + SizeOf(FTriangle)
Next j
Next i
;Les Pôles
For i = 0 To m - 1
*PtrF\f3=(m + 1) * p + 1
*PtrF\f2=(i + 1) * p
*PtrF\f1=i * p
*PtrF + SizeOf(FTriangle)
*PtrF\f1=(m + 1) * p + 1 ;Recto
*PtrF\f2=(i + 1) * p ;Recto
*PtrF\f3=i * p ;Recto
*PtrF + SizeOf(FTriangle)
Next i
For i = 0 To m - 1
*PtrF\f3=(m + 1) * p
*PtrF\f2=i * p + (p - 1)
*PtrF\f1=(i + 1) * p + (p - 1)
*PtrF + SizeOf(FTriangle)
*PtrF\f1=(m + 1) * p ;Recto
*PtrF\f2=i * p + (p - 1) ;Recto
*PtrF\f3=(i + 1) * p + (p - 1) ;Recto
*PtrF + SizeOf(FTriangle)
Next i
If CreateMesh(0, 100)
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
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure Morceau()
NbTriangle = 4 * meridien * Parallele
Morceau + PasMorceau
If morceau >= NbTriangle
PasMorceau = 0
Morceau = Nbtriangle
EndIf
SetMeshData(0, #PB_Mesh_Face, *IBuffer, Morceau)
EndProcedure
;-Mesh
CreateMeshSphere(meridien, Parallele)
;-Texture
CreateTexture(0, 128, 128)
StartDrawing(TextureOutput(0))
For i = 0 To 127 Step 4
Box(0, i , TextureWidth(0), 2, RGB(255,255,255))
Box(0, i + 2, TextureWidth(0), 2, RGB( 0, 0,155))
Next i
StopDrawing()
;-Material
CreateMaterial(0, TextureID(0))
RotateMaterial(0, 0.1, #PB_Material_Animated)
;-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))
Repeat
If fullscreen = 0
If WindowEvent() = #PB_Event_CloseWindow
End
EndIf
EndIf
Angle + Pas
RotateEntity(0, Angle, Angle,Angle)
If PasMorceau > 0
Morceau()
EndIf
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1)
CameraMode = 1 - CameraMode
CameraRenderMode(0, CameraMode)
EndIf
EndIf
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) 
Thanks guys (and dmoc!).
