RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on September 30, 2017, 01:13:32 PM
-
This is all from memory, I tried to look up Mystic Screen saver and got nowhere... so I might have the name wrong.
SmallBASIC version:
' Mystic memories.bas SmallBASIC 0.12.9 (B+=MGA) 2017-09-29
' I modified from my posted 2017-09-29 for QB64
' Mystic screen saver as I remember it plus...
option predef antialias off 'runs faster (or smoother) might improve image
randomize timer
dim x(2), y(2), dx(2), dy(2)
for i = 0 to 2
newPoint i
next
saveX = x : saveY = y : saveDX = dx : saveDY = dy
dmode = 1 : nT = 50
resetPlasma
while 1
cls
color 11
? " Number of triangles = ";nT;" press m for more, l for less,"
? " spacebar to change color, d for duplicate image toggle."
cN = cN - nT + 1
x = saveX : y = saveY : dx = saveDX : dy = saveDY
for i = 0 to 2
updatePoint i
next
saveX = x : saveY = y : saveDX = dx : saveDY = dy
for j = 1 to nT
for i = 0 to 2
updatePoint i
next
changePlasma
for i = 0 to 2
line x(i), y(i), x((i+1) mod 3), y((i+1) mod 3)
next
if dmode = 1 then
for i = 0 to 2
line xmax - x(i), ymax - y(i), xmax - x((i+1) mod 3), ymax - y((i+1) mod 3)
next
end if
next
showpage
delay 10
k = inkey
if k = " " then
resetPlasma
elif k = "d"
dmode = not dmode
elif k = "m"
nT = nT + 1: if nT > 100 then nT = 100
elif k = "l"
nT = nT - 1: if nT < 1 then nT = 1
fi
wend
sub newPoint(p)
x(p) = RND * xmax
y(p) = RND * ymax
dx(p) = (RND * 10 + 1) * rdir
dy(p) = (RND * 6 + 1) * rdir
end
sub updatePoint(p)
if x(p) + dx(p) < 0 then dx(p) = -dx(p)
if y(p) + dy(p) < 40 then dy(p) = -dy(p)
if x(p) + dx(p) > xmax then dx(p) = -dx(p)
if y(p) + dy(p) > ymax - 40 then dy(p) = -dy(p)
x(p) = x(p) + dx(p)
y(p) = y(p) + dy(p)
end
sub changePlasma ()
cN = cN + 1
color rgb(127 + 127 * sin(pR * .2 * cN), 127 + 127 * sin(pG * .2 * cN), 127 + 127 * sin(pB * .2 * cN))
end
sub resetPlasma ()
pR = rnd ^ 2: pG = rnd ^ 2: pB = rnd ^ 2
end
func rdir()
IF rnd < .5 THEN rdir = -1 ELSE rdir = 1
end
QB64 version (which you might see, no great difference in PL):
_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
Maybe you guys have a favorite cloned from the past?
-
yeah, something from some version of mac os.
import "ifx.lib"
import "Speed.lib"
constant:
W 800
H 600
HW# 400.0
HH# 300.0
visible:
curves?[6]
particles?[500]
hidden:
randomize 3
create image 1, 31, 31
set image 1
set color 0, 0, 0
cls
for y = 0 to 30;
dy# = float(y - 15)
dysqr# = dy*dy
for x = 0 to 30
dx# = float(x - 15)
d# = sqr(dx*dx + dysqr)
if d < 15.0
c = int(32.0*(1.0 - d/15.0))
set color c, c, c
set pixel x, y
endif
next
next
set image primary
set window (screenw() - W)/2, (screenh() - H)/2, W, H
set redraw off
if not IFX_Init() then end
for i = 0 to sizeof(curves) - 1
_InitCurve curves[i]
next
for i = 0 to sizeof(particles) - 1
particles[i].c = -1
next
tick = 0
do
tick = tick + 1
for i = 0 to sizeof(curves) - 1
_UpdateCurve curves[i]
if tick%6 = i
_AddParticle i
endif
next
last = sizeof(particles) - 1
for i = 0 to last
if particles[i].c >= 0
particles[i].p# = particles[i].p# + 0.00225
if particles[i].p# > 1.0
particles[i].c = -1
endif
endif
next
set color 0, 0, 0, 16; cls
_IFX_Blur 16
_DrawParticles
redraw
_SPD_HoldFrame 60
until keydown(27, true)
procedure InitCurve(&curve?)
curve.x0# = HW
curve.y0# = HH
curve.d1# = 100.0 + float(rnd(300))
curve.a1# = float(rnd(360))
curve.x1# = HW + cos(curve.a1#)*curve.d1#
curve.y1# = HH + sin(curve.a1#)*curve.d1#
curve.s1# = float(rnd(100) - 50)*0.02
curve.d2# = 300.0 + float(rnd(300))
curve.a2# = float(rnd(360))
curve.x2# = HW + cos(curve.a2#)*curve.d2#
curve.y2# = HH + sin(curve.a2#)*curve.d2#
curve.s2# = float(rnd(100) - 50)*0.02
curve.d3# = 300.0 + float(rnd(300))
curve.a3# = float(rnd(360))
curve.x3# = HW + cos(curve.a3#)*curve.d3#
curve.y3# = HH + sin(curve.a3#)*curve.d3#
curve.s3# = float(rnd(100) - 50)*0.02
endproc
procedure UpdateCurve(&curve?)
curve.a1# = curve.a1# + curve.s1#
curve.x1# = HW + cos(curve.a1#)*curve.d1#
curve.y1# = HH + sin(curve.a1#)*curve.d1#
curve.a2# = curve.a2# + curve.s2#
curve.x2# = HW + cos(curve.a2#)*curve.d2#
curve.y2# = HH + sin(curve.a2#)*curve.d2#
curve.a3# = curve.a3# + curve.s3#
curve.x3# = HW + cos(curve.a3#)*curve.d3#
curve.y3# = HH + sin(curve.a3#)*curve.d3#
endproc
procedure EvaluateCurve(&curve?, p#, &x#, &y#)
ip# = 1.0 - p
a# = ip*ip*ip
b# = 3.0*ip*ip*p
c# = 3.0*ip*p*p
d# = p*p*p
x = a*curve.x0# + b*curve.x1# + c*curve.x2# + d*curve.x3#
y = a*curve.y0# + b*curve.y1# + c*curve.y2# + d*curve.y3#
endproc
' debug.
procedure PlotCurve(&curve?, points)
step# = 1.0/float(points)
p# = 0.0
x#; y#
for i = 0 to points - 1
_EvaluateCurve curve, p, x, y
set pixel int(x), int(y)
p = p + step
next
endproc
procedure AddParticle(index)
last = sizeof(particles) -1
for i = 0 to last
if particles[i].c < 0 then break
next
if i <= last
particles[i].c = index
particles[i].p# = 0.0
endif
endproc
procedure DrawParticles()
last = sizeof(particles) - 1
set additive true
for i = 0 to last
if particles[i].c >= 0
alpha = int((1.0 - particles[i].p#)*255.0)
set color 64, 128, 255, alpha
x#; y#
_EvaluateCurve curves[particles[i].c], particles[i].p#, x, y
'draw pixel int(x), int(y)
draw image 1, int(x), int(y)
endif
next
set additive false
endproc
-
B+ : Mystify.
-
Hi D
Mystify, yeah! that's it. Thanks
Hi Marcus,
Yeah, I saw that at Naalaa, nice - more modern looking that Mystify. I don't remember your saying it was a screen saver from the past. I did try out the code and maybe that did plant the thought of trying to recreate my own clone of a favorite.
Well maybe your past does not go as far back as mine. Do you remember ever typing up a program on punch cards and having to wait a day or so only to find out you had a typo from your blank printout? ...just Big Macs then.
-
Nah, got my first computer in 1991 or st, an Amiga :) I'm in the mobile phone business, so yesterday is "past" for me :)
-
Brings back old memories indeed :) Trying to stick to the Qb64 code as much as possible.
'_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...
'Ported to BaCon - GIF version, so no keyboard interaction - PvE
INCLUDE canvas-gd
DEF FN RAND = (float)RND/MAXRANDOM
CONST xmax = 400
CONST ymax = 300
RECORD dot
LOCAL x TYPE int
LOCAL y TYPE int
LOCAL dx TYPE short
LOCAL dy TYPE short
END RECORD
DECLARE pR, pG, pB, cN TYPE FLOATING
WINDOW("Mystic", xmax, ymax)
DECLARE tri[3] TYPE dot_type
FOR i = 0 TO 2
tri[i] = newPoint()
NEXT
DECLARE saveP1 TYPE dot_type
DECLARE saveP2 TYPE dot_type
DECLARE saveP3 TYPE dot_type
saveP1 = tri[0]: saveP2 = tri[1]: saveP3 = tri[2]
dmode = 0: nT = 50
CALL resetPlasma
FRAMES(384)
CALLBACK(20, Redraw)
WAITKEY
SUB Redraw
INK(0,0,0,255):CLS
cN = cN - nT
tri[0] = saveP1: tri[1] = saveP2: tri[2] = saveP3
FOR i = 0 TO 2
CALL updatePoint(&tri[i])
NEXT
saveP1 = tri[0]: saveP2 = tri[1]: saveP3 = tri[2]
FOR j = 1 TO nT
FOR i = 0 TO 2
CALL updatePoint(&tri[i])
NEXT
CALL changePlasma
FOR i = 0 TO 2
LINE (tri[i].x, tri[i].y, tri[MOD(i + 1, 3)].x, tri[MOD(i + 1, 3)].y)
NEXT
IF dmode THEN
FOR i = 0 TO 2
LINE (xmax - tri[i].x, ymax - tri[i].y, xmax - tri[MOD(i + 1, 3)].x, ymax - tri[MOD(i + 1, 3)].y)
NEXT
END IF
NEXT
END SUB
FUNCTION newPoint TYPE dot_type
LOCAL p TYPE dot_type
p.x = RAND * xmax
p.y = RAND * ymax
p.dx = (RAND * 10 + 1) * rdir
p.dy = (RAND * 6 + 1) * rdir
RETURN p
ENDFUNCTION
SUB updatePoint (dot_type *p)
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
INK(127 + 127 * SIN(pR * .1 * cN), 127 + 127 * SIN(pG * .1 * cN), 127 + 127 * SIN(pB * .1 * cN), 255)
END SUB
SUB resetPlasma ()
pR = POW(RAND, 2): pG = POW(RAND, 2): pB = POW(RAND, 2)
END SUB
DEF FN rdir = IIF(RAND < .5, -1, 1)
(http://basic-converter.org/canvas/mystic.gif)