Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
Code: (Select All) 'smokemotes
'playing with circlefill
'
'key presses to stimulate chnages
'R,r, G,g , B,b change colore channels
'w,a,s,d directs the flow of particles
'M,m change the magnifcation on the motes
'<,> change the count of motes displayed
'V,v change the velocity chnages will be applied
'
Screen _NewImage(600, 500, 32)
Type motetype
x As Integer
y As Integer
gx As Integer
gy As Integer
r As Single
tr As Integer
kr As Integer
kg As Integer
kb As Integer
v As Integer
End Type
Randomize Timer
Dim smoke(60000) As motetype
For m = 1 To 60000
smoke(m).x = Int(1 + Rnd * _Width)
smoke(m).y = Int(1 + Rnd * _Height)
smoke(m).gx = Int(Rnd * 3) - Int(Rnd * 3)
smoke(m).gy = Int(Rnd * 3) - Int(Rnd * 3)
smoke(m).r = Int(.5 + Rnd * 3)
smoke(m).tr = Int(6 + Rnd * 10 + Rnd * 10)
smoke(m).kr = 100 + Int(Rnd * 12) - Int(Rnd * 12)
smoke(m).kg = 100 + Int(Rnd * 12) - Int(Rnd * 12)
smoke(m).kb = 200 + Int(Rnd * 20) - Int(Rnd * 20)
smoke(m).v = Int(30 + Rnd * 12 - Rnd * 12)
Next m
mm = 30000
_FullScreen
Do
_Limit 30
Cls
For m = 1 To mm
_Limit 1000000
CircleFill smoke(m).x, smoke(m).y, smoke(m).r, _RGB32(smoke(m).kr, smoke(m).kg, smoke(m).kb, smoke(m).tr)
If Rnd * 100 < 3 Then smoke(m).gx = smoke(m).gx + Int(Rnd * 2) - Int(Rnd * 2)
If Rnd * 100 < 3 Then smoke(m).gy = smoke(m).gy + Int(Rnd * 2) - Int(Rnd * 2)
If Rnd * 100 < smoke(m).v Then smoke(m).x = smoke(m).x + smoke(m).gx
If Rnd * 100 < smoke(m).v Then smoke(m).y = smoke(m).y + smoke(m).gy
If smoke(m).x > _Width Or smoke(m).x < 0 Then smoke(m).x = Int(1 + Rnd * _Width)
If smoke(m).y > _Height Or smoke(m).y < 0 Then smoke(m).y = Int(1 + Rnd * _Width)
Select Case kk$
Case "w"
smoke(m).gy = smoke(m).gy - Int(Rnd * 4)
Case "a"
smoke(m).gx = smoke(m).gx - Int(Rnd * 4)
Case "s"
smoke(m).gy = smoke(m).gy + Int(Rnd * 4)
Case "d"
smoke(m).gx = smoke(m).gx + Int(Rnd * 4)
Case "R"
If Rnd * 100 < 66 Then
smoke(m).kr = smoke(m).kr + Int(Rnd * 3)
If smoke(m).kr > 255 Then smoke(m).kr = 0
End If
Case "G"
If Rnd * 100 < 66 Then
smoke(m).kg = smoke(m).kg + Int(Rnd * 3)
If smoke(m).kg > 255 Then smoke(m).kg = 0
End If
Case "B"
If Rnd * 100 < 66 Then
smoke(m).kb = smoke(m).kb + Int(Rnd * 3)
If smoke(m).kb > 255 Then smoke(m).kb = 0
End If
Case "r"
If Rnd * 100 < 66 Then
smoke(m).kr = smoke(m).kr - Int(Rnd * 3)
If smoke(m).kr < 0 Then smoke(m).kr = 255
End If
Case "g"
If Rnd * 100 < 66 Then
smoke(m).kg = smoke(m).kg - Int(Rnd * 3)
If smoke(m).kg < 0 Then smoke(m).kg = 255
End If
Case "b"
If Rnd * 100 < 66 Then
smoke(m).kb = smoke(m).kb - Int(Rnd * 3)
If smoke(m).kb < 0 Then smoke(m).kb = 255
End If
Case "v"
If Rnd * 100 < 66 Then
smoke(m).v = smoke(m).v - Int(Rnd * 3)
If smoke(m).v < 1 Then smoke(m).v = 1
End If
Case "V"
If Rnd * 100 < 66 Then
smoke(m).v = smoke(m).v + Int(Rnd * 3)
If smoke(m).v > 98 Then smoke(m).v = 98
End If
Case "m"
If Rnd * 100 < 66 Then
smoke(m).r = smoke(m).r * .95
End If
Case "M"
If Rnd * 100 < 66 Then
smoke(m).r = smoke(m).r * 1.1
End If
Case "t"
If Rnd * 100 < 66 Then
smoke(m).tr = smoke(m).tr * .95
End If
Case "T"
If Rnd * 100 < 66 Then
smoke(m).tr = smoke(m).tr * 1.1
End If
End Select
Next m
Select Case kk$
Case "<"
mm = mm - Int(1 + Rnd * 100)
If mm < 10 Then mm = 10
Case ">"
mm = mm + Int(1 + Rnd * 100)
If mm > 60000 Then mm = 60000
End Select
_Display
kk$ = InKey$
Loop Until kk$ = Chr$(27)
Sub CircleFill (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
Of course, after I eat dinner, I realize how to make that program a little more interesting by having the motes emit from a center region on the screen.
Code: (Select All) 'smokemotes _center
'playing with circlefill
'
'key presses to stimulate chnages
'R,r, G,g , B,b change colore channels
'w,a,s,d directs the flow of particles
'M,m change the magnifcation on the motes
'<,> change the count of motes displayed
'V,v change the velocity chnages will be applied
'
Screen _NewImage(600, 500, 32)
Type motetype
x As Integer
y As Integer
gx As Integer
gy As Integer
r As Single
tr As Integer
kr As Integer
kg As Integer
kb As Integer
v As Integer
End Type
Randomize Timer
Dim smoke(60000) As motetype
For m = 1 To 60000
smoke(m).x = Int(_Width / 2 + 1 + Rnd * 50) - Int(1 + Rnd * 50)
smoke(m).y = Int(_Height / 2 + 1 + Rnd * 50) - Int(1 + Rnd * 50)
smoke(m).gx = Int(Rnd * 3) - Int(Rnd * 3)
smoke(m).gy = Int(Rnd * 3) - Int(Rnd * 3)
smoke(m).r = Int(.5 + Rnd * 3)
smoke(m).tr = Int(6 + Rnd * 10 + Rnd * 10)
smoke(m).kr = 100 + Int(Rnd * 12) - Int(Rnd * 12)
smoke(m).kg = 100 + Int(Rnd * 12) - Int(Rnd * 12)
smoke(m).kb = 200 + Int(Rnd * 20) - Int(Rnd * 20)
smoke(m).v = Int(30 + Rnd * 12 - Rnd * 12)
Next m
mm = 30000
_FullScreen
Do
_Limit 30
Cls
For m = 1 To mm
_Limit 1000000
CircleFill smoke(m).x, smoke(m).y, smoke(m).r, _RGB32(smoke(m).kr, smoke(m).kg, smoke(m).kb, smoke(m).tr)
If Rnd * 100 < 3 Then smoke(m).gx = smoke(m).gx + Int(Rnd * 2) - Int(Rnd * 2)
If Rnd * 100 < 3 Then smoke(m).gy = smoke(m).gy + Int(Rnd * 2) - Int(Rnd * 2)
If Rnd * 100 < smoke(m).v Then smoke(m).x = smoke(m).x + smoke(m).gx
If Rnd * 100 < smoke(m).v Then smoke(m).y = smoke(m).y + smoke(m).gy
If smoke(m).x > _Width Or smoke(m).x < 0 Then
smoke(m).x = Int(_Width / 2 + 1 + Rnd * 50) - Int(1 + Rnd * 50)
smoke(m).y = Int(_Height / 2 + 1 + Rnd * 50) - Int(1 + Rnd * 50)
End If
If smoke(m).y > _Height Or smoke(m).y < 0 Then
smoke(m).x = Int(_Width / 2 + 1 + Rnd * 50) - Int(1 + Rnd * 50)
smoke(m).y = Int(_Height / 2 + 1 + Rnd * 50) - Int(1 + Rnd * 50)
End If
Select Case kk$
Case "w"
smoke(m).gy = smoke(m).gy - Int(Rnd * 4)
Case "a"
smoke(m).gx = smoke(m).gx - Int(Rnd * 4)
Case "s"
smoke(m).gy = smoke(m).gy + Int(Rnd * 4)
Case "d"
smoke(m).gx = smoke(m).gx + Int(Rnd * 4)
Case "R"
If Rnd * 100 < 66 Then
smoke(m).kr = smoke(m).kr + Int(Rnd * 3)
If smoke(m).kr > 255 Then smoke(m).kr = 0
End If
Case "G"
If Rnd * 100 < 66 Then
smoke(m).kg = smoke(m).kg + Int(Rnd * 3)
If smoke(m).kg > 255 Then smoke(m).kg = 0
End If
Case "B"
If Rnd * 100 < 66 Then
smoke(m).kb = smoke(m).kb + Int(Rnd * 3)
If smoke(m).kb > 255 Then smoke(m).kb = 0
End If
Case "r"
If Rnd * 100 < 66 Then
smoke(m).kr = smoke(m).kr - Int(Rnd * 3)
If smoke(m).kr < 0 Then smoke(m).kr = 255
End If
Case "g"
If Rnd * 100 < 66 Then
smoke(m).kg = smoke(m).kg - Int(Rnd * 3)
If smoke(m).kg < 0 Then smoke(m).kg = 255
End If
Case "b"
If Rnd * 100 < 66 Then
smoke(m).kb = smoke(m).kb - Int(Rnd * 3)
If smoke(m).kb < 0 Then smoke(m).kb = 255
End If
Case "v"
If Rnd * 100 < 66 Then
smoke(m).v = smoke(m).v - Int(Rnd * 3)
If smoke(m).v < 1 Then smoke(m).v = 1
End If
Case "V"
If Rnd * 100 < 66 Then
smoke(m).v = smoke(m).v + Int(Rnd * 3)
If smoke(m).v > 98 Then smoke(m).v = 98
End If
Case "m"
If Rnd * 100 < 66 Then
smoke(m).r = smoke(m).r * .95
End If
Case "M"
If Rnd * 100 < 66 Then
smoke(m).r = smoke(m).r * 1.1
End If
Case "t"
If Rnd * 100 < 66 Then
smoke(m).tr = smoke(m).tr * .95
End If
Case "T"
If Rnd * 100 < 66 Then
smoke(m).tr = smoke(m).tr * 1.1
End If
End Select
Next m
Select Case kk$
Case "<"
mm = mm - Int(1 + Rnd * 100)
If mm < 10 Then mm = 10
Case ">"
mm = mm + Int(1 + Rnd * 100)
If mm > 60000 Then mm = 60000
End Select
_Display
kk$ = InKey$
Loop Until kk$ = Chr$(27)
Sub CircleFill (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
01-19-2023, 02:27 AM
(This post was last modified: 01-19-2023, 02:40 AM by bplus.)
To be more interesting try having smoke originate at mouse and drifting up while spreading out left and right.
This kind of thing is kinda goofy:
Code: (Select All) var = Int(Rnd * 3) - Int(Rnd * 3)
if you want a random single at 10 +/- 5
r = 10 + rnd*10 -5
for integers at 100 +/- 10
Code: (Select All) For i = 1 To 100
r = 100 + Int(21 * Rnd) - 10 ' because INT() rounds down, int(Rnd * 1 more than max range) minus 1/2 range
Print r,
Next
b = b + ...
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
(01-19-2023, 02:27 AM)bplus Wrote: To be more interesting try having smoke follow mouse and drifting up.
This kind of thing is kinda goofy:
Code: (Select All) var = Int(Rnd * 3) - Int(Rnd * 3)
if you want a random single at 10 +/- 5
r = 10 + rnd*10 -5
for integers at 100 +/- 10
Code: (Select All) For i = 1 To 100
r = 100 + Int(21 * Rnd) - 10 ' because INT() rounds down, int(Rnd * 1 more than max range) minus 1/2 range
Print r,
Next
It's not even remotely goofy. I didn't do that because I want the bell curve created by the two calls to rnd to make the median result more likely than the extremes. What you are showing here would create a linear distribution within the range which I didn't want.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
01-19-2023, 04:15 AM
(01-19-2023, 02:43 AM)James D Jarvis Wrote: (01-19-2023, 02:27 AM)bplus Wrote: To be more interesting try having smoke follow mouse and drifting up.
This kind of thing is kinda goofy:
Code: (Select All) var = Int(Rnd * 3) - Int(Rnd * 3)
if you want a random single at 10 +/- 5
r = 10 + rnd*10 -5
for integers at 100 +/- 10
Code: (Select All) For i = 1 To 100
r = 100 + Int(21 * Rnd) - 10 ' because INT() rounds down, int(Rnd * 1 more than max range) minus 1/2 range
Print r,
Next
It's not even remotely goofy. I didn't do that because I want the bell curve created by the two calls to rnd to make the median result more likely than the extremes. What you are showing here would create a linear distribution within the range which I didn't want.
+1 OK not seen that before, works great!
Code: (Select All) Dim As Long a(-11 To 11)
For i = 1 To 100000
r = Int(Rnd * 11) - Int(Rnd * 11)
a(r) = a(r) + 1
Next
For i = -11 To 11
Print String$(Int(a(i) / 1000), "*")
Next
b = b + ...
Posts: 57
Threads: 6
Joined: Jan 2023
Reputation:
5
Ticks all the boxes - lovely effect and fun to play around with
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
(01-19-2023, 01:01 PM)RokCoder Wrote: Ticks all the boxes - lovely effect and fun to play around with
It's fun what can be done with a solid routine like circlefill and a little additional code.
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
(01-19-2023, 04:15 AM)bplus Wrote: +1 OK not seen that before, works great!
Code: (Select All) Dim As Long a(-11 To 11)
For i = 1 To 100000
r = Int(Rnd * 11) - Int(Rnd * 11)
a(r) = a(r) + 1
Next
For i = -11 To 11
Print String$(Int(a(i) / 1000), "*")
Next
You beat me to the code that demonstrates a bell curve at work. You shouldn't ever get -11 or 11 with that code however (unless rnd bumps a bit over at some point).
You can alter the distribution on the curve by changing the range of elements used.
These would all produce a score of 2 to 20 but have different looking result curves:
Code: (Select All) r1 = Int(1 + Rnd * 10) + (1 + Rnd * 10)
r2 = Int(1 + Rnd * 12) + (1 + Rnd * 8)
r3 = Int(1 + Rnd * 8) + Int(1 + Rnd * 8) + Int(Rnd * 5)
run enough times and r1 is the most pronounced curve with most results coming in the middle.
r2 will have a flatter curve than r1 with a wider range of likely results with a collapsing chance of getting the rarer results (2,3,19,and20) , and r3 should be flatter than that.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
01-19-2023, 06:11 PM
(This post was last modified: 01-19-2023, 06:12 PM by bplus.)
(01-19-2023, 03:16 PM)James D Jarvis Wrote: (01-19-2023, 04:15 AM)bplus Wrote: +1 OK not seen that before, works great!
Code: (Select All) Dim As Long a(-11 To 11)
For i = 1 To 100000
r = Int(Rnd * 11) - Int(Rnd * 11)
a(r) = a(r) + 1
Next
For i = -11 To 11
Print String$(Int(a(i) / 1000), "*")
Next
You beat me to the code that demonstrates a bell curve at work. You shouldn't ever get -11 or 11 with that code however (unless rnd bumps a bit over at some point).
You can alter the distribution on the curve by changing the range of elements used.
These would all produce a score of 2 to 20 but have different looking result curves:
Code: (Select All) r1 = Int(1 + Rnd * 10) + (1 + Rnd * 10)
r2 = Int(1 + Rnd * 12) + (1 + Rnd * 8)
r3 = Int(1 + Rnd * 8) + Int(1 + Rnd * 8) + Int(Rnd * 5)
run enough times and r1 is the most pronounced curve with most results coming in the middle.
r2 will have a flatter curve than r1 with a wider range of likely results with a collapsing chance of getting the rarer results (2,3,19,and20) , and r3 should be flatter than that.
Thanks for this the first one I demo'd has been something I've sort of been wanting for long time.
Now I see the dust smoke mote connection, also might be good for sun and stars?
These new ones I will definitely check out.
+1 between this and Rotozoom you deserve at least another point from me. Two beauties in one night!
b = b + ...
Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
I suppose it would work fine for stars and other objects that can be illustrated with a circle. It might work for water splashing on the screen as if it was a window if you scale up some as they "hit" the screen as if it was a car window (I suppose the drip could be tracked post "impact" too).
|
