Posted: Thu Jul 23, 2009 7:19 pm
Very cool. 
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) 