Screen Savers

[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: