http://aesculier.chez-alice.fr/fichiers ... lages.html
Code: Select all
;Comtois 02/05/06
;PB4.0 Beta 11
Resultat = MessageRequester("Coquillage 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
EndIf
If InitSprite() = 0 Or InitKeyboard() = 0
MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
End
EndIf
If Fullscreen
OpenScreen(800,600,32,"Coquillage 3D")
Else
OpenWindow(0,0, 0, 800 , 600 ,"Coquillage 3D",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0)
EndIf
#E = 2.71828182
Global Angle.f,Pas.f, CameraMode.l
Global *VBuffer,*IBuffer
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
Procedure.f Exp(value.f)
ProcedureReturn Pow(#E, value)
EndProcedure
Macro CX(p1,p2)
exp(p1/k)*Cos(p1)*(1+b*Cos(p2))
EndMacro
Macro CY(p1,p2)
exp(p1/k)*Sin(p1)*(1+b*Cos(p2))
EndMacro
Macro CZ(p1,p2)
exp(p1/k)*(k+b*Sin(p2))
;exp(p1/k)*(1+b*Sin(p2))
EndMacro
Macro SOUSTRACTION_VECTEUR(V, V1, V2)
V\x = V1\x - V2\x
V\y = V1\y - V2\y
V\z = V1\z - V2\z
EndMacro
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 CreateMeshCoquillage()
;http://aesculier.chez-alice.fr/fichiersPovray/coquillages/coquillages.html
;A arranger , j'ai juste recopié pour tester.
; equation - Coquillage
;x=exp(p1/k)*Cos(p1)*(1+b*Cos(p2))
;y=exp(p1/k)*Sin(p1)*(1+b*Cos(p2))
;z=exp(p1/k)*(1+b*Sin(p2))
;Peut s'appliquer à toute surface paramétrique en mettant les
;bonnes formules dans CX, CY, CZ
;Coq 1
k = 25 ; coq1 : 25 ; coq2 : 10;
b.f = 5 ; coq1 : 5 ; coq2 : 0.49268
umin.f = -90 ; coq1 : -90 ; coq2 : -34
umax.f = -26.7 ; coq1 : -26.7 ; coq2 : 4
NbSommet = 26000 ; A recalculer avec plus de précision !
NbTriangle = NbSommet ; Idem
; Coq 2
; k = 10 ; coq1 : 25 ; coq2 : 10;
; b.f = 0.49268 ; coq1 : 5 ; coq2 : 0.49268
; umin.f = -34 ; coq1 : -90 ; coq2 : -34
; umax.f = -4 ; coq1 : -26.7 ; coq2 : 4
; NbSommet = 25000 ; A recalculer avec plus de précision !
; NbTriangle = 12500 ; Idem
;Commun aux deux
vmin.f = 0 ;
vmax.f = 6.3 ;
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 ;
Define.f uu, vv
Define.f x1, y1, z1
Define.f x2, y2, z2
Define.f x3, y3, z3
Define.f x4, y4, z4
Define.f nx1, ny1, nz1
Define.f nx2, ny2, nz2
Define.f nx3, ny3, nz3
Define.f nx4, ny4, nz4
Define.s_Vecteur n1, n2, n3, n4, n5, n6, n7, n8, n9
Define.s_Vecteur vn1, vn2, vn3, vn4
*VBuffer = AllocateMemory(SizeOf(Vertex) * NbSommet)
*IBuffer = AllocateMemory(SizeOf(FTriangle) * NbTriangle)
*PtrV.Vertex = *Vbuffer
*PtrF.FTriangle = *IBuffer
uu = umin
p = 0
Coul = Random($00FFFF) + $FF0000
While (uu<=umax)
vv = vmin
While (vv<=vmax)
;POINTS
x1=CX(uu,vv)
y1=CY(uu,vv)
z1=CZ(uu,vv)
uu=uu+iu
x2=CX(uu,vv)
y2=CY(uu,vv)
z2=CZ(uu,vv)
vv=vv+iv
x3=CX(uu,vv)
y3=CY(uu,vv)
z3=CZ(uu,vv)
uu=uu-iu
x4=CX(uu,vv)
y4=CY(uu,vv)
z4=CZ(uu,vv)
vv=vv-iv
;NORMALS
uu=uu+2*iu
nx1=CX(uu,vv)
ny1=CY(uu,vv)
nz1=CZ(uu,vv)
uu=uu-2*iu
vv=vv+2*iv
nx2=CX(uu,vv)
ny2=CY(uu,vv)
nz2=CZ(uu,vv)
vv=vv-2*iv
uu=uu-iu
nx3=CX(uu,vv)
ny3=CY(uu,vv)
nz3=CZ(uu,vv)
uu=uu+iu
vv=vv-iv
nx4=CX(uu,vv)
ny4=CY(uu,vv)
nz4=CZ(uu,vv)
vv=vv+iv
vcross(n1, nx2-x4, ny2-y4, nz2-z4, nx1-x2, ny1-y2, nz1-z2)
vcross(n2, x4-x3, y4-y3, z4-z3, nx2-x4, ny2-y4, nz2-z4)
vcross(n3, nx3-x1, ny3-y1, nz3-z1, nx2-x4, ny2-y4, nz2-z4)
vcross(n4, x3-x2, y3-y2, z3-z2, nx1-x2, ny1-y2, nz1-z2)
vcross(n5, x1-x2, y1-y2, z1-z2, x3-x2, y3-y2, z3-z2)
vcross(n6, nx3-x1, ny3-y1, nz3-z1, x4-x1, y4-y1, z4-z1)
vcross(n7, nx1-x2, ny1-y2, nz1-z2, nx4-x1, ny4-y1, nz4-z1)
vcross(n8, nx4-x1, ny4-y1, nz4-z1, x1-x2, y1-y2, z1-z2)
vcross(n9, nx4-x1, ny4-y1, nz4-z1, nx3-x1, ny3-y1, nz3-z1)
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
*PtrV\px = x1
*PtrV\py = y1
*PtrV\pz = z1
*PtrV\nx = vn1\x
*PtrV\ny = vn1\y
*PtrV\nz = vn1\z
*PtrV\co = Coul
*PtrV\u = 0
*PtrV\v = 0
*PtrV + SizeOf(Vertex)
*PtrV\px = x2
*PtrV\py = y2
*PtrV\pz = z2
*PtrV\nx = vn2\x
*PtrV\ny = vn2\y
*PtrV\nz = vn2\z
*PtrV\co = Coul
*PtrV\u = 1
*PtrV\v = 0
*PtrV + SizeOf(Vertex)
*PtrV\px = x3
*PtrV\py = y3
*PtrV\pz = z3
*PtrV\nx = vn3\x
*PtrV\ny = vn3\y
*PtrV\nz = vn3\z
*PtrV\co = Coul
*PtrV\u = 1
*PtrV\v = 1
*PtrV + SizeOf(Vertex)
*PtrV\px = x4
*PtrV\py = y4
*PtrV\pz = z4
*PtrV\nx = vn4\x
*PtrV\ny = vn4\y
*PtrV\nz = vn4\z
*PtrV\co = Coul
*PtrV\u = 0
*PtrV\v = 1
*PtrV + SizeOf(Vertex)
;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)
*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)
p + 4
vv = vv+iv
Wend
uu = uu+iu
Wend
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
;-Mesh
;CreateMeshCone(meridien,2,2,0)
CreateMeshCoquillage()
;-Texture
CreateTexture(0,128, 128)
StartDrawing(TextureOutput(0))
Box(0, 0, 128, 128, $FFFFFF)
StopDrawing()
;-Material
CreateMaterial(0,TextureID(0))
MaterialAmbientColor(0,-1)
;-Entity
CreateEntity(0,MeshID(0),MaterialID(0))
ScaleEntity(0,15,15,15)
;-Camera
CreateCamera(0, 0, 0 , 100 , 100)
MoveCamera(0,0,0,-400)
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))
;-Light
AmbientColor(RGB(205,205,205))
CreateLight(0,RGB(155,155,55),EntityX(0)+150,EntityY(0),EntityZ(0))
;CreateLight(1,RGB(55,255,255),EntityX(0)-150,EntityY(0),EntityZ(0))
;CreateLight(2,RGB(255,55,255),EntityX(0),EntityY(0)+150,EntityZ(0))
;CreateLight(3,RGB(255,255,55),EntityX(0),EntityY(0)-150,EntityZ(0))
pas = 0.8
Repeat
;ClearScreen(0)
If fullscreen = 0
While WindowEvent() : Wend
EndIf
Angle + Pas
RotateEntity(0,angle,angle/2,-Angle)
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1)
CameraMode=1-CameraMode
CameraRenderMode(0,CameraMode)
EndIf
EndIf
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
