Screen Savers

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