QB64 Phoenix Edition › QB64 Rising › Prolific Programmers › bplus v
Screen Savers

Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Threaded Mode
Screen Savers
bplus Offline
Mini-Mod
***
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation: 322
#71
01-11-2026, 11:44 AM (This post was last modified: 01-11-2026, 12:26 PM by bplus.)
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! Smile
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Find
Reply
ahenry3068 Offline
Member
***
Posts: 243
Threads: 15
Joined: Apr 2024
Reputation: 30
#72
01-11-2026, 02:35 PM (This post was last modified: 01-11-2026, 02:36 PM by ahenry3068.)
Me and bplus have been going back and forth on the GotBASIC DISCORD with this.   So Here's my newer blingier version.    Smile


Attached Files
.zip   Mystify.zip (Size: 2.42 MB / Downloads: 10)
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation: 322
#73
01-11-2026, 03:15 PM
+1 Yes don't accept the default options, pick red white and blue and national anthem, is my suggestion for ahenry3068 version!
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Find
Reply
ahenry3068 Offline
Member
***
Posts: 243
Threads: 15
Joined: Apr 2024
Reputation: 30
#74
01-11-2026, 09:58 PM
And added a U.S. Navy    Blue & Gold Color scheme too.   !


Attached Files
.zip   Mystify.zip (Size: 3.86 MB / Downloads: 12)
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation: 322
#75
01-13-2026, 12:51 AM (This post was last modified: 01-13-2026, 03:07 AM by bplus.)
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:


Attached Files
.zip   Simpler Mystic 3 Image.zip (Size: 95.87 KB / Downloads: 5)
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Find
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)