(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 Sub
Also changed your way of mouse polling to single line loop to update mouse position and buttons.
b = b + ...