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)
