Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Smokemotes
#1
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
Reply
#2
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
Reply
#3
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 + ...
Reply
#4
(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.
Reply
#5
Thumbs Up 
(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 + ...
Reply
#6
Ticks all the boxes - lovely effect and fun to play around with
RokCoder - dabbling in QB64pe for fun
Reply
#7
(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.
Reply
#8
(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.
Reply
#9
Thumbs Up 
(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 + ...
Reply
#10
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).
Reply




Users browsing this thread: 3 Guest(s)