Scrolling fog/cloud image for moving background

[vince]

B+ mod time

Code: (Select All)

Option _Explicit
_Title "Noise Texture Generator" ' trans Yabasic Port by Galileo to QB64 b+ 2022-02-02
'//Noise texure generator
'//Taken from
'//http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html/CG/randomnoise.html
'//=======================================================================
'// Ported from FreeBASIC to Yabasic by Galileo, 1/2018
'// Original code: https://www.freebasic.net/forum/viewtopic.php?f=7&t=13842

Const twidth = 800, theight = 600, zoom = 128
Dim Shared noise(10*twidth * theight) '//the noise array
Dim Shared texture(10*twidth * theight) '//texture array
Dim Shared pal(256) As _Unsigned Long '//color palette

Screen _NewImage(twidth, theight, 32)
_ScreenMove 100, 100
Dim x, y

locate 1,1
? "please give us a few seconds"
_display

MakePalette 255, 255, 255, 100, 100, 180

GenerateNoise
buildtexture


dim i as integer
do
for i=0 to 9*(twidth )
        drawtexture i
        _limit 30
        _display
next
loop

'Do
'    For y = 0 To theight - 1
'        For x = 0 To twidth - 1
'            If x <> twidth - 1 Then
'                noise(x + y * theight) = noise((x + 1) + y * theight)
'            Else
'                If Rnd < .5 Then noise(x + y * theight) = Rnd Else noise(x + y * theight) = noise((x - 1) + y * theight)
'            End If
'        Next
'    Next
'    buildtexture
'    drawtexture
'    _Display
'Loop Until _KeyDown(27)
sleep
system

'//interpolation code by rattrapmax6
Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
    Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)

    interpol(0) = 255
    istart(1) = sr
    istart(2) = sg
    istart(3) = sb
    iend(1) = er
    iend(2) = eg
    iend(3) = eb
    interpol(1) = (istart(1) - iend(1)) / interpol(0)
    interpol(2) = (istart(2) - iend(2)) / interpol(0)
    interpol(3) = (istart(3) - iend(3)) / interpol(0)
    rend(1) = istart(1)
    rend(2) = istart(2)
    rend(3) = istart(3)

    For i = 0 To 255
        ishow(1) = rend(1)
        ishow(2) = rend(2)
        ishow(3) = rend(3)

        pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))

        rend(1) = rend(1) - interpol(1)
        rend(2) = rend(2) - interpol(2)
        rend(3) = rend(3) - interpol(3)
    Next i
End Sub

'//generates random noise.
Sub GenerateNoise ()
    Dim As Long x, y

    For x = 0 To 10*twidth - 1
        For y = 0 To theight - 1
            noise(x + y * twidth) = Rnd
        Next y
    Next x
End Sub

Function SmoothNoise (x, y)
    '//get fractional part of x and y
    Dim fractx, fracty, x1, y1, x2, y2, value
    fractx = x - Int(x)
    fracty = y - Int(y)

    '//wrap around
    x1 = (Int(x) + 10*twidth) Mod twidth
    y1 = (Int(y) + theight) Mod theight

    '//neighbor values
    x2 = (x1 + 10*twidth - 1) Mod twidth
    y2 = (y1 + theight - 1) Mod theight

    '//smooth the noise with bilinear interpolation
    value = 0.0
    value = value + fractx * fracty * noise(x1 + y1 * twidth)
    value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
    value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
    value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)

    SmoothNoise = value
End Function

Function Turbulence (x, y, size)
    Dim value, initialsize

    initialsize = size
    While (size >= 1)
        value = value + SmoothNoise(x / size, y / size) * size
        size = size / 2.0
    Wend
    Turbulence = (128.0 * value / initialsize)
End Function

'//builds the texture.
Sub buildtexture
    Dim x, y

    For x = 0 To 10*twidth - 1
        For y = 0 To theight - 1
            texture(x + y * 10*twidth) = Turbulence(x, y, zoom)
        Next y
    Next x
End Sub

'//draws texture to screen.
Sub drawtexture (dx )
    Dim x, y

    For x = 0 To twidth - 1
        For y = 0 To theight - 1
            PSet (x, y), pal(texture(((x + dx) + y * 10*twidth)))
        Next y
    Next x
End Sub