Rookie Rainfall - Printable Version

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