# PureBasic Forum

 It is currently Wed Jun 03, 2020 2:32 pm

 All times are UTC + 1 hour

 Page 1 of 1 [ 11 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: demo - Perlin noisePosted: Thu Mar 28, 2019 11:08 pm
 Enthusiast

Joined: Thu Jul 09, 2015 9:07 am
Posts: 106

Hi, guys,

a 3d perlin noise code: it allows to deform objects
it's pretty easy to use:
we define our "perlin space" with the InitPerlinNoise function by entering a list of frequencies and amplitudes
then just use the PerlinNoise3D function to modify the 3d coordinates
in the example following the original shape is a sphere

I also test this function to apply a texture, (press[F2])
the results are very uneven, but I think that with the right texture you can make very nice maps of wood or marble
the interest is above all to be able to cover "closed" shapes (sphere type) avoiding the problem of "polar convergence" or visible "sewing" (if you know what I mean...)
covering a sphere is a real headache
(the next version of PB will support cubemap textures, but to create them is not easy)

[EDIT]
I added the possibility to change the mesh:
sphere, torus, cylinder and cone
(press [F1])

Code:
; demo - Perlin 3D - Pf Shadoko -2019

EnableExplicit

;{ ============================= biblio

Structure Vector2
x.f
y.f
EndStructure

Structure Vector3
x.f
y.f
z.f
EndStructure

Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
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

p\x=p1\x+p2\x
p\y=p1\y+p2\y
p\z=p1\z+p2\z
EndMacro

Macro div3d(p1,v)
p1\x/(v)
p1\y/(v)
p1\z/(v)
EndMacro

Macro mul3d(p1,v)
p1\x*(v)
p1\y*(v)
p1\z*(v)
EndMacro

Procedure.f POM(v.f)
ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure

;}

;################################################################# Perlin Noise ###############################################################

Procedure InitPerlinNoise(seed=0,  fq1.f=1,amp1.f=0.5,  fq2.f=0,amp2.f=0,  fq3.f=0,amp3.f=0,  fq4.f=0,amp4.f=0)
#per_Size = 1023
Global Dim per_fq.f(4)
Global Dim per_am.f(4)
Global per_nb=0,per_dim
Protected i

If fq1>0:per_fq(1)=fq1:per_am(1)=amp1/fq1:per_nb=1:EndIf
If fq2>0:per_fq(2)=fq2:per_am(2)=amp2/fq2:per_nb=2:EndIf
If fq3>0:per_fq(3)=fq3:per_am(3)=amp3/fq3:per_nb=3:EndIf
If fq4>0:per_fq(4)=fq4:per_am(4)=amp4/fq4:per_nb=4:EndIf

RandomSeed(Seed)
For i = 0 To #per_Size
Next
EndProcedure

Procedure.f per_gr(X.i, Y.i, Z.i, *V.Vector3)
Protected Index.i= (x+y * 101+z * 241+ per_dim * 409)&#per_Size
EndProcedure

Procedure.f PerlinValue(*p.vector3,fq.f)
Protected.i X0, X1, Y0, Y1, Z0, Z1
Protected.f WX0, WY0, WZ0, WX1, WY1, WZ1
Protected p.vector3

vec3d(p,*p\x*fq,*p\y*fq,*p\z*fq)

X0 = Int(p\X+1<<30)-1<<30:X1 = X0+1
Y0 = Int(p\Y+1<<30)-1<<30:Y1 = Y0+1
Z0 = Int(p\Z+1<<30)-1<<30:Z1 = Z0+1
WX0 = X0-p\X:wx0=(2* wx0+3)* wx0 * wx0 :wx1=1-wx0
WY0 = Y0-p\Y:wy0=(2* wy0+3)* wy0 * wy0 :wy1=1-wy0
WZ0 = Z0-p\Z:wz0=(2* wz0+3)* wz0 * wz0 :wz1=1-wz0
ProcedureReturn ( (per_gr(X0, Y0, Z0, p)*WX1+per_gr(X1, Y0, Z0, p)*WX0)*wy1 +
(per_gr(X0, Y1, Z0, p)*WX1+per_gr(X1, Y1, Z0, p)*WX0)*WY0 ) * wz1 +
( (per_gr(X0, Y0, Z1, p)*WX1+per_gr(X1, Y0, Z1, p)*WX0)*wy1 +
(per_gr(X0, Y1, Z1, p)*WX1+per_gr(X1, Y1, Z1, p)*WX0)*WY0 ) * WZ0
EndProcedure

Procedure.f PerlinNoise(*p.vector3,_dimension=0)
Protected i, Noise.f
per_dim=_dimension
For i = 1 To per_nb:Noise + PerlinValue(*p,per_fq(i)) * per_am(i):Next
ProcedureReturn Noise
EndProcedure

Procedure.f PerlinNoise3D(*p.vector3,*r.vector3, mode)  ; mode -> #PB_Absolute: return the new position,  #PB_Relative: retrun the offset
*r\x=PerlinNoise(*p.vector3,0)
*r\y=PerlinNoise(*p.vector3,1)
*r\z=PerlinNoise(*p.vector3,2)
EndProcedure
;######################################################################################################

Structure PB_MeshVertexV
p.vector3
n.vector3
t.vector3
u.f
v.f
color.l
EndStructure

Global ptype,ptext,objet,fdf

Procedure test_perlin()
Protected i,j,n,num,nv,u.f,v.f,p.vector3

For num=1 To 6
Select objet
Case 0:CreateSphere(num,0.7,64,64)
Case 1:CreateTorus(num,0.6,0.3,64,64)
Case 2:CreateCylinder(num,0.5,1,64,64,1)
Case 3:CreateCone(num,0.8,1,64,64)
EndSelect
CreateEntity(num,MeshID(num),MaterialID(num))

Select ptype
Case 0:InitPerlinNoise(num,1,0.7)
Case 1:InitPerlinNoise(num,2,0.6)
Case 2:InitPerlinNoise(num,6,0.5)
Case 3:InitPerlinNoise(num,0.2,0.3,2,0.4,6,0.5)
EndSelect

nv=MeshVertexCount(num)-1
Dim v.PB_MeshVertexv(nv)
GetMeshData(num,0,v(),#PB_Mesh_Vertex|#PB_Mesh_UVCoordinate,0,nv)
For n=0 To nv
With v(n)
If ptext:\u=0.5+PerlinNoise(\p,3)*4:v(n)\v=0.5+PerlinNoise(\p,4)*4:EndIf
p=\p:PerlinNoise3d(p,\p,#PB_Absolute)
EndWith
Next
SetMeshData(num,0,v(),#PB_Mesh_Vertex|#PB_Mesh_UVCoordinate,0,nv)
NormalizeMesh(num)
If ptext:ScaleMaterial(num,1,1):Else:ScaleMaterial(num,1/8,1/8):EndIf
Next
EndProcedure

Procedure init()
Protected i
InitEngine3D(#PB_Engine3D_DebugLog):InitSprite():InitKeyboard():InitMouse()

OpenWindow(0, 0,0,800,600, "Perlin 3d - [F1] Change objects - [F2] Change Perlin parameters - [F3] Change texture mode - [F12] Wireframe -  [Esc] quit",#PB_Window_Maximize)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0)

Parse3DScripts()

CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,1+4*0,4):CameraLookAt(0,0,-0.5,0)
CreateLight(0,\$ffffff, -100, 100, 50):SetLightColor(0,#PB_Light_SpecularColor,\$ffffff)
AmbientColor(\$444444)
CameraBackColor(0,\$880044)

CreateTexture(1,1,64):StartDrawing(TextureOutput(1)):For i=0 To 63:Plot(0,i,Random(\$ffffff)):Next:StopDrawing()
For i=1 To 6
CreateMaterial(i,TextureID(i))
SetMaterialColor(i,#PB_Material_SpecularColor,\$888888):MaterialShininess(i,40)
Next
test_perlin()
EndProcedure

Procedure rendu()
Protected.f rx,ry,a,ai,i.l
Repeat
ExamineMouse()
ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1):objet=(objet+1)%4:test_perlin():EndIf
If KeyboardReleased(#PB_Key_F2):ptype=(ptype+1)%4:test_perlin():EndIf
If KeyboardReleased(#PB_Key_F3):ptext=1-ptext:test_perlin():EndIf
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
ry=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*1
rx=(-Bool(KeyboardPushed(#PB_Key_Down))+Bool(KeyboardPushed(#PB_Key_Up   )))*1
a+0.002:For i=1 To 6:ai=a+i*2*#PI/6:MoveEntity(i,Cos(ai)*2,0,Sin(ai)*2,#PB_Absolute):RotateEntity(i,0.2,0.25,0.3,#PB_Relative):Next
RenderWorld()
FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardReleased(#PB_Key_Escape)
EndProcedure

init()
rendu()

Last edited by pf shadoko on Fri Mar 29, 2019 7:06 pm, edited 2 times in total.

Top

 Post subject: Re: demo - Perlin noisePosted: Fri Mar 29, 2019 10:30 am

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1238
Location: right here
Very nice, thanks!

On Linux I had to make these changes:

Code:

- give the window some size:
Code:
OpenWindow(0, 0,0,800,600, ...

- swallow events:
Code:
Repeat
While WindowEvent() : Wend
ExamineMouse()

Top

 Post subject: Re: demo - Perlin noisePosted: Fri Mar 29, 2019 11:22 am
 User

Joined: Mon Jul 17, 2017 7:22 am
Posts: 76
Location: Cotswolds England
Coming from the database & commercial software brigade I find this sort of stuff simply amazing.
Now that I'm retired I often think I really must have a go to see what I can achieve sometime with the 3D library......definitely start tomorrow!

Excellent work

_________________
If it's falling over......just remember the computer is never wrong!

Top

 Post subject: Re: demo - Perlin noisePosted: Fri Mar 29, 2019 11:28 am
 Enthusiast

Joined: Thu Jul 09, 2015 9:07 am
Posts: 106
@ #NULL :
thank you for information
the line
"Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardReleased(#PB_Key_Escape)"
is not enough ?
you have a lot of events on linux...

@ C87 :
it's exciting to create your own little universe

Top

 Post subject: Re: demo - Perlin noisePosted: Fri Mar 29, 2019 11:45 am

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 1238
Location: right here
For games/screens it's better to process all events per frame, instead of only one event per frame. Like a second event loop nested in the main loop. I'm not sure if the 3D commands generate events, but as soon as events would be generated by any means (by a SetGadgetWathever() for example) in the main loop, processing only one of them in that main loop will never catch up. And I also think Flipbuffers() relies on event processing.

Top

 Post subject: Re: demo - Perlin noisePosted: Fri Mar 29, 2019 7:12 pm
 Enthusiast

Joined: Thu Jul 09, 2015 9:07 am
Posts: 106
EDIT]
I added the possibility to change the mesh:
sphere, torus, cylinder and cone
(press [F1])

Top

 Post subject: Re: demo - Perlin noisePosted: Fri Mar 29, 2019 7:59 pm

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1760
Location: Uttoxeter, UK
Looks very nice on my MacBook Pro.
Impressive!

_________________
DE AA EB

Top

 Post subject: Re: demo - Perlin noisePosted: Fri Mar 29, 2019 9:40 pm
 PureBasic Team

Joined: Fri Apr 25, 2003 6:14 pm
Posts: 1837
Location: Germany (Saxony, Deutscheinsiedel)
Looks impressive (and I have no clue about 3D programming, I already fail with 3D VectorDrawing...)

_________________
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)

Top

 Post subject: Re: demo - Perlin noisePosted: Sun Mar 31, 2019 2:15 pm

Joined: Sat Feb 19, 2011 10:06 am
Posts: 853
Location: Denmark
Short and to the point.
Thanks for sharing.

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 10, Intel 6800K, GeForce Gtx 1060, 32 gb ram.

Top

 Post subject: Re: demo - Perlin noisePosted: Tue Apr 02, 2019 10:53 pm

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4623
Location: Spa, relaxing and thinking, and learning...
Nice

_________________
http://www.zeitgeistmovie.com

Top

 Post subject: Re: demo - Perlin noisePosted: Wed Apr 03, 2019 11:22 am
 User

Joined: Thu Oct 26, 2017 12:13 pm
Posts: 10
wow, always amazed about the stuff PureBasic is able to produce.

_________________
Michael

Windows 10, PureBasic 5.70 LTS

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 11 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 17 guests

 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite