## ellipse.pkg
# Compiled by:
# src/lib/x-kit/draw/xkit-draw.sublib# Code for producing rotated ellipses.
#
# Based on an ellipse generator, written by James Tough, 7th May 92
package ellipse
: (weak) Ellipse # Ellipse is from src/lib/x-kit/draw/ellipse.api{
package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkg exception BAD_AXIS;
fun round x
=
if (x > 0.0)
floor (x+0.5);
else -1 * floor (-x + 0.5); fi;
fun do_ellipse (xg::POINT { col=>center_x, row=>center_y }, radius_x, radius_y, angle)
=
loop ([firstp], [make_point (d, 0)], [], [firstp], 1, c3', c2, v1 + c6)
where
a = real radius_x;
b = real radius_y;
cphi = math::cos angle;
sphi = math::sin angle;
cphisqr = cphi*cphi;
sphisqr = sphi*sphi;
asqr = a*a;
bsqr = b*b;
cphisphi = cphi*sphi;
c1 = (cphisqr//asqr)+(sphisqr//bsqr);
c2 = ((cphi*sphi//asqr)-(cphi*sphi//bsqr))//c1;
c3 = (bsqr*cphisqr) + (asqr*sphisqr);
c4 = a * b // c3;
fun make_point (x, y)
=
xg::POINT { col => center_x + round x,
row => center_y + y
};
# ymax = truncate (sqrt c3)
v1 = c4 * c4;
c6 = v1 + v1;
c3' = c3 * v1 - v1;
d = c4 * (math::sqrt c3);
firstp = make_point(-d, 0);
fun flip_on ( [], l) => l;
flip_on (i ! rest, l) => flip_on (rest, i ! l);
end;
fun merge (l1, l2, l3, l4)
=
flip_on (l1, l2 @ (flip_on (l3, l4)));
fun loop (l1, l2, l3, l4, y, c3, c5, v1)
=
if (c3 < 0.0)
#
merge (l1, l2, l3, l4);
else
d = math::sqrt c3;
xleft = c5 - d;
xright = c5 + d;
loop (
make_point (xleft, y) ! l1,
make_point (xright, y) ! l2,
make_point(-xleft, -y) ! l3,
make_point(-xright, -y) ! l4,
y + 1,
c3 - v1,
c5 + c2,
v1 + c6
);
fi;
end; # fun do_ellipse
# ellipse (pt, a, b, phi) produces a list of points
# describing the ellipse x^2 // a^2 + y^2 // b^2 = 1
# translated to point pt and rotated phi radians
# counterclockwise. If a = 0 or b = 0, it returns [].
# Raises BAD_AXIS if a < 0 or b < 0.
#
fun ellipse (arg as (_, radius_x, radius_y, _))
=
if (radius_x < 0 or radius_y < 0)
raise exception BAD_AXIS;
else
if (radius_x == 0 or radius_y == 0) [];
else do_ellipse arg;
fi;
fi;
}; # Ellipse