ça devrait être le dernier de la série.
Code : Tout sélectionner
;Comtois 05/05/06
;PB4.0 Beta 11
;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$ = "Tore 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
Global Angle.f,Pas.f, CameraMode.l
Global *VBuffer,*IBuffer
Global meridien.l
Global aa, bb
aa = 3 ; Amusez vous à changer cette valeur
bb = 1 ; Amusez vous à changer cette valeur
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
Macro CX(u,v)
(aa + bb * Cos(v)) * Cos(u)
EndMacro
Macro CY(u,v)
(aa + bb * Cos(v)) * Sin(u)
EndMacro
Macro CZ(u,v)
bb * Sin(v)
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 CreateMeshTore()
Define.l p, NbSommet, NbTriangle
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
umin.f = -#PI
umax.f = #PI
vmin.f = -#PI
vmax.f = #PI
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 ;
NbSommet = 24000 ; uiter * viter * 4
NbTriangle = NbSommet / 2
*VBuffer = AllocateMemory(SizeOf(Vertex) * NbSommet)
*IBuffer = AllocateMemory(SizeOf(FTriangle) * NbTriangle)
*PtrV.Vertex = *Vbuffer
*PtrF.FTriangle = *IBuffer
uu = umin
p = 0
;Coul = Random($00FFFF) + $FF0000
;Coul = $12143F
;Coul = $DB1702
;Coul = $7FDD4C
Coul = $884DA7
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)
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
CreateMeshTore()
;-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,35,35,35)
;-Camera
CreateCamera(0, 0, 0 , 100 , 100)
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.8
Repeat
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)
