Waterfall effect

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

Re: Waterfall effect

Post by UEZ »

Water ripples effect: Water Effect
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Waterfall effect

Post by dodicat »

Waterfall effect slower.

Code: Select all

#cmdline "-gen gcc -O 2"
Dim Shared As Long Xres,Yres
Screenres 1024,850,32,,64
Screeninfo (Xres),(Yres)

Type pt
    As Long x,y
    As Ulong col
    As Long jmp
End Type

'get a point (Length pixels) along a line between fp and p
Function shortline(fp As pt,p As pt,length As Integer) As pt
    Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
    Return Type(fp.x+length*diffx/L,fp.y+length*diffy/L)
End Function

Sub getdata(P1c() As pt,P2c() As pt)
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    Redim P1c(1 To 380)
    Redim P2c(1 To 380)
    Restore x_values1:
    For n As Long=1 To 380
        Read P1c(n).x
        P1c(n).x-=50
    Next
    Restore y_values1
    For n As Long=1 To 380
        Read P1c(n).y
        P1c(n).y=map(0,917,P1c(n).y,10,yres) 
    Next
    
    Restore x_values2:
    For n As Long=1 To 380
        Read P2c(n).x
        P2c(n).x-=50
    Next
    Restore y_values2
    For n As Long=1 To 380
        Read P2c(n).y
        P2c(n).y=map(0,917,P2c(n).y,10,yres) 
    Next
End Sub


Sub rangedata(a() As pt,p1C() As pt,p2C()As pt)
    Redim  a(0)
    'colours for ripples
    Dim  As Ulong col1=Rgba(0,155,255,50)
    Dim  As Ulong col2=Rgba(0,100\2,255\2,50)
    Dim  As Ulong col3=Rgba(255,255,255,155)
    #define range(f,l) Int(Rnd*((l+1)-(f))+(f))
    Dim As Ulong col
    For n As Long=Ubound(p1c) To Lbound(P1c) Step -1
        Var dist=Sqr((p1c(n).x-P2c(n).x)*(p1c(n).x-P2c(n).x) +(p1c(n).y-P2c(n).y)*(p1c(n).y-P2c(n).y))'distance across falls
        For m As Long=1 To dist 
            Redim Preserve a(1 To Ubound(a)+1)
            a(Ubound(a))=shortline(p1c(n),p2c(n),m) ' points on a line joining opposite falls points
            Dim As Long i=range(0,2)
            Dim As Ulong clr
            If Rnd>.95 Then clr=Rgb(0,100,0) Else clr=col2
            Select Case As Const i
            Case 0
                col=col1
            Case 1
                col=clr
            Case 2
                col=col3
            End Select
            a(Ubound(a)).col=col
            a(Ubound(a)).jmp=dist 
        Next m
    Next
    'add a touch of randomness
    For n As Long=Lbound(a) To Ubound(a)
        a(n).x+=Rnd-Rnd:a(n).y+=Rnd-Rnd
    Next
End Sub

Function regulateW(MyFps As Long,Byref fps As Long) As Double
    Dim As Double k=1/MyFps
    Static As Double timervalue
    Var c=timervalue
    Do While (Timer - TimerValue) <= k
    Loop 
    Var ans=(Timer-timervalue)
    timervalue=Timer
    fps=1/(timervalue-c)
    If Abs(Myfps-fps)>MyFps\2 Then fps=Myfps
    Return ans*60
End Function


Redim As pt P1c(),P2c(),a()
getdata(p1C(),p2C())
rangedata(a(),P1c(),P2c())
Dim As Long ctr,fps
Dim As Any Ptr trn=Imagecreate(xres,yres,Rgb(0,0,20))
Line trn,(0,0)-(xres,15),Rgb(200,200,255),bf
Line trn,(0,15)-(xres,18),Rgb(0,155,0),bf

Do
    ctr+=1
    Screenlock
    If ctr Mod 3=0 Then
        ctr=0
        'swap through the colours.
        For n As Long=Lbound(a) To Ubound(a)'-50
            If n+a(n).jmp < Ubound(a) Then
                Swap a(n).col,a(n+a(n).jmp).col
                If a(n).y<yres Then   Circle trn,(a(n).x,a(n).y),2,a(n).col,,,,f
            Else
                Continue For
            End If
        Next
    End If
    Put(0,0),trn,Alpha 'background plus flow
   Locate 1,1
    Print fps
    Screenunlock
    regulatew(200,fps)
Loop Until Inkey=Chr(27)

Imagedestroy trn

X_values1:

Data _
648,648,649,649,649,650,650,651,652,652,653,653,654,654,655,656, _
656,657,657,658,658,658,659,659,659,660,660,660,660,661,661,661, _
661,662,662,662,662,662,663,663,663,663,663,664,664,664,664,664, _
665,665,665,665,665,665,666,666,666,666,666,667,667,667,668,668, _
668,668,669,669,669,670,670,670,671,671,672,672,672,673,673,674, _
674,674,675,675,676,677,677,678,678,679,679,680,681,681,682,682, _
683,683,684,685,685,685,686,686,687,687,688,688,688,689,689,690, _
690,690,691,691,692,692,692,693,693,693,694,694,695,695,695,696, _
696,696,697,697,698,698,698,699,699,699,699,700,700,700,700,701, _
701,701,701,701,701,702,702,702,702,702,702,702,702,703,703,703, _
703,703,703,703,704,704,704,704,704,704,704,705,705,705,705,705, _
705,706,706,706,706,706,706,706,707,707,707,707,707,707,707,708, _
708,708,708,708,708,708,709,709,709,709,709,710,710,710,710,711, _
711,711,712,712,712,712,713,713,713,713,714,714,714,714,714,714, _
714,714,714,714,714,714,714,714,714,714,714,714,715,715,715,715, _
715,715,715,716,716,716,716,717,717,717,718,718,718,719,719,719, _
720,720,720,721,721,721,722,722,722,723,723,724,724,724,725,725, _
725,726,726,727,727,727,727,728,728,728,728,729,729,729,729,729, _
729,730,730,730,730,730,730,730,730,731,731,731,731,731,731,732, _
732,732,732,732,733,733,733,733,733,734,734,734,734,734,735,735, _
735,735,735,735,736,736,736,736,736,736,736,737,737,737,737,737, _
737,737,738,738,738,738,738,739,739,739,739,739,740,740,740,740, _
741,741,741,741,742,742,742,743,743,743,744,744,745,745,745,746, _
746,747,747,748,748,749,749,749,750,750,751,751


Y_values1:

Data _
2,3,5,6,8,10,13,15,17,20,23,25,28,31,33,36, _
39,41,44,47,49,51,54,56,58,61,63,66,68,70,73,75, _
77,80,82,85,87,90,92,94,97,100,102,105,107,110,113,115, _
118,121,124,126,129,132,134,137,140,142,145,147,150,152,155,157, _
160,162,164,167,169,171,174,176,178,180,183,185,187,190,192,195, _
197,200,202,205,207,210,213,215,218,221,223,226,229,231,234,237, _
239,242,245,247,250,253,255,258,260,263,265,268,270,273,275,278, _
280,283,285,288,290,293,295,298,300,302,305,307,310,312,315,317, _
320,322,325,327,329,332,334,337,339,342,344,347,349,351,354,356, _
359,361,364,366,369,371,373,376,378,381,383,386,388,391,393,396, _
398,400,403,405,408,410,413,415,418,420,423,425,428,430,433,435, _
438,440,443,445,448,451,453,456,458,461,463,466,468,471,474,476, _
479,481,484,486,489,491,494,496,499,501,504,506,509,511,514,516, _
519,521,523,526,528,531,533,536,538,541,543,545,548,551,553,556, _
558,561,564,566,569,571,574,577,579,582,585,587,590,592,595,597, _
600,602,605,607,610,612,615,617,619,622,624,626,629,631,633,636, _
638,641,643,646,648,651,653,656,658,661,663,666,669,671,674,677, _
679,682,684,687,690,692,695,697,700,703,705,707,710,712,715,717, _
720,722,724,727,729,732,734,737,739,742,744,746,749,752,754,757, _
759,762,765,767,770,772,775,778,780,783,786,788,791,793,796,799, _
801,803,806,808,811,813,815,818,820,822,825,827,829,832,834,836, _
838,841,843,846,848,850,853,856,858,861,864,867,869,872,875,877, _
880,883,885,888,890,892,894,896,898,900,901,903,904,905,907,908, _
909,910,911,911,912,913,914,914,915,915,916,917


X_values2:

Data _
451,451,450,449,449,448,447,447,446,445,444,443,442,441,440,439, _
439,438,437,437,436,435,435,435,434,434,434,433,433,433,432,432, _
432,432,431,431,431,431,431,430,430,430,429,429,429,429,429,428, _
428,428,428,428,428,427,427,427,426,426,426,425,425,425,424,423, _
423,422,422,421,420,420,419,418,417,417,416,415,415,414,413,413, _
412,411,411,410,410,409,409,408,408,407,407,406,406,405,405,404, _
404,403,403,402,402,402,401,401,401,400,400,400,399,399,399,399, _
398,398,398,398,397,397,397,396,396,396,395,395,394,394,394,393, _
393,392,392,391,391,390,390,390,389,389,389,388,388,388,388,387, _
387,387,387,387,387,387,387,387,387,387,387,387,387,387,387,387, _
387,387,387,387,387,387,387,387,387,387,387,387,387,386,386,386, _
386,386,386,386,386,386,386,386,386,385,385,385,385,385,385,384, _
384,384,384,384,384,383,383,383,383,383,383,383,382,382,382,382, _
382,381,381,381,381,381,381,380,380,380,380,380,380,380,380,380, _
380,380,381,381,381,381,381,382,382,382,382,382,382,382,382,382, _
382,382,382,381,381,380,380,380,379,379,378,377,377,376,376,375, _
375,374,374,373,373,373,372,372,372,371,371,371,370,370,370,369, _
369,369,369,368,368,368,368,367,367,367,366,366,366,366,365,365, _
365,365,365,364,364,364,364,363,363,363,363,362,362,362,361,361, _
361,360,360,360,359,359,358,358,358,357,357,357,356,356,356,355, _
355,355,354,354,354,354,353,353,353,353,353,352,352,352,352,351, _
351,351,351,350,350,350,349,349,349,348,348,347,347,347,346,346, _
345,345,344,344,344,343,343,342,342,342,341,341,340,340,340,339, _
339,338,338,338,337,337,337,336,336,336,335,335


Y_values2:

Data _
1,2,4,6,8,10,12,15,17,20,23,25,28,31,34,37, _
40,42,45,48,50,52,55,57,59,62,64,67,69,71,74,76, _
78,80,83,85,88,90,92,95,97,99,102,104,107,109,111,114, _
116,119,121,124,126,128,131,133,136,138,141,143,146,149,151,154, _
156,159,162,164,167,170,173,175,178,181,183,186,189,191,194,196, _
199,202,204,206,209,211,214,216,219,221,223,226,228,230,233,235, _
237,240,242,245,247,249,252,254,257,259,261,264,266,269,271,273, _
276,278,281,283,285,288,290,293,295,297,300,302,304,307,309,312, _
314,316,319,321,323,326,328,331,333,335,338,340,343,346,348,351, _
354,356,359,362,365,368,370,373,376,379,382,385,387,390,393,395, _
398,401,403,406,408,411,413,415,418,420,423,425,427,430,432,435, _
437,439,442,444,447,450,452,455,457,460,463,465,468,471,474,476, _
479,482,484,487,490,492,495,497,500,503,505,508,510,513,515,517, _
520,522,525,527,530,532,534,537,539,542,544,547,549,551,554,556, _
559,561,563,566,568,571,573,575,578,580,583,585,587,590,592,595, _
597,599,602,604,607,609,611,614,616,619,621,624,626,628,631,633, _
636,638,641,643,646,649,651,654,657,659,662,665,667,670,673,676, _
678,681,684,687,689,692,695,697,700,703,705,708,710,713,716,718, _
721,723,726,728,731,734,736,739,741,744,746,749,751,753,756,758, _
761,763,765,768,770,772,774,777,779,781,784,786,788,791,793,796, _
798,800,803,805,808,810,813,816,818,821,823,826,828,831,834,836, _
839,841,844,846,849,852,854,857,860,862,865,868,870,873,876,879, _
881,884,886,889,891,893,895,897,899,901,902,904,905,907,908,909, _
910,912,913,914,915,915,916,917,918,918,919,919

 
deltarho[1859]
Posts: 4315
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Waterfall effect

Post by deltarho[1859] »

Trust dodicat to come up with a 'cracker'.

I have two monitors. Everybody's graphics end up with half on my secondary monitor and half on my primary monitor.

I should have mentioned this ages ago, but I include

#include "fbgfx.bi"
and
ScreenControl fb.SET_WINDOW_POS, 100, 10

That way I get the graphics on my primary monitor. If you only have one monitor, the additions are redundant.

The first parameter is 100 because my taskbar is on the left-hand side of my primary monitor. My secondary monitor is, obviously, to my primary's left.

There are -probably better and easier ways, but I am not a 'graphics guy'. It works for me, so I didn't bother to consider alternatives.
neil
Posts: 594
Joined: Mar 17, 2022 23:26

Re: Waterfall effect

Post by neil »

@dodicat Nice waterfall.

Linux users if you want a waterfall sound playing in the background.
From the console, type play -n synth brownnoise
For Ubuntu users. If play is not installed, then from the console, type apt install sox
Post Reply