Code : Tout sélectionner
;Comtois 03/02/06
;PB4.0 Beta 1
Resultat = MessageRequester("Sphere 3D","Full Screen ?",#PB_MessageRequester_YesNo)
If Resultat = 6
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 ,#PB_Window_ScreenCentered ,"Sphere 3D" )
OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0)
EndIf
Macro MaCouleur(Rouge,Vert,Bleu)
Rouge << 16 + Vert << 8 + Bleu
EndMacro
Macro CalculNormale
Normale\x=*PtrV\px
Normale\y=*PtrV\py
Normale\z=*PtrV\pz
Normalise(@Normale)
*PtrV\nx=Normale\x
*PtrV\ny=Normale\y
*PtrV\nz=Normale\z
EndMacro
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 Facette
P1.Vertex
P2.vertex
P3.Vertex
P4.Vertex
EndStructure
Structure FTriangle
f1.w
f2.w
f3.w
EndStructure
Procedure Normalise(*N.Vecteur)
Norme.f=Sqr(*N\x * *N\x + *N\y * *N\y + *N\z * *N\z)
If Norme = 0.0
*N\x = 0.0
*N\y = 0.0
*N\z = 0.0
Else
*N\x / Norme
*N\y / Norme
*N\z / Norme
EndIf
EndProcedure
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*3.14159*2.0/m
ctheta.f=Cos(theta)
stheta.f=Sin(theta)
For j=1 To p
Coul=MaCouleur(Random(255),Random(255),Random(255))
alpha.f =j*3.14159/(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
CalculNormale
*PtrV\couleur=Coul
*PtrV\u=Theta/(2.0*3.14159)
*PtrV\v=alpha/3.14159
Next j
Next i
*PtrV.Vertex = *VBuffer + SizeOf(Vertex) * ((m+1)*p)
;Pole sud
*PtrV\px=0
*PtrV\py=0
*PtrV\pz=-1
CalculNormale
*PtrV\Couleur=MaCouleur(Random(255),Random(255),Random(255))
*PtrV\u=0
*PtrV\v=0
*PtrV + SizeOf(Vertex)
;Pole nord
*PtrV\px=0
*PtrV\py=0
*PtrV\pz=1
CalculNormale
*PtrV\Couleur=MaCouleur(Random(255),Random(255),Random(255))
*PtrV\u=0
*PtrV\v=0
;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
ClearScreen(0)
If fullscreen = 0
While WindowEvent() : Wend
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)
