Smokemotes

[James D Jarvis]

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