Waterfall effect

neil · Post by **neil** » Mar 29, 2024 6:42

Here's a waterfall effect.

' 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 · Post by **UEZ** » Mar 29, 2024 14:19

I like it - well done.

Slightly modified by adding blue shades and transparency:

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

Post by **fxm** » Mar 29, 2024 14:54

Code: Select all

    For i As Integer = 0 To iNum - 1

neil · Post by **neil** » Mar 29, 2024 18:13

@UEZ Well done!

neil · Post by **neil** » Mar 29, 2024 23:13

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 · Post by **dodicat** » Mar 30, 2024 12:18

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 · Post by **UEZ** » Mar 30, 2024 23:04

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

neil · Post by **neil** » Mar 30, 2024 23:39

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

@dodicat Nice rain demo.

deltarho[1859] · Post by **deltarho[1859]** » Mar 31, 2024 0:49

Use Randomize , 5

Why? Why not

mindlord · Post by **mindlord** » Mar 31, 2024 14:25

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] · Post by **deltarho[1859]** » Mar 31, 2024 15:24

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 · Post by **neil** » Apr 01, 2024 1:43

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 · Post by **neil** » Apr 01, 2024 6:52

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 · Post by **David Watson** » Apr 01, 2024 8:40

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 · Post by **neil** » Apr 01, 2024 8:55

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

Waterfall effect

Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect

Re: Waterfall effect