Page 1 of 1

MaterialTextureAliases

Posted: Tue Jan 22, 2019 10:08 pm
by pf shadoko
Image

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()

Re: MaterialTextureAliases

Posted: Mon Jan 28, 2019 10:32 am
by DK_PETER
Your example looks very good.
Thank you for sharing. :wink:

Re: MaterialTextureAliases

Posted: Thu Apr 11, 2019 5:08 pm
by pf shadoko
[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.

Re: MaterialTextureAliases

Posted: Thu Apr 11, 2019 11:46 pm
by IdeasVacuum
Hi pf

How do we get your sample to work? (crashes @ your comment "BUG")

Re: MaterialTextureAliases

Posted: Fri Apr 12, 2019 9:46 am
by DK_PETER
@pf
That looks really good. :)

@IV
Download the zip file and unpack
Copy/paste the code and save to the unpacked folder
Change line 483 to
Add3DArchive(".", #PB_3DArchive_FileSystem )
Run...

Re: MaterialTextureAliases

Posted: Thu Mar 28, 2024 5:28 pm
by Psychophanta
Does not work as it should in PB6.10

Re: MaterialTextureAliases

Posted: Thu Mar 28, 2024 5:55 pm
by pf shadoko
indeed, the "ParallaxOcclusionMapping" script is no longer in the scripts folder (it was directx)
but it's no longer useful, as many effects are now integrated into the 3d engine.
The new version finally includes examples shaderXXX.pb (+ environnementmapping.pb)