## band.pkg
# Compiled by:
# src/lib/x-kit/draw/xkit-draw.sublib# Code for band data package.
#
# A band is a list non-continguous rectangles listed from left
# to right (increasing x) that all have the same upper and lower
# y coordinates. Regions (see region.api and region.pkg)
# are essentially ordered lists of bands.
### "Mark Twain and I are in very much the same position.
### We have to put things in such a way as to make people
### who would otherwise hang us, believe that we are joking."
###
### -- George Bernard Shaw
api Band {
package g: Xgeometry; # Xgeometry is from src/lib/std/2d/xgeometry.api Box_Overlap
= BOX_OUT
| BOX_IN
| BOX_PART
;
Band = BAND { y1: Int, # top y value
y2: Int, # Bottom y value
xs: List( (Int, Int) ) # list of (left, right) values
};
y1of: Band -> Int; # Return y1 of band
y2of: Band -> Int; # Return y2 of band
size_of: Band -> Int; # Return number of intervals. Always > 0
boxes_of_band
:
(Band, List( g::Box ))
->
List( g::Box );
#
# Concat list of rectangles of band on accumulator list.
# The leftmost rectangle in the band will be the head of
# the resulting list.
in_band: (Band, g::Point) -> Bool;
#
# TRUE if point is in band.
band_extent: Band -> (Int, Int);
#
# Return left and right extent of band
box_in_band: (Band, Int, Int) -> Box_Overlap;
#
# Compares argument interval with x intervals of band
overlap: (Band, Band) -> Bool;
#
# Returns TRUE if any two x intervals of the bands intersect
offset_band: g::Point -> Band -> Band;
#
# Translate band by given vector
x_offset_band: Int -> Band -> Band;
y_offset_band: Int -> Band -> Band;
#
# Translate band horizontally (vertically)
coalesce
:
{ lower: Band,
upper: Band
}
->
Null_Or( Band );
#
# Coalesce lower band below upper band.
# Return THE new band if successful.
# Assumes y values are compatible.
union: (Band, Band, Int, Int) -> (Band, Int);
intersect: (Band, Band, Int, Int) -> (Band, Int);
subtract: (Band, Band, Int, Int) -> (Band, Int);
#
# Create a new band that is the
# union (intersection, difference)
# of the two argument bands.
#
# The integer return value is the
# number of intervals in the band.
#
# The integer arguments provide the upper
# and lower y coordinates for the resulting band.
#
# The operation only involves the x intervals;
# it is assumed that y overlap has already been checked.
squeeze: (Band, Int, Int) -> (Band, Int);
#
# Return a new band that has the same x intervals as the
# argument band, but with the new upper and lower y values.
};
package band
: (weak) Band # Band is from src/lib/x-kit/draw/band.pkg{
package g = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkg Box_Overlap = BOX_OUT
| BOX_IN
| BOX_PART
;
Band = BAND {
y1: Int,
y2: Int,
xs: List( (Int, Int) )
};
# It might be worthwhile to maintain the length of xs in the band
fun is_in (x: Int) (x1, x2) = x1 <= x and x < x2;
fun xoff (x: Int) (x1, x2) = (x1+x, x2+x);
fun ontop ( [], l, n) => (l, n);
ontop (a ! t, l, n) => ontop (t, a ! l, n+1);
end;
fun mkr (y1, y2)
=
{ high = y2 - y1;
fn ((x1, x2), l)
=
( (g::BOX { col=>x1, row=>y1, wide=>x2 - x1, high } )
!
l
);
};
fun boxes_of_band (BAND { xs, y1, y2 }, l)
=
fold_backward (mkr (y1, y2)) l xs;
fun squeeze (BAND { xs, ... }, top, bot)
=
(BAND { xs, y1=>top, y2=>bot }, length xs);
fun y1of (BAND { y1, ... } ) = y1;
fun y2of (BAND { y2, ... } ) = y2;
fun size_of (BAND { xs, ... } )
=
length xs;
fun in_band (BAND { y1, y2, xs }, g::POINT { col=>px, row=>py } )
=
y1 <= py and
py < y2 and
list::exists (is_in px) xs;
fun band_extent (BAND { xs => xs as ((x1, _) ! _), ... } )
=>
(x1, right xs)
where
fun right ([(l, r)]) => r;
right (_ ! t) => right t;
right _ => raise exception lib_base::IMPOSSIBLE "Band::bandExtent::right";
end;
end;
band_extent _
=>
raise exception lib_base::IMPOSSIBLE "Band::bandExtent";
end;
fun box_in_band (BAND { y1, y2, xs }, x1, x2)
=
{ fun rib [] => BOX_OUT;
rib ((l, r) ! rest)
=>
if (r <= x1 ) rib rest;
elif (x2 <= l ) BOX_OUT;
elif (l <= x1 and x2 <= r ) BOX_IN;
else BOX_PART;
fi;
end;
rib xs;
};
# Only check overlap of x intervals
fun overlap (BAND { xs, ... }, BAND { xs=>xs', ... } )
=
{ fun loop ([], _) => FALSE;
loop(_, []) => FALSE;
loop (x as ((x1, x2) ! xs), x' as ((x1', x2') ! xs'))
=>
if (x2 <= x1')
loop (xs, x');
else
if (x2' <= x1)
loop (x, xs');
else
TRUE;
fi;
fi;
end;
loop (xs, xs');
};
fun x_offset_band dx (BAND { y1, y2, xs } )
=
BAND { y1, y2, xs => map (xoff dx) xs };
fun y_offset_band dy (BAND { y1, y2, xs } )
=
BAND { y1=>y1+dy, y2=>y2+dy, xs };
fun offset_band (g::POINT { col=>dx, row=>dy } ) (BAND { y1, y2, xs } )
=
BAND { y1=>y1+dy, y2=>y2+dy, xs => map (xoff dx) xs };
# Coalesce two bands into one, if possible.
# Assume y1 of lower band = y2 of upper band
# Check that each contain same horizontal intervals.
# If so, combine and return THE of resulting band.
# Else return NULL.
fun coalesce { lower => BAND { y2, xs, ... }, upper => BAND { y1=>y1', xs=>xs', ... }}
=
if (xs == xs' ) THE (BAND { y1=>y1', y2, xs } );
else NULL; fi;
fun union (BAND { xs, ... }, BAND { xs=>xs', ... }, top, bot)
=
{ h = head xs;
h' = head xs';
fun finalmerge ([], ci, xs)
=>
ontop (xs,[ci], 1);
finalmerge((i as (l, r)) ! t, i' as (l', r'), xs)
=>
if (r' < l ) ontop (xs, i' ! i ! t, 2 + length t);
elif (r <= r' ) finalmerge (t, i', xs);
else ontop (xs, (l', r) ! t, 1 + length t);
fi;
end;
fun loop ([],[], ci, xs) => ontop (xs,[ci], 1);
loop (x,[], ci, xs) => finalmerge (x, ci, xs);
loop ([], x, ci, xs) => finalmerge (x, ci, xs);
loop (x as ((i as (x1, x2)) ! t), x' as ((i' as (x1', x2')) ! t'), ci, xs)
=>
if (x1 < x1' ) merge (t, x', i, ci, xs); else merge (x, t', i', ci, xs);fi;
end
also
fun merge (t, t', i as (l, r), i' as (l', r'), xs)
=
if (r' < l ) loop (t, t', i, i' ! xs);
elif (r <= r' ) loop (t, t', i', xs);
else loop (t, t', (l', r), xs);
fi;
my (xs'', n)
=
if (#1 h < #1 h')
loop (tail xs, xs', h,[]);
else loop (xs, tail xs', h',[]); fi;
(BAND { y1=>top, y2=>bot, xs=> xs''}, n);
};
fun intersect (BAND { xs, ... }, BAND { xs=>xs', ... }, top, bot)
=
{ fun loop ([], _, xs) => ontop (xs,[], 0);
loop (_,[], xs) => ontop (xs,[], 0);
loop (x as ((x1, x2) ! t), x' as ((x1', x2') ! t'), xs)
=>
{ l = int::max (x1, x1');
r = int::min (x2, x2');
xs' = if (l < r ) (l, r) ! xs;
else xs;fi;
if (x2 < x2')
loop (t, x', xs');
elif (x2 > x2')
loop (x, t', xs');
else loop (t, t', xs');
fi;
};
end;
case (loop (xs, xs',[]))
(xs'', n) => (BAND { y1=>top, y2=>bot, xs=> xs''}, n);
esac;
};
fun subtract (BAND { xs, ... }, BAND { xs=>xs', ... }, top, bot)
=
{ fun loop ([], _, xs) => ontop (xs,[], 0);
loop (x,[], xs) => ontop (xs, x, length x);
loop (x as ((x1, x2) ! t), x' as ((x1', x2') ! t'), xs)
=>
if (x2' <= x1 ) loop (x, t', xs);
elif (x2 <= x1' ) loop (t, x', (x1, x2) ! xs);
elif (x1' <= x1 )
if (x2' < x2 ) loop((x2', x2) ! t, t', xs);
elif (x2' == x2 ) loop (t, t', xs);
else loop (t, x', xs);
fi;
elif (x2' < x2 ) loop((x2', x2) ! t, t', (x1, x1') ! xs);
elif (x2' == x2 ) loop (t, t', (x1, x1') ! xs);
else loop (t, x', (x1, x1') ! xs);
fi;
end;
case (loop (xs, xs',[]))
(xs'', n) => (BAND { y1=>top, y2=>bot, xs=>xs''}, n);
esac;
};
};