Mystic memories for QB64
#1
This might bring back old memories:
Code:
_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...

RANDOMIZE TIMER
CONST xmax = 1100
CONST ymax = 700

TYPE point
    x AS INTEGER
    y AS INTEGER
    dx AS SINGLE
    dy AS SINGLE
END TYPE
COMMON SHARED pR, pG, pB, cN
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE (_DESKTOPWIDTH - xmax) / 2, (_DESKTOPHEIGHT - ymax) / 2 '_MIDDLE does not work?

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 1
    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
    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 * .1 * cN), 127 + 127 * SIN(pG * .1 * cN), 127 + 127 * SIN(pB * .1 * 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
B += x
Reply
#2
Could be used as a screen saver, nudge, nudge, wink, wink....

Very cool.

J
May your journey be free of incident.

Live long and prosper.
Reply
#3
Johnno, you never encountered this classic screen saver 20-30 years ago?

It's almost as famous as the flying toasters, which inspired Pink Floyd's flying pigs. (here is how fake news gets started, ... well it could have happened like that!)

Which came first: flying toasters or flying pigs?

Now that I think about it, flying pigs beat out flying toasters by a long shot (just like eggs beat chickens in first priority). The expression "when pigs fly" must have come at least from the 1800's...

wait... there is still hope for flying toasters if you believe in Ancient Aliens! Big Grin
B += x
Reply
#4
Ah... You need to hone your skills for detecting sarcasm... lol... Of course I recognized the screensave... lol I've been around a lot longer than that beastie... lol  Still... I think YOUR version, with mods and all, is WAY better than that of Micro$oft....

Flying toasters... Hmm...

Time for coffee... (When isn't it?  lol)

J
May your journey be free of incident.

Live long and prosper.
Reply