+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Updated old Googly Eyes screen saver (/showthread.php?tid=1828)
Pages:
1
2
RE: Updated old Googly Eyes screen saver - bplus - 07-10-2023
(07-10-2023, 06:31 AM)vince Wrote: I have attempted a similar mod a long time ago, bplus, but I was incapable of getting it to work correctly as it can be challenging
Code: (Select All)$resize:on
deflng a-z
sw = 640
sh = 600
screen _newimage(sw,sh,32),,1,0
line (0,0)-(sw,sh),_rgb(255,255,255),bf
ellipsef sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef 3*sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
ellipsef 3*sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
screen ,,0,0
dim a as double, b as double
do
do
mx = _mousex
my = _mousey
loop while _mouseinput
if _resize then
sw = _resizewidth
sh = _resizeheight
screen ,,1,0
line (0,0)-(sw,sh),_rgb(255,255,255),bf
ellipsef sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef 3*sw/4, sh/2, 0.9*sw/4, 0.9*sh/2, _rgb(0,0,0)
ellipsef sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
ellipsef 3*sw/4, sh/2, 0.8*sw/4, 0.8*sh/2, _rgb(255,255,255)
screen ,,0,0
end if
pcopy 1,0
a = _atan2(sh/2 - my, sw/4 - mx)
b = _atan2(sh/2 - my, 3*sw/4 - mx)
x1 = sw/4 - 0.5*sw*cos(a)/4
y1 = sh/2 - 0.5*sh*sin(a)/2
if abs(sw/4-mx) < 0.5*sw/4 or abs(sh/2-my) < 0.5*sh/2 then
x1 = mx
y1 = my
end if
x2 = 3*sw/4 - 0.5*sw*cos(b)/4
y2 = sh/2 - 0.5*sh*sin(b)/2
if abs(3*sw/4-mx) < 0.5*sw/4 or abs(sh/2-my) < 0.5*sh/2 then
x2 = mx
y2 = my
end if
ellipsef x1, y1, 0.2*sw/4, 0.2*sh/2, _rgb(0,0,0)
ellipsef x2, y2, 0.2*sw/4, 0.2*sh/2, _rgb(0,0,0)
_display
loop until _keyhit = 27
system
sub ellipsef (x0, y0, rx, ry, c)
a = 2*rx*rx
b = 2*ry*ry
x = rx
y = 0
xx = ry*ry*(1 - 2*rx)
yy = rx*rx
e = 0
sx = b*rx
sy = 0
do while sx >= sy
line (x0 - x, y0 + y)-(x0 + x, y0 + y), c, bf
line (x0 - x, y0 - y)-(x0 + x, y0 - y), c, bf
y = y + 1
sy = sy + a
e = e + yy
yy = yy + a
if 2*e + xx > 0 then
x = x - 1
sx = sx - b
e = e + xx
xx = xx + b
end if
loop
x = 0
y = ry
xx = rx*ry
yy = rx*rx*(1 - 2*ry)
e = 0
sx = 0
sy = a*ry
do while sx <= sy
line (x0 - x, y0 - y)-(x0 + x, y0 - y), c, bf
line (x0 - x, y0 + y)-(x0 + x, y0 + y), c, bf
x = x + 1
sx = sx + b
e = e + xx
xx = xx + b
if 2*e + yy > 0 then
y = y - 1
sy = sy - a
e = e + yy
yy = yy + a
end if
loop
end sub
Hey @vince just get rid of the If Abs(... blocks
Code: (Select All)
$Resize:On
DefLng A-Z
sw = 640
sh = 600
Screen _NewImage(sw, sh, 32), , 1, 0
Line (0, 0)-(sw, sh), _RGB(255, 255, 255), BF
ellipsef sw / 4, sh / 2, 0.9 * sw / 4, 0.9 * sh / 2, _RGB(0, 0, 0)
ellipsef 3 * sw / 4, sh / 2, 0.9 * sw / 4, 0.9 * sh / 2, _RGB(0, 0, 0)
ellipsef sw / 4, sh / 2, 0.8 * sw / 4, 0.8 * sh / 2, _RGB(255, 255, 255)
ellipsef 3 * sw / 4, sh / 2, 0.8 * sw / 4, 0.8 * sh / 2, _RGB(255, 255, 255)
Screen , , 0, 0
Dim a As Double, b As Double
Do
Do: Loop While _MouseInput
mx = _MouseX
my = _MouseY
If _Resize Then
sw = _ResizeWidth
sh = _ResizeHeight
Screen , , 1, 0
Line (0, 0)-(sw, sh), _RGB(255, 255, 255), BF
ellipsef sw / 4, sh / 2, 0.9 * sw / 4, 0.9 * sh / 2, _RGB(0, 0, 0)
ellipsef 3 * sw / 4, sh / 2, 0.9 * sw / 4, 0.9 * sh / 2, _RGB(0, 0, 0)
ellipsef sw / 4, sh / 2, 0.8 * sw / 4, 0.8 * sh / 2, _RGB(255, 255, 255)
ellipsef 3 * sw / 4, sh / 2, 0.8 * sw / 4, 0.8 * sh / 2, _RGB(255, 255, 255)
Screen , , 0, 0
End If
PCopy 1, 0
a = _Atan2(sh / 2 - my, sw / 4 - mx)
b = _Atan2(sh / 2 - my, 3 * sw / 4 - mx)
x1 = sw / 4 - 0.5 * sw * Cos(a) / 4
y1 = sh / 2 - 0.5 * sh * Sin(a) / 2
x2 = 3 * sw / 4 - 0.5 * sw * Cos(b) / 4
y2 = sh / 2 - 0.5 * sh * Sin(b) / 2
ellipsef x1, y1, 0.2 * sw / 4, 0.2 * sh / 2, _RGB(0, 0, 0)
ellipsef x2, y2, 0.2 * sw / 4, 0.2 * sh / 2, _RGB(0, 0, 0)
_Display
Loop Until _KeyHit = 27
System
Sub ellipsef (x0, y0, rx, ry, c)
a = 2 * rx * rx
b = 2 * ry * ry
x = rx
y = 0
xx = ry * ry * (1 - 2 * rx)
yy = rx * rx
e = 0
sx = b * rx
sy = 0
Do While sx >= sy
Line (x0 - x, y0 + y)-(x0 + x, y0 + y), c, BF
Line (x0 - x, y0 - y)-(x0 + x, y0 - y), c, BF
y = y + 1
sy = sy + a
e = e + yy
yy = yy + a
If 2 * e + xx > 0 Then
x = x - 1
sx = sx - b
e = e + xx
xx = xx + b
End If
Loop
x = 0
y = ry
xx = rx * ry
yy = rx * rx * (1 - 2 * ry)
e = 0
sx = 0
sy = a * ry
Do While sx <= sy
Line (x0 - x, y0 - y)-(x0 + x, y0 - y), c, BF
Line (x0 - x, y0 + y)-(x0 + x, y0 + y), c, BF
x = x + 1
sx = sx + b
e = e + xx
xx = xx + b
If 2 * e + yy > 0 Then
y = y - 1
sy = sy - a
e = e + yy
yy = yy + a
End If
Loop
End SubAlso changed your way of mouse polling to single line loop to update mouse position and buttons.