
Et blague à part, effectivement, bravo à Comtois et G-Rom (et au reste de l'équipe PB, ne faites pas les modestes!) : non seulement la 3D en PB tourne bien, mais en plus elle reste assez facile à comprendre; que du bonheur!
Code : Tout sélectionner
InitEngine3D(#PB_Engine3D_DebugLog )
InitKeyboard()
InitSprite()
#B = $100
#BM = $ff
#N = $1000
#NP = 12 ; 2^N
#NM = $fff
Structure InnerDoubleArray
d.d[0]
EndStructure
Macro Unsigned(value)
((value) + 1) / 2
EndMacro
Macro s_curve(t)
( t * t * ( 3 - 2 * t ) )
EndMacro
Macro lerp(t, a, b)
( a + t * (b - a) )
EndMacro
Macro setup(i,b0,b1,r0,r1)
t = vec(i) + #N
b0 = Int(t) & #BM
b1 = (b0 + 1) & #BM
r0 = t - Int(t)
r1 = r0 - 1.
EndMacro
Macro at2(rx,ry)
( rx * *q\d[0] + ry * *q\d[1] )
EndMacro
Macro at3(rx,ry,rz)
( rx * *q\d[0] + ry * *q\d[1] + rz * *q\d[2] )
EndMacro
Declare init()
Declare.d noise1(arg.d)
Declare.d noise2(Array vec.d(1))
Declare.d noise3(Array vec.d(1))
Declare normalize2(d.i)
Declare normalize3(d.i)
Declare.d PerlinNoise1D(x.d, alpha.d, beta.d, n.i);
Declare.d PerlinNoise2D(x.d, y.d, alpha.d, beta.d, n.i);
Declare.d PerlinNoise3D(x.d, y.d, z.d, alpha.d, beta.d, n.i);
Global Dim p.i(#B + #B + 1)
Global Dim g1.d(#B + #B + 1)
Global Dim g2.d(#B + #B + 1, 1)
Global Dim g3.d(#B + #B + 1, 2)
Global start.i = 1
Procedure.d noise1(arg.d)
Protected bx0.i, bx1.i
Protected rx0.d, rx1.d, sx.d, t.d, u.d, v.d
Dim vec.d(1)
vec(0) = arg
If start
start = 0
init()
EndIf
setup(0,bx0,bx1,rx0,rx1)
sx = s_curve(rx0)
u = rx0 * g1( p( bx0 ) )
v = rx1 * g1( p( bx1 ) )
ProcedureReturn lerp(sx, u, v)
EndProcedure
Procedure.d noise2(Array vec.d(1))
Protected bx0.i, bx1.i, by0.i, by1.i, b00.i, b10.i, b01.i, b11.i
Protected rx0.d, rx1.d, ry0.d, ry1.d, *q.InnerDoubleArray, sx.d, sy.d, a.d, b.d, t.d, u.d, v.d
Protected i.i, j.i
If start
start = 0
init()
EndIf
setup(0, bx0,bx1, rx0,rx1)
setup(1, by0,by1, ry0,ry1)
i = p( bx0 )
j = p( bx1 )
b00 = p( i + by0 )
b10 = p( j + by0 )
b01 = p( i + by1 )
b11 = p( j + by1 )
sx = s_curve(rx0)
sy = s_curve(ry0)
*q = @g2( b00, 0 ) : u = at2(rx0,ry0)
*q = @g2( b10, 0 ) : v = at2(rx1,ry0)
a = lerp(sx, u, v)
*q = @g2( b01, 0 ) : u = at2(rx0,ry1)
*q = @g2( b11, 0 ) : v = at2(rx1,ry1)
b = lerp(sx, u, v)
Protected rv.d = lerp(sy, a, b)
ProcedureReturn rv
EndProcedure
Procedure.d noise3(Array vec.d(1))
Protected bx0.i, bx1.i, by0.i, by1.i, bz0.i, bz1.i, b00.i, b10.i, b01.i, b11.i
Protected rx0.d, rx1.d, ry0.d, ry1.d, rz0.d, rz1.d, *q.InnerDoubleArray, sy.d, sz.d, a.d, b.d, c.d, d.d, t.d, u.d, v.d
Protected i.i, j.i
If (start)
start = 0
init()
EndIf
setup(0, bx0,bx1, rx0,rx1);
setup(1, by0,by1, ry0,ry1);
setup(2, bz0,bz1, rz0,rz1);
i = p( bx0 )
j = p( bx1 )
b00 = p( i + by0 )
b10 = p( j + by0 )
b01 = p( i + by1 )
b11 = p( j + by1 )
t = s_curve(rx0)
sy = s_curve(ry0)
sz = s_curve(rz0)
*q = @g3( b00 + bz0, 0 ) : u = at3(rx0,ry0,rz0)
*q = @g3( b10 + bz0, 0 ) : v = at3(rx1,ry0,rz0)
a = lerp(t, u, v)
*q = @g3( b01 + bz0, 0 ) : u = at3(rx0,ry1,rz0);
*q = @g3( b11 + bz0, 0 ) : v = at3(rx1,ry1,rz0);
b = lerp(t, u, v);
c = lerp(sy, a, b);
*q = @g3( b00 + bz1, 0 ) : u = at3(rx0,ry0,rz1);
*q = @g3( b10 + bz1, 0 ) : v = at3(rx1,ry0,rz1);
a = lerp(t, u, v);
*q = @g3( b01 + bz1, 0 ) : u = at3(rx0,ry1,rz1);
*q = @g3( b11 + bz1, 0 ) : v = at3(rx1,ry1,rz1);
b = lerp(t, u, v);
d = lerp(sy, a, b);
ProcedureReturn lerp(sz, c, d);
EndProcedure
Procedure normalize2(*v.InnerDoubleArray)
Protected s.d = Sqr(*v\d[0] * *v\d[0] + *v\d[1] * *v\d[1])
*v\d[0] = *v\d[0] / s
*v\d[1] = *v\d[1] / s
EndProcedure
Procedure normalize3(*v.InnerDoubleArray)
Protected s.d = Sqr(*v\d[0] * *v\d[0] + *v\d[1] * *v\d[1] + *v\d[2] * *v\d[2])
*v\d[0] = *v\d[0] / s
*v\d[1] = *v\d[1] / s
*v\d[2] = *v\d[2] / s
EndProcedure
Procedure init()
Protected i.i, j.i, k.i, tmp.i
Protected *t.InnerDoubleArray
i = 0
While i < #B
p(i) = i
tmp = ((Random(2147483647) % (#B + #B)) - #B)
g1(i) = tmp / #B
For j = 0 To 1
tmp = ((Random(2147483647) % (#B + #B)) - #B)
g2(i, j) = tmp / #B
Next
normalize2(@g2(i, 0))
For j = 0 To 2
tmp = ((Random(2147483647) % (#B + #B)) - #B)
g3(i, j) = tmp / #B
Next
normalize3(@g3(i, 0))
i + 1
Wend
i - 1
While i > 0
i - 1
k = p(i)
j = Random(2147483647) % #B
p(i) = p(j)
p(j) = k;
Wend
i = 0
While i < #B + 2
p(#B + i) = p(i)
g1(#B + i) = g1(i)
For j = 0 To 1
g2(#B + i, j) = g2(i, j)
Next
For j = 0 To 2
g3(#B + i, j) = g3(i, j)
Next
i + 1
Wend
EndProcedure
Procedure.d PerlinNoise1D(x.d, alpha.d, beta.d, interations.i)
Protected i.i
Protected val.d = 0, sum.d = 0
Protected p.d = 1, scale.d = 1
p = x
For i = 1 To interations
val = noise1(p)
sum + val / scale
scale * alpha
p * beta
Next
ProcedureReturn(sum)
EndProcedure
Procedure.d PerlinNoise2D(x.d ,y.d, alpha.d, beta.d, interations.i)
Protected i.i
Protected val.d = 0, sum.d = 0
Protected scale.d = 1
Dim args.d(1)
args(0) = x
args(1) = y
For i = 1 To interations
val = noise2(args())
sum + val / scale
scale * alpha
args(0) * beta
args(1) * beta
Next
ProcedureReturn(sum)
EndProcedure
Procedure.d PerlinNoise3D(x.d, y.d, z.d, alpha.d, beta.d, interations.i)
Protected i.i
Protected val.d = 0, sum.d = 0
Protected scale.d = 1
Dim args.d(2)
args(0) = x
args(1) = y
args(2) = z
For i = 1 To interations
val = noise3(args())
sum = sum + (val / scale)
scale * alpha
args(0) * beta
args(1) * beta
args(2) * beta
Next
ProcedureReturn(sum)
EndProcedure
Global ww = 1024
Global wh = 768
Global window = OpenWindow(#PB_Any,0,0,ww,wh,"")
OpenWindowedScreen(WindowID(window),0,0,ww,wh,1,0,0,#PB_Screen_NoSynchronization)
Global camera = CreateCamera(#PB_Any,0,0,100,100)
MoveCamera(camera,1000,1000,1000)
CameraLookAt(camera,500,500,500)
; CameraRenderMode(camera,#PB_Camera_Wireframe)
CreateNode(0,500,500,500)
AttachNodeObject(0,CameraID(camera))
Global light.i = CreateLight(#PB_Any,$FFFFFF,-2000,2000,2000)
AmbientColor($505050)
Global cube_mesh.i = CreateCube(#PB_Any,10)
Global cube_entity.i = CreateEntity(#PB_Any,MeshID(cube_mesh),#PB_Material_None)
; generate minecraft terrain
;
#CHUNCK_SIZE = 100
Dim world.i(#CHUNCK_SIZE,#CHUNCK_SIZE,#CHUNCK_SIZE)
Dim surface.i(#CHUNCK_SIZE,#CHUNCK_SIZE,#CHUNCK_SIZE)
Dim cave.i(#CHUNCK_SIZE,#CHUNCK_SIZE,#CHUNCK_SIZE)
; generate surface
;
div.f = 2 / #CHUNCK_SIZE
For z = 0 To #CHUNCK_SIZE-1
For x = 0 To #CHUNCK_SIZE-1
noise.d = Unsigned(PerlinNoise2D(div * x, div * z, 4, 4, 10))
height.i = (#CHUNCK_SIZE/2) + Int(noise * (#CHUNCK_SIZE/2))
surface(x,height,z) = 255
;fill internal
;
For fill = height To 0 Step -1
surface(x,fill,z) = 255
Next
Next
Next
; generate cave
;
div.f = 500 / (#CHUNCK_SIZE*10)
For z = 0 To (#CHUNCK_SIZE-1)
For y = 0 To #CHUNCK_SIZE-1
For x = 0 To #CHUNCK_SIZE-1
noise.d = Unsigned(PerlinNoise3D(div * x, div * y, div * z, 2, 2, 5))
value.i = Int(noise * 255)
If value < 128
value = 0
EndIf
cave(x,y,z) = value
Next
Next
Next
; boolean operation : surface - cave = world
;
For z = 0 To (#CHUNCK_SIZE-1)
For y = 0 To #CHUNCK_SIZE-1
For x = 0 To #CHUNCK_SIZE-1
If surface(x,y,z) = 255
world(x,y,z) = surface(x,y,z) - cave(x,y,z)
EndIf
Next
Next
Next
; push world into static geometry
;
static_world.i = CreateStaticGeometry(#PB_Any,#CHUNCK_SIZE*1000,#CHUNCK_SIZE*1000,#CHUNCK_SIZE*1000,#False)
For z = 0 To #CHUNCK_SIZE-1
For y = 0 To #CHUNCK_SIZE-1
For x = 0 To #CHUNCK_SIZE-1
If world(x,y,z) = 255
AddStaticGeometryEntity(static_world, EntityID(cube_entity), x*10, y*10, z*10 )
EndIf
Next
Next
Next
BuildStaticGeometry(static_world)
HideEntity(cube_entity,#True)
While #True
If WindowEvent() = #PB_Event_CloseWindow
Break
EndIf
RotateNode(0,0,1,0,#PB_Relative)
ClearScreen(0)
RenderWorld()
FlipBuffers()
Wend
Idem pour moi. Runtime erreur du compilateur. J'ai essayé aussi avec le sous systeme OpenGl et j'ai la même erreur.venom a écrit :Chez moi, le compilateur plante direct. (Avec le dernier zip)
Je ne suis pas sûr d'avoir compris...G-Rom a écrit :Tu peux en revanche optimiser encore plus en utilisant qu'un seul mesh par type de bloc, je m'explique :
ton niveau est un "nuage" de point & les blocs ont une taille constante. Tu gagnerais donc en performance à supprimer / recréer ton mesh à chaque modification du terrain
Code : Tout sélectionner
Dim vertexInfos.PB_vertex(3,0)
GetMeshData(cubeMesh(i),0,vertexInfos(2, ), [etc..]
Code : Tout sélectionner
Stucture vertexInfos_struct
infos.PB_vertex()
endstructure
Dim vertexInfos.vertexInfos_struct(3)
GetMeshData(cubeMesh(i),0,vertexInfos\infos(), [etc..]