(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.
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever