Perlin Noise

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Perlin Noise

Beitrag von Sicro »

Keya hat geschrieben:sorry for English but does anyone know how to get this to work in the latest PB? it gives error regarding "Noise.Noise(1))"

Code: Alles auswählen

; PB 5.41

; Auf und Ab drücken!

EnableExplicit

Prototype.d NoiseFunc(x.d, y.d, z.d)

Structure Noise
  Noise.NoiseFunc
EndStructure

Procedure.d Interpolate(a.d, b.d, x.d)
  Protected f.d
 
  f = (1 - Cos(x * #PI)) * 0.5
  ProcedureReturn a * (1 - f) + b * f
EndProcedure

Procedure.d InterpolatedNoise(Noise.NOISEFUNC, x.d, y.d, z.d)
  Protected integer_X.l, fractional_X.d, integer_Y.l, fractional_Y.d, integer_Z.l, fractional_Z.d
  Protected v1.d, v2.d, v3.d, v4.d, i1.d, i2.d, n1.d, n2.d
  integer_X    = Int(x)
  fractional_X = x - integer_X
 
  integer_Y    = Int(y)
  fractional_Y = y - integer_Y
 
  integer_Z    = Int(z)
  fractional_Z = z - integer_Z
 
  v1 = Noise(integer_X,     integer_Y,     integer_Z)
  v2 = Noise(integer_X + 1, integer_Y,     integer_Z)
  v3 = Noise(integer_X,     integer_Y + 1, integer_Z)
  v4 = Noise(integer_X + 1, integer_Y + 1, integer_Z)
  i1 = Interpolate(v1 , v2 , fractional_X)
  i2 = Interpolate(v3 , v4 , fractional_X)
  n1 = Interpolate(i1 , i2 , fractional_Y)
  
  v1 = Noise(integer_X,     integer_Y,     integer_Z + 1)
  v2 = Noise(integer_X + 1, integer_Y,     integer_Z + 1)
  v3 = Noise(integer_X,     integer_Y + 1, integer_Z + 1)
  v4 = Noise(integer_X + 1, integer_Y + 1, integer_Z + 1)
  i1 = Interpolate(v1 , v2 , fractional_X)
  i2 = Interpolate(v3 , v4 , fractional_X)
  n2 = Interpolate(i1 , i2 , fractional_Y)
 
  ProcedureReturn Interpolate(n1, n2, fractional_Z)
  ;ProcedureReturn n1*(1-fractional_Z) + n2*fractional_Z
EndProcedure

Procedure.d PerlinNoise_3D(x.d, y.d, z.d, Array Noise.Noise(1))
  Protected total.d, p.d, i.l, frequency.d, amplitude.d, count.l
  total = 0
  p = 1 / 1.4142
  count = PeekL(Noise() - 8)
  For i = 0 To count - 1
    If Noise(i)
      frequency = Pow(2.0, i)
      amplitude = Pow(p, i)
      total + InterpolatedNoise(Noise(i)\Noise, x * frequency, y * frequency, z * frequency) * amplitude
    Else
      Break
    EndIf
  Next
 
  ProcedureReturn 1 / (1 + Pow(2.718281828459045, -total.d))
EndProcedure

;- Noises
Procedure.d Noise1(x.d, y.d, z.d)
  Protected n.l
  n = x * 13 + y * 57 + z * 14
  n = (n << 13) ! n
  n = ( (n * (n * n * 15731 + 789221) + 1376312589) & $7FFFFFFF)
  ProcedureReturn ( 1.0 - n / 1073741824.0)
EndProcedure

Procedure.d Noise2(x.d, y.d, z.d)
  Protected n.l
  n = x * 12 + y * 25 + z * 24
  n = (n << 13) ! n
  n = ( (n * (n * n * 15727 + 789221) + 1376312589) & $7FFFFFFF)
  ProcedureReturn ( 1.0 - n / 1073741824.0)
EndProcedure

Procedure.d Noise3(x.d, y.d, z.d)
  Protected n.l
  n = x * 22 + y * 13 + z * 15
  n = (n << 13) ! n
  n = ( (n * (n * n * 15727 + 789221) + 1376312589) & $7FFFFFFF)
  ProcedureReturn ( 1.0 - n / 1073741824.0)
EndProcedure

#img = 1
#win = 0

Procedure.d CloudExpCurve(v.d)
  #CloudCover = 110 ; 0-255
  #CloudSharpness = 0.97 ; 0-1
  Protected c.d
  c = v - #CloudCover
  If c < 0
    c = 0
  EndIf
 
  ProcedureReturn 255 - ((Pow(#CloudSharpness, c)) * 255)
EndProcedure

Procedure CalcPerlin(Width.l, Height.l, i.d)
  Protected x.l, y.l, h.d
  Static z.d = 10.1
 
  Dim N.Noise(2)
  N(0)\Noise = @Noise1()
  N(1)\Noise = @Noise2()
  N(2)\Noise = @Noise3()
 
  CreateImage(#img, Width, Height)
  StartDrawing(ImageOutput(#img))
  Width-1 : Height-1 ; <<<< Without this line, caused Plot () a "outside the drawing range" error
  For x = 0 To Width
    For y = 0 To Height
      h = CloudExpCurve(PerlinNoise_3D(x/Width*2, y/Height*2, z, N()) * 255)
      Plot(x, y, h)
    Next
  Next
  DrawText(0, 0, StrD(z))
  StopDrawing()
  z + 0.03 * i
EndProcedure

OpenWindow(#win,0,0,200,200,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget)
CalcPerlin(200, 200, 1)

ImageGadget(#img, 0, 0, 200, 200, ImageID(#img))

Define EventID.l
Repeat
  EventID = WaitWindowEvent()
 
  If GetAsyncKeyState_(#VK_UP)
    CalcPerlin(WindowWidth(#win), WindowHeight(#win), 1)
    SetGadgetState(#img, ImageID(#img))
  ElseIf GetAsyncKeyState_(#VK_DOWN)
    CalcPerlin(WindowWidth(#win), WindowHeight(#win), -1)
    SetGadgetState(#img, ImageID(#img))
  EndIf
 
  Select EventID
    Case #PB_Event_SizeWindow
      CalcPerlin(WindowWidth(#win), WindowHeight(#win), 0)
      ResizeGadget(#img, 0, 0, WindowWidth(#win), WindowHeight(#win))
      SetGadgetState(#img, ImageID(#img))
  EndSelect
 
Until EventID = #PB_Event_CloseWindow

CloseWindow(#win)
End
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Keya
Beiträge: 4
Registriert: 18.06.2015 19:40

Re: Perlin Noise

Beitrag von Keya »

Beautiful, thankyou! :) how do I randomize the output? changing the order of N() works, but im assuming there's a better way!
Nino
Beiträge: 1300
Registriert: 13.05.2010 09:26
Wohnort: Berlin

Re: Perlin Noise

Beitrag von Nino »

@Sicro:
Dein Code stürzt hier (PB 5.41 x64 unter Windows 10) ab in Zeile 58 mit der Fehlermeldung
[ERROR] Array-Index außerhalb der zulässigen Grenzen.
Der Fehler lässt sich offenbar beheben, indem man Zeile 56

Code: Alles auswählen

count = PeekL(Noise() - 8)
ersetzt durch

Code: Alles auswählen

count = ArraySize(Noise()) + 1
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Perlin Noise

Beitrag von ts-soft »

Naja, das reicht aber nicht ganz, da mußt noch GetAsyncKeyState_() gefixed werden. Für 64-Bit und natürlich auch für 32-Bit noch:

Code: Alles auswählen

Repeat
  EventID = WaitWindowEvent()
 
  If GetAsyncKeyState_(#VK_UP)  & 32768
    CalcPerlin(WindowWidth(#win), WindowHeight(#win), 1)
    SetGadgetState(#img, ImageID(#img))
  ElseIf GetAsyncKeyState_(#VK_DOWN) & 32768
    CalcPerlin(WindowWidth(#win), WindowHeight(#win), -1)
    SetGadgetState(#img, ImageID(#img))
  EndIf
 
  Select EventID
    Case #PB_Event_SizeWindow
      CalcPerlin(WindowWidth(#win), WindowHeight(#win), 0)
      ResizeGadget(#img, 0, 0, WindowWidth(#win), WindowHeight(#win))
      SetGadgetState(#img, ImageID(#img))
  EndSelect
 
Until EventID = #PB_Event_CloseWindow

CloseWindow(#win)
End 
Dann läuft es halbwegs, wobei ich nicht genau wie es aussehen soll.

Gruß
Thomas
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Perlin Noise

Beitrag von Sicro »

Wird in CodeArchiv unter Graphics/2D/Perlin_Noise.pbi in korrigierter Version aufgenommen:

Code: Alles auswählen

; Auf und Ab drücken!

EnableExplicit

Prototype.d NoiseFunc(x.d, y.d, z.d)

Structure Noise
  Noise.NoiseFunc
EndStructure

Procedure.d Interpolate(a.d, b.d, x.d)
  Protected f.d

  f = (1 - Cos(x * #PI)) * 0.5
  ProcedureReturn a * (1 - f) + b * f
EndProcedure

Procedure.d InterpolatedNoise(Noise.NOISEFUNC, x.d, y.d, z.d)
  Protected integer_X, fractional_X.d, integer_Y, fractional_Y.d, integer_Z, fractional_Z.d
  Protected v1.d, v2.d, v3.d, v4.d, i1.d, i2.d, n1.d, n2.d
  integer_X    = Int(x)
  fractional_X = x - integer_X

  integer_Y    = Int(y)
  fractional_Y = y - integer_Y

  integer_Z    = Int(z)
  fractional_Z = z - integer_Z

  v1 = Noise(integer_X,     integer_Y,     integer_Z)
  v2 = Noise(integer_X + 1, integer_Y,     integer_Z)
  v3 = Noise(integer_X,     integer_Y + 1, integer_Z)
  v4 = Noise(integer_X + 1, integer_Y + 1, integer_Z)
  i1 = Interpolate(v1 , v2 , fractional_X)
  i2 = Interpolate(v3 , v4 , fractional_X)
  n1 = Interpolate(i1 , i2 , fractional_Y)

  v1 = Noise(integer_X,     integer_Y,     integer_Z + 1)
  v2 = Noise(integer_X + 1, integer_Y,     integer_Z + 1)
  v3 = Noise(integer_X,     integer_Y + 1, integer_Z + 1)
  v4 = Noise(integer_X + 1, integer_Y + 1, integer_Z + 1)
  i1 = Interpolate(v1 , v2 , fractional_X)
  i2 = Interpolate(v3 , v4 , fractional_X)
  n2 = Interpolate(i1 , i2 , fractional_Y)

  ProcedureReturn Interpolate(n1, n2, fractional_Z)
  ;ProcedureReturn n1*(1-fractional_Z) + n2*fractional_Z
EndProcedure

Procedure.d PerlinNoise_3D(x.d, y.d, z.d, Array Noise.Noise(1))
  Protected total.d, p.d, i, frequency.d, amplitude.d, count
  total = 0
  p = 1 / 1.4142
  count = ArraySize(Noise()) + 1
  For i = 0 To count - 1
    If Noise(i)
      frequency = Pow(2.0, i)
      amplitude = Pow(p, i)
      total + InterpolatedNoise(Noise(i)\Noise, x * frequency, y * frequency, z * frequency) * amplitude
    Else
      Break
    EndIf
  Next

  ProcedureReturn 1 / (1 + Pow(2.718281828459045, -total.d))
EndProcedure

;- Noises
Procedure.d Noise1(x.d, y.d, z.d)
  Protected n
  n = x * 13 + y * 57 + z * 14
  n = (n << 13) ! n
  n = ( (n * (n * n * 15731 + 789221) + 1376312589) & $7FFFFFFF)
  ProcedureReturn ( 1.0 - n / 1073741824.0)
EndProcedure

Procedure.d Noise2(x.d, y.d, z.d)
  Protected n
  n = x * 12 + y * 25 + z * 24
  n = (n << 13) ! n
  n = ( (n * (n * n * 15727 + 789221) + 1376312589) & $7FFFFFFF)
  ProcedureReturn ( 1.0 - n / 1073741824.0)
EndProcedure

Procedure.d Noise3(x.d, y.d, z.d)
  Protected n
  n = x * 22 + y * 13 + z * 15
  n = (n << 13) ! n
  n = ( (n * (n * n * 15727 + 789221) + 1376312589) & $7FFFFFFF)
  ProcedureReturn ( 1.0 - n / 1073741824.0)
EndProcedure

#img = 1
#win = 0

Procedure.d CloudExpCurve(v.d)
  #CloudCover = 110 ; 0-255
  #CloudSharpness = 0.97 ; 0-1
  Protected c.d
  c = v - #CloudCover
  If c < 0
    c = 0
  EndIf

  ProcedureReturn 255 - ((Pow(#CloudSharpness, c)) * 255)
EndProcedure

Procedure CalcPerlin(Width, Height, i.d)
  Protected x, y, h.d
  Static z.d = 10.1

  Dim N.Noise(2)
  N(0)\Noise = @Noise1()
  N(1)\Noise = @Noise2()
  N(2)\Noise = @Noise3()

  CreateImage(#img, Width, Height)
  StartDrawing(ImageOutput(#img))
  Width-1 : Height-1 ; <<<< Without this line, caused Plot () a "outside the drawing range" error
  For x = 0 To Width
    For y = 0 To Height
      h = CloudExpCurve(PerlinNoise_3D(x/Width*2, y/Height*2, z, N()) * 255)
      Plot(x, y, h)
    Next
  Next
  DrawText(0, 0, StrD(z))
  StopDrawing()
  z + 0.03 * i
EndProcedure

OpenWindow(#win,0,0,200,200,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget)
CalcPerlin(200, 200, 1)

ImageGadget(#img, 0, 0, 200, 200, ImageID(#img))

Define EventID
Repeat
  EventID = WaitWindowEvent()

  If GetAsyncKeyState_(#VK_UP) & 32768
    CalcPerlin(WindowWidth(#win), WindowHeight(#win), 1)
    SetGadgetState(#img, ImageID(#img))
  ElseIf GetAsyncKeyState_(#VK_DOWN) & 32768
    CalcPerlin(WindowWidth(#win), WindowHeight(#win), -1)
    SetGadgetState(#img, ImageID(#img))
  EndIf

  Select EventID
    Case #PB_Event_SizeWindow
      CalcPerlin(WindowWidth(#win), WindowHeight(#win), 0)
      ResizeGadget(#img, 0, 0, WindowWidth(#win), WindowHeight(#win))
      SetGadgetState(#img, ImageID(#img))
  EndSelect

Until EventID = #PB_Event_CloseWindow

CloseWindow(#win)
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Antworten