+ some integer geometry operations (minkowski sum, box to box centering)

source/base/video-integer_geometry.ads

@@ -56,13 +56,20 @@ package Video.Integer_Geometry with Pure is
 	-- A type like an Ada range (but a type)
 
 	function Empty_Interval return Interval is (Coordinate'Last, Coordinate'First);
+	-- Interval with nothing in
 
 	function Full_Interval return Interval is (Coordinate'First, Coordinate'Last);
+	-- Interval covering entire Coordinate range
+	-- Note: many operations on Full_Interval could cause overflow
 
 	-- Note that transformations can cause overflow when applied to
 	-- Empty and Full intervals. User code should detect that corner cases.
 
 	function Is_Empty (A : Interval) return Boolean is (A.First >= A.Last);
+	-- Test is interval have nothing in
+
+	subtype Nonempty_Interval is Interval with Dynamic_Predicate => not Is_Empty (Nonempty_Interval);
+	-- A type for an interval that is not empty
 
 	function Length (A : Interval) return Distance is
 	(if Is_Empty (A) then 0 else A.Last - A.First);
@@ -76,10 +83,33 @@ package Video.Integer_Geometry with Pure is
 	function Intersects (A, B : Interval) return Boolean is
 	((not Is_Empty (A)) and then (not Is_Empty (B)) and then (A.First <= B.Last and B.First <= A.Last));
 
-	function "+" (A : Interval; B : Coordinate) return Interval is
-	(A.First + B, A.Last + B);
+	function "+" (A : Interval) return Interval is (A);
+	-- Identity function
+
+	function "-" (A : Interval) return Interval
+	is (if Is_Empty (A) then Empty_Interval else (-A.Last, -A.First));
+	-- Negation
+
+	function "+" (A : Interval; B : Coordinate) return Interval
+	is (if Is_Empty (A) then Empty_Interval else (A.First + B, A.Last + B));
 	-- Translate interval
 
+	function "+" (A : Coordinate; B : Interval) return Interval
+	is (if Is_Empty (B) then Empty_Interval else (A + B.First, A + B.Last));
+	-- Translate interval (other form)
+
+	function "+" (A, B : Interval) return Interval
+	is (if Is_Empty (A) or else Is_Empty (B) then Empty_Interval else (A.First + B.First, A.Last + B.Last));
+	-- Minkowski sum
+
+	function "-" (A : Interval; B : Coordinate) return Interval
+	is (if Is_Empty (A) then Empty_Interval else (A.First - B, A.Last - B));
+	-- Translate interval
+
+	function "-" (A : Interval; B : Nonempty_Interval) return Interval
+	is (if Is_Empty (A) then Empty_Interval else (A.First - B.Last, A.Last - B.First));
+	-- Minkowski difference
+
 	function "and" (A, B : Interval) return Interval is
 	(Coordinate'Max (A.First, B.First), Coordinate'Min (A.Last, B.Last));
 	-- Intersection
@@ -90,41 +120,87 @@ package Video.Integer_Geometry with Pure is
 	else (Coordinate'Min (A.First, B.First), Coordinate'Max (A.Last, B.Last)));
 	-- Minimal interval enclosing both arguments
 
-	function Center (A : Interval) return Coordinate
+	function Center (A : Nonempty_Interval) return Coordinate
 	is (A.First / 2 + A.Last / 2 + (A.First rem 2 + A.Last rem 2) / 2);
 
+	function Center (A, B : Nonempty_Interval) return Coordinate
+	is ((B.First + B.Last - A.First - A.Last) / 2);
+	-- Offset to translate interval A to match center of interval B
+
+	--
+
 	type Box is record
 		X, Y : Interval;
 	end record;
+	-- An area enclosed by coordinate limits
 
 	function Empty_Box return Box is (Empty_Interval, Empty_Interval);
+	-- A box with no area
 
 	function Full_Box return Box is (Full_Interval, Full_Interval);
 	-- A "no clip" box
 
 	function Is_Empty (B : Box) return Boolean is (Is_Empty (B.X) or else Is_Empty (B.Y));
+	-- Test if a box is null
+
+	subtype Nonempty_Box is Box with Dynamic_Predicate => not Is_Empty (Nonempty_Box);
+	-- A type for a box that is not empty
+
+	function Area (B : Box) return Coordinate_Product
+	is (Coordinate_Product (Length (B.X)) * Coordinate_Product (Length (B.Y)));
 
 	function Contains (B : Box; Q : Point) return Boolean is
 	(Contains (B.X, Q.X) and then Contains (B.Y, Q.Y));
+	-- Test is point is inside or on the edge of a box
 
 	function Contains (Outer, Inner : Box) return Boolean is
 	(Contains (Outer.X, Inner.X) and then Contains (Outer.Y, Inner.Y));
+	-- Test if Inner is inside Outer
 
 	function Intersects (A, B : Box) return Boolean is
 	(Intersects (A.X, B.X) and then Intersects (A.Y, B.Y));
+	-- Test if two boxes have common area
 
-	function "+" (P : Box; Q : Point) return Box is
-	(P.X + Q.X, P.Y + Q.Y);
+	function "+" (B : Box) return Box is (B);
+	-- Identity
+
+	function "-" (B : Box) return Box
+	is (if Is_Empty (B) then Empty_Box else (-B.X, -B.Y));
+	-- Negation
+
+	function "+" (B : Box; P : Point) return Box
+	is (if Is_Empty (B) then Empty_Box else (B.X + P.X, B.Y + P.Y));
 	-- Translate box
 
+	function "+" (P : Point; B : Box) return Box
+	is (if Is_Empty (B) then Empty_Box else (P.X + B.X, P.Y + B.Y));
+	-- Translate box
+
+	function "+" (A, B : Box) return Box
+	is (if Is_Empty (A) or else Is_Empty (B) then Empty_Box else (A.X + B.X, A.Y + B.Y));
+	-- Minkowski sum
+
+	function "-" (B : Box; P : Point) return Box
+	is (if Is_Empty (B) then Empty_Box else (B.X - P.X, B.Y - P.Y));
+	-- Translate box
+
+	function "-" (A : Box; B : Nonempty_Box) return Box
+	is (if Is_Empty (A) then Empty_Box else (A.X - B.X, A.Y - B.Y));
+	-- Minkowski difference
+
 	function "and" (P, Q : Box) return Box is
 	(P.X and Q.X, P.Y and Q.Y);
-	-- Intersection
+	-- Intersection (like in sets)
 
 	function "or" (P, Q : Box) return Box is
 	(P.X or Q.X, P.Y or Q.Y);
 	-- Minimal box enclosing both arguments
+	-- Note: contrary to "and" it is not an set union
 
 	function Center (P : Box) return Point
 	is (X => Center (P.X), Y => Center (P.Y));
-end Video.Integer_Geometry;
+
+	function Center (A, B : Nonempty_Box) return Point
+	is (Center (A.X, B.X), Center (A.Y, B.Y));
+
+end Video.Integer_Geometry;