Posts: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
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: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
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: 4,693
Threads: 222
Joined: Apr 2022
Reputation:
322
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
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
(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: 4,693
Threads: 222
Joined: Apr 2022
Reputation:
322
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
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 80
Threads: 7
Joined: Jan 2023
Reputation:
12
Ticks all the boxes - lovely effect and fun to play around with
RokCoder - dabbling in QB64pe for fun
Posts: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
(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: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
(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: 4,693
Threads: 222
Joined: Apr 2022
Reputation:
322
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!
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
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).
|
