Proggies

[NakedApe]

Wow, super cool blended plasma, Dav! And sweet mod, bplus. Who needs psychadelics with you guys around? Very mesmerizing. Now just add a Grateful Dead soundtrack and I'll start flashing back...

[Dav]

Hey, bplus, I really like your mod.   Played around with the angles today, to come up with a few variations,  Replace the original angle (a) line with one of these to see the different effects achieved manipulating the angle.

- Dav

Code: (Select All)

            a = _Atan2(y - cy, x - cx) + t 'original
 
            a = _Atan2(y - cy, x - cx) + Sin(rad * 2 + t) 'spiral twist
            a = _Atan2(y - cy, x - cx) + Sin(t) * 4 'churning using sin
            a = _Atan2(y - cy, x - cx) + Cos(t) * 4 'churning using cos
            a = _Atan2(y - cy, x - cx) + Sin(t) * rad 'spiral (radius)
            a = _Atan2(y - cy, x - cx) + Sin(t * 4 + (x / _Width)) * .5 'edge wave
            a = _Atan2(y - cy, x - cx) + (x / _Width) * Sin(t) * 5 'distort

[bplus]

I think I like spiral twist best.

[Dav]

Here's a few more, that's about all I think.

- Dav

Code: (Select All)

            a = _Atan2(y - cy, x - cx) + Cos(t) * 3 + Sin(x / _Width + t * 3) 'better wave
            a = _Atan2(y - cy, x - cx) + Sin(t * 2) * Cos(rad * 2) 'double twist!
            a = _Atan2(y - cy, x - cx) + Sin(rad * 1.5 + t * 4) 'inward spiral
            a = _Atan2(y - cy, x - cx) + Sin(x * .01 + t) * Cos(y * .01 + t) 'mumps!

[madscijr]

Here's a few more, that's about all I think.

- Dav

Code: (Select All)

            a = _Atan2(y - cy, x - cx) + Cos(t) * 3 + Sin(x / _Width + t * 3) 'better wave
            a = _Atan2(y - cy, x - cx) + Sin(t * 2) * Cos(rad * 2) 'double twist!
            a = _Atan2(y - cy, x - cx) + Sin(rad * 1.5 + t * 4) 'inward spiral
            a = _Atan2(y - cy, x - cx) + Sin(x * .01 + t) * Cos(y * .01 + t) 'mumps!

I wanted to see all the variations so this version lets you cycle through them by pressing the "a" key... 

Code: (Select All)

_Title "Dav 'Pulse' Plasma Blend: press 'a' to change angle style, any other key for random, esc to quit"
' 2024-10-02 Dav      Hey, bplus, I thought you may like like this little proggie since you have shared some really great plasmas here.  I wondered what it would look like to show more than one plasma effect using a pulse factor to blend them.  Here's a little example of that.
' 2024-10-02 b+       thank you Dav for nice blended plasma effect, now I play with it :D
' 2024-10-03 Dav      Hey, bplus, I really like your mod.   Played around with the angles today, to come up with a few variations,  Replace the original angle (a) line with one of these to see the different effects achieved manipulating the angle.
' 2024-10-03 Dav      Here's a few more, that's about all I think.
' 2024-10-07 madscijr added press A to cycle through formulas

Const FALSE = 0
Const TRUE = Not FALSE
Dim bFinished As Integer
Dim bRestart As Integer
Dim bChange As Integer
Dim iLastKey As Integer
Dim iAngleFn As Integer
Dim iMaxAngleFn As Integer
Dim cx As Integer
Dim cy As Integer
Dim m1 As Integer
Dim m2 As Integer
Dim m3 As Integer

Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60

bFinished = FALSE
bRestart = TRUE
iAngleFn = 0
iMaxAngleFn = 11

Do
    If bRestart = TRUE Then
        ' Init values
        cx = _Width / 2
        cy = _Height / 2
        m1 = 9
        m2 = 27
        m3 = 3

        ' Choose a new formula
        'iAngleFn = RandomNumber%(1, iMaxAngleFn)
        iAngleFn = iAngleFn + 1: If iAngleFn > iMaxAngleFn Then iAngleFn = 1

        '' Display in title bar
        '_Title "Dav 'Pulse' Plasma Blend: angle style " + _Trim$(Str$(iAngleFn)) + " (press a to change, any other key for random, esc to quit)"

        ' Don't run again until user presses "a" again
        bRestart = FALSE
    ElseIf bChange = TRUE Then
        ' Randomize values
        m3 = Int(Rnd * 12)
        m = Int(Rnd * 3) + 2
        m1 = m * m3
        m2 = m * m1

        ' Don't run again until user presses "b"
        bChange = FALSE
    End If

    T = T + .01 ' mod
    pulse = Sin(T) * .8 'pulse factor

    For y = 0 To _Height Step 3
        For x = 0 To _Width Step 3

            ' --------------------------------------------------------------------------------
            ' case 1
            ' bplus
            ' 10-02-2024, 04:45 PM (This post was last modified: 10-02-2024, 04:47 PM by bplus.)
            ' #207 OK here is a mod Smile
            ' --------------------------------------------------------------------------------
            ' Case 2-7
            ' Dav
            ' 10-03-2024, 03:31 PM
            ' #210: Hey, bplus, I really like your mod.
            ' Played around with the angles today, to come up with a few variations,
            ' Replace the original angle (a) line with one of these
            ' to see the different effects achieved manipulating the angle.
            ' --------------------------------------------------------------------------------
            ' case 8-11
            ' Dav
            ' 10-03-2024, 07:04 PM
            ' #212 Here's a few more, that's about all I think.
            ' --------------------------------------------------------------------------------

            Select Case iAngleFn
                Case 1:
                    a = _Atan2(y - cy, x - cx) + T 'original
                Case 2:
                    a = _Atan2(y - cy, x - cx) + Sin(rad * 2 + T) 'spiral twist
                Case 3:
                    a = _Atan2(y - cy, x - cx) + Sin(T) * 4 'churning using sin
                Case 4:
                    a = _Atan2(y - cy, x - cx) + Cos(T) * 4 'churning using cos
                Case 5:
                    a = _Atan2(y - cy, x - cx) + Sin(T) * rad 'spiral (radius)
                Case 6:
                    a = _Atan2(y - cy, x - cx) + Sin(T * 4 + (x / _Width)) * .5 'edge wave
                Case 7:
                    a = _Atan2(y - cy, x - cx) + (x / _Width) * Sin(T) * 5 'distort
                Case 8:
                    a = _Atan2(y - cy, x - cx) + Cos(T) * 3 + Sin(x / _Width + T * 3) 'better wave
                Case 9:
                    a = _Atan2(y - cy, x - cx) + Sin(T * 2) * Cos(rad * 2) 'double twist!
                Case 10:
                    a = _Atan2(y - cy, x - cx) + Sin(rad * 1.5 + T * 4) 'inward spiral
                Case 11:
                    a = _Atan2(y - cy, x - cx) + Sin(x * .01 + T) * Cos(y * .01 + T) 'mumps!
            End Select

            rad = Sqr((x - cx) ^ 2 + (y - cy) ^ 2) / 100

            '1st plasma colors
            r1 = (Sin(rad * m3 + T) + Sin(a * m1 + T)) * 127 '+ 128
            g1 = (Sin(rad * m3 + T + 1) + Sin(a * m1 + T + 1)) * 127 '+ 128
            b1 = (Sin(rad * m3 + T + 2) + Sin(a * m1 + T + 2)) * 127 ' + 128

            '2nd plasma colors
            r2 = (Sin(rad * 3 + T) + Sin(a * 3 + T + 1)) * 127 + 128
            g2 = (Sin(rad * 3 + T + 2) + Sin(a * m2 + T + 3)) * 127 + 128
            b2 = (Sin(rad * 3 + T + 4) + Sin(a * m2 + T + 4)) * 127 + 128

            'Blend plasma colors using pulse factor
            r = r1 * (1 - pulse) + r2 * pulse
            g = g1 * (1 - pulse) + g2 * pulse
            b = b1 * (1 - pulse) + b2 * pulse

            Line (x, y)-Step(2, 2), _RGB(r, g, b), BF

        Next x
    Next y

    Locate 1, 1: Print _Trim$(Str$(iAngleFn))

    _Display
    _Limit 30

    If _KeyDown(27) Then
        bFinished = TRUE
    ElseIf _KeyDown(Asc("a")) Then
        If iLastKey <> Asc("a") Then ' don't let user hold down "a" key
            bRestart = TRUE
            iLastKey = Asc("a")
        End If
    Else
        iLastKey = 0
        If InKey$ <> "" Then
            bChange = TRUE
        End If
    End If
Loop Until bFinished = TRUE ' _KeyDown(27)

End

' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.

Function RandomNumber% (Min%, Max%)
    Dim NumSpread%

    ' SET RANDOM SEED
    'Randomize ' Initialize random-number generator.
    Randomize Timer

    ' GET RANDOM # Min%-Max%
    'RandomNumber = Int((Max * Rnd) + Min) ' generate number

    NumSpread% = (Max% - Min%) + 1

    RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%

[bplus]

Wow we can try everything!

Here is a cool interferrence pattern I ran into:
   

[bplus]

Man I had fun with this one today!

Flipping Hex Maze

Code: (Select All)

_Title "Flipping Hex Maze" ' b+ 2024-11-01
Screen _NewImage(801, 590, 32): _ScreenMove 240, 60
Type BoardType
    As Single x, y, flipped, flipping, a
End Type
Dim Shared ubX, ubY
ubX = 18: ubY = 16
Dim Shared b(ubX, ubY) As BoardType
Dim Shared cellR, xspacing!, yspacing!
cellR = 25
xspacing! = 2 * cellR * Cos(_D2R(30)): yspacing! = cellR * (1 + Sin(_D2R(30)))
Dim xoffset!
Color &HFF000000, &HFFAAAAFF
Do
    m = (m + 1) Mod ubX
    Cls
    For y = 0 To ubY
        If y Mod 2 = 0 Then xoffset! = .5 * xspacing! Else xoffset! = 0
        For x = 0 To ubX
            b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing! - 20
            b(x, y).y = y * yspacing! + .5 * yspacing! - 20
            If Rnd < .002 Then b(x, y).flipping = 1
            showCell x, y
        Next
    Next
    _Display
    _Limit 60
Loop

Sub showCell (c, r)
    If b(c, r).flipping Then b(c, r).a = b(c, r).a + _Pi(1 / 90)
    If b(c, r).a >= _Pi(1 / 3) Then
        b(c, r).flipping = 0: b(c, r).a = 0
        If b(c, r).flipped Then b(c, r).flipped = 0 Else b(c, r).flipped = 1
    End If
    If b(c, r).flipped Then
        For a = _Pi(1 / 6) To _Pi(2) Step _Pi(2 / 3)
            Line (b(c, r).x, b(c, r).y)-Step(cellR * Cos(a + b(c, r).a), cellR * Sin(a + b(c, r).a))
        Next
    Else
        For a = _Pi(.5) To _Pi(2) Step _Pi(2 / 3)
            Line (b(c, r).x, b(c, r).y)-Step(cellR * Cos(a + b(c, r).a), cellR * Sin(a + b(c, r).a))
        Next
    End If
End Sub

   

It inspired a new drawing tool.
See here: https://qb64phoenix.com/forum/showthread...7#pid29637

[PhilOfPerth]

Man I had fun with this one today!

Flipping Hex Maze

Code: (Select All)

_Title "Flipping Hex Maze" ' b+ 2024-11-01
Screen _NewImage(801, 590, 32): _ScreenMove 240, 60
Type BoardType
    As Single x, y, flipped, flipping, a
End Type
Dim Shared ubX, ubY
ubX = 18: ubY = 16
Dim Shared b(ubX, ubY) As BoardType
Dim Shared cellR, xspacing!, yspacing!
cellR = 25
xspacing! = 2 * cellR * Cos(_D2R(30)): yspacing! = cellR * (1 + Sin(_D2R(30)))
Dim xoffset!
Color &HFF000000, &HFFAAAAFF
Do
    m = (m + 1) Mod ubX
    Cls
    For y = 0 To ubY
        If y Mod 2 = 0 Then xoffset! = .5 * xspacing! Else xoffset! = 0
        For x = 0 To ubX
            b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing! - 20
            b(x, y).y = y * yspacing! + .5 * yspacing! - 20
            If Rnd < .002 Then b(x, y).flipping = 1
            showCell x, y
        Next
    Next
    _Display
    _Limit 60
Loop

Sub showCell (c, r)
    If b(c, r).flipping Then b(c, r).a = b(c, r).a + _Pi(1 / 90)
    If b(c, r).a >= _Pi(1 / 3) Then
        b(c, r).flipping = 0: b(c, r).a = 0
        If b(c, r).flipped Then b(c, r).flipped = 0 Else b(c, r).flipped = 1
    End If
    If b(c, r).flipped Then
        For a = _Pi(1 / 6) To _Pi(2) Step _Pi(2 / 3)
            Line (b(c, r).x, b(c, r).y)-Step(cellR * Cos(a + b(c, r).a), cellR * Sin(a + b(c, r).a))
        Next
    Else
        For a = _Pi(.5) To _Pi(2) Step _Pi(2 / 3)
            Line (b(c, r).x, b(c, r).y)-Step(cellR * Cos(a + b(c, r).a), cellR * Sin(a + b(c, r).a))
        Next
    End If
End Sub

It inspired a new drawing tool.

Fascinating!
Dunno how to apply this to a game, but it's a whole new area for experimenting in!

[bplus]

hmm... maybe a maze like pin ball machine with these random popup 3 blade flippers swirl a ball down different tracks?

This code used to demo a new drawing tool here: https://qb64phoenix.com/forum/showthread...7#pid29637

[bplus]

bplus Plinko

Code: (Select All)

Option _Explicit
_Title "bplus Plinko" ' b+ 2024-11-08
' from
' Bonkers Symphony no 37.bas for QB64 fork (B+=MGA) trans 2017-09-15
' from: Bonkers Symphony Number 37.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-21
' looking at vince version I see I am almost there with this one!
 
Const XMax = 800
Const YMax = 720
Dim Shared BX, BY, BA, BCnt
Randomize Timer
Screen _NewImage(XMax, YMax, 32): _ScreenMove 250, 0
_PrintMode _KeepBackground
Dim gravity, br, speed, pR, maxRow, np, pxo, pyo, row, col
Dim pidx, i, r, j, dx, dy, slotSpace, slot, score
Dim slots(11), s$
gravity = 2.0
slotSpace = XMax / 12
br = 27: speed = 4 'balls
pR = 5: maxRow = 11: np = maxRow * (maxRow + 1) * .5 '   pins
pxo = XMax / (maxRow + 1) 'pin space along x
pyo = YMax / (maxRow + 1) 'pin spacing along y
Dim px(np), py(np)
For row = 3 To maxRow
    For col = 1 To row
        pidx = pidx + 1
        px(pidx) = pxo * col + (maxRow - row) * .5 * pxo
        py(pidx) = pyo * row
    Next
Next
NewBall
While 1
    Line (0, 0)-(_Width, _Height - 48), &HFF333366, BF
    Line (0, _Height - 48)-(_Width, _Height), &HFF008833, BF
    For i = 1 To np 'draw pins
        For r = pR To 1 Step -1
            FC3 px(i), py(i), r, _RGB32(r / pR * 255)
        Next
    Next
    For j = 1 To np 'calc collsions
        If Sqr((BX - px(j)) ^ 2 + (BY - py(j)) ^ 2) < br + pR Then
            BA = _Atan2(BY - py(j), BX - px(j))
            FC3 px(j), py(j), pR, &HFF000000
            Sound 120 + (YMax - py(j)) / YMax * 1000, .25
            Exit For
        End If
    Next
    dx = Cos(BA) * speed: dy = Sin(BA) * speed + gravity '  update ball
    BA = _Atan2(dy, dx)
    BX = BX + Cos(BA) * speed: BY = BY + Sin(BA) * speed ' + 2 * Rnd - 1
    If BX < br Or BX > XMax + br Or BY > YMax + br Then
        slot = Int(BX / slotSpace): slots(slot) = slots(slot) + 1: NewBall
    End If
    For r = br To 1 Step -1
        FC3 BX, BY, r, _RGB32(255 - (r / br) * 160, 0, 0)
    Next
    score = 0
    For i = 0 To 11
        Select Case i
            Case 0: s$ = "  "
            Case 11: s$ = "  "
            Case 1: score = score + slots(1) * 100: s$ = "x100$"
            Case 10: score = score + slots(10) * 100: s$ = "x100$"
            Case 2: score = score + slots(2) * 10: s$ = "x10$"
            Case 9: score = score + slots(9) * 10: s$ = "x10$"
            Case 3: score = score + slots(3) * 2: s$ = "x2$"
            Case 8: score = score + slots(8) * 2: s$ = "x2$"
            Case 4: score = score + slots(4) * 0: s$ = "x0$"
            Case 7: score = score + slots(7) * 0: s$ = "x0$"
            Case 5: score = score + slots(5) * -1: s$ = "x-1$"
            Case 6: score = score + slots(6) * -1: s$ = "x-1$"
        End Select
        _PrintString (i * slotSpace + .5 * slotSpace - 16, _Height - 40), Str$(slots(i))
        _PrintString (i * slotSpace + .5 * slotSpace - 16, _Height - 20), s$
    Next
    _PrintString (30, 30), "Balls:" + Str$(BCnt) + "    Score: $" + _Trim$(Str$(score))
    _Display: _Limit 30
Wend
 
Sub NewBall
    BX = XMax / 2 + 10 * Rnd - 5: BY = 0 - Rnd * 20: BCnt = BCnt + 1
    BA = _Pi(.5) + _Pi(2 / 90) * Rnd - _Pi(.9999 / 90)
End Sub
 
Sub FC3 (cx As Long, cy As Long, r As Long, clr~&)
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1: x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub