Seite 1 von 2

Perlin Noise

Verfasst: 05.04.2006 17:11
von remi_meier
Wird z. B. für Heightmaps und animierte Wolken benutzt. Dieses Beispiel
zeigt die 3-dimensionale Perlin Noise mit der Zeit als dritte Dimension,
soll heissen, 2-dimensionale animierte Wolken (oder Gebirge). Die
Dimensionen können beliebig erhöht werden wodurch auch 3-dimensional-
animierte Wolken erstellt werden können.

Pfeiltasten (Auf und Ab) benutzen um die Zeit zu verändern.

Code: Alles auswählen

; PB 4.0b9

; Auf und Ab drücken!

EnableExplicit

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



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, Noise.NOISEFUNC(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), 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.NOISEFUNC(2)
  N(0) = @Noise1()
  N(1) = @Noise2()
  N(2) = @Noise3()
  
  CreateImage(#img, Width, Height)
  StartDrawing(ImageOutput(#img))
  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)
CreateGadgetList(WindowID(#win))

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 
greetz
Remi

Verfasst: 06.04.2006 17:37
von Hades
Du haste ne PN. Schau mal rein.

Verfasst: 06.04.2006 19:35
von AND51
Woher weißt du das? :wink:

Verfasst: 28.11.2007 14:19
von Little John
Hallo,

ich beschäftige mich gerade mit dieser sehr interessanten Sache. Leider kann ich den Code (mit PB 4.10) nicht ausführen. Die Zeile

Code: Alles auswählen

Dim N.NOISEFUNC(2)
ruft folgende Fehlermeldung hervor:
A prototype can't be used with an array.
Gruß, Little John

Verfasst: 28.11.2007 14:43
von edel
tja so ist das eben, wenn die Entwickler nix dokumentieren ... und nein, ich meine nicht Remi!

Weiss nicht ob ich da alles richtig uebersetzt habe, aber zumindest
kommen keine Fehler mehr.

Code: Alles auswählen

; PB 4.0b9

; 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, 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))
  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)
CreateGadgetList(WindowID(#win))

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 

Verfasst: 28.11.2007 17:12
von Thalius
ha nice! Sowas könnt ich in meinem neuen terrainmanager genau brauchen...

ps. Remi du bist von Liestal ??? verd! das iss quasi um die ecke *g*.

Thalius

Verfasst: 28.11.2007 19:46
von DrShrek
edel hat geschrieben:tja so ist das eben, wenn die Entwickler nix dokumentieren ...
Er meint sicher mich. :oops:

Verfasst: 28.11.2007 22:44
von Little John
Cool!
Vielen Dank an remi_meier, und vielen Dank an edel für's reparieren.

Gruß, Little John

Verfasst: 06.12.2007 15:35
von remi_meier
@edel: Thx. Wär ja auch zu schön gewesen :roll:

@Thalius: Genauer bin ich von Wenslingen, wenn dir das auch was sagt :)
Obwohl, im Moment bin ich unter der Woche immer in Zürich.

Re: Perlin Noise

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