Hello, coders,
I worked for a week on the cube mapping (texture and relief) in order to make rocks.
the results were not very conclusive
my goal being to make a curly procedural texture in cube, on this side the result is drinkable (although)
on the other hand, concerning mesh creation, making the normals coincide is a little too crappy.
In fact, I dropped out when I realized that the right way of doing things meant a texturing mode that our ogre implementation doesn't allow (I'll see what I can do on this side)
you will see, it's not top (we can see the seams on the textures of the asteroid, the planet and the celestial vault is ok)
Code: Select all
; 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()
brilliant 
