## Waterfall effect

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Waterfall effect

Here's a waterfall effect.

Code: Select all

``````' waterfall effect by neil

Screenres 800, 600, 32

Dim As Integer x(800), y(800), x2(800), y2(800), r(800), a(800)
Dim As Double v(800)
Dim As String key

For i As Integer = 0 To 799
x(i) = Rnd * 800 : y(i) = Rnd * 600
x2(i) = x(i) : y2(i) = y(i)
r(i) = 100 + Rnd * 155 : a(i) = 0
Next

Do
key = Inkey
Screenlock
Cls

For i As Integer = 0 To 799
' Move water down
y(i) = y(i) + 2

' Reset if water reaches bottom
If y(i) > 599 Then
x(i) = Rnd * 800 : y(i) = Rnd * 10
End If

' Update water position
x2(i) = x(i) + r(i) * Cos(a(i))
y2(i) = y(i) + r(i) * Sin(a(i))

' Draw line between current and previous position
Line(x(i), y(i)) - (y2(i), x2(i)), Rgb(0, 0, 255)

' Increase angle for next frame
a(i) = a(i) + 0.05

' Add velocity to make waterfall effect
r(i) = r(i) + v(i)
v(i) = v(i) + 0.1
Next

ScreenUnlock
Sleep 10,1

Loop Until (key = Chr(27)) Or (key = Chr(255) & "k")
End``````
UEZ
Posts: 996
Joined: May 05, 2017 19:59
Location: Germany

### Re: Waterfall effect

I like it - well done.

Code: Select all

``````#include "fbgfx.bi"
Using FB

#define Min(a, b)						(IIf(a < b, a, b))
#define Max(a, b)						(IIf(a > b, a, b))
#define Col(c)							Max(0, Min(255, c))

' waterfall effect by neil

ScreenRes 800, 600, 32, 1, GFX_ALPHA_PRIMITIVES
Color &hFF, &h20101010

Dim As ULong iNum = 1999, c
Dim As Integer x(iNum), y(iNum), x2(iNum), y2(iNum), r(iNum), a(iNum)
Dim As Double v(iNum)
Dim As String key

Randomize

For i As Integer = 0 To iNum
x(i) = Rnd * 800 : y(i) = Rnd * 700 - 100
x2(i) = x(i) : y2(i) = y(i)
r(i) = 100 + Rnd * 155 : a(i) = 0
Next

Do
key = Inkey
ScreenLock
Cls

For i As Integer = 0 To iNum - 1
' Move water down
y(i) = y(i) + 2

' Reset if water reaches bottom
If y(i) > 599 Then
x(i) = Rnd * 800 : y(i) = -Rnd * 100
x(i + 1) =  x(i) + Rnd() * 200 - 100
End If

' Update water position
x2(i) = x(i) + r(i) * Cos(a(i))
y2(i) = y(i) + r(i) * Sin(a(i))

' Draw line between current and previous position

c = 60 * i / 255
Line(x(i), y(i)) - (y2(i + 1) + Rnd() * 10 - 5, x2(i)), RGBA(Col(255 - c / 2.5), Col(255 - c / 3), 255, 80)

' Increase angle for next frame
a(i) = a(i) + 0.05

' Add velocity to make waterfall effect
r(i) = r(i) + v(i)
v(i) = v(i) + 0.1
Next

ScreenUnlock
Sleep 10,1

Loop Until (key = Chr(27)) Or (key = Chr(255) & "k")
End
``````
Last edited by UEZ on Mar 29, 2024 16:19, edited 2 times in total.
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: Waterfall effect

Code: Select all

``    For i As Integer = 0 To iNum - 1``
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Waterfall effect

@UEZ Well done!
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Waterfall effect

Here's a rainstorm, or maybe a snow blizzard.

Code: Select all

``````' rainstorm or snow blizzard by neil

ScreenRes 800, 600, 32

Dim As Integer drops(800), dropSpeed(800)
Dim As String key

Randomize

for i As Integer = 0 To 799
drops(i) = Rnd * 600
dropSpeed(i) = Rnd * 10 + 1
Next

Do
key = Inkey
Screenlock
Cls

For i As Integer = 0 To 799
Line(i, drops(i)) - (i, drops(i) + 10),rgb(255,255,255)
drops(i) += dropSpeed(i)

If drops(i) > 599 Then
drops(i) = 0
End If
Next
ScreenUnlock
Sleep 10,1
Loop Until (key = Chr(27)) Or (key = Chr(255) & "k")``````
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Waterfall effect

Nice neil.
Good to see these little graphicals in fb again.
Pure rain

Code: Select all

``````

Sub Rain(z As Any Ptr,xres As Long,yres As Long)
Const max=1000
Static As Single xx(max),yy(max)
For i As Long = 0 To max
xx(i) = Rnd*xres
yy(i) = Rnd*yres
Put(xx(i),yy(i)),z,Alpha,Rnd*200
Next
End Sub

Screen 20,32
Color ,Rgb(200,200,200)
Dim As Long x,y
Screeninfo x,y

Var im=Imagecreate(5,20)
Line im,(0,0)-(5,20),Rgb(50,50,55)
Var f=Imagecreate(300,300)
Circle f,(150,150),100,Rgb(200,200,0),,,,f
Circle f,(100,120),10,Rgb(0,0,0),,,.5
Circle f,(200,120),10,Rgb(0,0,0),,,.5
Circle f,(150,250),90,Rgb(0,0,0),.9,2.2

Do
Screenlock
Cls
Put(x/2-150,y/2-150),f,trans
rain(im,x,y)
Screenunlock
Sleep 1,1
Loop until len(inkey)
Imagedestroy im
Imagedestroy f
``````
UEZ
Posts: 996
Joined: May 05, 2017 19:59
Location: Germany

### Re: Waterfall effect

Here my version of a waterfall:

Code: Select all

``````'Coded by UEZ build 2024-03-30 while watching revision 2024 :-)

#include "fbgfx.bi"
Using FB

Const w = 960
Const w2 = w Shr 1
Const h = Int(w * 9 / 16)
Const h2 = h Shr 1
Const _t = 1 / 60

ScreenRes w, h, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH 'Or GFX_NO_FRAME
ScreenSet 1, 0
Color &hFF, &h08202020
Cls

Randomize

Type v7
As Double x1, y1, x2, y2, s, d
As ULong c
End Type
Dim As ULong iFPS, cfps = 0
Dim As Long i, c = 1999
Dim As Double t, fTimer = Timer
Dim As v7 l(c)

For i = 0 To c
With l(i)
.x1 = w2 / 2 + Rnd() * w2
.y1 = Rnd() * -100
.x2 = .x1 + Rnd() * 50 - 25
.y2 = .y1 + h2 + Rnd() * h2
.s = 1 + Rnd() * 50
.c = Rnd() * 256
End With
Next

Do
Cls
For i = 0 To c
With l(i)
Line (.x1 - .d / 2, .y1) - (.x2 + .d, .y2), RGBA(.c, .c, 255, &h08), BF
.y1 += .s
.y2 += .s
.d = 10 + Sin(t * 2) * 5
If .y1 > h Then
.x1 = w2 / 2 + Rnd() * w2
.y1 = Rnd() * -100
.x2 = .x1 + Rnd() * 50 - 25
.y2 = .y1 + h2 + Rnd() * h2
.s = 1 + Rnd() * 50
.c = Rnd() * 256
End If
End With
Next
t += _t

Line (1, 0) - (55, 14), &hFF000000, BF
Draw String(4, 4), iFPS & " fps", &hFFFF0000

Flip

cfps += 1
If Timer - fTimer > 0.99 Then
iFPS = cfps
cfps = 0
fTimer = Timer
End If
Sleep (1)
Loop Until Len(Inkey())
``````

With sound: Waterfall with sound
Last edited by UEZ on Apr 02, 2024 13:15, edited 3 times in total.
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Waterfall effect

@UEZ I like it. This is the nicest waterfall so far.

@dodicat Nice rain demo.
deltarho[1859]
Posts: 4315
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

### Re: Waterfall effect

Use Randomize , 5

Why? Why not
mindlord
Posts: 29
Joined: Jul 18, 2020 19:59

### Re: Waterfall effect

Here's a take that uses palette shifting to assist in the animation effect.

Code: Select all

``````' *** purple rain ***
' palette shifting drippiness
screen 20
setmouse(0,0,0)
dim as integer index=0, column=0, row=0, lcolor=0, shift=0, red=0, green=0, blue=0, h, w,maxlen

screeninfo w,h
maxlen = h / 10
for index =1 to 15
palette index,255*(index/15),0,255*(index/15)
next index
index=15
do
row=0 : lcolor=int(rnd*15)+1
if int(rnd*100)+1>10 then
line(column,0)-(column,h),0
else
do
var length = int(rnd*maxlen)+2
line(column,row)-(column,row+length),lcolor
row=row+length
if lcolor=15 then lcolor=1 else lcolor=lcolor+1
loop until row>=h
end if
sleep 2
if index=1 then shift=15 else shift=index-1
palette get shift,red,green,blue
palette index,red,green,blue
if index=1 then index=15 else index=index-1
column=column+int(rnd*7)+1
if column>w then column=0
loop until len(inkey)
``````
deltarho[1859]
Posts: 4315
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

### Re: Waterfall effect

Sleep 1, Sleep 2, …, Sleep 15 all give a Sleep of 15 because Sleep is linked to the System Clock (64Hz). To get Sleep n to sleep for n milliseconds, then use:

Code: Select all

``````Declare Function settimer Lib "winmm" Alias "timeBeginPeriod"(As Ulong=1) As Long
settimer``````
That uses a timer with a frequency of 1000Hz.

With a resolution of 1ms Sleep 2 will sleep for 2 to 3 ms. That is too fast for me.

Sleep 10 looks good for me.

Again, use 'Randomize , 5'.
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Waterfall effect

Here's simulating water in a lake.

Code: Select all

``````' simulating water in a lake by neil

Screenres 800,600,32

Dim As Single Drop(800,600)
Randomize

Do
ScreenLock
Cls

For x As Integer = 0 To 799
For y As Integer = 0 To 599
If Rnd < 0.01 Then ' Randomly create new drops
Drop(x, y) = Rnd * 10
End If

If Drop(x, y) > 0 Then ' If drop is present, draw it
PSet (x, y), Rgb(0, 0, 255) ' Blue color for water
Drop(x, y) -= 0.1 ' Simulate water movement
End If
Next
Next
ScreenUnlock
Sleep 10, 1
Loop Until len(Inkey)``````
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Waterfall effect

Here's a new waterfall. This one is different.

Code: Select all

``````' a new waterfall by neil

Screenres 800, 600, 32
Const Screenwidth = 800
Const ScreenHeight = 600

Type Particle
Dim As Single x, y, vx, vy
Dim As Integer colr
End Type

Dim As Integer n = 100000 'number of water drops
Dim As Integer i, cnt
Dim As Particle drops(n)
cnt = 0

Randomize

For i = 1 To n
drops(i).x = Rnd * ScreenWidth
drops(i).y = 0
drops(i).vx = Rnd * 2 - 1
drops(i).vy = Rnd * 2
drops(i).colr = RGB(50,50,255)
Next

Do
ScreenLock
Cls

For i = 1 To n
drops(i).x = drops(i).x + drops(i).vx
drops(i).y = drops(i).y + drops(i).vy

If drops(i).y > ScreenHeight Then cnt += 1

IF cnt = 100 Then
drops(i).x = 400
drops(i).y = 0
cnt = 0
End If

PSet (drops(i).x, drops(i).y), drops(i).colr
Next

ScreenUnlock
Sleep 2, 1

Loop Until len(InKey)
End``````
David Watson
Posts: 59
Joined: May 15, 2013 16:48
Location: England

### Re: Waterfall effect

Here's a cheesy old effect from around 1980

Code: Select all

``````'oldskool water effect

dim as short		i, s
dim as short		rx(199), ry(199), rs(199)

randomize timer

'initial ripples
for i = 0 to 199
rx(i) = int(rnd * 1024)				'x centre
ry(i) = int(rnd * 768)				'y position
rs(i) = int(rnd * 9)				'size
next i

screen 20
color 7, 1

do
screenlock
cls

for i = 0 to 199
'produce sequence 0, 1, 2, 3, 4, 3, 2, 1, 0
s = rs(i)
if s > 4 then s = 8 - s

'draw ripple
line (rx(i) - s, ry(i)) - (rx(i) + s, ry(i))

'if ripple finished, respawn
rs(i) = (rs(i) + 1) mod 9
if rs(i) = 0 then
rx(i) = int(rnd * 1024)
ry(i) = int(rnd * 768)
endif
next i

screenunlock
sleep 50
loop until inkey <> ""
``````
neil
Posts: 594
Joined: Mar 17, 2022 23:26

### Re: Waterfall effect

Here's rushing water.

Code: Select all

``````' rushing water by neil

Screenres 800, 600, 32
Const Screenwidth = 800
Const ScreenHeight = 600

Type Particle
Dim As Single x, y, vx, vy
Dim As Integer colr
End Type

Dim As Integer n = 100000 'number of water drops
Dim As Integer i, cnt
Dim As Particle drops(n)

Randomize

For i = 1 To n
drops(i).x = Rnd * ScreenWidth
drops(i).y = 0
drops(i).vx = Rnd * 2 - 1
drops(i).vy = Rnd * 2
drops(i).colr = RGB(50,50,255)
Next

Do
ScreenLock
Cls

For i = 1 To n
drops(i).x = drops(i).x + drops(i).vx
drops(i).y = drops(i).y + drops(i).vy

If drops(i).y > ScreenHeight Then cnt += 1

IF cnt = 4 Then
drops(i).x = int(rnd * 200) + 300
drops(i).y = 0
cnt = 0
End If

PSet (drops(i).x, drops(i).y), drops(i).colr
Next

ScreenUnlock
Sleep 2, 1

Loop Until len(InKey)
End``````