Water Effect v0.60

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Water Effect v0.60

Postby UEZ » Jan 15, 2019 21:45

Here my version of Water like Effect. Because I embedded the fish frames to the code, Windows is needed to unpack and save it to disk. ¯\_(ツ)_/¯

Best compile options:
-gen gcc -O 3
-gen gcc -Wc -O2
-gen gcc -Wc -Ofast

x64 is horrible slow except -gen gcc -Wc -Ofast !?!?

Windows only version:

Code: Select all

'Coded by UEZ version v0.60 - original idea by Hugo Elias
'Thanks to: Joshy, duke4e
'
'Best compile settings for fastest fps: -gen gcc  -Wc -Ofast -fpmode FAST -fpu SSE
'


#Include "fbgfx.bi"
#Include "file.bi"

'remove these following two lines if you don't need it
#Include "windows.bi"
FreeConsole  'windows.bi Is needed

Using FB

Dim Shared As Ushort iW = 512, iH = 384 'original background image size

Declare Function Shade(iColor As Long, iGain As Long) As Ulong
Declare Function ImageScale(s as fb.Image ptr, w as integer, h as integer) as fb.Image ptr
Declare Sub ExtractFishAnim()
Declare Function Base91Decode(sString As String, Byref iBase91Len As Ulong) As Ubyte Ptr
Declare Function _WinAPI_LZNTDecompress(aBinary As Ubyte Ptr, iFileSize As Ulong, iCompressedSize As Ulong) As Ubyte Ptr

#Define Floor(x)                    (((x) * 2.0 - 0.5) Shr 1) ' http://www.freebasic.net/forum/viewtopic.php?p=118633
#Define Ceiling(x)                  (-((-(x) * 2.0 - 0.5) Shr 1))
#Define Round(x)                    ((x * 100 + 0.5) / 100 Shr 0) '2 decimal places 10^2 = 100
#Define PixelSet(_x, _y, colour)    *Cptr(Ulong Ptr, imgData + (_y) * pitch + (_x) Shl 2) = (colour)
#Define PixelGet(_x, _y)            *Cptr(Ulong Ptr, imgData2 + (_y) * pitch + (_x) Shl 2)
#Define PixelSet2(_x, _y, colour)   *Cptr(Ulong Ptr, imgData3 + (_y) * pitch + (_x) Shl 2) = (colour)
#Define Translate2Dto1D(_x, _y)    ((_x) + (_y) * (iUBW + 1))
#Define _Red(colors)                ((colors Shr 16) And 255)
#Define _Green(colors)              ((colors Shr 8) And 255)
#Define _Blue(colors)               (colors And 255)
#Define _Min(a, b)                  (Iif(a < b, a, b))

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Perlin -> https://www.freebasic.net/forum/viewtopic.php?t=10454#p91198
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Shared As Integer perm(512) = { _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180, _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180}


#Define FADE(_t) (_t * _t * _t * (_t * (_t * 6 - 15) + 10))
#Define NLERP(_t, _a, _b) ((_a) + (_t)*((_b)-(_a)))

Dim Shared As Single ms_grad4(512)
Dim As Single kkf(256)
For i As Integer = 0 To 255
   kkf(i) = -1.0f + 2.0f * (i / 255.0f)
Next
For i As Integer = 0 To 255
   ms_grad4(i) = kkf(perm(i)) * 0.507f
Next   

Function Noise(x As Single, y As Single, px As Integer, py As Integer) As Single
   Dim As Integer ix0, iy0, ix1, iy1
   Dim As Single fx0, fy0
   Dim As Single s, t, nx0, nx1, n0, n1
   
   ix0 = Cint(x - 0.5f)
   iy0 = Cint(y - 0.5f)
   
   fx0 = x - ix0
   fy0 = y - iy0
   If px < 1 Then px = 1
   If py < 1 Then py = 1
   ix1 = ((ix0 + 1) Mod px) And &hff
   iy1 = ((iy0 + 1) Mod py) And &hff
   ix0 = (ix0 Mod px) And &hff
   iy0 = (iy0 Mod py) And &hff
   
   t = FADE(fy0)
   s = FADE(fx0)
   
   nx0 = ms_grad4(perm(ix0 + perm(iy0)))
   nx1 = ms_grad4(perm(ix0 + perm(iy1)))
   n0 = NLERP( t, nx0, nx1 )
   
   nx0 = ms_grad4(perm(ix1 + perm(iy0)))
   nx1 = ms_grad4(perm(ix1 + perm(iy1)))
   n1 = NLERP(t, nx0, nx1)
   
   Return NLERP(s, n0, n1)
End Function

Function Turbulence(x As Single, y As Single, size As Single) As Ubyte  ' size must be 2 ^ n
    Dim As Single value = 0.0, initialSize = size
   
    While(size >= 1)
        value += Noise(x / size, y / size, iW / size, iH / size) * size
        size /= 2.0f
    Wend
   
    Return (128.0f * value / initialSize) + 127
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Randomize , 2

Dim As Single aCurrent(iH, iW), aPrevious(iH, iW)
Dim As Long iUBW = Ubound(aCurrent, 2), iX, iY
Dim As Single xOff, yOff, ripRadPower, ripRad = 5, depth = 2048
Dim Shared As Ulong aImage(iH, iW)
Dim As Single v, l, q
Dim As Single Ptr pACurrent, pAPrevious, pATmp

pACurrent = @aCurrent(0, 0)
pAPrevious = @aPrevious(0, 0)

Dim as Single fScale = 2.0 'scale factor for screen

Screenres iW * fScale, iH * fScale, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_ALWAYS_ON_TOP Or GFX_NO_SWITCH
Screenset 1, 0
Windowtitle("Water Effect v0.60 with a lonely fish coded by UEZ")

Dim As Any Ptr pImage = Imagecreate(iW, iH, 0, 32), pImage2 = Imagecreate(iW, iH, 0, 32), pImage2_Clone = Imagecreate(iW, iH, 0, 32), _
               pImage_Fish1 = Imagecreate(96, 128, , 32), pImage_Sky = Imagecreate(iW, iH, 0, 32), pImage_resized = Imagecreate(iW * fScale, iH * fScale, 0, 32)
Bload(Curdir & "\Pebbles under Water_512x384.bmp", pImage2) 'Download: https://ibb.co/dGT1wyX and convert to BMP format
Bload(Curdir & "\Pebbles under Water_512x384.bmp", pImage2_Clone)

If Fileexists(Curdir & "\Fish3.bmp") = 0 Then ExtractFishAnim()
Bload(Curdir & "\Fish3.bmp", pImage_Fish1)

Dim As Integer w, h, pitch
Dim As Any Pointer imgData, imgData2, imgData3
Imageinfo(pImage, w, h, , pitch, imgData)
Imageinfo(pImage2, , , , , imgData2)
Imageinfo(pImage_Sky, , , , , imgData3)
Dim As SIngle T

'Add sky With clouds To the background image
Dim As Long x, y, z
For y = 0 To iH - 1
    For x = 0 To iW - 1
        T = Turbulence(-x, y, 64)
        PixelSet2(x, y, Rgba(T, T, &hF0, _Min(&h08 + T, 255)))
    Next
Next

Put pImage2_Clone, (0, 0), pImage_Sky, Alpha 'Add sky with clouds
                         
                                       
Dim As Ulong i, iFPS = 0, iFPS_current = 0, iColor
Dim As Double fTimer, fTimer_drops = Timer

Dim As Integer mx, my, mb, iFrame
Dim As Single wave, light

Type tFishAnim
    As Single x, y, vy, movespeed, animspeed, frame
    As Ubyte Dir    'Dir  -> 0 = top To botton, 1 = Right To Left, 2 = Left To Right, 3 = bottom To top
    As Byte d
End Type

Dim As tFishAnim Fish

'one lonely fish
Fish.Dir = 2
Fish.x = -64
Fish.y = 32 + Rnd() * (iH - 32)
Fish.frame = 0
Fish.movespeed = 0.2 + Rnd() * 0.3
Fish.animspeed = Fish.movespeed / 2
Fish.d = 1

Do
    'rebuild color array from original background image
    For iY = 0 To iH  - 1
        For iX = 0 To iW  - 1
            aImage(iY, iX) = PixelGet(iX, iY) 'color values of bg image (pImage2)
        Next
    Next
   
    'mouse interaction to disturb water surface
    Getmouse (mx, my, , mb)
    If mb = 1 Then
      ripRadPower = Cushort(0.5 + Rnd() * 2.75)
      For iY = my / fScale - (ripRad + ripRadPower) To my / fScale + (ripRad + ripRadPower)
         For iX = mx / fScale - (ripRad + ripRadPower) To mx / fScale + (ripRad + ripRadPower)           
            pACurrent[Translate2Dto1D(Iif(iX < 0, 0, Iif(iX > iW - 1, iW - 1, iX)), _
                                 Iif(iY < 0, 0, Iif(iY > iH - 1, iH - 1, iY)))] += 20
         Next
      Next
    End If

    'calculate the wave
   For iY = 1 To iH - 1
      For iX = 1 To iW - 1         
         wave = _
               (pAPrevious[Translate2Dto1D((iX - 1),  iY)     ] + _
                pAPrevious[Translate2Dto1D((iX + 1),  iY)     ] + _
                pAPrevious[Translate2Dto1D( iX,      (iY - 1))] + _
                pAPrevious[Translate2Dto1D( iX,      (iY + 1))] + _                                 
                pAPrevious[Translate2Dto1D((iX - 1), (iY - 1))] + _
                pAPrevious[Translate2Dto1D((iX - 1), (iY + 1))] + _
                pAPrevious[Translate2Dto1D((iX + 1), (iY - 1))] + _
                pAPrevious[Translate2Dto1D((iX + 1), (iY + 1))] ) / 4
           
            wave -= pACurrent[Translate2Dto1D(iX, iY)]                                     
            wave -= wave / 256
           
            pACurrent[Translate2Dto1D(iX, iY)] = wave
           
            light = wave * 3 - pACurrent[Translate2Dto1D(iX, iY)] * 2
           
            wave = (depth - wave)   
            xOff = (((iX - iW) * wave) / depth) + iW
            yOff = (((iY - iH) * wave) / depth) + iH
            xOff = Iif(xOff >= iW, iW - 1, Iif(xOff < 0, 0, xOff))
            yOff = Iif(yOff >= iH, iH - 1, Iif(yOff < 0, 0, yOff))
            iColor = aImage(yOff, xOff)
           
           
            light = Iif(light < -8, -8, Iif(light > 64, 64, light))               
            PixelSet(iX, iY, Shade(iColor, light))

      Next
   Next
 
    For iX = 1 to 20
        aPrevious((Rnd() * (iH - 1)) Shr 0, (Rnd() * (iW - 1)) Shr 0) += -10 * Rnd() + 20 ' some turbulances on water surface
    next
       
    'draw generated image to screen incl. FPS
    If fScale <> 1 then
        pImage_Resized = ImageScale(pImage, iW * fScale, iH * fScale)
        Put (0,0), pImage_Resized, Pset
        Imagedestroy pImage_resized
    Else
        Put (0,0), pImage, Pset
    end if
   
    Draw String(2, 2), iFPS_current & " fps", Rgb(&hFF, &hFF, &h00)
   Flip
   
   
    'do some random drops
   If (Timer - fTimer_drops) > (1 + Rnd() * 10.0) Then
      x = 15 + Cushort(Rnd() * (iW - 30))
      y = 15 + Cushort(Rnd() * (iH - 30))
      ripRadPower = Cushort(0.5 + Rnd() * 2.75)
        Dim as Single fWPower = 32 + Rnd() * 224
      For iY = y - (ripRad + ripRadPower) To y + (ripRad + ripRadPower)
         For iX = x - (ripRad + ripRadPower) To x + (ripRad + ripRadPower)           
            pACurrent[Translate2Dto1D(Iif(iX < 0, 0, Iif(iX >= iW, iW - 1, iX)), _
                                 Iif(iY < 0, 0, Iif(iY >= iH, iH - 1, iY)))] += fWPower
         Next
      Next
      fTimer_drops = Timer
   Endif
   
   Swap pACurrent, pAPrevious
   
    Put pImage2, (0, 0), pImage2_Clone, Pset 'restore background image
   
    'do some very simple fish animation
    Select Case Fish.Dir
        Case 1
            iFrame = Cubyte(Fish.frame)
            Put pImage2, (Fish.x, Fish.y), pImage_Fish1, (iFrame * 32, Fish.Dir * 32) - (iFrame * 32 + 31, Fish.Dir * 32 + 31), Alpha
            Fish.x -= Fish.movespeed
            Fish.vy = Sin(Fish.x / 100 - Turbulence(Fish.x, Fish.y, 2048)) / 2
            Fish.y += Fish.vy
            If Fish.y > iH - 32 Then Fish.y = iH - 32
            If Fish.y < 32 Then Fish.y = 32
            Fish.frame += Fish.animspeed * Fish.d
            If Fish.frame < 0 Or Fish.frame > 2 Then
                Fish.d *= -1
            End If
            If Fish.x < -48 - Rnd() * 32 Then                   
                Fish.y = 32 + Rnd() * (iH - 32)
                Fish.movespeed = 0.2 + Rnd() * 0.3
                Fish.animspeed = Fish.movespeed / 2
                Fish.Dir = 2
            End If
        Case 2
            iFrame = Cubyte(Fish.frame)
            Put pImage2, (Fish.x, Fish.y), pImage_Fish1, (iFrame * 32, Fish.Dir * 32) - (iFrame * 32 + 31, Fish.Dir * 32 + 31), Alpha
            Fish.x += Fish.movespeed
            Fish.vy = Sin(Fish.x / 100 - Turbulence(Fish.x, Fish.y, 2048)) / 2
            Fish.y += Fish.vy
            If Fish.y > iH - 32 Then Fish.y = iH - 32
            If Fish.y < 32 Then Fish.y = 32           
            Fish.frame += Fish.animspeed * Fish.d
            If Fish.frame < 0 Or Fish.frame > 2 Then
                Fish.d *= -1
            End If
            If Fish.x > iW + 16 + Rnd() * 32 Then                       
                Fish.y = 32 + Rnd() * (iH - 32)
                Fish.movespeed = 0.2 + Rnd() * 0.3
                Fish.animspeed = Fish.movespeed / 2
                Fish.Dir = 1
            End If
    End Select
                             
   If Timer - fTimer > 0.99 Then       
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   Endif
   Sleep(1, 1)
Loop Until Inkey = Chr(27)

Imagedestroy pImage
Imagedestroy pImage2
Imagedestroy pImage2_Clone
Imagedestroy pImage_Sky
Imagedestroy pImage_Fish1


Function Shade(iColor As Long, iGain As Long) As Ulong
   Dim As Long a, r, g, b
   r = _Red(iColor) + iGain
   r = Iif(r < 0, 0, Iif(r > 255, 255, r))
   g = _Green(iColor) + iGain
   g = Iif(g < 0, 0, Iif(g > 255, 255, g))
   b = _Blue(iColor) + iGain
   b = Iif(b < 0, 0, Iif(b > 255, 255, b))
   Return r Shl 16 Or g Shl 8 Or b
End Function

function ImageScale(s as fb.Image ptr, w as integer, h as integer) as fb.Image ptr 'by D.J. Peters aka Joshy (https://www.freebasic.net/forum/viewtopic.php?t=10533#p91780)
    if s        =0 then return 0
    if s->width <1 then return 0
    if s->height<1 then return 0
    if w<4 then w=4
    if h<4 then h=4
    dim as fb.Image ptr t=ImageCreate(w,h)
    dim as Long xs=(s->width /t->Width ) * &h10000 '(1024*64)
    dim as Long ys=(s->height/t->height) * &h10000 '(1024*64)
    dim as integer x,y,sy
    select case as const s->bpp
        case 1
            dim as ubyte ptr ps=cptr(ubyte ptr,s)+32
            dim as uinteger   sp=s->pitch
            dim as ubyte ptr pt=cptr(ubyte ptr,t)+32
            dim as uinteger   tp=t->pitch-t->width
            for ty as integer = 0 to t->height-1
                dim as ubyte ptr src=ps+(sy shr 16)*sp
                for tx as integer = 0 to t->width-1
                    *pt=src[x shr 16]:pt+=1:x+=xs
                next
                pt+=tp:sy+=ys:x=0
            next
    case 2
        dim as ushort ptr ps=cptr(ushort ptr,s)+16
        dim as uinteger   sp=(s->pitch shr 1)
        dim as ushort ptr pt=cptr(ushort ptr,t)+16
        dim as uinteger   tp=(t->pitch shr 1)-t->width
        for ty as integer = 0 to t->height-1
            dim as ushort ptr src=ps+(sy shr 16)*sp
            for tx as integer = 0 to t->width-1
                *pt=src[x shr 16]:pt+=1:x+=xs
            next
            pt+=tp:sy+=ys:x=0
        next
    case 4
        dim as ULong ptr ps=cptr(Ulong ptr,s)+8
        dim as ULong     sp=(s->pitch shr 2)
        dim as ULong ptr pt=cptr(ULong ptr,t)+8
        dim as ULong     tp=(t->pitch shr 2)-t->width
        for ty as Long = 0 to t->height-1
            dim as ULong ptr src=ps+(sy shr 16)*sp
            for tx as Long = 0 to t->width-1
                *pt=src[x shr 16]:pt+=1:x+=xs
            next
            pt+=tp:sy+=ys:x=0
        next
    end select
    return t
end function

Sub ExtractFishAnim()
   Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
   Dim As String sBaseType, sBase91, aB91(1)
   Restore __Fish3bmp:
   Read iLines
   Read bCompressed
   Read iFileSize
   Read iCompressedSize
   Read sBaseType
   For i As Ushort = 0 To iLines - 1
      Read aB91(0)
      sBase91 &= aB91(0)
   Next

   Dim As Ulong l
   Dim As Ubyte Ptr aBinary = Base91Decode(sBase91, l)
   Dim As Boolean bError = False
   If bCompressed Then
      If iCompressedSize <> l Then bError = TRUE
   Else
      If iFileSize <> l Then bError = TRUE
   Endif
   If bError <> False Then
      ? "Something went wrong"
      Sleep
      End
   End If
   
   Dim As Long hFile = Freefile()
   Open Curdir & "\Fish3.bmp" For Binary Access Write As #hFile

    If bCompressed Then
        Dim As Ubyte Ptr aBinaryC = _WinAPI_LZNTDecompress(aBinary, iFileSize, iCompressedSize)
        Put #hFile, 0, aBinaryC[0], iFileSize
        Close #hFile
        Deallocate (aBinaryC)
    Else
        Put #hFile, 0, aBinary[0], iFileSize
        Close #hFile
    Endif
    aBinary = 0
End Sub

Function Base91Decode(sString As String, Byref iBase91Len As Ulong) As Ubyte Ptr
    Dim As String sB91, sDecoded
    sB91 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!#$%&()*+,./:;<=>?@[]^_`{|}~´" '´ instead of "
    Dim As Long i, n = 0, c, b = 0, v = -1

    Dim aChr(0 To Len(sString) - 1) As String
    For i = 0 To Ubound(aChr)             
        aChr(i) = Mid(sString, i + 1, 1)
    Next

    For i = 0 To Ubound(aChr)
    c = Instr(sB91, aChr(i)) - 1
    If v < 0 Then
        v = c
    Else
        v += c * 91
        b = b Or (v Shl n)
        n += 13 + (((v And 8191) <= 88) * -1)
        Do Until  (n > 7)=0
            sDecoded &= Chr(b And 255)
            b = b Shr 8
            n -= 8
        Loop
        v = -1
    Endif
    Next
    If (v + 1) Then
      sDecoded &= Chr((b Or (v Shl n)) And 255)
    End If
    iBase91Len = Len(sDecoded)

    Static As Ubyte aReturn(0 To Len(sDecoded))
    For i = 0 To Len(sDecoded) - 1 'convert result String To ascii code values
      aReturn(i) = Asc(sDecoded, i + 1)
    Next
    Return @aReturn(0) 'Return Pointer To the array
End Function

Function _WinAPI_LZNTDecompress(aBinary As Ubyte Ptr, iFileSize As Ulong, iCompressedSize As Ulong) As Ubyte Ptr
    '#Define COMPRESSION_FORMAT_LZNT1 2

    Dim As Any Ptr hLib = Dylibload("Ntdll.dll")
    Dim pRtlDecompressBuffer As Function _
                (Byval CompressionFormat As Ushort, _
                 Byval UncompressedBuffer As Ubyte Ptr, _
                 Byval UncompressedBufferSize As Ulong, _
                 Byval CompressedBuffer As Ubyte Ptr, _
                 Byval CompressedBufferSize As Ulong, _
                 Byval FinalUncompressedSize As Ulong Ptr) As Ulong
    pRtlDecompressBuffer = Dylibsymbol(hLib, "RtlDecompressBuffer") 'https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/content/ntifs/nf-ntifs-rtldecompressbuffer

    Dim As Ubyte Ptr pDecompress = Allocate(iFileSize)
    Dim As Ulong iUSize
    Dim As Ulong iReturn = pRtlDecompressBuffer(COMPRESSION_FORMAT_LZNT1, _
                                                pDecompress, _
                                                iFileSize, _
                                                aBinary, _
                                                iCompressedSize, _
                                                @iUSize)
    Dylibfree(hLib)
    Return pDecompress
End Function



'Generated by FB File2Bas Code Generator v0.80 build 2019-01-05 beta by UEZ

__Fish3bmp:
Data 7,1,49274,4765,"Base91"
Data "iyM7e2!CO´AAfBVx~;C´pI@QT|B´luFA5FUEEAMA$NH#wA|Ek_EB>CFB&mIcRe:o*BS´4GT/rFwVP/[d!}^),~C%[2QcJNoW´~2n!F6C.]7M@_k.^F_W)ER|pyty(T´(9GVDwAzK=´[KEPi<PAB´yF}4UX%xTEJ´tt3}iBPD:C%aQL}ElqPZl5J#lu&Cd~I`5yAt+>DAKX=~^KT|v(HAeF6F*,4y23~wD´*hl3)h<PuH´;QFA´CtAt~~`KT|uWzL´@+R4}j_~KT|v(]LI>´o&yQ|}FB´v(tWA´qF3r+>D´WLP|9~PA8A6CJV+>D´)h~~bFT|kByKk_BtHAA´=~QV+>D´tW+>D´HA´s=~MV+>D´HAA´BtHA´sZK})=?~CPA8A=~HAeA`~g~(_BtHAeAdBd~fAhFHpR´Y;4FeAdByKk_/CJVY4IqVsH>0~0_BtHAA´BtHAA´=~QV+>D´HAeA`~DA[q}~zKk_BtHAeAdBd~z}}ee|:?8hPA8A6CJV+>B´i|^)YFeAdByKk_BtWL~~/CtWdByKk_BtHAeA!>0~?s7CJV+>D´HAeA`~g~(_/CJV+>D´HAeAc_w~z_BtKVBtBA<*KA4I4}(4R8d+GBx68(S´lG$4?~K,,zcr/$6(AA}Q6(6~D$*+OD@CrW1Fp(k~I`5y>?mP+27{H´(z/C{~s~jB=~,}!^F´PA=~0_tLBth[!Ts0!~&(py%xbGe´SXhB9~i|d+fWk_Ct,Vj´$lrY~~!~fA@.`k;v^)O(!A&Cd~I`4F3rXL4FVkF~g~)_BAOKqyp*Ix,>4F&s1J/Vk_/CJV+>/CtWn(zKk_BtHAA´´ztW~~9~Uqv(DAPA`~#~tW`~b]bc(E@E8A6CJV+>u(f|T)4FA´6CJV+>D´]3TL%CWB`~$^n4jw"
Data "HAeAdBd~At>~7}h´lu)h8A6C4}J?B´a|T)4FA´6CJV+>/C.V`s1.´siK<}J?D´HAku=~7}B´9~a|4*DAPA~~!~i|T)B´z_huHAeA`~ds0RRu8gA´QttWdByKk_BtEh´~9~a|B´7Kk_BtHAA´=~7}K?4FAtv(DAPAP|tVU~[@n4Pd=~HAeAPLf~z_EtWL~~ZFT|kBd~(_lufA´s=~MV*hAAy*qAkE4}N´mBQ~uvoVq;zXVx/h]´Ty5Fi(WLR_At!}e[o4S|5yfAA´>~Atw}<~y|d+tWA´=~#}q?WLY44F}AAt`~<Vk_:vtW~~F´PAA´=~!r+>DAMlTF#~NI`~<Vk_:vtWhB]KT|^)B´(_CtPA?~Q$5}q?F´HAA´luWL~~ZFSqv(DAPA~~9~tW`~zKk_BtHAeA@}_|F`B´7}J?D´HAeAdBd~z_luB´K?D´HAeAdBd~z_luWL~~D´HAeAdB]q0_lu!N6m9~PA8A6CJV+>/CtW`~zKk_/CJV+>D´WL~~9~Zqv(DAAtv(DA9´+C]qyqv(DAPA~~D´WLg_9~Zqv(DAPA8A=~HAQq=~7}K?D´HAeAdBd~3}[~MV+>D´HAeAdBd~z_B´7}K?D´HAeAdBd~z_luB´K?D´HAeAdBd~!{EtWL~~D´HAeAdBd~z_EtWL8AxtHAIA!ea{7yDt,ob?%´fAjBHL4}/COWT|w(PAfAhB]KT|v(tWk_CtPA!A&C/Vk_CtPAA´CtPA!A&C/Vk_CtPA!A`~HAfAhB]KT|v(HAfAhB9~fAhBZFSqv(DAPA8A6C4}#A6CJV+>D´HAeAdByKk_/CJV+>D´HAeAdByKk_BttW+>D´HAeAdByKk_BtHAA´BtHAeAdByKk_BtHAeA`~DAPA8A6CJV+>D´O)!A=~HAeAdByKk_"
Data "Bt*>z[vFT|kByKk_BtHAeA!>zKk_BttW+>D´HA2}2>QV+>D´HA+}BtHA_smu43lCOWb|kByKk_BtHAeAc_fsz_BttW+>D´HAeAc_g~z_BtHAA´izHAeAy&J`z_puHAoWBtWq!]sJ(2rW]KO}B´Qc4@cBAtv(WL1r6CJV+>D´4FJ/RW#A~~cFSqv(TEeWe{DPa4D´:vFB[w3Qj,>O*hM8QcgYKC!kk|?BF1aycw<EJBxAjLQWqg`Ex64FlB12]R{!lU=N:8^}B+2s}QBt,E:m,bqIlBl3Mhf(N7d?B´X^MiDRT@4*GO5v2a´&CiiHxWjV[~]&kk!RU?oBaPb´BZsI$$Kf~s>sA´O~fAH3=s%V.ENp/7=WTF%^R$|}q?|}R´d6~PWBtJh~(_5yAt~~VL&s:=s~k_J´QL+{u#!}B´>p:C`e.C^V3_2u{L[h4Fy(WL.CeW4}P@R´(cr(#~At!>e~}FHtl[!.Q?`x(_&,4}6vWL~~Q(V|w(WL{s[~fAjBdJq@+>[´fA´s@~(}/COWT|#AGAP;d_]QF)2*At?{rwfAjB2>7}q?J´tW~~nI#A+C#TG}6(<5´s^~Y~AtOWT|D)3FKg6>dVY43IB´D)PAtW`~g~(_1utW~~.~Ux!>5}6{&v=WE_%~n}T)B´z_luWLx[bFT|4*4F´s=~WL~~OWT|^)LckBGW1~G@u(Zq%)DA´#>9g~z_luWL~~[CPA8A=~7}K?/CtWc_e~fA`~fs?}+,xKg_P(Zqv(At0_luWL~~9~a|T)DAPA~~GDtW`~e~z_luHAeAe>(,O8NtEAhnoIt1?´2BAyuD+O]X(?,2K<u(<HV4xAM_W~c*T|t+AtjB^n/}u(VWY4z/PA,o`~@Vk_CtB´L@[KfAhB]KT|v(HAfA~~WLfAhB]K"
Data "T|v(HAfAhB9~fAhB]KT|v(HAfAhB]KT|/C/Vk_BtHAeAdByKk_BttW+>D´HAeAdByKk_BtHAA´BtHAeAdByKk_BtHAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA<)DAPA8AlB1[Yeh´*P~~J´HAeAdByKk_/CJVuW~CPA8A6CJV+>D´tW+>4FAtdByKk_BtHAeARV3FG!$obAku6CJV+>4FSqv(DA$txF2Kk_BtHAR|BtHAA´=~QV+>D´BAeAy]B´%cz<FO2>efWLdBd~z_puHAeA`~*eeAdByKk_luiH8A$A+>%Wl0B´q?D´HA1rI4tW8A6Cv(gAduRF$49}I~YVsik_uzHA+s=~FK+C8si+KvLjaF<sAAG´dEvD:KIudZXLzKR}b):.l_`u&8sWEH9|#(TX<G*xh=p[ZC:RNt}Y!W#`P@kkoWWE`hT´[OaG)zgqlBlK?Rht{(5/dGkkP:Ah]!|$q?WL%t.`H;tWX<%+9ZHtsM9RU?KYD@z)1W)WxA.^j#uu@XO´ukB´5y9s~~6|}F_eYA/s`Jd~>H0nB*|4Q´iWXb?j5l|)~][yx6tWjb9~y|d+WL;~>~N~H^>hlZ]bdA!~!h`@(_5SP7Kv%h%aPLd~&nntMs~~WLB´`~&^dGn.6CkQN?C~i39~@W@9u(GW$~?$WX=RA´5ytWP|9~a|w(4FNZs>T~bQ]9^[WX>:F#FK4}D?J´"
Data "B´K?cZ#A+C9~a|<(PAtW`~q?A´=~#}q?/C#A~~P(a|kBcs1;=yNW,COWv(W;j_i_.%4F~~OWT|w(4FeA`~g~B´=~7}C?J´WL+CaFT|Z)RqS|tuMJZZf}n}Z)GL´s=~WL~~9~a|4*DAPA~~!~a|B´e~z_:vEJ8AHL8}o`!LB´3<oFjB!C4}L?/CtW`~e~At,;LV+>%CtW`~e~z_luB´L?D´HA/veW8}F?.94M`~DAPA~~9~a|T)4F+o6C4}8A=~7}K?/CtW=~E,NPJtYA4yp*@~It2|;h%t6N+yd5nA}{0~c~v_=u+h>a#opK[~,}0[WLtWk[ZSVLp[}}+>WLB´&Cd~#A&C/Vk_CtPA3F>s,r+>WLT|v(HAfAhB]KT|v(HAB´v(HAfAhB]KT|v(HAfA~~F´PA!AdByKk_BtHAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA`~DAPA8A6CJV+>D´HAeA<)DAPA8A*B6ybeJ´_AL/ytB´{%+TF`6#0AB´`~js`_5yfAL~>~hrz|$~z|^)WL!A&Cd~(_B´!r+>DAkWmK|[U|^)HAB´^)WL!A&Cd~(_:vPA!A_s3s#~eWss+>4FAt`~<Vk_B´#}q?F´PA2}%J4}K?[CAtv(DAPA8A=~7}K?J´HAA´BtHAeA`~e~z_luwF8A=~HAeA`~e~c/[yWL8A6C4}#A=~"
Data "7}K?/CtWdByKk_BtB´K?/CtW`~zKk_BtHAzrcst1Q|UW6y&(4FeAdBd~fA`~e~z_luWL8A6CJV+>B´a|T)PAtWdByKk_BtWL}s.C#A~~9~Zqv(DAPA~~9~!T`~e~z_BtHAeA`~e~x_WL4}K?D´HAeA`~2[I`tuB´K?/CPA8A6C4}K?/CtW`~4FeAdByKk_luWL~~9~a|kByKk_Bt,Vh_P(]vR)2Fy_puHAIA0k[BN/CtkB?(/~j??.>S[FcMpIz(IZoIq:)hmII),0G!x8*OIi~sA´lq´sKim[r~Qo/t^>+yFOi?HA(sO~2|z|M/u(2C7r:>`<1Fe}{~<Vk_O7B´#A/vSXg_!~y|d+HA|s_set%~2!&}Z]F´RX]~9sz|*>g~I`5yJSg_<nD,^)[KA´CtRXy~wj5|&,[KA´=~7}B´!~hqv(DAPATL!~a|T)*>q_BtHAeAxFn~z_luGb~~:BPA8A6C4}K?/C!TdBd~fAdByKk_=aWLP|ZFSqv(KLk_YB34`~8M;}T)DAAtv(DAPA~~!~a|^)DAPA~~D´HAkuz3c~K?D´HAeAM)DAPAx~vDofrWCA.Uu(.7f|)B1rmag´4Aku6CJV+>D´tW+>4FAtc_zKk_BtHAeA_s.FA´1f{&@>D´HAeAdBd~luz=|):?|QPA8A6CJV+>tWb|^)WLeAdByKk_BtHAA´luWL8A6CJV+>D´HAku?~2L8A6CJV+>D´HAA´2>@J8A6C8MXLr!&A~B9~j?0#qIBtoBQ~2(VQc&w(&HU<IeZE<>QDgcF<9~}~{(^}S|)hB´{~s~I`5yW+#MzKKduIh(VL?~,}B´`KT|uWULiC_~!r+>F´?QXL|P:sq1p~*_CtAt~~$~fAhB8sYY|)WL!A&CX;u{ERz#K`}FfAhB9~y|"
Data "v(HAB´^)WL!A&CyKk_}9aAjB^~HAeAdByKk_:vtW8A6C4}#A6CJV+>/CtWxF0Kk_BttW+>D´HA´s~}(}M?D´HAA´BtHAA´=~QV+>D´HAeA,(DA7VU):.5yJVfgIF$$T|T)DAPA8A6CUE!A1hfbWLQj?.´;WLk_BtHAeA`~g~(_:vHAA´BtHAeAc_2~F!lu2L8AqyHAeAdBcskkluz8sW<{V//=.s0_BtHAeA`~WLA´=~QV+>D´HAeAc_e~}lz38}K?D´HAeAdBd~1_r|p+ZMVDwAw4VvOs`s<AXIdByKk_BttW~~!~i|kByKk_BtHA´sHL,}=>%´tW+>D´HAeAH(s?AX´DvKH?ZqPAcA*By]Y4G´ZS.48rOAA"


Linux (without fish anim):

Code: Select all

'Coded by UEZ version v0.60 - original idea by Hugo Elias
'Thanks to: Joshy, duke4e
'
'Best compile settings for fastest fps: -gen gcc  -Wc -Ofast -fpmode FAST -fpu SSE
'

#Include "fbgfx.bi"
#Include "file.bi"

Using FB

Dim Shared As Ushort iW = 512, iH = 384  'original background image size

Declare Function ImageScale(s as fb.Image ptr, w as integer, h as integer) as fb.Image ptr
Declare Function Shade(iColor As Long, iGain As Long) As Ulong

#Define PixelSet(_x, _y, colour)    *Cptr(Ulong Ptr, imgData + (_y) * pitch + (_x) Shl 2) = (colour)
#Define PixelGet(_x, _y)            *Cptr(Ulong Ptr, imgData2 + (_y) * pitch + (_x) Shl 2)
#Define PixelSet2(_x, _y, colour)   *Cptr(Ulong Ptr, imgData3 + (_y) * pitch + (_x) Shl 2) = (colour)
#Define Translate2Dto1D(_x, _y)    ((_x) + (_y) * (iUBW + 1))
#Define _Red(colors)                ((colors Shr 16) And 255)
#Define _Green(colors)              ((colors Shr 8) And 255)
#Define _Blue(colors)               (colors And 255)
#Define _Min(a, b)                  (Iif(a < b, a, b))


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Perlin -> https://www.freebasic.net/forum/viewtopic.php?t=10454#p91198
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Shared As Integer perm(512) = { _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180, _
151,160,137, 91, 90, 15,131, 13,201, 95, 96, 53,194,233,  7,225,_
140, 36,103, 30, 69,142,  8, 99, 37,240, 21, 10, 23,190,  6,148, _
247,120,234, 75,  0, 26,197, 62, 94,252,219,203,117, 35, 11, 32, _
 57,177, 33, 88,237,149, 56, 87,174, 20,125,136,171,168, 68,175, _
 74,165, 71,134,139, 48, 27,166, 77,146,158,231, 83,111,229,122, _
 60,211,133,230,220,105, 92, 41, 55, 46,245, 40,244,102,143, 54, _
 65, 25, 63,161,  1,216, 80, 73,209, 76,132,187,208, 89, 18,169, _
200,196,135,130,116,188,159, 86,164,100,109,198,173,186,  3, 64, _
 52,217,226,250,124,123,  5,202, 38,147,118,126,255, 82, 85,212, _
207,206, 59,227, 47, 16, 58, 17,182,189, 28, 42,223,183,170,213, _
119,248,152,  2, 44,154,163, 70,221,153,101,155,167, 43,172,  9, _
129, 22, 39,253, 19, 98,108,110, 79,113,224,232,178,185,112,104, _
218,246, 97,228,251, 34,242,193,238,210,144, 12,191,179,162,241, _
 81, 51,145,235,249, 14,239,107, 49,192,214, 31,181,199,106,157, _
184, 84,204,176,115,121, 50, 45,127,  4,150,254,138,236,205, 93, _
222,114, 67, 29, 24, 72,243,141,128,195, 78, 66,215, 61,156,180}


#Define FADE(_t) (_t * _t * _t * (_t * (_t * 6 - 15) + 10))
#Define NLERP(_t, _a, _b) ((_a) + (_t)*((_b)-(_a)))

Dim Shared As Single ms_grad4(512)
Dim As Single kkf(256)
For i As Integer = 0 To 255
   kkf(i) = -1.0f + 2.0f * (i / 255.0f)
Next
For i As Integer = 0 To 255
   ms_grad4(i) = kkf(perm(i)) * 0.507f
Next   

Function Noise(x As Single, y As Single, px As Integer, py As Integer) As Single
   Dim As Integer ix0, iy0, ix1, iy1
   Dim As Single fx0, fy0
   Dim As Single s, t, nx0, nx1, n0, n1
   
   ix0 = Cint(x - 0.5f)
   iy0 = Cint(y - 0.5f)
   
    fx0 = x - ix0
   fy0 = y - iy0
   If px < 1 Then px = 1
   If py < 1 Then py = 1
   ix1 = ((ix0 + 1) Mod px) And &hff
   iy1 = ((iy0 + 1) Mod py) And &hff
   ix0 = (ix0 Mod px) And &hff
   iy0 = (iy0 Mod py) And &hff
   
   t = FADE(fy0)
   s = FADE(fx0)
   
   nx0 = ms_grad4(perm(ix0 + perm(iy0)))
   nx1 = ms_grad4(perm(ix0 + perm(iy1)))
   n0 = NLERP( t, nx0, nx1 )
   
   nx0 = ms_grad4(perm(ix1 + perm(iy0)))
   nx1 = ms_grad4(perm(ix1 + perm(iy1)))
   n1 = NLERP(t, nx0, nx1)
   
   Return NLERP(s, n0, n1)
End Function

Function Turbulence(x As Single, y As Single, size As Single) As Ubyte
    ' size must be 2 ^ n
    Dim As Single value = 0.0, initialSize = size
   
    While(size >= 1)
        value += Noise(x / size, y / size, iW / size, iH / size) * size
        size /= 2.0f
    Wend
   
    Return (128.0f * value / initialSize) + 127
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Randomize , 2

Dim As Single aCurrent(iH, iW), aPrevious(iH, iW)
Dim As Long iUBW = Ubound(aCurrent, 2), iX, iY
Dim As Single xOff, yOff, ripRadPower, ripRad = 3
Dim Shared As Ulong aImage(iH, iW)
Dim As Single v, l, q
Dim As Single Ptr pACurrent, pAPrevious, pATmp

pACurrent = @aCurrent(0, 0)
pAPrevious = @aPrevious(0, 0)

Dim as Single fScale = 2.0 'scale factor for screen

Screenres iW * fScale, iH * fScale, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_ALWAYS_ON_TOP Or GFX_NO_SWITCH
Screenset 1, 0
Windowtitle("Water Effect v0.60 coded by UEZ")

Dim As Any Ptr pImage = Imagecreate(iW, iH, 0, 32), pImage2 = Imagecreate(iW, iH, 0, 32), pImage2_Clone = Imagecreate(iW, iH, 0, 32), _
               pImage_Sky = Imagecreate(iW, iH, 0, 32), pImage_resized = Imagecreate(iW * fScale, iH * fScale, 0, 32)
Bload(Curdir & "\Pebbles under Water_512x384.bmp", pImage2) 'Download: https://ibb.co/dGT1wyX and convert to BMP format
Bload(Curdir & "\Pebbles under Water_512x384.bmp", pImage2_Clone)


Dim As Integer w, h, pitch
Dim As Any Pointer imgData, imgData2, imgData3
Imageinfo(pImage, w, h, , pitch, imgData)
Imageinfo(pImage2, , , , , imgData2)
Imageinfo(pImage_Sky, , , , , imgData3)
Dim As SIngle T

'Add sky With clouds To the background image
Dim As Long x, y, z
For y = 0 To iH - 1
    For x = 0 To iW - 1
        T = Turbulence(-x, y, 64)
        PixelSet2(x, y, Rgba(T, T, &hF0, _Min(&h08 + T, 255)))
    Next
Next

Put pImage2, (0, 0), pImage_Sky, Alpha 'Add sky with clouds
                         

                                       
Dim As Ulong i, iFPS = 0, iFPS_current = 0, iColor
Dim As Double fTimer, fTimer_drops = Timer

Dim As Integer mx, my, mb, iFrame
Dim As Single wave, light

'rebuild color array from original background image
For iY = 0 To iH  - 1
   For iX = 0 To iW  - 1
      aImage(iY, iX) = PixelGet(iX, iY) 'color values of bg image (pImage2)
   Next
Next


Do

    'mouse interaction to disturb water surface
    Getmouse (mx, my, , mb)
    If mb = 1 Then
      ripRadPower = Cushort(0.5 + Rnd() * 2.75)
      For iY = my / fScale - (ripRad + ripRadPower) To my / fScale + (ripRad + ripRadPower)
         For iX = mx / fScale - (ripRad + ripRadPower) To mx / fScale + (ripRad + ripRadPower)           
            pACurrent[Translate2Dto1D(Iif(iX < 0, 0, Iif(iX > iW - 1, iW - 1, iX)), _
                                 Iif(iY < 0, 0, Iif(iY > iH - 1, iH - 1, iY)))] += 16
         Next
      Next
    End If

    'calculate the wave
   For iY = 1 To iH - 1
      For iX = 1 To iW - 1
           
         wave = _
               (pAPrevious[Translate2Dto1D((iX - 1), iY)      ] + _
                pAPrevious[Translate2Dto1D((iX + 1),  iY)     ] + _
                pAPrevious[Translate2Dto1D( iX,      (iY - 1))] + _
                pAPrevious[Translate2Dto1D( iX,      (iY + 1))] + _                                 
                pAPrevious[Translate2Dto1D((iX - 1), (iY - 1))] + _
                pAPrevious[Translate2Dto1D((iX - 1), (iY + 1))] + _
                pAPrevious[Translate2Dto1D((iX + 1), (iY - 1))] + _
                pAPrevious[Translate2Dto1D((iX + 1), (iY + 1))] ) / 4
           
            wave -= pACurrent[Translate2Dto1D(iX, iY)]                                     
            wave -= wave / 160
                                   
            pACurrent[Translate2Dto1D(iX, iY)] = wave
           
            light = wave * 3 - pACurrent[Translate2Dto1D(iX - 1, iY)] * 2
           
            wave = (1024 - wave)
           
            xOff = (((iX - iW) * wave) / 1024) + iW
            yOff = (((iY - iH) * wave) / 1024) + iH
            xOff = Iif(xOff >= iW, iW - 1, Iif(xOff < 0, 0, xOff))
            yOff = Iif(yOff >= iH, iH - 1, Iif(yOff < 0, 0, yOff))
            iColor = aImage(yOff, xOff)
           
           
            light = Iif(light < -16, -16, Iif(light > 64, 64, light))
           
         PixelSet(iX, iY, Shade(iColor, light))
      Next
   Next
 
    For iX = 1 to 20
        aPrevious((Rnd() * (iH - 1)) Shr 0, (Rnd() * (iW - 1)) Shr 0) += -8 * Rnd() + 16 ' some turbulances on water surface
    next
       
    'draw generated image to screen incl. FPS
    If fScale <> 1 then
        pImage_Resized = ImageScale(pImage, iW * fScale, iH * fScale)
        Put (0,0), pImage_Resized, Pset
        Imagedestroy pImage_resized
    Else
        Put (0,0), pImage, Pset
    end if
   Draw String(2, 2), iFPS_current & " fps", Rgb(&hFF, &h00, &h00)
   Flip

    'do some random drops
   If (Timer - fTimer_drops) > (1 + Rnd() * 10.0) Then
      x = 15 + Cushort(Rnd() * (iW - 30))
      y = 15 + Cushort(Rnd() * (iH - 30))
      ripRadPower = Cushort(0.5 + Rnd() * 2.75)
        Dim as Single fWPower = 32 + Rnd() * 224
      For iY = y - (ripRad + ripRadPower) To y + (ripRad + ripRadPower)
         For iX = x - (ripRad + ripRadPower) To x + (ripRad + ripRadPower)           
            pACurrent[Translate2Dto1D(Iif(iX < 0, 0, Iif(iX >= iW, iW - 1, iX)), _
                                 Iif(iY < 0, 0, Iif(iY >= iH, iH - 1, iY)))] += fWPower
         Next
      Next
      fTimer_drops = Timer
   Endif
   
   Swap pACurrent, pAPrevious
   
    Put (0, 0), pImage, Pset 'restore background image
   
                           
   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   Endif
   Sleep(1, 1)
Loop Until Inkey = Chr(27)

Imagedestroy pImage
Imagedestroy pImage2
Imagedestroy pImage_Sky

Function Shade(iColor As Long, iGain As Long) As Ulong
   Dim As Long a, r, g, b
   r = _Red(iColor) + iGain
   r = Iif(r < 0, 0, Iif(r > 255, 255, r))
   g = _Green(iColor) + iGain
   g = Iif(g < 0, 0, Iif(g > 255, 255, g))
   b = _Blue(iColor) + iGain
   b = Iif(b < 0, 0, Iif(b > 255, 255, b))
   Return r Shl 16 Or g Shl 8 Or b
End Function

function ImageScale(s as fb.Image ptr, w as integer, h as integer) as fb.Image ptr 'by D.J. Peters aka Joshy (https://www.freebasic.net/forum/viewtopic.php?t=10533#p91780)
    if s        =0 then return 0
    if s->width <1 then return 0
    if s->height<1 then return 0
    if w<4 then w=4
    if h<4 then h=4
    dim as fb.Image ptr t=ImageCreate(w,h)
    dim as Long xs=(s->width /t->Width ) * &h10000 '(1024*64)
    dim as Long ys=(s->height/t->height) * &h10000 '(1024*64)
    dim as integer x,y,sy
    select case as const s->bpp
        case 1
            dim as ubyte ptr ps=cptr(ubyte ptr,s)+32
            dim as uinteger   sp=s->pitch
            dim as ubyte ptr pt=cptr(ubyte ptr,t)+32
            dim as uinteger   tp=t->pitch-t->width
            for ty as integer = 0 to t->height-1
                dim as ubyte ptr src=ps+(sy shr 16)*sp
                for tx as integer = 0 to t->width-1
                    *pt=src[x shr 16]:pt+=1:x+=xs
                next
                pt+=tp:sy+=ys:x=0
            next
    case 2
        dim as ushort ptr ps=cptr(ushort ptr,s)+16
        dim as uinteger   sp=(s->pitch shr 1)
        dim as ushort ptr pt=cptr(ushort ptr,t)+16
        dim as uinteger   tp=(t->pitch shr 1)-t->width
        for ty as integer = 0 to t->height-1
            dim as ushort ptr src=ps+(sy shr 16)*sp
            for tx as integer = 0 to t->width-1
                *pt=src[x shr 16]:pt+=1:x+=xs
            next
            pt+=tp:sy+=ys:x=0
        next
    case 4
        dim as ULong ptr ps=cptr(Ulong ptr,s)+8
        dim as ULong     sp=(s->pitch shr 2)
        dim as ULong ptr pt=cptr(ULong ptr,t)+8
        dim as ULong     tp=(t->pitch shr 2)-t->width
        for ty as Long = 0 to t->height-1
            dim as ULong ptr src=ps+(sy shr 16)*sp
            for tx as Long = 0 to t->width-1
                *pt=src[x shr 16]:pt+=1:x+=xs
            next
            pt+=tp:sy+=ys:x=0
        next
    end select
    return t
end function



I used this background image (probably you have to convert it to BMP format first):

Pebbles under Water_512x384.bmp
Image

I'm not using Linux and thus not tested!

v0.50: added one lonely fish
v0.55: try to add sky reflection to water surface
v0.60: added scale function + some small modifications
Last edited by UEZ on Jan 26, 2019 14:38, edited 9 times in total.
badidea
Posts: 1545
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Water Effect v0.4

Postby badidea » Jan 15, 2019 22:02

UEZ wrote:I'm not using Linux and thus not tested!

Looks cool and works fine under linux (#Include "windows.bi" and FreeConsole deleted) Not any more now
I did not notice a speed difference 32/64 bit, but I also compiled with -exx, so probably slower anyway.
Last edited by badidea on Jan 18, 2019 17:20, edited 2 times in total.
MrSwiss
Posts: 3269
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Water Effect v0.4

Postby MrSwiss » Jan 15, 2019 22:10

badidea wrote:#Include "windows.bi" and FreeConsole deleted
I'd also delete that, for any OS, including WIN.
In order to NOT open a console on WIN, simply use compiler switch:
fbc -s gui (additional to other compiler switches)

I'm not likely to include 1.5 MB "windows.bi", for no compelling reasons.
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Re: Water Effect v0.4

Postby UEZ » Jan 15, 2019 22:27

When I use -gen gcc then the cmd box will be opened always. That's the reason for these 2 lines. If you don't need it - delete it. :-)
MrSwiss
Posts: 3269
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Water Effect v0.4

Postby MrSwiss » Jan 15, 2019 22:39

UEZ wrote:When I use -gen gcc then the cmd box will be opened always.
May be due to the IDE used ...
In FBEdit, this is the case on "quick run", but not for "compile + run",
which has different settings:
"quick run" = always a console
"compile + run" = multiple options (even with the same GCC settings)
Win GUI + GCC stuff or Win Console + GCC stuff
Coolman
Posts: 208
Joined: Nov 05, 2010 15:09

Re: Water Effect v0.4

Postby Coolman » Jan 17, 2019 16:15

impressive. good job.

-Os optimization for code size
-O2 optimization more for code size and execution time
-O3 optimization more for code size and execution time
-Ofast O3 with fast none accurate math calculations

-gui = 21-22 fps
-gen gcc -Wc -O2 = 41-43 fps
-gen gcc -Wc -Ofast = 44-46 fps

the version of gcc used with freebasic is 5.2.0. there is version 8.2. I tried to use it with freebasic. it does not work. I do not have time to see why. pity. the generated code should be much faster ...

for the stability of programs. It is recommended to use the parameter -O2

I did not test in 64 bits
dodicat
Posts: 5947
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Water Effect v0.4

Postby dodicat » Jan 17, 2019 17:41

Very nice.
I get 46 fps with 32 bits -O3
64 bits is half that speed.
About 30 -gen gas.
I waited a while for a fish, even a minnow.
The water looks too clear though (acid rain probably).
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Re: Water Effect v0.4

Postby UEZ » Jan 17, 2019 19:53

Coolman wrote:impressive. good job.

-Os optimization for code size
-O2 optimization more for code size and execution time
-O3 optimization more for code size and execution time
-Ofast O3 with fast none accurate math calculations

-gui = 21-22 fps
-gen gcc -Wc -O2 = 41-43 fps
-gen gcc -Wc -Ofast = 44-46 fps

the version of gcc used with freebasic is 5.2.0. there is version 8.2. I tried to use it with freebasic. it does not work. I do not have time to see why. pity. the generated code should be much faster ...

for the stability of programs. It is recommended to use the parameter -O2

I did not test in 64 bits


Thank you for your feedback. :-)

dodicat wrote:Very nice.
I get 46 fps with 32 bits -O3
64 bits is half that speed.
About 30 -gen gas.
I waited a while for a fish, even a minnow.
The water looks too clear though (acid rain probably).


Well, due to the acid rain, the fish are dead. ;-)

I didn't find a well animated fish with top view to use. Further as this code operates with an color array rather than bitmaps it can be tricky to let swim fish outside the GUI.
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Re: Water Effect v0.5

Postby UEZ » Jan 18, 2019 16:29

dodicat wrote:I waited a while for a fish, even a minnow.
The water looks too clear though (acid rain probably).


The acid rain is now over and indeed one lonely fish is swimming around searching for other fishes...
Coolman
Posts: 208
Joined: Nov 05, 2010 15:09

Re: Water Effect v0.5

Postby Coolman » Jan 18, 2019 17:47

with freebasic and gcc 64 bit :

-gui = 13-14 fps ??? weird

-gen gcc -Wc -O2 = 20-21 fps ??? weird

-gen gcc -Wc -Ofast = 62-63 fps (even faster than 32 bit)
UEZ
Posts: 336
Joined: May 05, 2017 19:59
Location: Germany

Re: Water Effect v0.55 [Windows only]

Postby UEZ » Jan 22, 2019 23:00

Last update for now.

Have a look to the 1st post if you are interested.
Coolman
Posts: 208
Joined: Nov 05, 2010 15:09

Re: Water Effect v0.55

Postby Coolman » Jan 24, 2019 15:06

the colors are altered in this version

line 253 Draw String(2, 2), iFPS_current & " fps", RGB(&hFF, &hFF, &hFF) it's more visible

freebasic and gcc 32 bit :

-gui = 38-40 fps

-gen gcc -Wc -O2 = 70-71 fps

-gen gcc -Wc -Ofast = 96-100 fps

freebasic and gcc 64 bit :

-gui = 18-19 fps

-gen gcc -Wc -O2 = 25-27 fps

-gen gcc -Wc -Ofast = 88-90 fps

it seems that the programs generated by the 32 bit version of freebasic are faster than those generated by the 64 bit version... weird.

even the code generated in c is slower. it should be the opposite ...

the difference is sometimes very important except when the -Ofast option is used...

if I have time. I would try another type of program ...

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 36 guests