Hello everyone
the 5.70 integrates a new function: MaterialTextureAliases( material, texture1id=0, texture2id=0, texture3id=0, texture4id=0)
texture aliases allow to use different textures with the same material script.
this function substitutes the texture aliases of a material script with PureBasic textures.
In the script material, references to textures:
"texture mytexture.jpg"
must be replaced by
"texture_alias texture1" (or texture2, texture3, texture4)
my goal is to make a collection of material scripts (directx and opengl compatible) containing the main effects
- normal mapping
- offset mapping
- refraction
- reflection (on a heightmap)
- fresnel
...
if there are experts who want to help me, I'll gladly accept.
the example below uses a "normalmap" script that I retrieved from a kelebrindae program
(only for windows (HLSL))
textures are created with purebasic
I included 2 functions to create normal maps:
- textureArray2NM (uses a long array as input)
- textureHM2NM (uses an input texture, the heights correspond to the brightness of the pixels)
to make this example work, you must first upload the following file:
http://cg.racine.free.fr/MaterialScripts_Alias.zip
ldecompress it and put the path of the folder
in :
Add3DArchive("...\materialscripts_alias", #PB_3DArchive_FileSystem )
(line 480)
[EDIT 11/04/2019]
I changed the script (and code)
I retrieved the script "ParallaxOcclusionMapping" from samuel
by setting the alpha layer to 255, it can be used as a simple normalmapping
it is very fast and does not present any defect on the reflection
moreover, it is composed of 3 files, making less than 10k in total
in short, it is much better than the old one.
Code: Select all
; ----------------------------------------------------------------------------------------------------------
; MaterialTextureAliases - pf Shadoko - 2018
; ----------------------------------------------------------------------------------------------------------
;{ ============================= biblio
Structure Vector2
x.f
y.f
EndStructure
Structure Vector3
x.f
y.f
z.f
EndStructure
Structure PB_MeshVertexV
p.vector3
n.vector3
t.vector3
u.f
v.f
color.l
EndStructure
Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
EndMacro
Macro sub3D(p,p1,p2)
p\x=p1\x-p2\x
p\y=p1\y-p2\y
p\z=p1\z-p2\z
EndMacro
Macro add3d(p,p1,p2)
p\x=p1\x+p2\x
p\y=p1\y+p2\y
p\z=p1\z+p2\z
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
Procedure Pvectoriel3d(*r.vector3,*p.vector3,*q.vector3)
*r\x=*p\y * *q\z - *p\z * *q\y
*r\y=*p\z * *q\x - *p\x * *q\z
*r\z=*p\x * *q\y - *p\y * *q\x
EndProcedure
Procedure defmatrot(*p.vector3,w.f, orientation=0)
Global.vector3 lo_p,lo_q,lo_r
Protected pp.vector3, l.f
vec3d(lo_p,*p\x,*p\y,*p\z)
l=lng3d(lo_p)
Select orientation
Case 0:vec3d(pp,Cos(w),0,Sin(w))
Case 1:vec3d(pp,0,Cos(w),Sin(w))
Case 2:vec3d(pp,Cos(w),Sin(w),0)
EndSelect
pvectoriel3d(lo_q,lo_p,pp ):Norme3d(lo_q,l)
pvectoriel3d(lo_r,lo_p,lo_q):Norme3d(lo_r,l)
EndProcedure
Procedure calcmatrot(*v.vector3, *u.vector3)
Protected.f x=*u\x, y=*u\y, z=*u\z
*v\x=lo_p\x * x + lo_q\x * y + lo_r\x * z
*v\y=lo_p\y * x + lo_q\y * y + lo_r\y * z
*v\z=lo_p\z * x + lo_q\z * y + lo_r\z * z
EndProcedure
Procedure.f Max(v1.f,v2.f)
If v1>v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure
Procedure.f Min(v1.f,v2.f)
If v1<v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure
Procedure.f limite(V.f, i.f, s.f)
If V < i :v=i:EndIf
If V > s :v=s:EndIf
ProcedureReturn V
EndProcedure
Macro vec2d(v,vx,vy)
v\x=vx
v\y=vy
EndMacro
Macro interpol(v,v1,v2,r=0.5)
v=v1*(1-r)+v2*r
EndMacro
Procedure interpol3D(*R.Vector3, *V1.Vector3, *V2.Vector3, r.f)
*R\x = *V1\x + r * (*V2\x - *V1\x)
*R\y = *V1\y + r * (*V2\y - *V1\y)
*R\z = *V1\z + r * (*V2\z - *V1\z)
EndProcedure
Procedure.f POM(v.f)
ProcedureReturn (Random(v*1000)-v*500)/500
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 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,p
n-1
Dim pal(n)
split(lt(),gradient,"/")
Macro lparam(i)
pos=ValF(lt(i))*n
p=FindString(lt(i),",")
If p: col=Val(Mid(lt(i),p+1)):Else:col=acol:EndIf
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.l(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 Tmodulo(Array T(1), max, marge)
Protected i,d=max-marge/2
Dim T(max + 2*marge): For i = 0 To max + 2*marge: T(i) = (i+d) % (max+1): Next
EndProcedure
Procedure Tlimite(Array T(1), max, marge)
Protected i
Dim T(max + 2*marge): For i = 0 To max + 2*marge: T(i) = limite(i-1-marge/2, 0, max): Next
EndProcedure
Procedure lisser2D(Array s.l(2),di.w, dj.w,pass=1,loop=1)
If di=0 And dj=0:ProcedureReturn:EndIf
Protected i,j,k,dii,djj,dx,dy,dij,tx
dx = ArraySize(s(), 2):di=min(di,dx)
dy = ArraySize(s(), 1):dj=min(dj,dy)
Dim d.l(dy,dx)
dii=di+1
djj=dj+1
dij = dii * djj
Dim lx(0)
Dim ly(0)
If loop
Tmodulo (lx(), dx, di+1)
Tmodulo (ly(), dy, dj+1)
Else
Tlimite(lx(), dx, di+1)
Tlimite(ly(), dy, dj+1)
EndIf
For k=1 To pass
Dim ty.l(dx)
For j = 0 To djj - 1: For i = 0 To dx: ty(i) + s(ly(j),i): Next: Next
For j = 0 To dy
For i = 0 To dx: ty(i) + s(ly(djj+j),i) - s(ly(j),i): Next
tx=0:For i = 0 To dii-1: tx+ty(lx(i)): Next
For i = 0 To dx: tx + ty(lx(dii+i)) - ty(lx(i) ): d(j,i) = tx / dij: Next
Next
CopyArray(d(),s())
Next
EndProcedure
Procedure heightmap(Array t.l(2),rnd, dx.w, dy.w, Re.w)
Protected i,j,ii,jj,n,d,dd,dx1=dx-1,dy1=dy-1,l,R, rr,dec
RandomSeed(rnd)
n = 1<<re
dd=min(dx,dy) / n: If dd<1:dd=1:EndIf
Dim t.l(dy-1, dx-1)
rr = $1fff:r=rr>>1
For jj = 0 To dy/dd - 1:j=jj*dd: For ii = 0 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) & dy1,(i - d) & dx1) + t((j - d) & dy1,(i + d) & dx1) + t((j + d) & dy1,(i + d) & dx1) + t((j + d) & dy1,(i - d) & dx1)) / 4 + Random(rr) - R
Next
Next
For jj = 0 To dy/d - 1 :j=jj*d:dec=1- jj & 1
For ii = 0 To dx/dd - 1:i=ii*dd+dec*d
t(j,i) = (t(j,(i - d) & dx1) + t(j,(i + d) & dx1) + t((j - d) & dy1,i) + t((j + d) & dy1,i)) / 4 + Random(rr) - R
Next
Next
l/2
dd/2
r/2:rr/2
Wend
EndProcedure
Procedure textureArray2NM(Array hm.l(2),imgNM,amplitude.f)
Protected i,j,dx,dy,h00,h10,h01
Protected.f x,y,z,l, max=255/amplitude,max2=max*max
Protected.vector3 p
dx=ArraySize(hm(),2)+1
dy=ArraySize(hm(),1)+1
Dim bmp.l(dy-1,dx-1)
For j=0 To dy-1
For i=0 To dx-1
h00=hm(j,i)
h10=hm(j,(i+1) % dx)
h01=hm((j+1) % dy,i)
p\x=h00-h10
p\y=h00-h01
l=min(p\x*p\x+p\y*p\y,max2)
p\z=Sqr(max2-l)
Norme3D(p,127)
bmp(j,i)=RGBA(p\z+128,p\y+128,p\x+128,255)
Next
Next
CreateTexture(imgNM,dx,dy)
StartDrawing(TextureOutput(imgNM)):CopyMemory(@bmp(0,0),DrawingBuffer(),dx*dy*4):StopDrawing()
EndProcedure
Procedure textureHM2NM(imgHM,imgNM,amplitude.f)
Protected i,j,dx,dy,c
StartDrawing(TextureOutput(imgHM))
dx=OutputWidth()
dy=OutputHeight()
Dim hm.l(dy-1,dx-1)
Dim bmp.l(dy-1,dx-1)
CopyMemory(DrawingBuffer(),@bmp(0,0),dx*dy*4)
StopDrawing()
For j=0 To dy-1
For i=0 To dx-1
c=bmp(j,i)
hm(j,i)=Red(c)+Green(c)+Blue(c)
Next
Next
textureArray2NM(hm(),imgNM,amplitude/3)
EndProcedure
Procedure texture(tex,dx,dy,rnd=0,f=0,lissage=0,amplitude=64,profil.s="0,0/1,1",grad.s="0,$000000/1,$ffffff")
dx/2
dy/2
Protected Dim t.l(0,0)
Protected Dim bmp.l(dy-1,dx-1)
Protected Dim grad.l(0):gradienttoarray(grad(),1024,grad,1)
Protected i,j,n
heightmap(t(),rnd,dx,dy,f)
lisser2d(t(),lissage,lissage,2)
t2norme(t(),0,1023,profil)
For j=0 To dy-1:For i=0 To dx-1:bmp(j,i)=grad(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()
textureArray2NM(t(),tex+1,amplitude)
ProcedureReturn tex
EndProcedure
;}===================================================================================================================================================
;>>>>>>>>>>>>>>>>>>>> BUG GetScriptMaterial <<<<<<<<<<<<<<<<<<<<
Procedure.i GetScriptMaterial_(material.i,name.s)
Protected m,mtemp=GetScriptMaterial(-1,name)
m=CopyMaterial(mtemp,material)
If material=-1:material=m:EndIf
FreeMaterial(mtemp)
ProcedureReturn material
EndProcedure
Macro GetScriptMaterial(material,name):GetScriptMaterial_(material,name):EndMacro
#n=3
#ecart=6
Global diff=1,
spec=1,
rotL=1,
rotG=1,
fdf=0
Procedure mesh_node(mesh,size.f,radius.f,nbseg_length=128,nbseg_section=32,txrepeat_length.f=16,txrepeat_section.f=2)
Dim t.PB_MeshVertexV(nbseg_section,nbseg_length)
Protected.f ai,aj,sx,sy,c.b, rs
Protected.vector3 p,ap,d,s,ss
Macro ligne(jj)
aj=jj/nbseg_length *2*#PI
p\x = (Sin(aj)+2* Sin(2*aj))*size
p\y = (Cos(aj)-2* Cos(2*aj))*size
p\z = - 2*Sin(3*aj)*size
EndMacro
ligne(-1)
For j=0 To nbseg_length
ap=p:ligne(j)
sub3d(d,p,ap):Norme3D(d,1)
defmatrot(d,aj)
For i=0 To nbseg_section
With t(i,j)
ai=i*2*#PI/nbseg_section
s\y=Sin(ai)*radius
s\z=Cos(ai)*radius
calcmatrot(ss,s)
add3d(\p,p,ss)
Norme3D(ss):\n=ss
\u=i*txrepeat_section/nbseg_section
\v=j*txrepeat_length/nbseg_length
EndWith
Next
Next
CreateDataMesh(mesh,t())
BuildMeshTangents(mesh)
EndProcedure
Procedure menu()
Protected p=4
Macro DT(t1,etat=-1)
DrawText(8,p,t1)
If etat=0:DrawText(140,p,"OFF"):ElseIf etat=1:DrawText(140,p,"ON"):EndIf
p+17
EndMacro
CreateSprite(0,180,180,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawingFont(FontID(0))
Box(0,0,180,180,$22ffffff)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
Box(0,0,180,180,$44ffffff)
BackColor($22ffffff)
FrontColor($ffffffff)
dt("Moving :")
dt("Arrow keys + Mouse")
dt("")
dt("Controls :")
dt("[F1] Diffuse light",diff)
dt("[F2] Specular light",spec)
dt("[F3] Global rotation",rotg)
dt("[F4] Local rotation",rotl)
dt("[F12] Wireframe",fdf)
dt("[Esc] / [Click] Quit")
StopDrawing()
EndProcedure
Procedure affiche3d()
Protected.f MouseX,Mousey,keyx,keyz,a,ai
Repeat
WindowEvent()
ExamineMouse()
ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1 ):diff=1-diff:menu():SetLightColor(0,#PB_Light_DiffuseColor ,diff*$ffffff):EndIf
If KeyboardReleased(#PB_Key_F2 ):spec=1-spec:menu():SetLightColor(0,#PB_Light_SpecularColor,spec*$ffffff):EndIf
If KeyboardReleased(#PB_Key_F3 ):rotL=1-rotL:menu():EndIf:If rotL:For i=0 To #n:ai=a+i*2*#PI/(#n+1):MoveEntity(i,#ecart*Cos(ai),0,#ecart*Sin(ai),#PB_Absolute):Next:a+0.002:EndIf
If KeyboardReleased(#PB_Key_F4 ):rotG=1-rotG:menu():EndIf:If rotG:For i=0 To #n:RotateEntity(i,0.1,0.2,0.3,#PB_Relative):Next:EndIf
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:menu():If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
keyx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*0.1
keyz=(-Bool(KeyboardPushed(#PB_Key_Down))+Bool(KeyboardPushed(#PB_Key_Up )))*0.1+MouseWheel()*1
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
MoveCamera (0, KeyX, 0, -keyz)
RenderWorld()
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until MouseButton(#PB_MouseButton_Left) Or KeyboardReleased(#PB_Key_Escape)
EndProcedure
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
ExamineDesktops()
ex=DesktopWidth (0)
ey=DesktopHeight(0)
OpenWindow(0, 0,0, ex,ey, "MaterialTextureAliases - [F1, F2, F3, F4] - Change sample - [F12] Wireframe - [Esc] quit",#PB_Window_BorderLess | #PB_Window_Maximize)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
; <<<<<<<<<<<<<<<< insert path here >>>>>>>>>>>>>>>>
Add3DArchive("!!!", #PB_3DArchive_FileSystem )
Parse3DScripts()
;-------------------- scene
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,0,-14):CameraLookAt(0,0,0,0)
CreateLight(0, $111111* 15*diff, 4000, 4000, -4000):SetLightColor(0,#PB_Light_SpecularColor, $111111* 15*spec)
AmbientColor($111111* 2)
texture(1,512,512,0,5,8,2,"0,1/0.5,0/1,1","0,$000044/0.2,$0044bb/1,$00ff00")
texture(3,512,512,0,4,2,1,"0,0/0.5,1/1,0","0,$ff8800/1,$0088ff")
texture(5,512*2,512/2,0,2,2,1,"0,1/0.4,0.5/0.5,0/0.6,0.5/1,1","0,$224488/0.5,$3366bb/1,$4488dd")
texture(7,512,512,0,3,1,1,"0,0/0.5,1/0.7,0/1,1","0,$0088ff/0.8,$444488/1,$6666aa")
mesh_node(0,1,0.8,256,32,16,2)
For i=0 To #n
GetScriptMaterial(i,"ParallaxOcclusionMapping"):MaterialTextureAliases(i,TextureID(1+(i%4)*2),TextureID(2+(i%4)*2),0,0)
ai=i*2*#PI/(#n+1):CreateEntity(i,MeshID(0),MaterialID(i),#ecart*Cos(ai),0,#ecart*Sin(ai))
RotateEntity(i,Random(360),Random(360),Random(360))
Next
LoadFont(0,"arial",10)
menu()
affiche3d()
