+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Proggies (/showthread.php?tid=162)
RE: Proggies - NakedApe - 10-02-2024
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...
RE: Proggies - Dav - 10-03-2024
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 'distortRE: Proggies - bplus - 10-03-2024
I think I like spiral twist best.
RE: Proggies - Dav - 10-03-2024
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!RE: Proggies - madscijr - 10-07-2024
(10-03-2024, 11:04 PM)Dav Wrote: Here's a few more, that's about all I think.I wanted to see all the variations so this version lets you cycle through them by pressing the "a" key...
- 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!
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%RE: Proggies - bplus - 10-07-2024
Wow we can try everything!Here is a cool interferrence pattern I ran into:
RE: Proggies - bplus - 11-01-2024
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 SubIt inspired a new drawing tool.
See here: https://qb64phoenix.com/forum/showthread.php?tid=272&pid=29637#pid29637
RE: Proggies - PhilOfPerth - 11-01-2024
(11-01-2024, 09:28 PM)bplus Wrote: 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!
RE: Proggies - bplus - 11-01-2024
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.php?tid=272&pid=29637#pid29637
RE: Proggies - bplus - 11-09-2024
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