It is currently Sat Jul 11, 2020 2:42 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 8 posts ] 
Author Message
 Post subject: Summer Sky Demo (with Ken Perlin's Simplex Noise)
PostPosted: Sat Apr 08, 2006 3:39 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Tue May 17, 2005 8:39 pm
Posts: 188
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:
 
;-------------------------------------------------------------------------------------
;
; 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
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Apr 08, 2006 11:41 pm 
Offline
Moderator
Moderator

Joined: Sat Dec 27, 2003 3:55 am
Posts: 3321
Location: Great Southern Land
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
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 09, 2006 10:51 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2005 2:46 pm
Posts: 1799
Location: Pas-de-Calais, France
impressive :)


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 09, 2006 10:54 am 
Offline
PureBasic Expert
PureBasic Expert
User avatar

Joined: Sun Apr 27, 2003 4:41 pm
Posts: 1661
Location: Germany
Very nice, thanks for sharing! :)

_________________
Good programmers don't comment their code. It was hard to write, should be hard to read.


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 09, 2006 11:02 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Tue May 17, 2005 8:39 pm
Posts: 188
Thank you all for your nice comments. :D


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 09, 2006 12:18 pm 
Offline
Enthusiast
Enthusiast

Joined: Sun Sep 05, 2004 6:27 am
Posts: 762
Location: England
That's great! Very relaxing to watch :)

_________________
Mat


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 09, 2006 12:40 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Aug 19, 2003 11:36 am
Posts: 1418
Location: Doubs - France
very usefull , thank you :)

_________________
Please correct my english
http://purebasic.developpez.com/


Top
 Profile  
Reply with quote  
 Post subject: Re: Summer Sky Demo (with Ken Perlin's Simplex Noise)
PostPosted: Mon Sep 08, 2014 7:36 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2011 10:06 am
Posts: 854
Location: Denmark
Code:
;-------------------------------------------------------------------------------------
;
; 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()

_________________
“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
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 8 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 6 guests


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

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye