PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Morphing 3D

https://www.purebasic.fr/english/viewtopic.php?t=21634

Page 1 of 2

Morphing 3D

Posted: Sat May 06, 2006 1:35 pm
by Comtois

Code: Select all

;Comtois 07/05/06
;PB4.0 Beta 11
;32 formes 3D

;Site intéressant pour choisir une couleur
;http://pourpre.com/chroma/dico.php?typ=alpha

;Pour obtenir d'autres formes
;http://www.mathcurve.com/surfaces/surfaces.shtml

Texte$ = "Morphing 3D"

Resultat = MessageRequester(Texte$,"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
EndIf
   
If InitSprite() = 0 Or InitKeyboard() = 0
   MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
   End
EndIf

If Fullscreen
   ExamineDesktops()
   Sx = DesktopWidth(0)
   Sy = DesktopHeight(0)
   Sd = DesktopDepth(0)
  OpenScreen(Sx, Sy,Sd, Texte$)
Else
  OpenWindow(0,0, 0, 800 , 600 ,Texte$,#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0)
EndIf

Structure s_Vecteur
   x.f
   y.f
   z.f
EndStructure

Structure Vertex
   px.f
   py.f
   pz.f
   nx.f
   ny.f
   nz.f
   co.l
   U.f
   V.f
EndStructure

Structure FTriangle
   f1.w
   f2.w
   f3.w
EndStructure

Global Angle.f,Pas.f, CameraMode.l
Global *VBuffer,*IBuffer
Global b.f, k.f
Global NbSommet, NbTriangle, Forme3D

#E = 2.71828182
#NombreForme3D = 32
Forme3D = 31

NbSommet = 25000
NbTriangle = NbSommet

Global Dim Final.s_Vecteur(NbSommet)
Global Dim Intermediaire.Vertex(NbSommet)
*IBuffer = AllocateMemory(SizeOf(FTriangle) * NbTriangle)

Procedure.f Exp(value.f)
  ProcedureReturn Pow(#E, value)
EndProcedure

Procedure CoordonneesPoint(t,u.f,v.f,*Point.s_Vecteur)
   Select t
      Case 1 ;
         *Point\x = (3 + Cos(u)) * Cos(u)
         *Point\y = (3 + Cos(v)) * Sin(u)
         *Point\z = Sin(v)
                            
      Case 2 ; Astroide
         *Point\x = 4 * Cos(u) * Cos(u) * Cos(u) * Cos(v) * Cos(v) * Cos(v)
         *Point\y = 4 * Sin(u) * Sin(u) * Sin(u) * Cos(v) * Cos(v) * Cos(v)
         *Point\z = 4 * Sin(v) * Sin(v) * Sin(v)   

      Case 3 ; Tore
         *Point\x = (3 + Cos(v)) * Cos(u)
         *Point\y = (3 + Cos(v)) * Sin(u)
         *Point\z = Sin(v)
                 
      Case 4 ; Sphere
         *Point\x = 3 * Cos(u) * Cos(v)
         *Point\y = 3 * Sin(u) * Cos(v)
         *Point\z = 3 * Sin(v)
         
      Case 5 ; Cylindre creux
         *Point\x = 3 * Cos(u) * Cos(u)
         *Point\y = 3 * Cos(u) * Sin(u)
         *Point\z = 3 * Sin(v)
     
      Case 6 ;
         *Point\x = 3 * Cos(v) * Cos(u)
         *Point\y = 3 * Cos(v) * Sin(u)
         *Point\z = 3 * Sin(u)   

      Case 7 ;
         *Point\x = 3 * Cos(v) * Cos(v)
         *Point\y = 3 * Cos(v) * Sin(u)
         *Point\z = 3 * Sin(v)
         
      Case 8 ;
         *Point\x = 3 * Cos(u) * Cos(v)
         *Point\y = 3 * Sin(u) * Sin(v)
         *Point\z = 3 * Sin(u)
     
      Case 9 ;
         *Point\x = 3 * Cos(u) * Cos(v)
         *Point\y = 3 * Sin(u) * Sin(u)
         *Point\z = 3 * Sin(v)
         
      Case 10 ; Plan
         *Point\x = 3 * Cos(u) * Cos(u)
         *Point\y = 3 * Sin(u) * Sin(u)
         *Point\z = 3 * Sin(v)   
                 
      Case 11 ;
         *Point\x = 3 * Sin(u) * Cos(u)
         *Point\y = 3 * Sin(u) * Sin(v)
         *Point\z = 3 * Sin(v)
         
      Case 12 ;
         *Point\x = 3 * Cos(v) * Cos(v)
         *Point\y = 3 * Sin(v) * Sin(u)
         *Point\z = 3 * Sin(v)

      Case 13 ;
         *Point\x = 3 * Cos(u) * Cos(u)
         *Point\y = 3 * Cos(v) * Sin(v)
         *Point\z = 3 * Sin(v)

      Case 14 ; Coquillage
         *Point\x = 3 * (exp(u/k) * Cos(u) * (1 + b * Cos(v)))
         *Point\y = 3 * (exp(u/k) * Sin(u) * (1 + b * Cos(v)))
         *Point\z = 3 * (exp(u/k) * (1 + b * Sin(v)))
         
      Case 15 ; Trompette
         *Point\x = u * Cos(v)
         *Point\y = u * Sin(v)
         *Point\z = 1.0 / u   
         
      Case 16 ; le hasard fait bien les choses
         *Point\x = u * Cos(v)
         *Point\y = u * Sin(v)
         *Point\z = Cos(v) * Sin(u)     

      Case 17 ; Hélicoïde
         *Point\x = u * Cos(v)
         *Point\y = u * Sin(v)
         *Point\z = v
         
      Case 18 ; Hyperboloïde
         *Point\x =  0.05 * Cos(v) / Cos(u)
         *Point\y =  0.05 * Sin(v) / Cos(u)
         *Point\z =  0.05 * Tan(u)
         
      Case 19 ;Coquillage fin
         *Point\x =  0.45 * exp(u/k) * Cos(u) * (1 + b * Cos(v)) 
         *Point\y =  0.45 * exp(u/k) * Sin(u) * (1 + b * Cos(v))
         *Point\z =  0.45 * exp(u/k) * (k + b * Sin(v)) 
         
      Case 20 ;
         *Point\x = (2 + Cos(u)) * Cos(v) 
         *Point\y = (2 + Cos(v)) * Sin(u)
         *Point\z = Sin(v)

      Case 21 ; Disque
         *Point\x = 2 * Sin(v)  
         *Point\y = 2 * Sin(v)
         *Point\z = 3 * Cos(v) * Sin(u)    
         
      Case 22 ; Chapeau
         *Point\x = 3 * Cos(u)*Cos(v)
         *Point\y = 3 * Cos(u)*Sin(v)
         *Point\z = 3 * Pow(Sin(u),8) ; Changez 8 pour accentuer le rebord 

      Case 23 ; 
         *Point\x = 3 * Cos(v)*Cos(u)
         *Point\y = Sin(v)
         *Point\z = v
                  
      Case 24 ; 
         *Point\x = 3 * Pow(Cos(u)*Cos(v),3)
         *Point\y = 3 * Pow(Cos(u)*Sin(v),3)
         *Point\z = 3 * Pow(Sin(u),8)

      Case 25 ; 
         *Point\x = 3 * Pow(Cos(u)*Cos(v),3)
         *Point\y = 18 * Pow(Cos(u)*Sin(u),3)
         *Point\z = 5 * Pow(Sin(u),4)

      Case 26 ; 
         *Point\x = 2.5 * Sin(u)
         *Point\y = 2.5 * Cos(v)
         *Point\z = 3 * Pow(Sin(u),90)  
         
      Case 27 ; 
         *Point\x = 0.15 * exp(v) * Cos(u) 
         *Point\y = 0.15 * exp(v) * Sin(u) 
         *Point\z = 0.6 * Sin(v)    
      
      Case 28 ; 
         *Point\x = 2*Cos(v)+2*Cos(3*v) 
         *Point\y = 2*Sin(v)-2*Sin(3*v)
         *Point\z = Sin(2*u)      
      
      Case 29 ; 
         *Point\x = 2*Cos(v)
         *Point\y = 2*Sin(v)*Sin(u)
         *Point\z = 2*Sin(2*u)    
       
      Case 30 ;
         *Point\x = 2 * Cos(2*u)*Cos(v)
         *Point\y = 3*Sin(v)*Sin(u)
         *Point\z = 4*Sin(u)    
         
      Case 31 ;
         *Point\x = 2 * Cos(2*u)*Cos(v)
         *Point\y = 3 * Sin(v)*Sin(u)
         *Point\z = 3 * Sin(2*u) 
           
     Case 32 ;
         *Point\x = 2 * Pow(Cos(v),3)
         *Point\y = 3 * Sin(v)
         *Point\z = 3 * Sin(2*u)*Sin(v)                                                 
   EndSelect
EndProcedure

Macro vcross(N, x1, y1, z1, x2, y2, z2)
   N\x = (((y1) * (z2)) - ((z1) * (y2)))
   N\y = (((z1) * (x2)) - ((x1) * (z2)))
   N\z = (((x1) * (y2)) - ((y1) * (x2)))
EndMacro

Procedure CalculMesh(No.l)
   Define.l p, pp
   Define.f umin, umax, vmin, vmax, uiter, viter, uu, vv
   Define.f x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
   Define.f nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4
   Define.s_Vecteur n1, n2, n3, n4, n5, n6, n7, n8, n9   
   Define.s_Vecteur vn1, vn2, vn3, vn4
   Define.s_Vecteur p1, p2, p3, p4
   Define.s_Vecteur np1, np2, np3, np4
   
   DoubleTriangle = 0

   umin.f  = -#PI               
   umax.f  = #PI     
   vmin.f  = -#PI     
   vmax.f  =  #PI     

   
   NbSommet = 24000
   If No = 9 Or No = 10 
      vmin.f  = -#PI/2     
      vmax.f  =  #PI/2    
   ElseIf No = 14 ; Coquillage
      k = 10     
      b = 0.49268
      umin.f  = -34               
      umax.f  = -4   
      vmin.f  = 0        ;
      vmax.f  =  6.3
      DoubleTriangle = 1
      NbSommet = 25000
   ElseIf No = 15 ; Trompette
      umin.f  = #PI/16           
      umax.f  = #PI  
      DoubleTriangle = 1    
   ElseIf No = 17 ; Hélicoïde
      DoubleTriangle = 1  
   ElseIf No = 18  
      vmin.f  = -#PI/2           
      vmax.f  = #PI/2   
   ElseIf  No = 19 ; Coquillage allongé   
      k       = 25       
      b.f     = 5        
      umin.f  = -90          
      umax.f  = -26.7  
      vmin.f  = 0        
      vmax.f  = #PI*2 
      DoubleTriangle = 1
   ElseIf No = 21 ; Disque
      vmin.f  = -#PI/2     
      vmax.f  =  #PI/2   
   ElseIf No = 27
      DoubleTriangle = 1  
   EndIf
   
   
   uiter.f = 150               ;  nombre de pas en u
   viter.f = 40                ;  nombre de pas en v
   iu.f    = (umax-umin)/uiter ;   increment par pas
   iv.f    = (vmax-vmin)/viter ;   
     
   *PtrF.FTriangle = *IBuffer
   uu = umin   
   p = 0
   pp = 0
   ;Coul = $318CE7
   Coul = Random($FFFFFF)
   While (uu<=umax)                     
      vv = vmin
      While (vv<=vmax)                     
         ;POINTS     
         CoordonneesPoint(No,uu,vv,@p1)
           uu=uu+iu   
         CoordonneesPoint(No,uu,vv,@p2)           
         vv=vv+iv
         CoordonneesPoint(No,uu,vv,@p3)
         uu=uu-iu
         CoordonneesPoint(No,uu,vv,@p4)
         vv=vv-iv
         ;NORMALS                 
         uu=uu+2*iu
         CoordonneesPoint(No,uu,vv,@np1)
         uu=uu-2*iu
         vv=vv+2*iv
         CoordonneesPoint(No,uu,vv,@np2)
         vv=vv-2*iv
         uu=uu-iu
         CoordonneesPoint(No,uu,vv,@np3)
         uu=uu+iu
         vv=vv-iv
         CoordonneesPoint(No,uu,vv,@np4)
         vv=vv+iv
         vcross(n1, np2\x-p4\x, np2\y-p4\y, np2\z-p4\z, np1\x-p2\x, np1\y-p2\y, np1\z-p2\z)
         vcross(n2,  p4\x-p3\x,  p4\y-p3\y,  p4\z-p3\z, np2\x-p4\x, np2\y-p4\y, np2\z-p4\z)
         vcross(n3, np3\x-p1\x, np3\y-p1\y, np3\z-p1\z, np2\x-p4\x, np2\y-p4\y, np2\z-p4\z)
         vcross(n4,  p3\x-p2\x,  p3\y-p2\y,  p3\z-p2\z, np1\x-p2\x, np1\y-p2\y, np1\z-p2\z)
         vcross(n5,  p1\x-p2\x,  p1\y-p2\y,  p1\z-p2\z,  p3\x-p2\x,  p3\y-p2\y,  p3\z-p2\z)
         vcross(n6, np3\x-p1\x, np3\y-p1\y, np3\z-p1\z,  p4\x-p1\x,  p4\y-p1\y,  p4\z-p1\z)
         vcross(n7, np1\x-p2\x, np1\y-p2\y, np1\z-p2\z, np4\x-p1\x, np4\y-p1\y, np4\z-p1\z)
         vcross(n8, np4\x-p1\x, np4\y-p1\y, np4\z-p1\z,  p1\x-p2\x,  p1\y-p2\y,  p1\z-p2\z)
         vcross(n9, np4\x-p1\x, np4\y-p1\y, np4\z-p1\z, np3\x-p1\x, np3\y-p1\y, np3\z-p1\z)
         
         
         vn1\x = n5\x+n6\x+n8\x+n9\x   
         vn1\y = n5\y+n6\y+n8\y+n9\y
         vn1\z = n5\z+n6\z+n8\z+n9\z
         
         vn2\x = n4\x+n5\x+n7\x+n8\x   
         vn2\y = n4\y+n5\y+n7\y+n8\y
         vn2\z = n4\z+n5\z+n7\z+n8\z
           
         vn3\x = n1\x+n2\x+n4\x+n5\x   
         vn3\y = n1\y+n2\y+n4\y+n5\y
         vn3\z = n1\z+n2\z+n4\z+n5\z
         
         vn4\x = n2\x+n3\x+n5\x+n6\x   
         vn4\y = n2\y+n3\y+n5\y+n6\y
         vn4\z = n2\z+n3\z+n5\z+n6\z
 
         Final(pp)\x = p1\x
         Final(pp)\y = p1\y
         Final(pp)\z = p1\z
         Intermediaire(pp)\nx = vn1\x
         Intermediaire(pp)\ny = vn1\y
         Intermediaire(pp)\nz = vn1\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 0
         Intermediaire(pp)\v = 0
         pp + 1
       
         Final(pp)\x = p2\x
         Final(pp)\y = p2\y
         Final(pp)\z = p2\z
         Intermediaire(pp)\nx = vn2\x
         Intermediaire(pp)\ny = vn2\y
         Intermediaire(pp)\nz = vn2\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 1
         Intermediaire(pp)\v = 0
         pp + 1
         
         Final(pp)\x = p3\x
         Final(pp)\y = p3\y
         Final(pp)\z = p3\z
         Intermediaire(pp)\nx = vn3\x
         Intermediaire(pp)\ny = vn3\y
         Intermediaire(pp)\nz = vn3\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 1
         Intermediaire(pp)\v = 1
         pp + 1
                   
         Final(pp)\x = p4\x
         Final(pp)\y = p4\y
         Final(pp)\z = p4\z
         Intermediaire(pp)\nx = vn4\x
         Intermediaire(pp)\ny = vn4\y
         Intermediaire(pp)\nz = vn4\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 0
         Intermediaire(pp)\v = 1
         pp + 1
       
         ;TRIANGLES     
         *PtrF\f1 = p          ; p1
         *PtrF\f2 = p + 1      ; p2
         *PtrF\f3 = p + 2      ; p3
         *PtrF + SizeOf(FTriangle)
         *PtrF\f1 = p          ; p1
         *PtrF\f2 = p + 2      ; p3
         *PtrF\f3 = p + 3      ; p4
         *PtrF + SizeOf(FTriangle)
         If DoubleTriangle
            NbTriangle = NbSommet
            *PtrF\f3 = p          ; p1
            *PtrF\f2 = p + 1      ; p2
            *PtrF\f1 = p + 2      ; p3
            *PtrF + SizeOf(FTriangle)
            *PtrF\f3 = p          ; p1
            *PtrF\f2 = p + 2      ; p3
            *PtrF\f1 = p + 3      ; p4
            *PtrF + SizeOf(FTriangle)
         Else
            NbTriangle = NbSommet / 2
         EndIf
     
          p + 4

         vv = vv+iv
      Wend                 
      uu = uu+iu
   Wend   
   
   If IsMesh(0) = 0
      If CreateMesh(0,100)
         Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
         SetMeshData(0,Flag         ,Intermediaire(),NbSommet)
         SetMeshData(0,#PB_Mesh_Face,*IBuffer,NbTriangle)
       EndIf
   EndIf
   SetMeshData(0,#PB_Mesh_Face,*IBuffer,NbTriangle)
   
EndProcedure
Procedure.f  CurveValue(actuelle.f, Cible.f, P.f)
  Define.f Delta, Valeur
 
  Delta = Cible - actuelle
  If P > 1000 : P = 1000 : EndIf
  Valeur = actuelle + (Delta * P / 1000)
  ProcedureReturn Valeur
EndProcedure
 
Procedure Morphing()
   Delta.f = 0.01
   r.f = NbSommet*20
   For i = 0 To NbSommet-1
      ;If Final(i)\x > Intermediaire(i)\px : Intermediaire(i)\px + Delta : EndIf
      ;If Final(i)\x < Intermediaire(i)\px : Intermediaire(i)\px - Delta : EndIf
      ;If Final(i)\y > Intermediaire(i)\py : Intermediaire(i)\py + Delta : EndIf
      ;If Final(i)\y < Intermediaire(i)\py : Intermediaire(i)\py - Delta : EndIf
      ;If Final(i)\z > Intermediaire(i)\pz : Intermediaire(i)\pz + Delta : EndIf
      ;If Final(i)\z < Intermediaire(i)\pz : Intermediaire(i)\pz - Delta : EndIf
     Intermediaire(i)\px = CurveValue(Intermediaire(i)\px, Final(i)\x, 16)
     Intermediaire(i)\py = CurveValue(Intermediaire(i)\py, Final(i)\y, 16)
     Intermediaire(i)\pz = CurveValue(Intermediaire(i)\pz, Final(i)\z, 16)
   Next i
   
   Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
   SetMeshData(0,Flag         ,Intermediaire(),NbSommet)
EndProcedure


;-Mesh

CalculMesh(Forme3D)

;-Texture
CreateTexture(0,128, 128)
StartDrawing(TextureOutput(0))
  Box(0, 0, 128, 128, $FFFFFF)
StopDrawing()

;-Material
CreateMaterial(0,TextureID(0))
MaterialShadingMode(0,#PB_Material_Phong)
MaterialAmbientColor(0,-1)

;-Entity
CreateEntity(0,MeshID(0),MaterialID(0))
ScaleEntity(0,35,35,35)

;-Camera
CreateCamera(0, 0, 0 , 100 , 100)
CameraBackColor(0,RGB(0,0,255))
MoveCamera(0,0,0,-400)
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))


;-Light
AmbientColor(RGB(75,75,75))
CreateLight(0,RGB(155,155,155),EntityX(0)+150,EntityY(0),EntityZ(0))

pas = 0.9
Hasard = 0

Repeat
   If fullscreen = 0
      While WindowEvent() : Wend
   EndIf
   
    If Attente > 500
       
       If hasard 
         Forme3D = Random(#NombreForme3D) + 1
       Else
         Forme3D + 1
       EndIf  
       If Forme3D > #NombreForme3D : Forme3D = 1 : EndIf
       CalculMesh(Forme3D)
       Attente = 0
    EndIf   
   
   Morphing()
     
   Attente + 1
   
   Angle + Pas
   RotateEntity(0,angle,angle/2,-Angle)

   If ExamineKeyboard()
     If KeyboardReleased(#PB_Key_F1)
       CameraMode=1-CameraMode
       CameraRenderMode(0,CameraMode)
     ElseIf KeyboardReleased(#PB_Key_F2)
         CameraBackColor(0,0)
     ElseIf KeyboardReleased(#PB_Key_F3)
         CameraBackColor(0,RGB(255,0,0))
     ElseIf KeyboardReleased(#PB_Key_F4)
         CameraBackColor(0,RGB(255,255,0))  
     ElseIf KeyboardReleased(#PB_Key_F5)
         CameraBackColor(0,RGB(0,255,0)) 
     ElseIf KeyboardReleased(#PB_Key_F6)
         CameraBackColor(0,RGB(0,0,255))  
     ElseIf KeyboardReleased(#PB_Key_F7)
         CameraBackColor(0,RGB(0,255,255))    
     ElseIf KeyboardReleased(#PB_Key_F10)    
         Hasard = 1 - Hasard       
     EndIf
   EndIf
  RenderWorld()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Posted: Sat May 06, 2006 6:20 pm
by Derek
Very nice and fast too.

Posted: Sat May 06, 2006 10:13 pm
by Comtois
Thank you.

Added : Trompette, Au hasard, Hélicoïde, Hyperboloïde, Shell

Added : Hache, disque, chapeau

Posted: Mon May 08, 2006 8:13 am
by dige
It's magical, thank's for sharing Comtois!

Posted: Mon May 08, 2006 9:03 am
by Fangbeast
What can I say but "WOW".

Posted: Mon May 08, 2006 2:07 pm
by josku_x
THis is very cool indeed!

@Fangbeast: What does World of Warcraft do here?

Posted: Mon May 08, 2006 4:39 pm
by blueznl
yeah, we're guildwars players, all of us!

Posted: Mon May 08, 2006 4:44 pm
by josku_x
hehe, have you been playing too much lately, blueznl??
I don't play guildwars, I play [REMOVED by Moderator]
:wink:

Posted: Mon May 08, 2006 5:36 pm
by fsw
Don't care much about the 3D stuff myself, but what I see here is really impressive :shock:

Comtois, thanks for sharing your code/knowledge with this community.

Posted: Mon May 08, 2006 6:36 pm
by rsts
Very impressive.
Nicer than a lot of commercial screen savers.

Thanks for sharing.

cheers

Posted: Sat May 13, 2006 2:39 am
by dagcrack
josku_x wrote:hehe, have you been playing too much lately, blueznl??
I don't play guildwars, I play [REMOVED by Moderator]
:wink:
So what game is that one? :lol:

Posted: Sat May 13, 2006 3:33 am
by Fangbeast
josku_x wrote:THis is very cool indeed!

@Fangbeast: What does World of Warcraft do here?
I don't even know what that is.

Posted: Sat May 13, 2006 5:45 am
by dagcrack
Seriously I never played WoW, And I'm happy with that.

Posted: Sat Jul 18, 2009 1:11 am
by idle
hacked a fix for textureoutput() as it's no longer available

Code: Select all


;Comtois 07/05/06
;PB4.0 Beta 11
;32 formes 3D

;Site intéressant pour choisir une couleur
;http://pourpre.com/chroma/dico.php?typ=alpha

;Pour obtenir d'autres formes
;http://www.mathcurve.com/surfaces/surfaces.shtml

;#####################################################################
;quick hack to replace textureoutput for 4.31 uses global img number
;replace stopdrawing with StopDrawingT(TextureNumber)

Global gtImg

Procedure TextureOutPut(num) 
   
If IsTexture(num) 
 gtImg = CreateImage(#PB_Any,TextureWidth(0),TextureHeight(0))
EndIf 
 
ProcedureReturn ImageOutput(gTimg)
 
EndProcedure     

Procedure  StopDrawingT(num)
Static bArch 
mdir$ = GetTemporaryDirectory() 
StopDrawing()
 
 ;comment out if there's a 3D archive is declared  
 If Not bArch 
   mdir$ = GetTemporaryDirectory() 
   Add3DArchive(mdir$,#PB_3DArchive_FileSystem)
   bArch = 1
 EndIf 

 SaveImage(gtImg,mdir$ + "tImg" + Str(num))
 LoadTexture(num,"tImg" + Str(num)) 
  
EndProcedure 

;######################################################################

Texte$ = "Morphing 3D"

Resultat = MessageRequester(Texte$,"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
EndIf
   
If InitSprite() = 0 Or InitKeyboard() = 0
   MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
   End
EndIf

If Fullscreen
   ExamineDesktops()
   Sx = DesktopWidth(0)
   Sy = DesktopHeight(0)
   Sd = DesktopDepth(0)
  OpenScreen(Sx, Sy,Sd, Texte$)
Else
  OpenWindow(0,0, 0, 800 , 600 ,Texte$,#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0)
EndIf

Structure s_Vecteur
   x.f
   y.f
   z.f
EndStructure

Structure Vertex
   px.f
   py.f
   pz.f
   nx.f
   ny.f
   nz.f
   co.l
   U.f
   V.f
EndStructure

Structure FTriangle
   f1.w
   f2.w
   f3.w
EndStructure

Global Angle.f,Pas.f, CameraMode.l
Global *VBuffer,*IBuffer
Global b.f, k.f
Global NbSommet, NbTriangle, Forme3D

#E = 2.71828182
#NombreForme3D = 32
Forme3D = 31

NbSommet = 25000
NbTriangle = NbSommet

Global Dim Final.s_Vecteur(NbSommet)
Global Dim Intermediaire.Vertex(NbSommet)
*IBuffer = AllocateMemory(SizeOf(FTriangle) * NbTriangle)

Procedure.f Exp(value.f)
  ProcedureReturn Pow(#E, value)
EndProcedure

Procedure CoordonneesPoint(t,u.f,v.f,*Point.s_Vecteur)
   Select t
      Case 1 ;
         *Point\x = (3 + Cos(u)) * Cos(u)
         *Point\y = (3 + Cos(v)) * Sin(u)
         *Point\z = Sin(v)
                           
      Case 2 ; Astroide
         *Point\x = 4 * Cos(u) * Cos(u) * Cos(u) * Cos(v) * Cos(v) * Cos(v)
         *Point\y = 4 * Sin(u) * Sin(u) * Sin(u) * Cos(v) * Cos(v) * Cos(v)
         *Point\z = 4 * Sin(v) * Sin(v) * Sin(v)   

      Case 3 ; Tore
         *Point\x = (3 + Cos(v)) * Cos(u)
         *Point\y = (3 + Cos(v)) * Sin(u)
         *Point\z = Sin(v)
                 
      Case 4 ; Sphere
         *Point\x = 3 * Cos(u) * Cos(v)
         *Point\y = 3 * Sin(u) * Cos(v)
         *Point\z = 3 * Sin(v)
         
      Case 5 ; Cylindre creux
         *Point\x = 3 * Cos(u) * Cos(u)
         *Point\y = 3 * Cos(u) * Sin(u)
         *Point\z = 3 * Sin(v)
     
      Case 6 ;
         *Point\x = 3 * Cos(v) * Cos(u)
         *Point\y = 3 * Cos(v) * Sin(u)
         *Point\z = 3 * Sin(u)   

      Case 7 ;
         *Point\x = 3 * Cos(v) * Cos(v)
         *Point\y = 3 * Cos(v) * Sin(u)
         *Point\z = 3 * Sin(v)
         
      Case 8 ;
         *Point\x = 3 * Cos(u) * Cos(v)
         *Point\y = 3 * Sin(u) * Sin(v)
         *Point\z = 3 * Sin(u)
     
      Case 9 ;
         *Point\x = 3 * Cos(u) * Cos(v)
         *Point\y = 3 * Sin(u) * Sin(u)
         *Point\z = 3 * Sin(v)
         
      Case 10 ; Plan
         *Point\x = 3 * Cos(u) * Cos(u)
         *Point\y = 3 * Sin(u) * Sin(u)
         *Point\z = 3 * Sin(v)   
                 
      Case 11 ;
         *Point\x = 3 * Sin(u) * Cos(u)
         *Point\y = 3 * Sin(u) * Sin(v)
         *Point\z = 3 * Sin(v)
         
      Case 12 ;
         *Point\x = 3 * Cos(v) * Cos(v)
         *Point\y = 3 * Sin(v) * Sin(u)
         *Point\z = 3 * Sin(v)

      Case 13 ;
         *Point\x = 3 * Cos(u) * Cos(u)
         *Point\y = 3 * Cos(v) * Sin(v)
         *Point\z = 3 * Sin(v)

      Case 14 ; Coquillage
         *Point\x = 3 * (exp(u/k) * Cos(u) * (1 + b * Cos(v)))
         *Point\y = 3 * (exp(u/k) * Sin(u) * (1 + b * Cos(v)))
         *Point\z = 3 * (exp(u/k) * (1 + b * Sin(v)))
         
      Case 15 ; Trompette
         *Point\x = u * Cos(v)
         *Point\y = u * Sin(v)
         *Point\z = 1.0 / u   
         
      Case 16 ; le hasard fait bien les choses
         *Point\x = u * Cos(v)
         *Point\y = u * Sin(v)
         *Point\z = Cos(v) * Sin(u)     

      Case 17 ; Hélicoïde
         *Point\x = u * Cos(v)
         *Point\y = u * Sin(v)
         *Point\z = v
         
      Case 18 ; Hyperboloïde
         *Point\x =  0.05 * Cos(v) / Cos(u)
         *Point\y =  0.05 * Sin(v) / Cos(u)
         *Point\z =  0.05 * Tan(u)
         
      Case 19 ;Coquillage fin
         *Point\x =  0.45 * exp(u/k) * Cos(u) * (1 + b * Cos(v))
         *Point\y =  0.45 * exp(u/k) * Sin(u) * (1 + b * Cos(v))
         *Point\z =  0.45 * exp(u/k) * (k + b * Sin(v))
         
      Case 20 ;
         *Point\x = (2 + Cos(u)) * Cos(v)
         *Point\y = (2 + Cos(v)) * Sin(u)
         *Point\z = Sin(v)

      Case 21 ; Disque
         *Point\x = 2 * Sin(v) 
         *Point\y = 2 * Sin(v)
         *Point\z = 3 * Cos(v) * Sin(u)   
         
      Case 22 ; Chapeau
         *Point\x = 3 * Cos(u)*Cos(v)
         *Point\y = 3 * Cos(u)*Sin(v)
         *Point\z = 3 * Pow(Sin(u),8) ; Changez 8 pour accentuer le rebord

      Case 23 ;
         *Point\x = 3 * Cos(v)*Cos(u)
         *Point\y = Sin(v)
         *Point\z = v
                 
      Case 24 ;
         *Point\x = 3 * Pow(Cos(u)*Cos(v),3)
         *Point\y = 3 * Pow(Cos(u)*Sin(v),3)
         *Point\z = 3 * Pow(Sin(u),8)

      Case 25 ;
         *Point\x = 3 * Pow(Cos(u)*Cos(v),3)
         *Point\y = 18 * Pow(Cos(u)*Sin(u),3)
         *Point\z = 5 * Pow(Sin(u),4)

      Case 26 ;
         *Point\x = 2.5 * Sin(u)
         *Point\y = 2.5 * Cos(v)
         *Point\z = 3 * Pow(Sin(u),90) 
         
      Case 27 ;
         *Point\x = 0.15 * exp(v) * Cos(u)
         *Point\y = 0.15 * exp(v) * Sin(u)
         *Point\z = 0.6 * Sin(v)   
     
      Case 28 ;
         *Point\x = 2*Cos(v)+2*Cos(3*v)
         *Point\y = 2*Sin(v)-2*Sin(3*v)
         *Point\z = Sin(2*u)     
     
      Case 29 ;
         *Point\x = 2*Cos(v)
         *Point\y = 2*Sin(v)*Sin(u)
         *Point\z = 2*Sin(2*u)   
       
      Case 30 ;
         *Point\x = 2 * Cos(2*u)*Cos(v)
         *Point\y = 3*Sin(v)*Sin(u)
         *Point\z = 4*Sin(u)   
         
      Case 31 ;
         *Point\x = 2 * Cos(2*u)*Cos(v)
         *Point\y = 3 * Sin(v)*Sin(u)
         *Point\z = 3 * Sin(2*u)
           
     Case 32 ;
         *Point\x = 2 * Pow(Cos(v),3)
         *Point\y = 3 * Sin(v)
         *Point\z = 3 * Sin(2*u)*Sin(v)                                                 
   EndSelect
EndProcedure

Macro vcross(N, x1, y1, z1, x2, y2, z2)
   N\x = (((y1) * (z2)) - ((z1) * (y2)))
   N\y = (((z1) * (x2)) - ((x1) * (z2)))
   N\z = (((x1) * (y2)) - ((y1) * (x2)))
EndMacro

Procedure CalculMesh(No.l)
   Define.l p, pp
   Define.f umin, umax, vmin, vmax, uiter, viter, uu, vv
   Define.f x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4
   Define.f nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4
   Define.s_Vecteur n1, n2, n3, n4, n5, n6, n7, n8, n9   
   Define.s_Vecteur vn1, vn2, vn3, vn4
   Define.s_Vecteur p1, p2, p3, p4
   Define.s_Vecteur np1, np2, np3, np4
   
   DoubleTriangle = 0

   umin.f  = -#PI               
   umax.f  = #PI     
   vmin.f  = -#PI     
   vmax.f  =  #PI     

   
   NbSommet = 24000
   If No = 9 Or No = 10
      vmin.f  = -#PI/2     
      vmax.f  =  #PI/2   
   ElseIf No = 14 ; Coquillage
      k = 10     
      b = 0.49268
      umin.f  = -34               
      umax.f  = -4   
      vmin.f  = 0        ;
      vmax.f  =  6.3
      DoubleTriangle = 1
      NbSommet = 25000
   ElseIf No = 15 ; Trompette
      umin.f  = #PI/16           
      umax.f  = #PI 
      DoubleTriangle = 1   
   ElseIf No = 17 ; Hélicoïde
      DoubleTriangle = 1 
   ElseIf No = 18 
      vmin.f  = -#PI/2           
      vmax.f  = #PI/2   
   ElseIf  No = 19 ; Coquillage allongé   
      k       = 25       
      b.f     = 5       
      umin.f  = -90         
      umax.f  = -26.7 
      vmin.f  = 0       
      vmax.f  = #PI*2
      DoubleTriangle = 1
   ElseIf No = 21 ; Disque
      vmin.f  = -#PI/2     
      vmax.f  =  #PI/2   
   ElseIf No = 27
      DoubleTriangle = 1 
   EndIf
   
   
   uiter.f = 150               ;  nombre de pas en u
   viter.f = 40                ;  nombre de pas en v
   iu.f    = (umax-umin)/uiter ;   increment par pas
   iv.f    = (vmax-vmin)/viter ;   
     
   *PtrF.FTriangle = *IBuffer
   uu = umin   
   p = 0
   pp = 0
   ;Coul = $318CE7
   Coul = Random($FFFFFF)
   While (uu<=umax)                     
      vv = vmin
      While (vv<=vmax)                     
         ;POINTS     
         CoordonneesPoint(No,uu,vv,@p1)
           uu=uu+iu   
         CoordonneesPoint(No,uu,vv,@p2)           
         vv=vv+iv
         CoordonneesPoint(No,uu,vv,@p3)
         uu=uu-iu
         CoordonneesPoint(No,uu,vv,@p4)
         vv=vv-iv
         ;NORMALS                 
         uu=uu+2*iu
         CoordonneesPoint(No,uu,vv,@np1)
         uu=uu-2*iu
         vv=vv+2*iv
         CoordonneesPoint(No,uu,vv,@np2)
         vv=vv-2*iv
         uu=uu-iu
         CoordonneesPoint(No,uu,vv,@np3)
         uu=uu+iu
         vv=vv-iv
         CoordonneesPoint(No,uu,vv,@np4)
         vv=vv+iv
         vcross(n1, np2\x-p4\x, np2\y-p4\y, np2\z-p4\z, np1\x-p2\x, np1\y-p2\y, np1\z-p2\z)
         vcross(n2,  p4\x-p3\x,  p4\y-p3\y,  p4\z-p3\z, np2\x-p4\x, np2\y-p4\y, np2\z-p4\z)
         vcross(n3, np3\x-p1\x, np3\y-p1\y, np3\z-p1\z, np2\x-p4\x, np2\y-p4\y, np2\z-p4\z)
         vcross(n4,  p3\x-p2\x,  p3\y-p2\y,  p3\z-p2\z, np1\x-p2\x, np1\y-p2\y, np1\z-p2\z)
         vcross(n5,  p1\x-p2\x,  p1\y-p2\y,  p1\z-p2\z,  p3\x-p2\x,  p3\y-p2\y,  p3\z-p2\z)
         vcross(n6, np3\x-p1\x, np3\y-p1\y, np3\z-p1\z,  p4\x-p1\x,  p4\y-p1\y,  p4\z-p1\z)
         vcross(n7, np1\x-p2\x, np1\y-p2\y, np1\z-p2\z, np4\x-p1\x, np4\y-p1\y, np4\z-p1\z)
         vcross(n8, np4\x-p1\x, np4\y-p1\y, np4\z-p1\z,  p1\x-p2\x,  p1\y-p2\y,  p1\z-p2\z)
         vcross(n9, np4\x-p1\x, np4\y-p1\y, np4\z-p1\z, np3\x-p1\x, np3\y-p1\y, np3\z-p1\z)
         
         
         vn1\x = n5\x+n6\x+n8\x+n9\x   
         vn1\y = n5\y+n6\y+n8\y+n9\y
         vn1\z = n5\z+n6\z+n8\z+n9\z
         
         vn2\x = n4\x+n5\x+n7\x+n8\x   
         vn2\y = n4\y+n5\y+n7\y+n8\y
         vn2\z = n4\z+n5\z+n7\z+n8\z
           
         vn3\x = n1\x+n2\x+n4\x+n5\x   
         vn3\y = n1\y+n2\y+n4\y+n5\y
         vn3\z = n1\z+n2\z+n4\z+n5\z
         
         vn4\x = n2\x+n3\x+n5\x+n6\x   
         vn4\y = n2\y+n3\y+n5\y+n6\y
         vn4\z = n2\z+n3\z+n5\z+n6\z
 
         Final(pp)\x = p1\x
         Final(pp)\y = p1\y
         Final(pp)\z = p1\z
         Intermediaire(pp)\nx = vn1\x
         Intermediaire(pp)\ny = vn1\y
         Intermediaire(pp)\nz = vn1\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 0
         Intermediaire(pp)\v = 0
         pp + 1
       
         Final(pp)\x = p2\x
         Final(pp)\y = p2\y
         Final(pp)\z = p2\z
         Intermediaire(pp)\nx = vn2\x
         Intermediaire(pp)\ny = vn2\y
         Intermediaire(pp)\nz = vn2\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 1
         Intermediaire(pp)\v = 0
         pp + 1
         
         Final(pp)\x = p3\x
         Final(pp)\y = p3\y
         Final(pp)\z = p3\z
         Intermediaire(pp)\nx = vn3\x
         Intermediaire(pp)\ny = vn3\y
         Intermediaire(pp)\nz = vn3\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 1
         Intermediaire(pp)\v = 1
         pp + 1
                   
         Final(pp)\x = p4\x
         Final(pp)\y = p4\y
         Final(pp)\z = p4\z
         Intermediaire(pp)\nx = vn4\x
         Intermediaire(pp)\ny = vn4\y
         Intermediaire(pp)\nz = vn4\z
         Intermediaire(pp)\co = Coul
         Intermediaire(pp)\u = 0
         Intermediaire(pp)\v = 1
         pp + 1
       
         ;TRIANGLES     
         *PtrF\f1 = p          ; p1
         *PtrF\f2 = p + 1      ; p2
         *PtrF\f3 = p + 2      ; p3
         *PtrF + SizeOf(FTriangle)
         *PtrF\f1 = p          ; p1
         *PtrF\f2 = p + 2      ; p3
         *PtrF\f3 = p + 3      ; p4
         *PtrF + SizeOf(FTriangle)
         If DoubleTriangle
            NbTriangle = NbSommet
            *PtrF\f3 = p          ; p1
            *PtrF\f2 = p + 1      ; p2
            *PtrF\f1 = p + 2      ; p3
            *PtrF + SizeOf(FTriangle)
            *PtrF\f3 = p          ; p1
            *PtrF\f2 = p + 2      ; p3
            *PtrF\f1 = p + 3      ; p4
            *PtrF + SizeOf(FTriangle)
         Else
            NbTriangle = NbSommet / 2
         EndIf
     
          p + 4

         vv = vv+iv
      Wend                 
      uu = uu+iu
   Wend   
   
   If IsMesh(0) = 0
      If CreateMesh(0,100)
         Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
         SetMeshData(0,Flag         ,Intermediaire(),NbSommet)
         SetMeshData(0,#PB_Mesh_Face,*IBuffer,NbTriangle)
       EndIf
   EndIf
   SetMeshData(0,#PB_Mesh_Face,*IBuffer,NbTriangle)
   
EndProcedure
Procedure.f  CurveValue(actuelle.f, Cible.f, P.f)
  Define.f Delta, Valeur
 
  Delta = Cible - actuelle
  If P > 1000 : P = 1000 : EndIf
  Valeur = actuelle + (Delta * P / 1000)
  ProcedureReturn Valeur
EndProcedure
 
Procedure Morphing()
   Delta.f = 0.01
   r.f = NbSommet*20
   For i = 0 To NbSommet-1
      If Final(i)\x > Intermediaire(i)\px : Intermediaire(i)\px + Delta : EndIf
      If Final(i)\x < Intermediaire(i)\px : Intermediaire(i)\px - Delta : EndIf
      If Final(i)\y > Intermediaire(i)\py : Intermediaire(i)\py + Delta : EndIf
      If Final(i)\y < Intermediaire(i)\py : Intermediaire(i)\py - Delta : EndIf
      If Final(i)\z > Intermediaire(i)\pz : Intermediaire(i)\pz + Delta : EndIf
      If Final(i)\z < Intermediaire(i)\pz : Intermediaire(i)\pz - Delta : EndIf
     Intermediaire(i)\px = CurveValue(Intermediaire(i)\px, Final(i)\x, 16)
     Intermediaire(i)\py = CurveValue(Intermediaire(i)\py, Final(i)\y, 16)
     Intermediaire(i)\pz = CurveValue(Intermediaire(i)\pz, Final(i)\z, 16)
   Next i
   
   Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
   SetMeshData(0,Flag         ,Intermediaire(),NbSommet)
EndProcedure


;-Mesh

CalculMesh(Forme3D)

;-Texture
CreateTexture(0,128, 128)
StartDrawing(TextureOutput(0))
  Box(0, 0, 128, 128, $FFFFFF)
StopDrawingT(0)

;-Material
CreateMaterial(0,TextureID(0))
MaterialShadingMode(0,#PB_Material_Phong)
MaterialAmbientColor(0,-1)

;-Entity
CreateEntity(0,MeshID(0),MaterialID(0))
ScaleEntity(0,35,35,35)

;-Camera
CreateCamera(0, 0, 0 , 100 , 100)
CameraBackColor(0,RGB(0,0,255))
MoveCamera(0,0,0,-400)
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))


;-Light
AmbientColor(RGB(75,75,75))
CreateLight(0,RGB(155,155,155),EntityX(0)+150,EntityY(0),EntityZ(0))

pas = 0.9
Hasard = 0

Repeat
   If fullscreen = 0
      While WindowEvent() : Wend
   EndIf
   
    If Attente > 500
       
       If hasard
         Forme3D = Random(#NombreForme3D) + 1
       Else
         Forme3D + 1
       EndIf 
       If Forme3D > #NombreForme3D : Forme3D = 1 : EndIf
       CalculMesh(Forme3D)
       Attente = 0
    EndIf   
   
   Morphing()
     
   Attente + 1
   
   Angle + Pas
   RotateEntity(0,angle,angle/2,-Angle)

   If ExamineKeyboard()
     If KeyboardReleased(#PB_Key_F1)
       CameraMode=1-CameraMode
       CameraRenderMode(0,CameraMode)
     ElseIf KeyboardReleased(#PB_Key_F2)
         CameraBackColor(0,0)
     ElseIf KeyboardReleased(#PB_Key_F3)
         CameraBackColor(0,RGB(255,0,0))
     ElseIf KeyboardReleased(#PB_Key_F4)
         CameraBackColor(0,RGB(255,255,0)) 
     ElseIf KeyboardReleased(#PB_Key_F5)
         CameraBackColor(0,RGB(0,255,0))
     ElseIf KeyboardReleased(#PB_Key_F6)
         CameraBackColor(0,RGB(0,0,255)) 
     ElseIf KeyboardReleased(#PB_Key_F7)
         CameraBackColor(0,RGB(0,255,255))   
     ElseIf KeyboardReleased(#PB_Key_F10)   
         Hasard = 1 - Hasard       
     EndIf
   EndIf
  RenderWorld()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Posted: Thu Jul 23, 2009 5:23 pm
by Rook Zimbabwe
Comtois THIS IS SO COOL!

I had a thought that if you could somehow include this in your BLOX game you would take it to a whole new level!
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited