Summer Sky Demo (with Ken Perlin's Simplex Noise)

Advanced game related topics
Post Reply
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Summer Sky Demo (with Ken Perlin's Simplex Noise)

Post by Hades »

Perlin Noise is a well known method to generate procedural textures or terrains.
His improved version is much less known, and almost no one seem to know his Simplex Noise.

But especially for higher dimensions Simplex Noise is much faster.

I found this paper, switched to Simplex Noise and made a Demo for you to dream.

Enjoy!

Code: Select all

 
;-------------------------------------------------------------------------------------
;
; Summer Sky Demo
;
; Perlin Simplex Noise Demo 
; for PB4.0 (Beta 9)
;
; by Hades 
;
; April 2006 
;
;
; Escape to quit
;
;-------------------------------------------------------------------------------------

EnableExplicit




; ***************************************************************************************************
; Ken Perlin's Simplex Noise 3D. Optimized PB Version. 
; Ported from Stefan Gustavson's Java implementation 
; (http://staffwww.itn.liu.se/~stegu/simplexnoise/simplexnoise.pdf) 

#PN3DF3 = 1.0 / 3.0
#PN3DG3A = 1.0 / 6.0
#PN3DG3B = 2.0 * #PN3DG3A
#PN3DG3C = -1.0 + 3.0 * #PN3DG3A

Structure sPNVECTOR
  x.f
  y.f
  z.f
EndStructure

Global Dim PNHash.l(512)
Global Dim PNGrad3.sPNVECTOR(256)


Procedure PerlinNoiseInit()
  Protected n.l, rn.l
  For n=0 To 255
    PNHash(n) = n
  Next n  
  For n=0 To 255
    rn=Random(255)
    Swap PNHash(n),PNHash(rn)
  Next n
  For n=0 To 255
    PNHash(256 + n) = PNHash(n)
  Next n 
  PNHash(512) = PNHash(0)
  
  For n=0 To 15
    PNGrad3(n * 16 + 0)\x = 1 : PNGrad3(n * 16 + 0)\y = 1 : PNGrad3(n * 16 + 0)\z = 0
    PNGrad3(n * 16 + 1)\x = -1 : PNGrad3(n * 16 + 1)\y = 1 : PNGrad3(n * 16 + 1)\z = 0
    PNGrad3(n * 16 + 2)\x = 1 : PNGrad3(n * 16 + 2)\y = -1 : PNGrad3(n * 16 + 2)\z = 0
    PNGrad3(n * 16 + 3)\x = -1 : PNGrad3(n * 16 + 3)\y = -1 : PNGrad3(n * 16 + 3)\z = 0
    
    PNGrad3(n * 16 + 4)\x = 1 : PNGrad3(n * 16 + 4)\y = 0 : PNGrad3(n * 16 + 4)\z = 1
    PNGrad3(n * 16 + 5)\x = -1 : PNGrad3(n * 16 + 5)\y = 0 : PNGrad3(n * 16 + 5)\z = 1
    PNGrad3(n * 16 + 6)\x = 1 : PNGrad3(n * 16 + 6)\y = 0 : PNGrad3(n * 16 + 6)\z = -1
    PNGrad3(n * 16 + 7)\x = -1 : PNGrad3(n * 16 + 7)\y = 0 : PNGrad3(n * 16 + 7)\z = -1
    
    PNGrad3(n * 16 + 8)\x = 0 : PNGrad3(n * 16 + 8)\y = 1 : PNGrad3(n * 16 + 8)\z = 1
    PNGrad3(n * 16 + 9)\x = 0 : PNGrad3(n * 16 + 9)\y = -1 : PNGrad3(n * 16 + 9)\z = 1
    PNGrad3(n * 16 + 10)\x = 0 : PNGrad3(n * 16 + 10)\y = 1 : PNGrad3(n * 16 + 10)\z = -1
    PNGrad3(n * 16 + 11)\x = 0 : PNGrad3(n * 16 + 11)\y = -1 : PNGrad3(n * 16 + 11)\z = -1
    
    PNGrad3(n * 16 + 12)\x = 1 : PNGrad3(n * 16 + 12)\y = 1 : PNGrad3(n * 16 + 12)\z = 0
    PNGrad3(n * 16 + 13)\x = -1 : PNGrad3(n * 16 + 13)\y = 1 : PNGrad3(n * 16 + 13)\z = 0
    PNGrad3(n * 16 + 14)\x = 0 : PNGrad3(n * 16 + 14)\y = -1 : PNGrad3(n * 16 + 14)\z = 1
    PNGrad3(n * 16 + 15)\x = 0 : PNGrad3(n * 16 + 15)\y = -1 : PNGrad3(n * 16 + 15)\z = -1
  Next n  
EndProcedure

Procedure.f Noise3D(xin.f, yin.f, zin.f)
  Protected n0.f, n1.f, n2.f, n3.f, s.f, t.f, x0.f, y0.f, z0.f, xs.f, ys.f, zs.f
  Protected i.l, j.l, k.l, i1.l, j1.l, k1.l, i2.l, j2.l, k2.l, gi0.l, gi1.l, gi2.l, gi3.l
  Protected x1.f, y1.f, z1.f, x2.f, y2.f, z2.f, x3.f, y3.f, z3.f, t0.f, t1.f, t2.f, t3.f
  s = (xin + yin + zin) * #PN3DF3
  xs = xin + s
  i = Int(xs)
  If xs < 0.0
    i - 1 
  EndIf
  ys = yin + s
  j = Int(ys)
  If ys < 0.0
    j - 1 
  EndIf
  zs = zin + s
  k = Int(zs)
  If zs < 0.0
    k - 1 
  EndIf
  t = (i + j + k) * #PN3DG3A
  x0 = xin - (i - t)
  y0 = yin - (j - t)
  z0 = zin - (k - t)
  i = i & 255
  j = j & 255
  k = k & 255
  If x0 >= y0
    If y0 >= z0
      i1 = 1 : i2 = 1 : j2 = 1
    ElseIf x0 >= z0 
      i1 = 1 : i2 = 1 : k2 = 1
    Else
      k1 = 1 : i2 = 1 : k2 = 1
    EndIf
  Else
    If y0 < z0 
      k1 = 1 : j2 = 1 : k2 = 1
    ElseIf x0 < z0
      j1 = 1 : j2 = 1 : k2 = 1  
    Else  
      j1 = 1 : i2 = 1 : j2 = 1 
    EndIf
  EndIf
  x1 = x0 - i1 + #PN3DG3A
  y1 = y0 - j1 + #PN3DG3A
  z1 = z0 - k1 + #PN3DG3A
  x2 = x0 - i2 + #PN3DG3B
  y2 = y0 - j2 + #PN3DG3B
  z2 = z0 - k2 + #PN3DG3B
  x3 = x0 + #PN3DG3C
  y3 = y0 + #PN3DG3C
  z3 = z0 + #PN3DG3C
  gi0 = PNHash(i + PNHash(j + PNHash(k))) & 15
  gi1 = PNHash(i + i1 + PNHash(j + j1 + PNHash(k + k1))) & 15
  gi2 = PNHash(i + i2 + PNHash(j + j2 + PNHash(k + k2))) & 15
  gi3 = PNHash(i + 1 + PNHash(j + 1 + PNHash(k + 1))) & 15
  t0 = 0.6 - x0 * x0 - y0 * y0 - z0 * z0
  t1 = 0.6 - x1 * x1 - y1 * y1 - z1 * z1
  t2 = 0.6 - x2 * x2 - y2 * y2 - z2 * z2
  t3 = 0.6 - x3 * x3 - y3 * y3 - z3 * z3
  If t0 >= 0.0
    t0 * t0
    n0 = t0 * t0 * (PNGrad3(gi0)\x * x0 + PNGrad3(gi0)\y * y0 + PNGrad3(gi0)\z * z0)
  EndIf
  If t1 >= 0.0
    t1 * t1
    n1 = t1 * t1 * (PNGrad3(gi1)\x * x1 + PNGrad3(gi1)\y * y1 + PNGrad3(gi1)\z * z1)
  EndIf
  If t2 >= 0.0
    t2 * t2
    n2 = t2 * t2 * (PNGrad3(gi2)\x * x2 + PNGrad3(gi2)\y * y2 + PNGrad3(gi2)\z * z2)
  EndIf
  If t3 >= 0.0
    t3 * t3
    n3 = t3 * t3 * (PNGrad3(gi3)\x * x3 + PNGrad3(gi3)\y * y3 + PNGrad3(gi3)\z * z3)
  EndIf
  ProcedureReturn 32.0 * (n0 + n1 + n2 + n3)
EndProcedure  

; ***************************************************************************************************




#StartFreq = 1.0 / 64.0
#Border = 0.05
#StepSize = 2
  
Global ScrWidth.l = 320
Global ScrHeight.l = 240
Global StartTime.l
Global Now.l
Global Dim Sky.f(ScrWidth, ScrHeight)



Procedure TimerInit() 
  Shared _GT_DevCaps.TIMECAPS 
  timeGetDevCaps_(_GT_DevCaps,SizeOf(TIMECAPS)) 
  timeBeginPeriod_(_GT_DevCaps\wPeriodMin) 
EndProcedure 

Procedure Init()
  Shared Running.l
  If InitSprite() And InitKeyboard()
    If OpenScreen(ScrWidth,ScrHeight,32,"Summer Sky Demo")
      TimerInit()
      PerlinNoiseInit()
      RandomSeed(1)
      
      StartTime = TimeGetTime_()
      Running = #True
    EndIf  
  EndIf
EndProcedure

Procedure.f Clouds(x.f,y.f,z.f,Iter.l)
  Protected freq.f, amp.f, c.f , n.l
  freq = #StartFreq : amp = 0.5
  For n = 1 To Iter
    c + Noise3D(x * freq , y * freq, z * freq) * amp
    If c <= -amp
      Break
    EndIf
    freq * 2
    amp * 0.5
  Next n
  If c < 0.0 : c = 0.0 : EndIf
  ProcedureReturn c  
EndProcedure

Procedure Refine(StepSize.l, time.f)
  Protected x.l, y.l, HalfStep.l, OffX.f, OffY.f
  OffX = - time * 0.4
  OffY = time * 0.7
  HalfStep = StepSize / 2
  y = HalfStep
  While y <= ScrHeight - HalfStep
    x = HalfStep
    While x <= ScrWidth - HalfStep
      If Abs(Sky(x-HalfStep,y-HalfStep) - Sky(x+HalfStep,y+HalfStep)) < #Border And Abs(Sky(x-HalfStep,y+HalfStep) - Sky(x+HalfStep,y-HalfStep)) < #Border
        Sky(x,y) = (Sky(x-HalfStep,y-HalfStep) + Sky(x+HalfStep,y+HalfStep) + Sky(x-HalfStep,y+HalfStep) + Sky(x+HalfStep,y-HalfStep)) * 0.25
      Else
        Sky(x,y) = Clouds(OffX + x,OffY + y,time,4)
      EndIf
      x + StepSize
    Wend  
    y + StepSize
  Wend  
  y = 0
  While y <= ScrHeight
    x = HalfStep
    While x <= ScrWidth - HalfStep
      If Abs(Sky(x-HalfStep,y) - Sky(x+HalfStep,y)) < #Border
        Sky(x,y) = (Sky(x-HalfStep,y) + Sky(x+HalfStep,y)) * 0.5
      Else
        Sky(x,y) = Clouds(OffX + x,OffY + y,time,4)
      EndIf
      x + StepSize
    Wend  
    y + StepSize
  Wend  
  y = HalfStep
  While y <= ScrHeight - HalfStep
    x = 0
    While x <= ScrWidth
      If Abs(Sky(x,y-HalfStep) - Sky(x,y+HalfStep)) < #Border
        Sky(x,y) = (Sky(x,y-HalfStep) + Sky(x,y+HalfStep)) * 0.5
      Else
        Sky(x,y) = Clouds(OffX + x,OffY + y,time,4)
      EndIf
      x + StepSize
    Wend  
    y + StepSize
  Wend  
EndProcedure

Procedure ComputeSky()
  Protected x.l, y.l, time.f, sx.f, sy.f, StepSize.l, OffX.f, OffY.f
  time = (Now - StartTime) / 400.0
  OffX = - time * 0.4
  OffY = time * 0.7
  sx = OffX
  For y = 0 To ScrHeight Step #StepSize
    sy = y + OffY
    Sky(0,y) = Clouds(sx,sy,time,4)
  Next
  sy = OffY
  For x = #StepSize To ScrWidth Step #StepSize
    sx = x + OffX
    Sky(x,0) = Clouds(sx,sy,time,4)
  Next
  For y = #StepSize To ScrHeight Step #StepSize
    sy = y + OffY
    For x = #StepSize To ScrWidth Step #StepSize
      sx = x + OffX
      Sky(x,y) = Clouds(sx,sy,time,4)
    Next
  Next
  StepSize = #StepSize
  While StepSize > 1
    Refine(StepSize,time)
    StepSize / 2
  Wend  
EndProcedure

Procedure Render()
  Protected x.l, y.l, FrameTime.l, c.f
  ClearScreen(RGB(0,55,255))
  StartDrawing(ScreenOutput())
  For y = 0 To ScrHeight - 1
    For x = 0 To ScrWidth - 1 
      c = Sky(x,y) 
      If c > 0.0
        Plot(x,y,RGB(c * 255, 55 + c * 200, 255))
      EndIf
    Next
  Next
  ; FrameTime = TimeGetTime_() - Now
  ; DrawText(10,0,Str(FrameTime) + "ms")
  StopDrawing()
  FlipBuffers(0)
EndProcedure

Procedure CheckKeyboard()
  Shared Running.l
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    Running = #False
  EndIf
EndProcedure

Procedure Main()
  Shared Running.l
  Init()
  
  While Running
    Now = TimeGetTime_()
    
    ComputeSky()
    Render()
    
    Delay(1)
    CheckKeyboard()
  Wend
  
EndProcedure

Main()
Top
Dare2
Moderator
Moderator
Posts: 3321
Joined: Sat Dec 27, 2003 3:55 am
Location: Great Southern Land

Post by Dare2 »

Nice effect.

I was aware of Perlin noise, but didn't realise there was an advance on this by the same guy!
@}--`--,-- A rose by any other name ..
Top
User avatar
djes
Addict
Addict
Posts: 1806
Joined: Sat Feb 19, 2005 2:46 pm
Location: Pas-de-Calais, France

Post by djes »

impressive :)
Top
traumatic
PureBasic Expert
PureBasic Expert
Posts: 1661
Joined: Sun Apr 27, 2003 4:41 pm
Location: Germany
Contact:
Contact traumatic

Post by traumatic »

Very nice, thanks for sharing! :)
Good programmers don't comment their code. It was hard to write, should be hard to read.
Top
User avatar
Hades
Enthusiast
Enthusiast
Posts: 188
Joined: Tue May 17, 2005 8:39 pm

Post by Hades »

Thank you all for your nice comments. :D
Top
MrMat
Enthusiast
Enthusiast
Posts: 762
Joined: Sun Sep 05, 2004 6:27 am
Location: England

Post by MrMat »

That's great! Very relaxing to watch :)
Mat
Top
User avatar
Comtois
Addict
Addict
Posts: 1429
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Post by Comtois »

very usefull , thank you :)
Please correct my english
http://purebasic.developpez.com/
Top
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:
Contact DK_PETER

Re: Summer Sky Demo (with Ken Perlin's Simplex Noise)

Post by DK_PETER »

Code: Select all

;-------------------------------------------------------------------------------------
;
; Summer Sky Demo
;
; Perlin Simplex Noise Demo
; for PB4.0 (Beta 9)   
; UPDATED for PB 5.30  
; Thanks Hades.. I needed this now. 
; You just saved me the trouble from doing the work myself. :-)
;
; by Hades
;
; April 2006
;
;
; Escape to quit
;
;-------------------------------------------------------------------------------------

EnableExplicit


; ***************************************************************************************************
; Ken Perlin's Simplex Noise 3D. Optimized PB Version.
; Ported from Stefan Gustavson's Java implementation
; (http://staffwww.itn.liu.se/~stegu/simplexnoise/simplexnoise.pdf)

#PN3DF3 = 1.0 / 3.0
#PN3DG3A = 1.0 / 6.0
#PN3DG3B = 2.0 * #PN3DG3A
#PN3DG3C = -1.0 + 3.0 * #PN3DG3A

Structure sPNVECTOR
  x.f
  y.f
  z.f
EndStructure

Global Dim PNHash.l(512)
Global Dim PNGrad3.sPNVECTOR(256)


Procedure PerlinNoiseInit()
  Protected n.l, rn.l
  For n=0 To 255
    PNHash(n) = n
  Next n 
  For n=0 To 255
    rn=Random(255)
    Swap PNHash(n),PNHash(rn)
  Next n
  For n=0 To 255
    PNHash(256 + n) = PNHash(n)
  Next n
  PNHash(512) = PNHash(0)
 
  For n=0 To 15
    PNGrad3(n * 16 + 0)\x = 1 : PNGrad3(n * 16 + 0)\y = 1 : PNGrad3(n * 16 + 0)\z = 0
    PNGrad3(n * 16 + 1)\x = -1 : PNGrad3(n * 16 + 1)\y = 1 : PNGrad3(n * 16 + 1)\z = 0
    PNGrad3(n * 16 + 2)\x = 1 : PNGrad3(n * 16 + 2)\y = -1 : PNGrad3(n * 16 + 2)\z = 0
    PNGrad3(n * 16 + 3)\x = -1 : PNGrad3(n * 16 + 3)\y = -1 : PNGrad3(n * 16 + 3)\z = 0
   
    PNGrad3(n * 16 + 4)\x = 1 : PNGrad3(n * 16 + 4)\y = 0 : PNGrad3(n * 16 + 4)\z = 1
    PNGrad3(n * 16 + 5)\x = -1 : PNGrad3(n * 16 + 5)\y = 0 : PNGrad3(n * 16 + 5)\z = 1
    PNGrad3(n * 16 + 6)\x = 1 : PNGrad3(n * 16 + 6)\y = 0 : PNGrad3(n * 16 + 6)\z = -1
    PNGrad3(n * 16 + 7)\x = -1 : PNGrad3(n * 16 + 7)\y = 0 : PNGrad3(n * 16 + 7)\z = -1
   
    PNGrad3(n * 16 + 8)\x = 0 : PNGrad3(n * 16 + 8)\y = 1 : PNGrad3(n * 16 + 8)\z = 1
    PNGrad3(n * 16 + 9)\x = 0 : PNGrad3(n * 16 + 9)\y = -1 : PNGrad3(n * 16 + 9)\z = 1
    PNGrad3(n * 16 + 10)\x = 0 : PNGrad3(n * 16 + 10)\y = 1 : PNGrad3(n * 16 + 10)\z = -1
    PNGrad3(n * 16 + 11)\x = 0 : PNGrad3(n * 16 + 11)\y = -1 : PNGrad3(n * 16 + 11)\z = -1
   
    PNGrad3(n * 16 + 12)\x = 1 : PNGrad3(n * 16 + 12)\y = 1 : PNGrad3(n * 16 + 12)\z = 0
    PNGrad3(n * 16 + 13)\x = -1 : PNGrad3(n * 16 + 13)\y = 1 : PNGrad3(n * 16 + 13)\z = 0
    PNGrad3(n * 16 + 14)\x = 0 : PNGrad3(n * 16 + 14)\y = -1 : PNGrad3(n * 16 + 14)\z = 1
    PNGrad3(n * 16 + 15)\x = 0 : PNGrad3(n * 16 + 15)\y = -1 : PNGrad3(n * 16 + 15)\z = -1
  Next n 
EndProcedure

Procedure.f Noise3D(xin.f, yin.f, zin.f)
  Protected n0.f, n1.f, n2.f, n3.f, s.f, t.f, x0.f, y0.f, z0.f, xs.f, ys.f, zs.f
  Protected i.l, j.l, k.l, i1.l, j1.l, k1.l, i2.l, j2.l, k2.l, gi0.l, gi1.l, gi2.l, gi3.l
  Protected x1.f, y1.f, z1.f, x2.f, y2.f, z2.f, x3.f, y3.f, z3.f, t0.f, t1.f, t2.f, t3.f
  s = (xin + yin + zin) * #PN3DF3
  xs = xin + s
  i = Int(xs)
  If xs < 0.0
    i - 1
  EndIf
  ys = yin + s
  j = Int(ys)
  If ys < 0.0
    j - 1
  EndIf
  zs = zin + s
  k = Int(zs)
  If zs < 0.0
    k - 1
  EndIf
  t = (i + j + k) * #PN3DG3A
  x0 = xin - (i - t)
  y0 = yin - (j - t)
  z0 = zin - (k - t)
  i = i & 255
  j = j & 255
  k = k & 255
  If x0 >= y0
    If y0 >= z0
      i1 = 1 : i2 = 1 : j2 = 1
    ElseIf x0 >= z0
      i1 = 1 : i2 = 1 : k2 = 1
    Else
      k1 = 1 : i2 = 1 : k2 = 1
    EndIf
  Else
    If y0 < z0
      k1 = 1 : j2 = 1 : k2 = 1
    ElseIf x0 < z0
      j1 = 1 : j2 = 1 : k2 = 1 
    Else 
      j1 = 1 : i2 = 1 : j2 = 1
    EndIf
  EndIf
  x1 = x0 - i1 + #PN3DG3A
  y1 = y0 - j1 + #PN3DG3A
  z1 = z0 - k1 + #PN3DG3A
  x2 = x0 - i2 + #PN3DG3B
  y2 = y0 - j2 + #PN3DG3B
  z2 = z0 - k2 + #PN3DG3B
  x3 = x0 + #PN3DG3C
  y3 = y0 + #PN3DG3C
  z3 = z0 + #PN3DG3C
  gi0 = PNHash(i + PNHash(j + PNHash(k))) & 15
  gi1 = PNHash(i + i1 + PNHash(j + j1 + PNHash(k + k1))) & 15
  gi2 = PNHash(i + i2 + PNHash(j + j2 + PNHash(k + k2))) & 15
  gi3 = PNHash(i + 1 + PNHash(j + 1 + PNHash(k + 1))) & 15
  t0 = 0.6 - x0 * x0 - y0 * y0 - z0 * z0
  t1 = 0.6 - x1 * x1 - y1 * y1 - z1 * z1
  t2 = 0.6 - x2 * x2 - y2 * y2 - z2 * z2
  t3 = 0.6 - x3 * x3 - y3 * y3 - z3 * z3
  If t0 >= 0.0
    t0 * t0
    n0 = t0 * t0 * (PNGrad3(gi0)\x * x0 + PNGrad3(gi0)\y * y0 + PNGrad3(gi0)\z * z0)
  EndIf
  If t1 >= 0.0
    t1 * t1
    n1 = t1 * t1 * (PNGrad3(gi1)\x * x1 + PNGrad3(gi1)\y * y1 + PNGrad3(gi1)\z * z1)
  EndIf
  If t2 >= 0.0
    t2 * t2
    n2 = t2 * t2 * (PNGrad3(gi2)\x * x2 + PNGrad3(gi2)\y * y2 + PNGrad3(gi2)\z * z2)
  EndIf
  If t3 >= 0.0
    t3 * t3
    n3 = t3 * t3 * (PNGrad3(gi3)\x * x3 + PNGrad3(gi3)\y * y3 + PNGrad3(gi3)\z * z3)
  EndIf
  ProcedureReturn 32.0 * (n0 + n1 + n2 + n3)
EndProcedure 

; ***************************************************************************************************




#StartFreq = 1.0 / 64.0
#Border = 0.05
#StepSize = 2
 
Global ScrWidth.i = 640
Global ScrHeight.i = 480
Global StartTime.i
Global Now.i, ev.i
Global Dim Sky.f(ScrWidth.i, ScrHeight.i)
Global Runningtime.i=0, Running.i=#False


Procedure TimerInit()
  Runningtime = 0
EndProcedure

Procedure Init()
  If InitSprite() And InitKeyboard()
    OpenWindow(0, 0, 0, ScrWidth, ScrHeight, "Summer sky demo",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
    OpenWindowedScreen(WindowID(0),0, 0, ScrWidth, ScrHeight,0,0,0,#PB_Screen_WaitSynchronization)
      TimerInit()
      PerlinNoiseInit()
      RandomSeed(1)
      StartTime = timeGetTime_()
      Running = #True
  EndIf
EndProcedure

Procedure.f Clouds(x.f,y.f,z.f,Iter.l)
  Protected freq.f, amp.f, c.f , n.l
  freq = #StartFreq : amp = 0.5
  For n = 1 To Iter
    c + Noise3D(x * freq , y * freq, z * freq) * amp
    If c <= -amp
      Break
    EndIf
    freq * 2
    amp * 0.5
  Next n
  If c < 0.0 : c = 0.0 : EndIf
  ProcedureReturn c 
EndProcedure

Procedure Refine(StepSize.l, time.f)
  Protected x.l, y.l, HalfStep.l, OffX.f, OffY.f
  OffX = - time * 0.4
  OffY = time * 0.7
  HalfStep = StepSize / 2
  y = HalfStep
  While y <= ScrHeight - HalfStep
    x = HalfStep
    While x <= ScrWidth - HalfStep
      If Abs(Sky(x-HalfStep,y-HalfStep) - Sky(x+HalfStep,y+HalfStep)) < #Border And Abs(Sky(x-HalfStep,y+HalfStep) - Sky(x+HalfStep,y-HalfStep)) < #Border
        Sky(x,y) = (Sky(x-HalfStep,y-HalfStep) + Sky(x+HalfStep,y+HalfStep) + Sky(x-HalfStep,y+HalfStep) + Sky(x+HalfStep,y-HalfStep)) * 0.25
      Else
        Sky(x,y) = Clouds(OffX + x,OffY + y,time,4)
      EndIf
      x + StepSize
    Wend 
    y + StepSize
  Wend 
  y = 0
  While y <= ScrHeight
    x = HalfStep
    While x <= ScrWidth - HalfStep
      If Abs(Sky(x-HalfStep,y) - Sky(x+HalfStep,y)) < #Border
        Sky(x,y) = (Sky(x-HalfStep,y) + Sky(x+HalfStep,y)) * 0.5
      Else
        Sky(x,y) = Clouds(OffX + x,OffY + y,time,4)
      EndIf
      x + StepSize
    Wend 
    y + StepSize
  Wend 
  y = HalfStep
  While y <= ScrHeight - HalfStep
    x = 0
    While x <= ScrWidth
      If Abs(Sky(x,y-HalfStep) - Sky(x,y+HalfStep)) < #Border
        Sky(x,y) = (Sky(x,y-HalfStep) + Sky(x,y+HalfStep)) * 0.5
      Else
        Sky(x,y) = Clouds(OffX + x,OffY + y,time,4)
      EndIf
      x + StepSize
    Wend 
    y + StepSize
  Wend 
EndProcedure

Procedure ComputeSky()
  Protected x.l, y.l, time.f, sx.f, sy.f, StepSize.l, OffX.f, OffY.f
  time = (Now - StartTime) / 400.0
  OffX = - time * 0.4
  OffY = time * 0.7
  sx = OffX
  For y = 0 To ScrHeight Step #StepSize
    sy = y + OffY
    Sky(0,y) = Clouds(sx,sy,time,4)
  Next
  sy = OffY
  For x = #StepSize To ScrWidth Step #StepSize
    sx = x + OffX
    Sky(x,0) = Clouds(sx,sy,time,4)
  Next
  For y = #StepSize To ScrHeight Step #StepSize
    sy = y + OffY
    For x = #StepSize To ScrWidth Step #StepSize
      sx = x + OffX
      Sky(x,y) = Clouds(sx,sy,time,4)
    Next
  Next
  StepSize = #StepSize
  While StepSize > 1
    Refine(StepSize,time)
    StepSize / 2
  Wend 
EndProcedure

Procedure Render()
  Protected x.l, y.l, FrameTime.l, c.f
  ClearScreen(RGB(0,55,255))
  StartDrawing(ScreenOutput())
  For y = 0 To ScrHeight - 1
    For x = 0 To ScrWidth - 1
      c = Sky(x,y)
      If c > 0.0
        Plot(x,y,RGB(c * 255, 55 + c * 200, 255))
      EndIf
    Next
  Next
  ; FrameTime = TimeGetTime_() - Now
  ; DrawText(10,0,Str(FrameTime) + "ms")
  StopDrawing()
  FlipBuffers()
EndProcedure

Procedure Main()
  Init()
  Repeat
    
    Repeat:ev=WindowEvent():Until ev=0
    
    Now = ElapsedMilliseconds() - runningtime
   
    ComputeSky()
    
    Render()

    ExamineKeyboard()
  Until KeyboardPushed(#PB_Key_Escape)
 
EndProcedure
Main()
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
Top
Post Reply

Return to “Game Programming”