some improvements of my AxialMesh function (to create meshes that have axial symmetry)
- possibility to use polar coordinates (instead of cartesian)
- possibility to make the mesh in double face (for transparency (or alpharejection))
- fixed bug on normals
moreover I took the opportunity to put my shaders, so you have to compile in OpenGL
Code: Select all
;AxialMesh v2 - Pf shadoko - 2020
EnableExplicit
Global.w ex,ey,dx,dx1,dy,dy1,nb
;###############################################################################
;###############################################################################
;###############################################################################
Procedure.f POM(v.f)
ProcedureReturn (Random(2000)-1000)*0.001*v
EndProcedure
Structure f3
x.f
y.f
z.f
EndStructure
Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
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
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 mul3d(p1,v)
p1\x*(v)
p1\y*(v)
p1\z*(v)
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 interpol3D(*R.f3, *V1.f3, *V2.f3, 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
Structure PB_MeshVertexV
p.f3
n.f3
t.f3
u.f
v.f
color.l
EndStructure
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 CoRBinv(c.l)
ProcedureReturn RGBA(Blue(c),Green(c),Red(c),Alpha(c))
EndProcedure
Procedure GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
Protected i,j, apos,pos, acol.l,col.l,p,lt.s
n-1
Dim pal(n)
Repeat
apos=pos
acol=col
i+1
lt=StringField(gradient,i,"/"):If lt="":Break:EndIf
pos=ValF(lt)*n
p=FindString(lt,",")
If p
col=Val(Mid(lt,p+1))
If inv :col=CoRBinv(col):EndIf
If alpha:col | $ff000000:EndIf
Else
col=acol
EndIf
For j=apos To pos:pal(j)=ColorBlend(acol,col,(j-apos)/(pos-apos)):Next
ForEver
EndProcedure
Procedure textureArrayToNM(tex,Array t.f(2),amplitude.f)
Protected i,j,n,dx,dy
Protected.f h00,h10,h01,x,y,z,l, max=1/amplitude,max2=max*max
Protected.f3 p
dx=ArraySize(t(),2)+1
dy=ArraySize(t(),1)+1
Dim bmp.l(dy-1,dx-1)
For j=0 To dy-1
For i=0 To dx-1
h00=t(j,i)
h10=t(j,(i+1) % dx)
h01=t((j+1) % dy,i)
p\x=h00-h10
p\y=h00-h01
l=p\x*p\x+p\y*p\y:If l>max2:l=max2:EndIf
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.i textureHM2NM(imgNM,imgHM,amplitude.f)
Protected i,j,dx,dy,c
StartDrawing(TextureOutput(imgHM))
dx=OutputWidth()
dy=OutputHeight()
Dim hm.f(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
ProcedureReturn textureArraytoNM(imgNM,hm(),amplitude/3)
EndProcedure
Procedure Bspline(Array PS.f3(1), Array PD.f3(1),nd.w,ss.f=0.5)
Protected np,i,ii,n, t.f
Protected.f3 p,y0,y1,y2,y3,d1,d2,d00,v,a,b,c,d
np = ArraySize(PS())
ReDim ps(np+2):For i=np To 0 Step -1:ps(i+1)=ps(i):Next:np+2:ps(0)=ps(np)
If ps(np - 1)\X = ps(1)\X And ps(np - 1)\Y = ps(1)\Y And ps(np - 1)\z = ps(1)\z
ps(0) = ps(np - 2): ps(np) = ps(2)
Else
ps(0) = ps(2):ps(np) = ps(np - 2)
EndIf
Dim bs.f(np):For i=0 To np:bs(i)=(1-ps(i)\z)*ss:ps(i)\z=0:Next
Dim Pd((np - 2) * nd)
For i=0 To np-3
y0=ps(i+0)
y1=ps(i+1)
y2=ps(i+2)
y3=ps(i+3)
sub3d(d1,y2,y0):mul3d(d1,bs(i+1))
sub3d(d2,y3,y1):mul3d(d2,bs(i+2))
a=y1
b=d1
sub3d(c,y2,y1):mul3d(c,3):sub3d(c,c,d1):sub3d(c,c,d1):sub3d(c,c,d2)
sub3d(d,y1,y2):mul3d(d,2):add3d(d,d,d1):add3d(d,d,d2)
For ii=0 To nd
n=i*nd+ii
t=ii/nd
p=a
v=b:mul3d(v,t ):add3d(p,p,v)
v=c:mul3d(v,t*t ):add3d(p,p,v)
v=d:mul3d(v,t*t*t):add3d(p,p,v)
pd(n)=p
Next
Next
EndProcedure
Procedure stringTof3(Array s.f3(1),t.s)
Protected xy.s,i,n=CountString(t,"/")
Dim s.f3(n)
For i=0 To n
xy=StringField(t,i+1,"/")
s(i)\x=ValF(xy)
s(i)\y=ValF(StringField(xy,2,","))
s(i)\z=ValF(StringField(xy,3,","))
Next
EndProcedure
Procedure.f lg2D(x.f,y.f)
ProcedureReturn Sqr(x.f*x.f+y.f*y.f)
EndProcedure
Procedure CreateAxialMesh_(mesh,Array profils.f3(1),Array section.f3(1),doubleside.b)
Macro profilsJ()
ar=r
ah=h
r=profils(j)\x :If r=0:r=0.001:EndIf;bug CreateDataMesh
h=profils(j)\y
v+lg2D(r-ar,h-ah)
EndMacro
Protected i,j,i1,j1,r.f,h.f,ar.f,ah.f,v.f,vv.f,n,m,ni.f3,nj.f3
n=ArraySize(section())
m=ArraySize(profils())
Dim t.PB_MeshVertexv(n,m)
r=profils(0)\x:h=profils(0)\y:v=0
For j=0 To m:profilsJ():Next:vv=v
r=profils(0)\x:h=profils(0)\y:v=0
For j=0 To m
profilsJ()
For i=0 To n
With t(i,j)
vec3d(\p,section(i)\x* r,h,section(i)\y* r)
\u=i/n
\v=v/vv
\color=$ffffffff
EndWith
Next
Next
Protected im,ip,jm,jp
For j=0 To m
jm=j-1:jp=j+1:If j=0:jm=0:ElseIf j=m:jp=m:EndIf
For i=0 To n
im=i-1:ip=i+1:If i=0:im=n-1:ElseIf i=n:ip=1:EndIf
sub3d(ni,t(im,j)\p,t(ip,j)\p):sub3d(nj,t(i,jm)\p,t(i,jp)\p):pvectoriel3d(t(i,j)\n,nj,ni):Norme3D(t(i,j)\n)
Next
Next
If doubleside
ReDim t(n,m*2+1)
For j=0 To m:For i=0 To n:t(i,m+1+j)=t(i,m-j):mul3d(t(i,m+1+j)\n,-1):Next:Next
EndIf
ProcedureReturn CreateDataMesh(mesh,t())
EndProcedure
Procedure CreateAxialMesh(mesh,ProfilList.s,ProfilSubDiv,sectionList.s,SectionSubDiv,polar=0,doubleside.b=0)
Dim profil.f3(0)
Dim profils.f3(0)
Protected i,ii,iii,n,nn
Protected.f a,an,aa,r
stringTof3(profil(),ProfilList)
Bspline(profil(),profils(),ProfilSubDiv)
Dim sections.f3(0)
If sectionList
Dim section.f3(0)
stringTof3(section(),sectionList)
If polar
n=ArraySize(section())
; If polar=2
; an=section(n)\x
; nn=360/an
; ReDim section(nn*(n+1)-1)
; For ii=0 To nn-1:For i=0 To n:iii=ii*(n+1)+i:section(iii)=section(i):section(iii)\x+ii*an:Next:Next
; n=ArraySize(section())
; EndIf
For i=0 To n
a=Radian(section(i)\x)
r=section(i)\y
section(i)\x=Cos(a)*r:section(i)\y=Sin(a)*r
Next
EndIf
Bspline(section(),sections(),SectionSubDiv)
Else
Dim sections.f3(SectionSubDiv)
For i=0 To SectionSubDiv:a=Radian(360/SectionSubDiv)*i:sections(i)\x=Cos(a):sections(i)\y=Sin(a):Next
EndIf
ProcedureReturn CreateAxialMesh_(mesh,profils(),sections(),doubleside.b)
EndProcedure
;###############################################################################
;###############################################################################
;###############################################################################
Procedure generematiere(num,dx,dy,grad.s,type,brillance=256,transparence=0,relief.f=1,repeatx.f=1,repeaty.f=1)
Protected i,j,k,p,x,y,l,n,d
Protected Dim pal.l(0)
Dim txt(1)
For k=0 To Bool(relief<>0)
Select k
Case 0: GradientToArray(pal(),256,grad)
Case 1: GradientToArray(pal(),256,"0,$00/1,$ff")
EndSelect
txt(k)=CreateTexture(-1,dx,dy)
StartDrawing(TextureOutput(txt(k)))
DrawingMode(#PB_2DDrawing_AllChannels )
Select type
Case 1; point (plate /apple / flute)
For j=0 To dy-1:For i=0 To dx-1:Plot(i,j,pal(Random(255))):Next:Next
Case 2; basket
For i=0 To 2000:Line(Random(dx),0,1,dy,pal(Random(127)+128)):Line(0,Random(dy),dx,1,pal(Random(127))):Next
Case 3; brasselet
For j=0 To dy-1:For i=0 To dx-1:y=Abs(Cos(i*#PI*2/dx))*255: Plot(i ,j,pal(y)):Next:Next
Case 4; vase
For j=0 To dy-1:For i=0 To dx-1:y=Abs(Cos((j+i)/dy*#PI))*255: Plot(i ,j,pal(y)):Next:Next
Case 5; glass
Box(0,0,dx,dy,pal(0)):For j=0 To dy Step 16:Box (0,j,dx,1,pal(255)):Next;
Case 6; flower
For i=0 To dx-1:y=Abs(Cos(i*#PI/dx))*dy-2:d=Random(25):For j=0 To y:Plot(i,j,pal(j*(230+d)/y)):Next:Next
For i=0 To dx-1:y=Abs(Sin(i*#PI/dx))*dy-2:d=Random(25):For j=0 To y:Plot(i,j,pal(j*(230+d)/y)):Next:Next
EndSelect
StopDrawing()
If k:txt(k)=textureHM2NM(-1,txt(k),0.005*relief):EndIf
Next
If relief
n=GetScriptMaterial(num,"bump"):If num=-1:num=n:EndIf:MaterialTextureAliases(num,TextureID(txt(0)),TextureID(txt(1)),0,0)
Else
n=CreateMaterial(num,TextureID(txt(0))):If num=-1:num=n:EndIf:SetMaterialAttribute(num,#PB_Material_AlphaReject,128)
EndIf
If brillance:SetMaterialColor(num, #PB_Material_SpecularColor, $ffffff):MaterialShininess(num, brillance):EndIf
If transparence:MaterialBlendingMode(num, #PB_Material_Color):EndIf
MaterialFilteringMode(num,#PB_Material_Anisotropic,4)
ScaleMaterial(num,1/repeatx,1/repeaty)
ProcedureReturn num
EndProcedure
Procedure addentity(mesh,material,x.f,y.f,z.f,attach=0)
Protected n,matid
If material>=0:matid=MaterialID(material):EndIf
BuildMeshTangents(Mesh)
n=CreateEntity(-1,MeshID(mesh),matid,x,y,z)
If attach:AttachEntityObject(attach,"",EntityID(n)):EndIf
ProcedureReturn n
EndProcedure
Procedure scene()
Global table, basket,vase
Protected i,j,k,n,mesh,material,entity, a.f,r.f,h.f3,b.f3
;######################################## cameras
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0, 900, 500, 0, #PB_Absolute):CameraLookAt(0, 0, -50, 0):CameraBackColor(0, $333333)
CreateCamera(1, 0, 0,100,100); (glass table)
;######################################## light
CreateLight(0,$ffffff, 200, 1000, 1000)
AmbientColor($111111*4)
CreateSphere(100,10)
DisableDebugger:CreateMaterial(100,0):EnableDebugger:SetMaterialColor(100,#PB_Material_SelfIlluminationColor,$ffffff)
CreateEntity(100,MeshID(100),MaterialID(100), LightX(0), LightY(0), LightZ(0))
;######################################## mesh/entity
;table
mesh=CreateAxialMesh(-1,"500,-20/500,-1/500,0/0,-1",1,"",64)
material=generematiere(-1,128,256,"0,$00003344/1,$00002233",1,256,0,0.1,1,4)
table=addentity(mesh,material,0,0,0)
;glass table
mesh=CreateAxialMesh(-1,"500,0/0,0",1,"",64)
CreateRenderTexture(0,CameraID(1),ex,ey)
CreateMaterial(0, TextureID(0))
SetMaterialAttribute(0,#PB_Material_ProjectiveTexturing,1)
SetMaterialColor(0,#PB_Material_DiffuseColor,$ffffff):MaterialBlendingMode(0,#PB_Material_Color)
addentity(mesh,0,0,0,0,table)
;flute
mesh=CreateAxialMesh(-1,"0,0/50,1/10,20/10,100/54,200/50,200/0,90",4,"",32)
material=generematiere(-1,128,128,"0,$ffaa8800/1,$ff664400",1,128,1,1,4,4)
addentity(mesh,material,0,0,-300,table)
addentity(mesh,material,200,0,-320,table)
;plate
mesh=CreateAxialMesh(-1,"0,0/80,1/160,45/160,50/76,5/0,5",4,"",8)
material=generematiere(-1,256,256,"0,$88444444/1,$88666666",1,32,0,1,2,2)
addentity(mesh,material,250,0,250,table)
;box
mesh=CreateAxialMesh(-1,"0,0/80,1/110,70/85,140/90,140/90,150/10,160/20,190/0,200",8,"0,1/0,1/90,1/90,1/180,1/180,1/270,1/270,1/0,1",1,2)
material=generematiere(-1,256,256,"0,$441155aa/1,$442277cc",1,64,0,0.5,0.25,4)
addentity(mesh,material,-200,0,-200,table)
;bracelet (here, it's a torus, first point = last point)
mesh=CreateAxialMesh(-1,"43,15/45,0/55,15/45,30/43,15",4,"",32)
material=generematiere(-1,256,1,"0,$00ff0000/0.25/0.25,$ff33aaff/1",3,64,0,40,20,1)
addentity(mesh,material,-100,0,400,table)
;glass
mesh=CreateAxialMesh(-1,"0,0/49,0/50,1/51,2/60,150/59,152)/58,150/49,11/48,10/0,10",1,"",32)
material=generematiere(-1,1,256,"0,$ff555555/1,$ff0000ff",5,256,1)
addentity(mesh,material,0,0,200,table)
addentity(mesh,material,-200,0,200,table)
;basket (here, section is defined)
mesh=CreateAxialMesh(-1,"0,0/50,0/100,30/110,80/100,80/100,70/105,70/100,40/50,11/0,10",4,"-1.2,-1/1.2,-1/1.2,1/-1.2,1/-1.2,-1",8)
material=generematiere(-1,256,256,"0,$442255aa/1,$4466aaff",2,32,0,3,4,4)
basket=addentity(mesh,material,300,0,-100,table)
;apple
mesh=CreateAxialMesh(-1,"0,10/20,0/45,30/50,80/20,100/2,90/2,105/0,110",4,"",32)
material=generematiere(-1,16,8,"0,$55229999/0.5,$553399cc/1,$551111cc",1,128,0,1)
n=addentity(mesh,material,70,10,0,basket):RotateEntity(n,0,Random(360),0)
n=addentity(mesh,material,-20,10,-50,basket):RotateEntity(n,0,Random(360),0)
n=addentity(mesh,material,-20,10,50,basket):RotateEntity(n,0,Random(360),0)
;flat vase
mesh=CreateAxialMesh(-1,"0,0/80,1/100,100/60,200/75,20/0,20",8,"0,1/90,0.5/180,1/270,0.5/0,1",8,1)
material=generematiere(-1,256,256,"0,$ff0000ff/0.25/1,$00aaaa00",1,16,0,1,4,4)
addentity(mesh,material,-300,0,0,table)
;vase
mesh=CreateAxialMesh(-1,"0,0/80,1/120,150/80,250/110,300/100,300/75,250/75,20/0,20",8,"",32)
material=generematiere(-1,128,128,"0,$ff33aaff/0.2/0.2,$ff88bbbb/1",4,128,0,25,30,30)
vase=addentity(mesh,material,0,0,0,table)
;flower
material=generematiere(-1,16,32,"0,$88008844/1,$88004422",1,16)
Macro flower(fmesh,fmaterial,profil,gradient,petal)
fmesh=CreateMesh(-1)
CreateAxialMesh(-2,"2,0/2,300/7,305",1,"",5)
SetMeshMaterial(fmesh,MaterialID(material),0)
AddSubMesh()
CreateAxialMesh(-2,profil,3,"",24,0,1)
fmaterial=generematiere(-1,256,512,gradient,6,0,0,0,petal,1)
SetMeshMaterial(fmesh,MaterialID(fmaterial),1)
FinishMesh(1)
BuildMeshTangents(fmesh)
EndMacro
Dim fmesh(2)
Dim fmaterial(2)
flower(fmesh(0),fmaterial(0),"0,300/20,320/20,350","0,$ff002244/0.2/0.2,$ffffffff/0.6,$ff0022ff/1,$ff001188",3)
flower(fmesh(1),fmaterial(1),"0,300/15,310/35,315","0,$ff002244/0.1/0.1,$ff0000ff/1,$7a66ffff",6)
flower(fmesh(2),fmaterial(2),"0,297/10,315/30,330","0,$ffffffff/1,$7bff4444",2)
For i=0 To 49
a=i/49*2*#PI:r=60+pom(25):vec3d(h,Cos(a)*r,300,Sin(a)*r)
a=pom(#PI):vec3d(b,Cos(a)*40,180+pom(50),Sin(a)*40)
n=addentity(fmesh(Random(2)),-1,b\x,b\y,b\z,vase):EntityDirection(n,h\x-b\x,h\y-b\y,h\z-b\z,#PB_World ,#PB_Vector_Y)
Next
EndProcedure
Define.f KeyX, KeyY,keyz,dist, MouseX, MouseY,v,a,x,y,z,r.l
Define i,j,c,px,py,p,fdf,rot=1
InitEngine3D()
InitSprite()
InitKeyboard()
InitMouse()
OpenWindow(0, 0, 0, 0,0, " Mesh Axial",#PB_Window_Maximize|#PB_Window_BorderLess)
ex=WindowWidth (0,#PB_Window_InnerCoordinate)
ey=WindowHeight(0,#PB_Window_InnerCoordinate)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Scripts/MaterialScriptsGeneric", #PB_3DArchive_FileSystem ):Parse3DScripts()
;{ menu
Macro DT(t1)
DrawText(4,p,t1)
p+17
EndMacro
LoadFont(0,"arial",10)
CreateSprite(0,180,120,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingFont(FontID(0))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,180,120,$22ffffff)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_AlphaClip|#PB_2DDrawing_Outlined )
BackColor($22ffffff)
FrontColor($ffffffff)
dt("Moving :")
dt("Arrow keys + Mouse")
dt("")
dt("Controls :")
dt("[F1] Rotation")
dt("[F12] Wireframe")
dt("[Esc] / [Click] Quit")
StopDrawing()
;}
scene()
Repeat
WindowEvent()
ExamineMouse()
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
ExamineKeyboard()
keyx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*4
keyz=(-Bool(KeyboardPushed(#PB_Key_Down))+Bool(KeyboardPushed(#PB_Key_Up )))*4+MouseWheel()*50: dist+(keyz-dist)*0.1
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera (0, KeyX, keyy, -dist)
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
If KeyboardReleased(#PB_Key_F1)Or MouseButton(2):rot=1-rot:EndIf
RotateEntity(table,0,0.2*rot,0,#PB_Relative)
CameraReflection(1,0,EntityID(table))
RenderWorld()
DisplayTransparentSprite(0, 8,8)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)Or MouseButton(3)
