+- 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: Screen Savers (/showthread.php?tid=219)
RE: Screen Savers - bplus - 01-11-2026
Simpler Mystic 2 Now with Number of Poly Points Option: 1 to 9 Points
Code: (Select All)
t$ = "Simpler Mystic 2 (now with points option) d = double on/off, q = 4 on/off,"
t$ = t$ + " spacebar resets color, m = more, l = less, n = new Poly, f = faster,"
t$ = t$ + " s = slower, 1-9 = Poly with digit points": _Title t$
' 2026-01-10 attempt to do Mystic with only one Poly and fades
' 2026-01-11 add number of points option from 1 to 9 points, one aint much but...
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! KEY Instructions !!!!!!!!!!!!!!!!!!!
' d = double ie 2 sets of Polys q = quad ie 4 sets of Polys
' spacebar resets pallet coloring
' m = more triagles by decreasing alpha screen fades
' l = less Polys by increasing alpha in screen fades
' f = faster s = slower
' n = new Poly digits 1 to 9 = number of polygon points to run
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Const xmax = 1280, ymax = 720
Dim Shared pR, pG, pB, cN, NPm1
Randomize Timer: Screen _NewImage(xmax, ymax, 32): _ScreenMove 0, 0
np = 3: NPm1 = np - 1
ReDim Shared X(NPm1), Y(NPm1), DX(NPm1), DY(NPm1), dMode, qMode
dMode = 0: alpha = 35: lim = 10
resetPlasma: newPoly
While _KeyDown(27) = 0
Line (0, 0)-(xmax, ymax), _RGB32(0, 0, 0, alpha), BF
updatePoly
Color &HFFFFFFFF
Locate 1, 1: Print "Poly Points:"; NPm1 + 1,
If qMode Then
Print " Mode: 4 Symmetric Sets",
ElseIf dMode Then
Print " Mode: 2 Symmetric Sets",
Else
Print "Mode: 1 Poly Set",
End If
Print " alpha:"; alpha, " "; "speed:"; lim
_Display
k$ = InKey$: If k$ = " " Then
resetPlasma
ElseIf k$ = "d" Then
Cls: dMode = Not dMode: qMode = 0
ElseIf k$ = "m" Then ' less alpha shows more triantgles
alpha = alpha - 1: If alpha < 1 Then alpha = 1
ElseIf k$ = "l" Then ' more alpha shows less Polys
alpha = alpha + 1: If alpha > 255 Then alpha = 255 ' one Poly
ElseIf k$ = "q" Then
Cls: qMode = Not qMode: dMode = 0
ElseIf k$ = "f" Then
lim = lim + 5: If lim > 250 Then lim = 250
ElseIf k$ = "s" Then
lim = lim - 5: If lim < 5 Then lim = 5
ElseIf k$ = "n" Then
Cls: newPoly
ElseIf k$ <> "" And InStr("123456789", k$) > 0 Then
Cls: np = Asc(k$) - 48: NPm1 = np - 1: ReDim X(NPm1), Y(NPm1), DX(NPm1), DY(NPm1): newPoly
End If
_Limit lim
Wend
Sub newPoly
For i = 0 To NPm1
X(i) = Rnd * xmax: Y(i) = Rnd * ymax: DX(i) = (Rnd * 10 + 1) * rdir: DY(i) = (Rnd * 6 + 1) * rdir
Next
End Sub
Sub updatePoly
changePlasma
For i = 0 To NPm1
If X(i) + DX(i) < 0 Or X(i) + DX(i) >= xmax Then DX(i) = DX(i) * -1
If Y(i) + DY(i) < 0 Or Y(i) + DY(i) >= ymax Then DY(i) = DY(i) * -1
X(i) = X(i) + DX(i): Y(i) = Y(i) + DY(i)
If i > 0 Then
Line (X(i - 1), Y(i - 1))-(X(i), Y(i))
If dMode Then
Line (xmax - X(i - 1), ymax - Y(i - 1))-(xmax - X(i), ymax - Y(i))
ElseIf qMode Then
Line (xmax - X(i - 1), ymax - Y(i - 1))-(xmax - X(i), ymax - Y(i))
Line (X(i - 1), ymax - Y(i - 1))-(X(i), ymax - Y(i))
Line (xmax - X(i - 1), Y(i - 1))-(xmax - X(i), Y(i))
End If
End If
Next
Line (X(NPm1), Y(NPm1))-(X(0), Y(0))
If dMode Then
Line (xmax - X(NPm1), ymax - Y(NPm1))-(xmax - X(0), ymax - Y(0))
ElseIf qMode Then
Line (xmax - X(NPm1), ymax - Y(NPm1))-(xmax - X(0), ymax - Y(0))
Line (X(NPm1), ymax - Y(NPm1))-(X(0), ymax - Y(0))
Line (xmax - X(NPm1), Y(NPm1))-(xmax - X(0), Y(0))
End If
End Sub
Sub changePlasma
cN = cN + 1
Color _RGB(127 + 127 * Sin(pR * .5 * cN), 127 + 127 * Sin(pG * .5 * cN), 127 + 127 * Sin(pB * .5 * cN))
End Sub
Sub resetPlasma ()
pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2
End Sub
Function rdir% ()
If Rnd < .5 Then rdir% = -1 Else rdir% = 1
End Function
Yeah! <100 LOC with comments!
RE: Screen Savers - ahenry3068 - 01-11-2026
Me and bplus have been going back and forth on the GotBASIC DISCORD with this. So Here's my newer blingier version.
RE: Screen Savers - bplus - 01-11-2026
+1 Yes don't accept the default options, pick red white and blue and national anthem, is my suggestion for ahenry3068 version!
RE: Screen Savers - ahenry3068 - 01-11-2026
And added a U.S. Navy Blue & Gold Color scheme too. !
RE: Screen Savers - bplus - 01-13-2026
Simpler Mystic 3 try image
This code, screenshot and zip have been updated 2 hours after original post. I wanted to keep in spirit of Mystic with the multiple frames fading.
Code: (Select All)
t$ = "Simpler Mystic 3 try image d = double on/off, q = 4 on/off,"
t$ = t$ + " spacebar resets color, m = more, l = less, n = new Poly, f = faster,"
t$ = t$ + " s = slower": _Title t$
_Title t$
' 2026-01-10 attempt to do Mystic with only one Poly and fades
' 2026-01-11 add number of points option from 1 to 9 points, one aint much but...
' 2026-01-12 Simpler Mystic 3 now try an image using a 4 point Poly
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! KEY Instructions !!!!!!!!!!!!!!!!!!!
' d = double ie 2 sets of Polys
' q = quad ie 4 sets of Polys
' f = faster s = slower
' m = more, l = less image Polys
' n = new Poly
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Const xmax = 1280, ymax = 720
Dim Shared pR, pG, pB, cN, NPm1, Img
Randomize Timer: Screen _NewImage(xmax, ymax, 32): _ScreenMove 0, 10
I$ = "Doyle Spirals.PNG" ' <<<<<<<<<<<< OR try your own image here!
Img = _LoadImage(I$, 32)
If Img = -1 Then Print "Image did not load, so sorry, goodbye!": End
_ClearColor &HFF000000, Img
np = 4: NPm1 = np - 1
ReDim Shared X(NPm1), Y(NPm1), DX(NPm1), DY(NPm1), dMode, qMode
dMode = 0: alpha = 35: lim = 10
resetPlasma: newPoly
While _KeyDown(27) = 0
Line (0, 0)-(xmax, ymax), _RGB32(0, 0, 0, alpha), BF
updatePoly
Color &HFFFFFFFF
Locate 1, 1
If qMode Then
Print " Mode: 4 Symmetric Sets",
ElseIf dMode Then
Print " Mode: 2 Symmetric Sets",
Else
Print "Mode: 1 Poly Set",
End If
Print " alpha:"; alpha, "speed:"; lim
_Display
k$ = InKey$
If k$ = "d" Then
Cls: dMode = Not dMode: qMode = 0
ElseIf k$ = "q" Then
Cls: qMode = Not qMode: dMode = 0
ElseIf k$ = "f" Then
lim = lim + 5: If lim > 120 Then lim = 120
ElseIf k$ = "s" Then
lim = lim - 5: If lim < 5 Then lim = 5
ElseIf k$ = "m" Then ' less alpha shows more triantgles
alpha = alpha - 1: If alpha < 1 Then alpha = 1
ElseIf k$ = "l" Then ' more alpha shows less Polys
alpha = alpha + 1: If alpha > 255 Then alpha = 255 ' one Poly
ElseIf k$ = "n" Then
Cls: newPoly
End If
_Limit lim
Wend
Sub newPoly
For I = 0 To NPm1
X(I) = Rnd * xmax: Y(I) = Rnd * ymax: DX(I) = (Rnd * 10 + 10) * rdir: DY(I) = (Rnd * 6 + 10) * rdir
Next
End Sub
Sub updatePoly
changePlasma
For I = 0 To NPm1
If X(I) + DX(I) < 0 Or X(I) + DX(I) >= xmax Then DX(I) = DX(I) * -1
If Y(I) + DY(I) < 0 Or Y(I) + DY(I) >= ymax Then DY(I) = DY(I) * -1
X(I) = X(I) + DX(I): Y(I) = Y(I) + DY(I)
Next
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(X(0), Y(0))-(X(1), Y(1))-(X(2), Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(X(2), Y(2))-(X(3), Y(3))-(X(0), Y(0)), 0
If dMode Then
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(xmax - X(0), ymax - Y(0))-(xmax - X(1), ymax - Y(1))-(xmax - X(2), ymax - Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(xmax - X(2), ymax - Y(2))-(xmax - X(3), ymax - Y(3))-(xmax - X(0), ymax - Y(0)), 0
ElseIf qMode Then
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(xmax - X(0), ymax - Y(0))-(xmax - X(1), ymax - Y(1))-(xmax - X(2), ymax - Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(xmax - X(2), ymax - Y(2))-(xmax - X(3), ymax - Y(3))-(xmax - X(0), ymax - Y(0)), 0
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(X(0), ymax - Y(0))-(X(1), ymax - Y(1))-(X(2), ymax - Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(X(2), ymax - Y(2))-(X(3), ymax - Y(3))-(X(0), ymax - Y(0)), 0
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(xmax - X(0), Y(0))-(xmax - X(1), Y(1))-(xmax - X(2), Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(xmax - X(2), Y(2))-(xmax - X(3), Y(3))-(xmax - X(0), Y(0)), 0
End If
End Sub
Sub changePlasma
cN = cN + 1
Color _RGB(127 + 127 * Sin(pR * .5 * cN), 127 + 127 * Sin(pG * .5 * cN), 127 + 127 * Sin(pB * .5 * cN))
End Sub
Sub resetPlasma ()
pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2
End Sub
Function rdir% ()
If Rnd < .5 Then rdir% = -1 Else rdir% = 1
End Function
The image being manipulated is this:
zip with image used in screen shot: