07-10-2023, 06:31 AM
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