Rookie Rainfall
#1
You can use 'w' and 's' to adjust the display speed

Code: (Select All)
'Rookie Rainfall
'james2464

Dim scx As Integer
Dim scy As Integer
Dim res As Integer

scx = 500
scy = 400
res = 1



Screen _NewImage(scx, scy, 32)

$Resize:Smooth

Dim c0(100) As Long

'cyan
c0(0) = _RGB(0, 0, 0) 'black
c0(2) = _RGB(0, 127, 255) 'cyan
c0(3) = _RGB(0, 45, 90) 'cyan
c0(4) = _RGB(0, 30, 60) 'cyan
c0(5) = _RGB(0, 20, 40) 'cyan
c0(6) = _RGB(0, 10, 20) 'cyan
c0(7) = _RGB(0, 5, 10) 'cyan



Randomize Timer


'starting speed delay value
Dim dv As Long
dv = 20

'screen sized array
Dim a(scx, scy) As Integer

'set to zero
For f = 0 To scx
    For s = 0 To scy
        a(f, s) = 0
    Next s
Next f

'fill screen with colour c0(0) pixels
For s = 0 To scx
    For f = 0 To scy
        PSet (s, f), c0(a(s, f))
    Next
Next

'smaller array size for higher value of "res"
scx2 = scx / res
scy2 = scy / res

Dim dtx(2000) As Integer 'stores droplet position along x axis
Dim dty(2000) As Integer 'stores droplet postion along y axis
Dim dx, ct As Integer 'used in loops when "drying"
Dim dice1 As Long 'used to randomize things
Dim p1~& 'used to interpret pixel colours when "drying"



flag = 0
ct = 0
ctmax = 150 'max number of active droplets
rain = 488 'starting value for rainflow
dry1 = 0
dryrate = 0

'dtx array -1 value makes the position inactive...higher than -1 is active
'initialize by setting to -1
For j = 1 To scx
    dtx(j) = -1
Next j

'used to separate pixel colours from _Point to _Red32 _Blue32 etc
Dim a99, b99, c99, d99 As Integer

Do

    t = Int(Rnd * 500)
    If t > 480 Then 'sometimes allow for changes in the amount of rainfall
        flowchange = Int(Rnd * 3) - 1 'randomize the change in amount of rain.  Even overall with minor ups and downs
        rain = rain + flowchange 'go up or down slightly depending on the previous line
    End If
    If rain < 470 Then 'if too much rain (lower is more chance of additional rain drops) the bump flow back up next line
        rain = rain + 5
    End If

    'dry if rainfall rate is slow enough - 495 is not much rainfall.  Below that it's too wet to expect any drying to happen
    If rain > 495 Then
        dry1 = dry1 + 1
        If dry1 > 35 Then
            dry1 = 0
            For jx = 0 To scx

                p1~& = Point(jx, scy - 1)
                a99 = _Red32(p1~&)
                b99 = _Green32(p1~&)
                c99 = _Blue32(p1~&)
                d99 = a99 + b99 + c99

                If d99 > 0 Then
                    If a99 > 0 Then a99 = a99 - 1
                    If b99 > 0 Then b99 = b99 - 1
                    If c99 > 0 Then c99 = c99 - 1
                    c0(40) = _RGB(a99, b99, c99)
                    Line (jx, scy - 1)-(jx, scy), c0(40), BF
                End If
            Next jx
        End If
    End If

    'no rain when over 500, bump flow value towards some rainfall
    If rain > 510 Then
        rain = rain - 7
    End If


    'generate rain droplets
    dice1 = Int(Rnd * 500)

    If dice1 > rain Then 'sometimes introduce a new droplet
        flag2 = 0

        'count up active droplets
        ct = 0
        For j = 1 To scx2
            If dtx(j) > -1 Then
                ct = ct + 1
            End If
        Next j

        If ct < ctmax Then 'if not maxxed out, a new droplet is born
            dx = Int(Rnd * scx2)
            If dtx(dx) = -1 Then 'only in an available position
                dtx(dx) = dx * res
                dty(dx) = 0
            End If
        End If
    End If


    'droplets moving down until splash
    For j = 1 To scx2
        If dtx(j) > -1 Then
            dty(j) = dty(j) + 1
            If dty(j) < scy Then
                Line (dtx(j), dty(j) - 4 * res)-(dtx(j) + res, dty(j) - 4 * res + res), c0(0), BF
                Line (dtx(j), dty(j) - 0)-(dtx(j) + res, dty(j) - 0 + res), c0(7), BF
                Line (dtx(j), dty(j) + 10 * res)-(dtx(j) + res, dty(j) + 10 * res + res), c0(6), BF
                Line (dtx(j), dty(j) + 16 * res)-(dtx(j) + res, dty(j) + 16 * res + res), c0(5), BF
                Line (dtx(j), dty(j) + 22 * res)-(dtx(j) + res, dty(j) + 22 * res + res), c0(4), BF
                Line (dtx(j), dty(j) + 28 * res)-(dtx(j) + res, dty(j) + 28 * res + res), c0(3), BF
                Line (dtx(j), dty(j) + 30 * res)-(dtx(j) + res, dty(j) + 30 * res + res), c0(2), BF
            End If
            If dty(j) = scy - 9 Then
                Circle (dtx(j), scy + 2), 2, c0(3)
                Circle (dtx(j) - 3, scy - 5), 1, c0(3)
                Circle (dtx(j) + 3, scy - 5), 1, c0(3)
            End If
            If dty(j) = scy - 8 Then
                Circle (dtx(j), scy + 2), 3, c0(4)
            End If
            If dty(j) = scy - 6 Then
                Circle (dtx(j) - 5, scy - 8), 1, c0(3)
                Circle (dtx(j) + 5, scy - 8), 1, c0(3)
            End If

            If dty(j) = scy - 2 Then
                Circle (dtx(j), scy + 2), 4, c0(5)
            End If

            If dty(j) = scy - 1 Then
                Circle (dtx(j), scy + 2), 5, c0(6)

            End If
            If dty(j) >= scy + 10 Then
                Circle (dtx(j) - 3, scy - 5), 1, c0(0)
                Circle (dtx(j) + 3, scy - 5), 1, c0(0)
            End If

            If dty(j) >= scy + 20 Then
                Line (dtx(j) - 2, scy - 5)-(dtx(j) + 2, scy), c0(2), BF
            End If

            If dty(j) >= scy + 30 Then
                Line (dtx(j) - 4, scy - 3)-(dtx(j) + 4, scy), c0(2), BF

            End If

            If dty(j) >= scy + 45 Then
                Line (dtx(j) - 7, scy - 2)-(dtx(j) + 7, scy), c0(2), BF
            End If

            If dty(j) >= scy + 60 Then
                Circle (dtx(j) - 5, scy - 8), 1, c0(0)
                Circle (dtx(j) + 5, scy - 8), 1, c0(0)
                Line (dtx(j) - 12, scy - 8)-(dtx(j) + 12, scy - 1), c0(0), BF
                Line (dtx(j) - 12, scy - 1)-(dtx(j) + 12, scy), c0(2), BF
                dtx(j) = -1 'expired
            End If


        End If
    Next j




    '======================================================

    'adjust display speed using "w" and "s" keys
    keypress$ = InKey$


    If keypress$ = Chr$(115) Then dv = dv + 2
    If keypress$ = Chr$(119) Then dv = dv - 2

    If dv > 200 Then dv = 200
    If dv < 2 Then dv = 2


    'fancy indicator for display speed
    '======================================================
    'Locate 1, 1
    'Print Using "#######"; dv
    'Print "Speed"
    'Line (69, 1)-(270, 10), c0(2), BF
    'Line (70, 2)-(269, 9), c0(0), BF
    'Line (69, 1)-(271 - dv, 10), c0(2), BF
    '======================================================

    For del1 = 1 To dv * 10000
    Next del1



Loop Until flag > 0

End
Reply
#2
Nicely done Smile


Reply
#3
Nice! If you'd like to take it further, check out this rain animation by TheBOB: https://staging.qb64phoenix.com/showthread.php?tid=191

Pete
Reply
#4
(08-22-2022, 02:40 PM)Petr Wrote: Nicely done Smile

Thanks!
Reply
#5
(08-22-2022, 02:58 PM)Pete Wrote: Nice! If you'd like to take it further, check out this rain animation by TheBOB: https://staging.qb64phoenix.com/showthread.php?tid=191

Pete

This is excellent...I admit I was thinking along those lines for a future challenge.

Cheers
Reply
#6
Yea, TheBOB has some great stuff from the ol' QBasic era. If you ever want to discuss stuff with him, he hangs out at: https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Just tell him Pete sent you... and then duck.

Pete
Reply
#7
there might be a few JB originals on this subject
Reply
#8
Very cool rain drops! I like the splashes.
Reply




Users browsing this thread: 1 Guest(s)