Hello, coders,
I've been doing shaders lately, I'll show you my first batch:
http://cg.racine.free.fr/MaterialScript ... c-next.zip
decompress the archive somewhere and put the path in Add3DArchive
These shaders are relatively well integrated in PB, they take care of the following functions (not all):
- Fog
- AmbientColor
- SetLightColor, LightAttenuation
- MaterialShininess, SetMaterialColor
- ScaleMaterial, RotateMaterial, ScrollMaterial
...
and also the color of the vertex (bump and perpixel).
problems:
- Fog has to be set (if we don't want to put fog: Fog($ffffffff,1,10000,10001) )
- if the color of the vertex is not defined they appear black
if you want to get started I suggest the following links:
https://docs.microsoft.com/fr-fr/window ... -functions
https://www.ogre3d.org/docs/manual18/ma ... C_Contents
(see 3.1.9 for the passage of the ogre parameters).
still have to convert these shaders to GLSL (opengl) so that the whole PB community can use them (they will be integrated in the next release)
I'm hoping someone will take care of it...
There are experts.
Code: Select all
;{ ============================= biblio
Structure f2
x.f
y.f
EndStructure
Structure f3
x.f
y.f
z.f
EndStructure
Structure PB_MeshVertexV
p.f3
n.f3
t.f3
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.f3)
ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure
Procedure Norme3D(*V.f3,l.f=1)
Protected.f lm
lm = l / lng3d(*v)
*V\x * lm
*V\y * lm
*V\z * lm
EndProcedure
Procedure Pvectoriel3d(*r.f3,*p.f3,*q.f3)
*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.f3,w.f, orientation=0)
Global.f3 lo_p,lo_q,lo_r
Protected pp.f3, 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.f3, *u.f3)
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
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 string2f2(Array s.f2(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.f2(0)
string2f2(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.l(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.l(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.l(0)
Dim ly.l(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(tex,Array hm.l(2),amplitude.f)
Protected i,j,dx,dy,h00,h10,h01
Protected.f x,y,z,l, max=255/amplitude,max2=max*max
Protected.f3 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
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 texturediffuse(tex,dx,dy,rnd=0,f=0,lissage=0,grad.s="0,$000000/1,$ffffff",profil.s="0,0/1,1",relief.f=-1)
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()
ProcedureReturn tex
EndProcedure
Procedure texturenormal(tex,dx,dy,rnd=0,f=0,lissage=0,relief.f=1,profil.s="0,0/1,1")
Protected Dim t.l(0,0)
heightmap(t(),rnd,dx,dy,f)
lisser2d(t(),lissage,lissage,2)
t2norme(t(),0,1023,profil)
textureArray2NM(tex,t(),relief)
ProcedureReturn tex
EndProcedure
#n=3
#ecart=8
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.f3 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
\color=($ffffff)+$ff000000
EndWith
Next
Next
CreateDataMesh(mesh,t())
BuildMeshTangents(mesh)
EndProcedure
Procedure mesh_foliage(mesh,size.f,n=8)
Protected.f n2.l=n/2, r1,r2, cx,cy,cz,fq,phase,souplesse=10
fq=min(250/size,255)
phase=Random(200)
Global Dim t.PB_MeshVertexv(n,n)
For j=0 To n:jn=j/n
For i=0 To n
With t(i,j)
cx=(i-n2)/n*size
cy=(j)/n*size
vec3d(\p,cx,cy,0)
vec3d(\n,0,1,0)
\u=i/n
\v=j/n
\Color=RGBA(fq,min((cx*cx+cy*cy)*souplesse,255),phase,0);:Debug min((cx*cx+cy*cy)*souplesse,255)
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")
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*$111111* 8*spec):EndIf
If KeyboardReleased(#PB_Key_F2 ):spec=1-spec:menu():SetLightColor(0,#PB_Light_SpecularColor,spec*$111111* 15*spec):EndIf
If KeyboardReleased(#PB_Key_F3 ):rotG=1-rotG:menu():EndIf:If rotG:For i=0 To #n:ai=a+i*2*#PI/(#n+1):MoveEntity(i,#ecart*Cos(ai),4,#ecart*Sin(ai),#PB_Absolute):Next:a+0.002:EndIf
If KeyboardReleased(#PB_Key_F4 ):rotL=1-rotL:menu():EndIf:If rotL: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: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)
CameraReflection(1,0,EntityID(10))
RenderWorld()
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until MouseButton(#PB_MouseButton_Left) Or KeyboardReleased(#PB_Key_Escape)
EndProcedure
Procedure main()
InitEngine3D(#PB_Engine3D_DebugLog):InitSprite():InitKeyboard():InitMouse()
ExamineDesktops()
ex=DesktopWidth (0)
ey=DesktopHeight(0)
OpenWindow(0, 0,0, ex,ey, "Demo Shader",#PB_Window_BorderLess | #PB_Window_Maximize)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
Add3DArchive(!!! MaterialScriptsGeneric-Next folder path !!!, #PB_3DArchive_FileSystem )
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Packs/desert.zip", #PB_3DArchive_Zip)
Parse3DScripts()
;-------------------- scene
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,2,-20):CameraLookAt(0,0,0,0):CameraBackColor(0,$ff4444)
AmbientColor($111111* 4)
SkyBox("desert07.jpg")
Fog($ffffff,1,10000,10001); <--- !!! required to use these shaders !!!
CreateLight(0, $111111* 8*diff, 8000, 4000,0)
mesh_node(0,1,0.8, 64,16, 16,2)
; ================================================== Flow
texturediffuse(1,64,64,0,2,4,"0,$a060/1,$60a0")
texturediffuse(2,256,256,0,4,0,"0,$ffff8800/0.5,$ff000000/1,$ff88ff00")
GetScriptMaterial(0,"flow"):MaterialTextureAliases(0,TextureID(1),TextureID(2),0,0)
SetMaterialColor(0,#PB_Material_SpecularColor,$888888):MaterialShininess(0,32)
; ================================================== PerPixel Lighting
texturediffuse(3,256,256,0,3,0,"0,$4400ffff/0.4,$440000ff/0.5,$ff44aaff/1,$ff4466aa")
GetScriptMaterial(1,"perpixel"):MaterialTextureAliases(1,TextureID(3),0,0,0)
SetMaterialColor(1,#PB_Material_SpecularColor,$ffffff):MaterialShininess(1,32)
; ================================================== Bump
texturediffuse(5,256,256,0,3,2,"0,$ff444400/0.2,$ffaaaa00/1,$ff44ffff","0,1/0.5,0/1,1")
texturenormal(6,256,256,0,3,2, 2,"0,1/0.5,0/1,1")
GetScriptMaterial(2,"bump"):MaterialTextureAliases(2,TextureID(5),TextureID(6),0,0)
SetMaterialColor(2,#PB_Material_SpecularColor,$ffffff):MaterialShininess(2,64)
; ================================================== Water reflect
texturediffuse(7,256,256,0,0,0,"0,$ff440088/0.6,$ff008888/1,$ff444400");reflect
texturenormal(8,64,64,0,0,1,4,"0,0/1,1")
GetScriptMaterial(3,"water_reflect"):MaterialTextureAliases(3,TextureID(7),TextureID(8),0,0)
For i=0 To #n
MaterialFilteringMode(i,#PB_Material_Anisotropic,4)
ai.f=i*2*#PI/(#n+1):CreateEntity(i,MeshID(0),MaterialID(i))
RotateEntity(i,Random(360),Random(360),Random(360))
Next
; ================================================== Water RTT
CreateCamera(1,0,0,100,100):CreateRenderTexture(10,CameraID(1),ex,ey)
texturenormal(11,64,64,0,2,2,3,"0,0/0.5,1/1,0")
GetScriptMaterial(10,"water_rtt"):MaterialTextureAliases(10,TextureID(11),TextureID(10),0,0)
MaterialBlendingMode(10,#PB_Material_AlphaBlend)
SetMaterialColor(10,#PB_Material_DiffuseColor,$44444400)
CreatePlane(10,100,100,128,128,20,20)
CreateEntity(10,MeshID(10),MaterialID(10),0,0,0)
texturediffuse(12,256,256,0,4,0,"0,$002244/0.5,$44/0.6,$4400/1,$ff004466");underwater ground plane
CreateMaterial(12,TextureID(12))
CreateEntity(12,MeshID(10),MaterialID(12),0,-1,0)
; ================================================== grass
CreateTexture(20,1024,1024):StartDrawing(TextureOutput(20)):DrawingMode(#PB_2DDrawing_AllChannels):For ii=0 To 100:ai=pom(#PI/2):col=RGBA(100+Random(100),150+Random(100),0,255):For i=-5 To 5:LineXY(512+i,0,512+Sin(ai)*512,Cos(ai)*1024,col):Next:Next:StopDrawing()
GetScriptMaterial(20,"foliage"):MaterialTextureAliases(20,TextureID(20),0,0,0):MaterialCullingMode(20,#PB_Material_NoCulling)
For i= 0 To 20
mesh_foliage(20+i,2+pom(1),4)
CreateEntity(20+i,MeshID(20+i),MaterialID(20),pom(2),0,pom(2))
RotateEntity(20+i,0,pom(180),0)
Next
LoadFont(0,"arial",10)
menu()
affiche3d()
EndProcedure
main()
great stuff pf shadoko and +1 for OpenGL versions
