salut les codeurs,
j'ai bossé pendant une semaine sur le cube mapping (texture et relief) dans le but de faire des rochers
les resultats n'ont pas été tres concluant
mon but étant de faire une texture procédurale bouclé en cube, de ce coté le resultat est potable (quoi que)
en revanche au niveau de la création du mesh, faire coincider les normales est un peu trop merdique
en fait, j'ai laisser tombé quand j'ai compris que la bonne façon de faire impliquait un mode texturage que notre implementation d'ogre ne permet pas (je vais voir ce que je peux faire de ce coté)
vous verrez, c'est pas top (on voit les coutures sur les textures de l’astéroïde, la planète et la voute celeste c'est ok)
EDIT:
j'ai fais quelques modifs : 4 different asteroides + coloration
Code : Tout sélectionner
; demo Asteroïde - pf Shadoko - 2018
EnableExplicit
Structure vector2
x.f
y.f
EndStructure
Structure Vector3
x.f
y.f
z.f
EndStructure
Structure Svertex2
p.vector3
n.vector3
diag.b
ai.b
aj.b
uv.vector2
color.l
EndStructure
Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
EndMacro
Macro vec2d(v,vx,vy)
v\x=vx
v\y=vy
EndMacro
Procedure.f lng3D(*v.Vector3)
ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure
Procedure Norme3D(*V.Vector3,l.f=1)
Protected.f lm
lm = l / lng3d(*v)
*V\x * lm
*V\y * lm
*V\z * lm
EndProcedure
Macro sub3D(p,p1,p2)
p\x=p1\x-p2\x
p\y=p1\y-p2\y
p\z=p1\z-p2\z
EndMacro
Procedure addvertex(px.f,py.f,pz.f, nx.f,ny.f,nz.f, u.f,v.f,c=0)
MeshVertexPosition(px,py,pz)
MeshVertexNormal(nx,ny,nz)
MeshVertexTextureCoordinate(u,v)
MeshVertexColor(c)
EndProcedure
Procedure Createsurface(mesh,Array t.Svertex2(2))
Protected p,i,j,m,diag,nx=ArraySize(t(),2),nz=ArraySize(t(),1)
Protected.vector3 d1,d2,n
m=CreateMesh(mesh):If mesh=-1:mesh=m:EndIf
For j=0 To nz
For i=0 To nx
With t(j,i)
addvertex(\P\x,\p\y,\p\z,\n\x,\n\y,\n\z,\uv\x,\uv\y,\color)
EndWith
Next
Next
For j=0 To nz-1
For i=0 To nx-1
p=j*(nx+1)+i
diag=t(j,i)\diag
If diag=0
sub3d(d1,t(j,i)\p,t(j+1,i+1)\p)
sub3d(d2,t(j+1,i)\p,t(j,i+1)\p)
If lng3d(d1)>lng3d(d2):diag=1:Else:diag=-1:EndIf
EndIf
If diag=1
MeshFace(p,p+nx+1,p+1): MeshFace(p+nx+2,p+1,p+nx+1)
Else
MeshFace(p+nx+1,p+nx+2,p): MeshFace(p+1,p,p+nx+2)
EndIf
Next
Next
FinishMesh(1)
NormalizeMesh(mesh)
UpdateMeshBoundingBox(mesh)
ProcedureReturn mesh
EndProcedure
Procedure AddMesh(mesho,Mesh,mat, NewX.f=0 , NewY.f=0, NewZ.f=0, ScaleX.f=1, ScaleY.f=1, ScaleZ.f=1, RotateX.f=0, RotateY.f=0, RotateZ.f=0)
Protected Dim MeshDataV.PB_MeshVertex(0)
Protected Dim MeshDataF.PB_MeshFace(0)
Protected i,meshc
meshc=CopyMesh(mesh,-1)
TransformMesh(Meshc, NewX,NewY,NewZ, ScaleX,ScaleY,ScaleZ, RotateX,RotateY,RotateZ)
GetMeshData(Meshc,0, MeshDataV(), #PB_Mesh_Vertex | #PB_Mesh_UVCoordinate| #PB_Mesh_Normal|#PB_Mesh_Color, 0, MeshVertexCount(Meshc, 0)-1)
GetMeshData(Meshc,0, MeshDataF(), #PB_Mesh_Face, 0, MeshIndexCount(Meshc, 0)-1)
FreeMesh(meshc)
AddSubMesh()
For i=0 To ArraySize(MeshDataV())
With MeshDatav(i)
addvertex(\x,\y,\z,\NormalX,\NormalY,\NormalZ,\u,\v,\Color)
EndWith
Next
For i=0 To ArraySize(MeshDataF()) Step 3
MeshFace(MeshDataF(i)\Index, MeshDataF(i+1)\Index,MeshDataF(i+2)\Index)
Next
If mat>=0:SetMeshMaterial(mesho, MaterialID(mat), SubMeshCount(mesho)-1):EndIf
EndProcedure
Procedure Split(Array t.s(1),l.s,sep.s=",",nmax=100)
Protected ap.l,p.l,n,ls
Dim t(nmax)
ls=Len(sep)
l+sep
p=1-ls
Repeat
ap=p+ls:p=FindString(l,sep,ap)
If p=0:Break:EndIf
n+1
t(n)= Mid(l,ap,p-ap)
ForEver
ReDim t(n)
EndProcedure
Procedure string2vector2(Array s.vector2(1),txt.s)
Dim tt.s(0)
Dim t.s(0)
Protected i,n
split(tt(),txt,"/",100)
n=ArraySize(tt())
Dim s(n-1)
For i=1 To n
split(t(),tt(i)+",0",",")
With s(i-1)
\x=ValF(t(1))
\y=ValF(t(2))
EndWith
Next
EndProcedure
Procedure.f Mini(v1.f,v2.f)
If v1<v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure
Procedure limite(V, i, s)
If V < i :v=i:EndIf
If V > s :v=s:EndIf
ProcedureReturn V
EndProcedure
Procedure CoRBinv(c.l)
ProcedureReturn RGBA(Blue(c),Green(c),Red(c),Alpha(c))
EndProcedure
Procedure ColorBlend(color1.l, color2.l, blend.f)
Protected r.w,g.w,b.w,a.w
r= Red(color1) + (Red(color2) - Red(color1)) * blend
g=Green(color1) + (Green(color2) - Green(color1)) * blend
b= Blue(color1) + (Blue(color2) - Blue(color1)) * blend
a=Alpha(color1) + (Alpha(color2) - Alpha(color1)) * blend
ProcedureReturn RGBA(r,g,b,a)
EndProcedure
Procedure GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
Protected Dim lt.s(0)
Protected i,j, apos,pos, acol.l,col.l
n-1
Dim pal(n)
split(lt(),gradient,"/")
Macro lparam(i)
pos=ValF(lt(i))*n
col=Val(Mid(lt(i),FindString(lt(i),",")+1))
If inv :col=CoRBinv(col):EndIf
If alpha:col | $ff000000:EndIf
EndMacro
lparam(1)
For i=2 To ArraySize(lt())
apos=pos
acol=col
lparam(i)
For j=apos To pos:pal(j)=ColorBlend(acol,col,(j-apos)/(pos-apos)):Next
Next
EndProcedure
Procedure Finterpol(Array F.f(1),t.s,rx.f=1,ry.f=1,oy.f=0)
Protected.l i,j,n,c,ac
Protected.f y,dx,dy,p
Protected Dim s.vector2(0)
string2vector2(s(),t)
n=ArraySize(s())
For i=0 To n
s(i)\x*rx
s(i)\y*ry+oy
Next
Dim f(Int(s(n)\x))
For j=0 To n-1
y=s(j)\y
dx=s(j+1)\x-s(j)\x
dy=s(j+1)\y-s(j)\y
p=dy/dx
ac=c
While c<=s(j+1)\x
f(c)=y+p*(c-ac):c+1
Wend
Next
EndProcedure
Procedure t2norme(Array t.w(2),dmin.w,dmax.w,profil.s="")
Protected smin.w,smax.w,dx1,dy1,i,j,sr,dr
If profil="":profil="0,0/1,1":EndIf
dy1 = ArraySize(t(), 1)
dx1 = ArraySize(t(), 2)
smax = -32768
smin = 32767
For j=0 To dy1
For i=0 To dx1
If t(j,i)>smax : smax=t(j,i): EndIf
If t(j,i)<smin : smin=t(j,i): EndIf
Next
Next
sr=smax-smin
dr=dmax-dmin
Protected Dim conv.f(sr)
Finterpol(conv(),profil,sr,dr,dmin)
For j=0 To dy1
For i=0 To dx1
t(j,i)=conv(t(j,i)-smin)
Next
Next
EndProcedure
Procedure Embos(Array s.w(2), px.w=0, py.w=0)
Protected i,j,dx,dy
px=1<<Int(Abs(px))*Sign(px)
py=1<<Int(Abs(py))*Sign(py)
Macro gra(j0,i0,j1,i1)
t(j0,i0)=Abs(s(j0,i0)-s(j0,i1)+px)+Abs(s(j0,i0)-s(j1,i0)+py)
EndMacro
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
Dim T.w(dy,dx)
For j=0 To dy-1
For i=0 To dx-1
gra(j,i,j+1,i+1)
Next
gra(j,dx,j+1,0)
Next
For i = 0 To dx-1
gra(dy,i,0,i+1)
Next
gra(dy,dx,0,0)
CopyArray(t(),s())
EndProcedure
;######################################################################################################
Declare asteroide(n)
Procedure heightline(Array t.w(1),dx,re,symetric.b)
Protected i,ii,n,d,dd,l,R, rr
n = 1<<re
dd=dx / n: If dd<1:dd=1:EndIf
Dim t.w(dx)
rr = $1fff:r=rr/2
For ii = 1 To d/dd - 1:i=ii*dd: t(i) = Random(rr) - R: Next
While dd > 1
d = dd / 2
For ii = 0 To dx/dd - 1:i=ii*dd+d
t(i) = (t(i - d) + t(i + d)) /2 + Random(rr) - R
Next
l/2
dd/2
r/2:rr/2
Wend
If symetric:For i=0 To dx/2:t(dx-i)=t(i):Next:EndIf
EndProcedure
Procedure heightmapSym(Array t.w(2),rnd, dx.w, dy.w, Re.w)
Protected i,j,ii,jj,n,d,dd,l,R, rr,dec
n = 1<<re
dd=mini(dx,dy) / n: If dd<1:dd=1:EndIf
Dim t.w(dy, dx)
Dim b.w(dx)
RandomSeed(rnd)
heightline(b(),dx,re,1)
For i=0 To dx:t(0,i)=b(i):Next
For i=0 To dx:t(dy,i)=b(i):Next
For j=0 To dy:t(j,0)=b(j):Next
For j=0 To dy:t(j,dx)=b(j):Next
RandomSeed(rnd)
rr = $1fff:r=rr/2
For jj = 1 To dy/dd - 1:j=jj*dd: For ii = 1 To dx/dd - 1:i=ii*dd: t(j,i) = Random(rr) - R: Next: Next
l = dd
While dd > 1
d = dd / 2
For jj = 0 To dy/dd - 1 :j=jj*dd+d
For ii = 0 To dx/dd - 1:i=ii*dd+d
t(j,i) = (t(j - d,i - d) + t(j - d,i + d) + t(j + d,i + d) + t(j + d,i - d)) / 4 + Random(rr) - R
Next
Next
For jj = 1 To dy/d - 1 :j=jj*d:dec=1- jj & 1
For ii = 1-dec To dx/dd - 1:i=ii*dd+dec*d
t(j,i) = (t(j,i - d) + t(j,i + d) + t(j - d,i) + t(j + d,i)) / 4 + Random(rr) - R
Next
Next
l/2
dd/2
r/2:rr/2
Wend
EndProcedure
Procedure texture(tex,dx,dy,rnd=0,f=0,lissage=0,embos=-1000,pal.s="0,$000000/1,$ffffff")
Protected Dim t.w(0,0)
Protected Dim bmp.l(dy-1,dx-1)
Protected Dim pal.l(0):gradienttoarray(pal(),1024,pal,1)
Protected i,j,n
heightmapSym(t(),rnd,dx,dy,f)
If embos<>-1000:embos(t(),embos,embos):EndIf
t2norme(t(),0,1023)
For j=0 To dy-1:For i=0 To dx-1:bmp(j,i)=pal(t(j,i)):Next:Next
n=CreateTexture(tex,dx,dy)
If tex=-1:tex=n:EndIf
StartDrawing(TextureOutput(tex))
CopyMemory(@bmp(0,0),DrawingBuffer(),dx*dy*4)
StopDrawing()
ProcedureReturn tex
EndProcedure
Procedure affiche3d()
Static.f MouseX,Mousey,keyx,keyy,keyz,a, fdf.b,iu.b=1,rot.f=1
Protected i,event,transit=200
Repeat
event=WindowEvent()
ExamineMouse()
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
If WaitWindowEvent(1) = #PB_Event_LeftClick And IsScreenActive():iu=1-iu: ReleaseMouse(iu):EndIf
ExamineKeyboard()
keyx=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*0.02
keyz=(-Bool(KeyboardPushed(#PB_Key_Down)<>0)+Bool(KeyboardPushed(#PB_Key_Up )<>0))*0.02+MouseWheel()*0.2
If KeyboardReleased(#PB_Key_F1):asteroide(1):transit=200:EndIf
If KeyboardReleased(#PB_Key_F2):asteroide(2):transit=200:EndIf
If KeyboardReleased(#PB_Key_F3):asteroide(3):transit=200:EndIf
If KeyboardReleased(#PB_Key_F4):asteroide(4):transit=200:EndIf
If transit>0:transit-1:CameraFollow(0,EntityID(1),0,0,10,0.05,0.05,1):EndIf
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera (0, KeyX, 0, -keyz) :MoveCamera(0,CameraX(0),CameraY(0),CameraZ(0),#PB_Absolute)
RotateEntity(1,rot*0.01,rot*0.03,0,#PB_Relative)
RenderWorld()
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until event=#PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
EndProcedure
Procedure createsphereCM(mesh,rnd,rayon.f,detail,amp.f,fraction,lissage=0,ntile=1,profil.s="",pal.s="")
Define i,j,d=1<<detail ,d2=d/2,n,icolor
Dim t.svertex2(d,d)
Dim hm.w(d,d)
Dim pal.l(0):gradienttoarray(pal(),1024,pal,1)
heightmapSym(hm(),rnd,d,d,fraction)
t2norme(hm(),-1024,1024,profil)
For j=0 To d
For i=0 To d
vec3d(t(i,j)\p,-Tan((i/d2-1)*#PI/4),1,Tan((j/d2-1)*#PI/4))
norme3d(t(i,j)\p,(1+hm(i,j)/1024*amp)*rayon)
vec2d(t(i,j)\uv,i/d*ntile,j/d*ntile)
icolor=1023*(hm(i,j)+1024)/2048:t(i,j)\color=pal(icolor)
Next
Next
n= createsurface(-1,t())
CreateMesh(mesh)
addmesh(mesh,n,-1,0,0,0,1,1,1,0,0,0)
addmesh(mesh,n,-1,0,0,0,1,1,1,0,270,270)
addmesh(mesh,n,-1,0,0,0,1,1,1,180,0,0)
addmesh(mesh,n,-1,0,0,0,1,1,1,0,270,90)
addmesh(mesh,n,-1,0,0,0,1,1,1,270,90,0)
addmesh(mesh,n,-1,0,0,0,1,1,1,90,0,270)
FinishMesh(1)
NormalizeMesh(mesh)
EndProcedure
Procedure asteroide(n)
Protected past.vector3
Select n
Case 1:createspherecm(1,0,4,8,0.05,0,0,4,"0,1/0.3,0.8/0.5,0/0.6,0.5/1,1","0,$004488/1,$ffffff"):vec3d(past,1000,0,2000)
Case 2:createspherecm(1,4,4,8,0.1,0,0,4,"0,0/1,1","0,$ffffff/1,$ffffff"):vec3d(past,-2000,0,-1000)
Case 3:createspherecm(1,1,4,8,0.04,2,0,4,"0,0.4/0.5,0.6/0.7,1/0.8,0.1/1,0.0","0,$ff0000/0.5,$0088ff/1,$ffffff"):vec3d(past,-1000,0,1000)
Case 4:createspherecm(1,1,4,8,0.08,2,0,4,"0,0/0.5,0.3/0.6,0.7/1,1","0,$ffffff/1,$0000ff"):vec3d(past,-1000,0,-1500)
EndSelect
CreateEntity(1,MeshID(1),MaterialID(1),past\x,past\y,past\z)
EndProcedure
Procedure menu()
Protected p=8
Macro DT(t1,t2)
DrawText(8,p,t1)
DrawText(100,p,t2)
p+22
EndMacro
CreateSprite(0,256,180,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawingFont(FontID(0))
Box(0,0,256,180,$44000000)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
Box(0,0,256,180,$ffffffff)
BackColor($44000000)
FrontColor($ffffffff)
dt("Moving:","")
dt("Cursor + Mouse","")
dt("","")
dt("Commandes:","")
dt("[F1]->[F4]","Select asteroid")
dt("[F12]","Wireframe")
dt("[Esc]","Quit")
StopDrawing()
EndProcedure
Procedure test_CubeMap()
Protected i,ex,ey,r.f=1
ExamineDesktops()
ex=DesktopWidth(0)
ey=DesktopHeight(0)
InitKeyboard():InitMouse():InitEngine3D():InitSprite()
OpenWindow(0,0,0,ex*r,ey*r,"",#PB_Window_BorderLess)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0),WindowHeight(0))
LoadFont(0,"arial",14)
menu()
;-------------------- scene
CreateLight(0, $aaaaaa, -5000, 1000, 2000)
SetLightColor(0, #PB_Light_SpecularColor, $444444)
AmbientColor($444444)
CreateCamera(0, 0, 0, 100, 100)
CameraRange(0,0,100000)
MoveCamera(0, -10,1,-10, #PB_Absolute)
CameraLookAt(0, 0, 0, 0)
;planete
texture(3,256,256,1, 3,0,-1000,"0,$ffffff/0.4,$446666/0.5,$6688bb/1,$446688")
CreateMaterial(3, TextureID(3))
createspherecm(3,0,500,5,0,0,0,1)
CreateEntity(3,MeshID(3),MaterialID(3))
;anneau
texture(4,128,128,0, 2,0,-1000,"0,$000000/1,$ffffffff")
CreateMaterial(4, TextureID(4)):ScaleMaterial(4,1,0.1)
MaterialFilteringMode(4,#PB_Material_Anisotropic,4)
MaterialBlendingMode(4,#PB_Material_AlphaBlend)
CreateTorus(4,800,180,8,64):TransformMesh(4,0,0,0,1,0.0001,1,-15,-40,0):NormalizeMesh(4)
CreateEntity(4,MeshID(4),MaterialID(4))
;etoiles
texture(5,256,256,4, 1,0,-1000,"0,$442222/0.1,$221111/0.5,$000000/0.7,$000000/1,$112222")
CreateTexture(6,512,512)
StartDrawing(TextureOutput(6)):For i=0 To 400:Circle(Random(512),Random(512),Pow(Random(3)+1,4)/200,Random(255)*$010101):Next:StopDrawing()
CreateMaterial(5, TextureID(5))
AddMaterialLayer(5, TextureID(6),#PB_Material_Add):ScaleMaterial(5,1/4,1/4,1)
SetMaterialColor(5,#PB_Material_SelfIlluminationColor,$ffffff):MaterialCullingMode(5, #PB_Material_NoCulling)
createspherecm(5,0,10000,2,0,0,0,1)
CreateEntity(5,MeshID(5),MaterialID(5))
;soleil
CreateTexture(7,2,2)
StartDrawing(TextureOutput(7)):Box(0,0,2,2,$ffffff):StopDrawing()
CreateMaterial(7, TextureID(7))
SetMaterialColor(7,#PB_Material_SelfIlluminationColor,$ffffff):MaterialCullingMode(5, #PB_Material_NoCulling)
CreateSphere(7,100)
CreateEntity(7,MeshID(7),MaterialID(7),-5000, 1000, 2000)
;asteroide
texture(1,512,512,0, 4,0,0,"0,$ffffff/1,$000000")
texture(2,512,512,0, 3,0,20,"0,$ff000000/0.5,$00/1,$ffffffff")
CreateMaterial(1, TextureID(1))
SetMaterialColor(1, #PB_Material_SpecularColor, $ffffff):MaterialShininess(1, 10)
AddMaterialLayer(1, TextureID(2),#PB_Material_AlphaBlend):ScaleMaterial(1,1/4,1/4,1)
MaterialFilteringMode(1,#PB_Material_Anisotropic,4)
SetMaterialColor(1, #PB_Material_AmbientColor,-1)
asteroide(1)
affiche3d():End
EndProcedure
test_CubeMap()