Morphing 3D

Share your advanced PureBasic knowledge/code with the community.
Post Reply
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Post by Mistrel »

Very cool. :)
Top
User avatar
Comtois
Addict
Addict
Posts: 1431
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Re: Morphing 3D

Post by Comtois »

Updated for 5.20 LTS

Code: Select all

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



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

Resultat = MessageRequester(Texte$,"Full Screen ?",#PB_MessageRequester_YesNo)
If Resultat = 6     
  FullScreen=1
Else           
  FullScreen=0
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

#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 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     
  
  MaterialCullingMode(0, #PB_Material_ClockWiseCull)
  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
    MaterialCullingMode(0, #PB_Material_NoCulling)
    ; NbSommet = 25000
  ElseIf No = 15 ; Trompette
    umin.f  = #PI/16           
    umax.f  = #PI
    ;DoubleTriangle = 1   
    MaterialCullingMode(0, #PB_Material_NoCulling)
    
  ElseIf No = 17 ; Hélicoïde
    ;DoubleTriangle = 1
    MaterialCullingMode(0, #PB_Material_NoCulling)
  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
    MaterialCullingMode(0, #PB_Material_NoCulling)
  ElseIf No = 21 ; Disque
    vmin.f  = -#PI/2     
    vmax.f  =  #PI/2   
  ElseIf No = 27
    ;DoubleTriangle = 1
    MaterialCullingMode(0, #PB_Material_NoCulling)
  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)
  
  If IsMesh(0) = 0
    CreateMesh(0, #PB_Mesh_TriangleList, #PB_Mesh_Dynamic)
    MeshVertexPosition(0,0,0)
    MeshVertexNormal(0,0,0)
    MeshVertexColor(0)
    MeshVertexTextureCoordinate(0,0)    
    
  Else
    UpdateMesh(0, 0)
  EndIf   
  
  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
      
      MeshFace(p, p + 1, P + 2) 
      MeshFace(p, p + 2, P + 3) 
      
      P + 4
      vv = vv+iv
    Wend                 
    uu = uu+iu
  Wend   
  
  FinishMesh(0)
  
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
  
  UpdateMesh(0,0)
  p=0
  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)
    
    MeshVertexPosition(Intermediaire(i)\px, Intermediaire(i)\py, Intermediaire(i)\pz)
    MeshVertexNormal(Intermediaire(i)\nx, Intermediaire(i)\ny, Intermediaire(i)\nz)
    MeshVertexColor(Intermediaire(i)\co)
    MeshVertexTextureCoordinate(Intermediaire(i)\u, Intermediaire(i)\V)
    MeshFace(p, p + 1, P + 2) 
    MeshFace(p, p + 2, P + 3) 
    p+4 
  Next i
  
  FinishMesh(0)
EndProcedure

;-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)
SetMaterialColor(0, #PB_Material_AmbientColor, -1)


;-Mesh
CalculMesh(Forme3D)
SetMeshMaterial(0, MaterialID(0))

;-Node
CreateNode(0)
AttachNodeObject(0, MeshID(0))

ScaleNode(0,35,35,35)

;-Camera
CreateCamera(0, 0, 0 , 100 , 100)
CameraBackColor(0,RGB(0,0,155))
MoveCamera(0,0,0,-500)
CameraLookAt(0,NodeX(0),NodeY(0),NodeZ(0))


;-Light
AmbientColor(RGB(75,75,75))
CreateLight(0,RGB(155,155,155),NodeX(0)+150,NodeY(0),NodeZ(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
  RotateNode(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)
Please correct my english
http://purebasic.developpez.com/
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Morphing 3D

Post by davido »

@Comtois

Very nice. Thank you for sharing. :D
DE AA EB
Top
Post Reply

Return to “Tricks 'n' Tips”