PureBasic Forums - English

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)     

Code: Select all

---------------------------
PureBasic0.exe - Unable To Locate Component
---------------------------
This application has failed to start because stlport_vc646.dll was not found. Re-installing the application may fix this problem. 
---------------------------
OK   
---------------------------

Code: Select all

---------------------------
Erreur
---------------------------
Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll
---------------------------
OK   
---------------------------

Code: Select all

;-Texture
CreateTexture(0,128, 128)
StartDrawing(TextureOutput(0))
  For i = 0 To 127 Step 8
  Box(0,i,TextureWidth(0),1,RGB(255,255,255))
  Box(0,i+1,TextureWidth(0),1,RGB(0,0,155))
  Next i
StopDrawing()

;-Material
CreateMaterial(0,TextureID(0))
MaterialBlendingMode(0,#PB_Material_Add)
RotateMaterial(0,0.1,#PB_Material_Animated)