08-22-2022, 01:11 AM
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
