PureBasic

;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)

Donc si je comprends bien cela oblige à charger la V4 turbo si on veut tester ce prog ?
C'est pousser au vice

Ne me dis pas que tu ne l'as pas encore téléchargée ?

J'ai un message d'erreur: stlport_vc646.dll introuvable !!!

tu peux récupérer le fichier ici

http://www.purebasic.com/beta/

Sympa la démo.

Ne me dis pas que tu ne l'as pas encore téléchargée ?

Pourquoi, il n'y en aura pas pour tout le monde ?

Faut que je me dépèche alors

Frenchy Pilou a écrit :
Ne me dis pas que tu ne l'as pas encore téléchargée ?
Pourquoi, il n'y en aura pas pour tout le monde ?
Faut que je me dépèche alors

Exactement , si tu attends trop , il n'y aura plus assez de bugs pour toi

Bon voilà, c'est fait mais j'ai dû bouculer du monde pour avoir la dernière du magasin

Rigolotte cette sphère en sucre candy qui tourniquotte

Par contre il y a un très léger défaut de blayage horizontal à l'affichage, comme si l'image n'était pas encore arrivée dans le buffer pour être affichée qu'aussitôt une autre prenait sa place ?

Bon voilà, c'est fait mais j'ai dû bousculer du monde pour avoir la dernière du magasin

Rigolotte cette sphère en sucre candy qui tourniquotte

Par contre il y a un très léger défaut de balayage horizontal à l'affichage, comme si l'image n'était pas encore arrivée dans le buffer pour être affichée
qu'aussitôt une autre prenait sa place ?

@Frenchy Pilou: tu begaie ?

C'est l'émotion

Frenchy Pilou a écrit :Par contre il y a un très léger défaut de balayage horizontal à l'affichage, comme si l'image n'était pas encore arrivée dans le buffer pour être affichée
qu'aussitôt une autre prenait sa place ?

Oui j'ai remarqué ça dans le mode fenêtré , par contre dans le mode plein écran , l'affichage est correct.

Je n'y connais rien aux applis windows , j'ai sûrement oublié de faire un truc , ou alors je fais tout de travers ? aucune idée.

Splendide Comtois! t'es vraiment le pro de la 3D

Grave au comptétence de Comtois faudrait faire un projet de jeux en 3D complet grace à Pure

, je sais j'ai de l'espoir

.