Screen Savers

[bplus]

Screen Savers - you are welcome to post your own favorites in this thread!
________________________________________________________________________________________________

Pete's post of The Bob's Mystic version of a Screen Saver brought back memories of my own version and even today I continue to Modify. I didn't want to go Full Screen on this one because the Title bar has help for keys you can press to play with screen saver a bit add or subtract triangles, draw a mirror image and not toggle, change color scheme (Plasma of Course!)

Code: (Select All)

_Title "Mystic Memories by bplus, d toggles duplicate on/off, spacebar resets color, m = more, l = less triangles"
'posted 2017-09-29 for QB64, Mystic screen saver as I remember it plus...
' 2022-04-26 fix up a few things for post
Randomize Timer
Const xmax = 1280
Const ymax = 720

Type point
    x As Integer
    y As Integer
    dx As Single
    dy As Single
End Type
Common Shared pR, pG, pB, cN
Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 60, 0

Dim tri(2) As point
For i = 0 To 2
    newPoint tri(i)
Next
Dim saveP1 As point
Dim saveP2 As point
Dim saveP3 As point
saveP1 = tri(0): saveP2 = tri(1): saveP3 = tri(2)
dmode = 0: nT = 50
resetPlasma
While _KeyDown(27) = 0
    Cls , 0
    cN = cN - nT
    tri(0) = saveP1: tri(1) = saveP2: tri(2) = saveP3
    For i = 0 To 2
        updatePoint tri(i)
    Next
    saveP1 = tri(0): saveP2 = tri(1): saveP3 = tri(2)
    For j = 1 To nT
        For i = 0 To 2
            updatePoint tri(i)
        Next
        changePlasma
        For i = 0 To 2
            Line (tri(i).x, tri(i).y)-(tri((i + 1) Mod 3).x, tri((i + 1) Mod 3).y)
        Next
        If dmode Then
            For i = 0 To 2
                Line (xmax - tri(i).x, ymax - tri(i).y)-(xmax - tri((i + 1) Mod 3).x, ymax - tri((i + 1) Mod 3).y)
            Next
        End If
    Next
    _Display

    'The following commented code worked (works) like a charm
    k$ = InKey$
    If k$ = " " Then
        resetPlasma
    ElseIf k$ = "d" Then
        dmode = Not dmode
    ElseIf k$ = "m" Then
        nT = nT + 1: If nT > 500 Then nT = 500
    ElseIf k$ = "l" Then
        nT = nT - 1: If nT < 1 Then nT = 1
    End If

    _Limit 10
Wend

Sub newPoint (p As point)
    p.x = Rnd * xmax
    p.y = Rnd * ymax
    p.dx = (Rnd * 10 + 1) * rdir
    p.dy = (Rnd * 6 + 1) * rdir
End Sub

Sub updatePoint (p As point)
    If p.x + p.dx < 0 Then p.dx = p.dx * -1
    If p.y + p.dy < 0 Then p.dy = p.dy * -1
    If p.x + p.dx > xmax Then p.dx = p.dx * -1
    If p.y + p.dy > ymax Then p.dy = p.dy * -1
    p.x = p.x + p.dx
    p.y = p.y + p.dy
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

---

A similar thing with rectangles but not as elegant I think:

Code: (Select All)

_Title " *** Screen Saver #3 - Mystic Rectangles *** " ' by bplus 2018-03-01
' 2022-04-26 a couple mod before posting again use full screen and alpha coloring

' translated from
' Screen Saver #3 Mystic Rectangles.bas SmallBASIC 0.12.11 (B+=MGA) 2018-02-28
' instead of wire frame triangles try solid color rectangles
' arrays? we don't need no dang arrays!
' oh to share everything use GOSUBs instead of SUBs

'====================================================================================

'                  spacebar will switch the color scheme

'====================================================================================

Randomize Timer
Const xmax = 1024
Const ymax = 572
Screen _NewImage(xmax, ymax, 32)
'_ScreenMove 100, 20
_FullScreen
nT = 50 'number of Things per screen
GoSub newRect
savex1 = x1: savey1 = y1: savedx1 = dx1: savedy1 = dy1
savex2 = x2: savey2 = y2: savedx2 = dx2: savedy2 = dy2
cN = nT
GoSub resetPlasma
While _KeyDown(27) = 0
    Cls

    'reset color Number back to beginning + 1
    cN = cN - nT + 1

    'reset rect back to beginning and then update it once and save this for next round
    x1 = savex1: y1 = savey1: dx1 = savedx1: dy1 = savedy1
    x2 = savex2: y2 = savey2: dx2 = savedx2: dy2 = savedy2
    GoSub updateRect
    savex1 = x1: savey1 = y1: savedx1 = dx1: savedy1 = dy1
    savex2 = x2: savey2 = y2: savedx2 = dx2: savedy2 = dy2

    For j = 1 To nT
        GoSub updateRect
        GoSub changePlasma
        Line (x1 - 12, y1 - 7)-(x2, y2), , B
        'inverse image and color
        xx1 = xmax - x1: yy1 = ymax - y1
        xx2 = xmax - x2: yy2 = ymax - y2
        If xx1 > xx2 Then Swap xx1, xx2
        If yy1 > yy2 Then Swap yy1, yy2
        Line (xx1 - 12, yy1 - 7)-(xx2, yy2), invColor&&, B
    Next
    _Display
    _Limit 60
    'k$ = InKey$
    'If k$ = " " Then GoSub resetPlasma
    If _KeyDown(32) Then GoSub resetPlasma
Wend
System

newRect:
x1 = Rnd * xmax
y1 = Rnd * ymax
dx1 = (Rnd * 9 + 3) * rdir
dy1 = (Rnd * 5 + 2) * rdir
x2 = Rnd * xmax
y2 = Rnd * ymax
dx2 = (Rnd * 9 + 3) * rdir
dy2 = (Rnd * 5 + 2) * rdir
'keep x1, y1 the lesser corner and x2, y2 the greater
If x1 > x2 Then Swap x1, x2: Swap dx1, dx2
If y1 > y2 Then Swap y1, y2: Swap dy1, dy2
Return

updateRect:
If x1 + dx1 < 0 Then dx1 = -dx1
If x1 + dx1 > xmax Then dx1 = -dx1
x1 = x1 + dx1
If y1 + dy1 < 0 Then dy1 = -dy1
If y1 + dy1 > ymax Then dy1 = -dy1
y1 = y1 + dy1
If x2 + dx2 < 0 Then dx2 = -dx2
If x2 + dx2 > xmax Then dx2 = -dx2
x2 = x2 + dx2
If y2 + dy2 < 0 Then dy2 = -dy2
If y2 + dy2 > ymax Then dy2 = -dy2
y2 = y2 + dy2
'keep x1, y1 the lesser corner and x2, y2 the greater
If x1 > x2 Then Swap x1, x2: Swap dx1, dx2
If y1 > y2 Then Swap y1, y2: Swap dy1, dy2
Return

changePlasma:
cN = cN + 1
Color _RGB32(127 + 127 * Sin(pR * .5 * cN), 127 + 127 * Sin(pG * .5 * cN), 127 + 127 * Sin(pB * .5 * cN))
invColor&& = _RGB32(255 - (127 + 127 * Sin(pR * .5 * cN)), 255 - (127 + 127 * Sin(pG * .5 * cN)), 255 - (127 + 17 * Sin(pB * .5 * cN)))
Return

resetPlasma:
pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2
Return

Function rdir ()
    If Rnd < .5 Then rdir = -1 Else rdir = 1
End Function