## three-d.pkg
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "The competent programmer is fully aware
### of the limited size of his own skull.
### He therefore approaches his task with full humility,
### and avoids clever tricks like the plague."
###
### -- E.J. Dijkstra
stipulate
package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package wb = widget_base; # widget_base is from src/lib/x-kit/widget/basic/widget-base.pkg package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkgherein
package three_d
: (weak) Three_D # Three_D is from src/lib/x-kit/widget/lib/three-d.api {
Relief = FLAT | RAISED | SUNKEN | GROOVE | RIDGE;
fun draw3drect drawable (xg::BOX { col, row, wide, high }, width)
=
{ point_list
=
[ xg::POINT { col, row=>row+high },
xg::POINT { col, row },
xg::POINT { col=>col+wide, row },
xg::POINT { col=>col+wide-width, row=>row+width },
xg::POINT { col=>col+width, row=>row+width },
xg::POINT { col=>col+width, row=>row+high-width },
xg::POINT { col, row=>row+high }
];
r1 = xg::BOX { col, row=>row+high-width, wide, high=>width };
r2 = xg::BOX { col=>col+wide-width, row, wide=>width, high };
dblw = width + width;
if (wide < dblw or high < dblw)
fn _ = ();
else
fn { top, bottom }
=
{
xc::fill_box drawable bottom r1;
xc::fill_box drawable bottom r2;
xc::fill_polygon drawable top
{ verts=>point_list,
shape => xc::NONCONVEX_SHAPE
};
};
fi;
};
fun draw3drect2 drawable (box as (xg::BOX { col, row, wide, high } ), width)
=
{ half_width = width / 2;
half_width' = width - half_width;
outer = draw3drect drawable (box, half_width');
r' = xg::BOX
{ col => col+half_width',
row => row+half_width',
#
wide => wide - 2*half_width',
high => high - 2*half_width'
};
inner = draw3drect drawable (r', half_width);
fn pens = { outer pens; inner { top=> pens.bottom, bottom=> pens.top }; };
};
fun draw_box drawable { box, width, relief }
=
case relief
#
FLAT =>
{ f = draw3drect drawable (box, width);
fn ( { base, ... }: wb::Shades)
=
f { top=>base, bottom=>base };
};
RAISED
=>
{ f = draw3drect drawable (box, width);
fn { light, dark, ... }
=
f { top=>light, bottom=>dark };
};
SUNKEN
=>
{ f = draw3drect drawable (box, width);
fn { light, dark, ... }
=
f { top=>dark, bottom=>light };
};
RIDGE
=>
{ f = draw3drect2 drawable (box, width);
fn { light, dark, ... }
=
f { top=>light, bottom=>dark };
};
GROOVE
=>
{ f = draw3drect2 drawable (box, width);
fn { light, dark, ... }
=
f { top=>dark, bottom=>light };
};
esac;
fun draw_filled_box dr { box, relief=>FLAT, width } shades
=>
xc::fill_box dr shades.base box;
draw_filled_box dr { box, width=>0, relief => _ } shades
=>
xc::fill_box dr shades.base box;
draw_filled_box dr (a as { box=>xg::BOX { col, row, wide, high }, width, ... } ) shades
=>
{ delta = width + width;
box' = xg::BOX { col=>col+width, row=>row+width, wide=>wide - delta, high=>high - delta };
xc::fill_box dr shades.base box';
draw_box dr a shades;
};
end;
fun draw3dround_box drawable { box, width, c_wid, c_ht }
=
{ box -> xg::BOX { col, row, wide, high };
halfwidth = width / 2;
col = col + halfwidth;
row = row + halfwidth;
w = wide - 2*halfwidth;
h = high - 2*halfwidth;
w2 = c_wid+c_wid;
h2 = c_ht+c_ht;
my (ew, ew2) = if (w2 > w ) (0, 0); else (c_wid, w2); fi;
my (eh, eh2) = if (h2 > h ) (0, 0); else (c_ht, h2); fi;
fn { top, bottom }
=
{ top = xc::clone_pen (top, [xc::p::LINE_WIDTH width]);
bottom = xc::clone_pen (bottom,[xc::p::LINE_WIDTH width]);
xc::draw_arcs drawable top
[
xg::ARC { col=> col, row=> row, wide=> ew2, high=> eh2, angle1=> 180*64, angle2=> -90*64 },
xg::ARC { col=> col+ew, row=> row, wide=> w - ew2, high=> 0, angle1=> 180*64, angle2=> -180*64 },
xg::ARC { col=> col, row=> row+eh, wide=> 0, high=> h - eh2, angle1=> 270*64, angle2=> -180*64 },
xg::ARC { col=> col+w - ew2, row=> row, wide=> ew2, high=> eh2, angle1=> 45*64, angle2=> 45*64 },
xg::ARC { col=> col, row=> row+h - eh2, wide=> ew2, high=> eh2, angle1=> 225*64, angle2=> -45*64 }
];
xc::draw_arcs drawable bottom
[
xg::ARC { col=> col+w - ew2, row=> row, wide=> ew2, high=> eh2, angle1=> 45*64, angle2=> -45*64 },
xg::ARC { col=> col+w, row=> row+eh, wide=> 0, high=> h - eh2, angle1=> 90*64, angle2=> -180*64 },
xg::ARC { col=> col+w - ew2, row=> row+h - eh2, wide=> ew2, high=> eh2, angle1=> 0, angle2=> -90*64 },
xg::ARC { col=> col+ew, row=> row+h, wide=> w - ew2, high=> 0, angle1=> 0, angle2=> -180*64 },
xg::ARC { col=> col, row=> row+h - eh2, wide=> ew2, high=> eh2, angle1=> 270*64, angle2=> -45*64 }
];
};
};
fun draw3dround_box2 drawable { box as xg::BOX { col, row, wide, high }, width, c_wid, c_ht }
=
{ half_width = width / 2;
half_width' = width - half_width;
outer = draw3dround_box drawable
{ box, width=>half_width', c_wid, c_ht };
r' = xg::BOX
{ col => col+half_width',
row => row+half_width',
wide => wide - 2*half_width',
high => high - 2*half_width'
};
inner = draw3dround_box drawable
{ box=>r', width=>half_width, c_wid, c_ht };
fn pens = { outer pens; inner { top=> pens.bottom, bottom=> pens.top }; };
};
fun draw_round_box drawable { box, width, c_wid, c_ht, relief }
=
case relief
#
FLAT => { f = draw3dround_box drawable { box, width, c_wid, c_ht };
fn ( { base, ... }: wb::Shades)
=
f { top=>base, bottom=>base };
};
RAISED => { f = draw3dround_box drawable { box, width, c_wid, c_ht };
fn { light, dark, ... }
=
f { top=>light, bottom=>dark };
};
SUNKEN => { f = draw3dround_box drawable { box, width, c_wid, c_ht };
fn { light, dark, ... }
=
f { top=>dark, bottom=>light };
};
RIDGE => { f = draw3dround_box2 drawable { box, width, c_wid, c_ht };
fn { light, dark, ... }
=
f { top=>light, bottom=>dark };
};
GROOVE => { f = draw3dround_box2 drawable { box, width, c_wid, c_ht };
fn { light, dark, ... }
=
f { top=>dark, bottom=>light };
};
esac;
# The table below is used for a quick approximation in
# computing a new point parallel to a given line
# An index into the table is 128 times the slope of the
# original line (the slope must always be between 0.0
# and 1.0). The value of the table entry is 128 times
# the amount to displace the new line in row for each unit
# of perpendicular distance. In other words, the table
# maps from the tangent of an angle to the inverse of
# its cosine. If the slope of the original line is greater
# than 1, then the displacement is done in col rather than in row.
#
shift_table
=
{ fun compute i
=
{ tangent = (real i) // 128.0;
#
f8b::truncate ((128.0 // math::cos (math::atan tangent)) + 0.5);
};
v = vector::from_fn (129, compute);
fn i = vector::get (v, i);
};
# Given two points on a line, compute a point on a
# new line that is parallel to the given line and
# a given distance away from it.
#
fun shift_line (p1 as xg::POINT { col, row }, p2, distance)
=
{ fun (<<) (w, i) = unt::to_int (unt::(<<) (unt::from_int w, i));
fun (>>) (w, i) = unt::to_int (unt::(>>) (unt::from_int w, i));
infix my << >>;
my (xg::POINT { col=>dx, row=>dy } )
=
xg::point::subtract (p2, p1);
my (dy, dy_neg) = if (dy < 0) (-dy, TRUE); else (dy, FALSE); fi;
my (dx, dx_neg) = if (dx < 0) (-dx, TRUE); else (dx, FALSE); fi;
fun adjust (dy, dx)
=
((distance * shift_table((dy << 0u7) / dx)) + 64) >> 0u7;
if (dy <= dx )
#
dy = adjust (dy, dx);
xg::POINT { col, row=> row + (if dx_neg dy; else -dy;fi) };
else
dx = adjust (dx, dy);
xg::POINT { col=> col + (if dy_neg -dx; else dx;fi), row };
fi;
};
# Find the intersection of two lines
# with the given endpoints.
# Return NULL if lines are parallel
#
fun intersect
( a1 as (xg::POINT { col=>a1x, row=>a1y } ), a2,
b1 as (xg::POINT { col=>b1x, row=>b1y } ), b2
)
=
{ my xg::POINT { col=>ax, row=>ay } = xg::point::subtract (a2, a1);
my xg::POINT { col=>bx, row=>by } = xg::point::subtract (b2, b1);
axby = ax * by;
bxay = bx * ay;
axbx = ax * bx;
ayby = ay * by;
fun solve (p, q)
=
{ my (p, q)
=
if (q < 0 ) (-p,-q);
else ( p, q); fi;
if (p < 0)
-(((-p) + q / 2) / q);
else
(p + (q / 2)) / q;
fi;
};
if (axby == bxay)
NULL;
else
col = solve (a1x*bxay - b1x*axby + (b1y - a1y)*axbx, bxay - axby);
row = solve (a1y*axby - b1y*bxay + (b1x - a1x)*ayby, axby - bxay);
(THE (xg::POINT { col, row } ));
fi;
};
fun make_perp
( xg::POINT { col, row },
xg::POINT { col=>col', row=>row' }
)
=
xg::POINT { col=>col+(row'-row), row=>row-(col'-col) };
fun last2pts [] => raise exception lib_base::IMPOSSIBLE "three_d::last2Pts";
last2pts [v1, v2] => (v1, v2);
last2pts (v ! vs) => last2pts vs;
end;
/*
* draw3DPoly draws a polygon of given width. The widening occurs
* on the left of the polygon as it is traversed. If the width
* is negative, the widening occurs on the right. Duplicate points
* are ignored. If there are less than two distinct points, nothing
* is drawn.
*
* The main loop below (loop2) is executed once for each vertex in
* the polgon. At the beginning of each iteration things get like this:
*
* poly1 /
* * /
* | /
* b1 * poly0
* | |
* | |
* | |
* | |
* | |
* | | p1 p2
* b2 *--------------------*
* |
* |
* *----*--------------------*
* poly2 newb1 newb2
*
* For each interation, we:
* (a) Compute poly2 (the border corner corresponding to p1)
* As part of this process, compute a new b1 and b2 value
* for the next side (p1-p2) of the polygon.
* (b) Draw the polygon (poly0, poly1, poly2, p1)
*
* The above situation doesn't exist until two points have
* been processed. We start with the last two points in the list
* (in loop0) to get an initial b1 and b2. Then, in loop1, we
* use the first point to get a new b1 and b2, with which we
* can calculate an initial poly1 (poly0 is the last point in
* the list). At this point, we can start the main loop.
*
* If two consecutive segments of the polygon are parallel,
* then things get more complex. (See findIntersect).
* Consider the following diagram:
*
* poly1
* *----b1-----------b2------a
* \
* \
* *---------*----------* b
* poly0 p2 p1 /
* /
* --*--------*----c
* newB1 newB2
*
* Instead of using the intersection and p1 as the last two points
* in the polygon and as poly1 and poly0 in the next iteration, we
* use a and b, and b and c, respectively.
*
* Do the computation in three stages:
* 1. Compute a point "perp" such that the line p1-perp
* is perpendicular to p1-p2.
* 2. Compute the points a and c by intersecting the lines
* b1-b2 and newb1-newb2 with p1-perp.
* 3. Compute b by shifting p1-perp to the right and
* intersecting it with p1-p2.
*/
fun draw3dpoly _ ([], _) _ => ();
draw3dpoly _ ([_], _) _ => ();
draw3dpoly drawable (ps as (i_p ! _), width) { top, bottom }
=>
loop0 (p1, p2 ! ps)
where
my (p1, p2) = last2pts ps;
fun calc_off_points (v1, v2)
=
{ b1 = shift_line (v1, v2, width);
(b1, xg::point::add (b1, xg::point::subtract (v2, v1)));
};
fun find_intersect (p1, p2, newb1, newb2, b1, b2)
=
case (intersect (newb1, newb2, b1, b2))
#
THE col => (col, p1, col);
#
NULL =>
(poly2, poly3, c)
where
perp = make_perp (p1, p2);
poly2 = the (intersect (p1, perp, b1, b2));
c = the (intersect (p1, perp, newb1, newb2));
shift1 = shift_line (p1, perp, width);
shift2 = xg::point::add (shift1, xg::point::subtract (perp, p1));
poly3 = the (intersect (p1, p2, shift1, shift2));
end;
esac;
fun draw (p0, p1, p2, p3)
=
{ my xg::POINT { col=>dx, row=>dy }
=
xg::point::subtract (p3, p0);
pen = if (dx > 0) if (dy <= dx) bottom; else top; fi;
elif (dy < dx) bottom; else top; fi;
xc::fill_polygon drawable pen
{ verts => [p0, p1, p2, p3],
shape => xc::CONVEX_SHAPE
};
};
fun loop2 (p1,[], b1, b2, poly0, poly1)
=>
if (p1 != i_p)
#
my (newb1, newb2) = calc_off_points (p1, i_p);
my (poly2, poly3, _) = find_intersect (p1, i_p, newb1, newb2, b1, b2);
draw (poly0, poly1, poly2, poly3);
fi;
loop2 (p1, p2 ! ps, b1, b2, poly0, poly1)
=>
if (p1 == p2)
#
loop2 (p1, ps, b1, b2, poly0, poly1);
else
my (newb1, newb2) = calc_off_points (p1, p2);
my (poly2, poly3, c) = find_intersect (p1, p2, newb1, newb2, b1, b2);
draw (poly0, poly1, poly2, poly3);
loop2 (p2, ps, newb1, newb2, poly3, c);
fi;
end;
fun loop1 (p1,[], _, _)
=>
();
loop1 (p1, p2 ! ps, b1, b2)
=>
if (p1 == p2)
#
loop1 (p1, ps, b1, b2);
else
my (newb1, newb2) = calc_off_points (p1, p2);
my (poly2, poly3, c) = find_intersect (p1, p2, newb1, newb2, b1, b2);
loop2 (p2, ps, newb1, newb2, poly3, c);
fi;
end;
fun loop0 (_,[])
=>
();
loop0 (p1, p2 ! ps)
=>
if (p1 == p2)
loop0 (p2, ps);
else
my (b1, b2) = calc_off_points (p1, p2);
loop1 (p2, ps, b1, b2);
fi;
end;
end;
end;
fun draw3dpoly2 drawable (pts, width)
=
{ half_width = width / 2;
outer = draw3dpoly drawable (pts, half_width);
inner = draw3dpoly drawable (pts,-half_width);
fn pens
=
{ outer pens;
inner { top=> pens.bottom, bottom=> pens.top };
};
};
fun draw_poly drawable { pts, width, relief }
=
case relief
#
FLAT => { f = draw3dpoly drawable (pts, width);
fn ( { base, ... }: wb::Shades)
=
f { top=>base, bottom=>base };
};
RAISED => { f = draw3dpoly drawable (pts, width);
fn { light, dark, ... }
=
f { top=>light, bottom=>dark };
};
SUNKEN => { f = draw3dpoly drawable (pts, width);
fn { light, dark, ... }
=
f { top=>dark, bottom=>light };
};
RIDGE => { f = draw3dpoly2 drawable (pts, width);
fn { light, dark, ... }
=
f { top=>light, bottom=>dark };
};
GROOVE => { f = draw3dpoly2 drawable (pts, width);
fn { light, dark, ... }
=
f { top=>dark, bottom=>light };
};
esac;
};
end;