From 61385137b65514f03a0a66eb585131894358890f Mon Sep 17 00:00:00 2001 From: Jaro Date: Sat, 3 Jun 2023 18:11:52 +0200 Subject: [PATCH] Parametrise rectangle union bias. --- .../Internal/ParagraphExtents.hs | 2 +- .../Text/ParagraphLayout/Internal/Rect.hs | 56 +++++++++++---- test/Data/Text/ParagraphLayout/RectSpec.hs | 71 +++++++++++++++---- 3 files changed, 100 insertions(+), 29 deletions(-) diff --git a/src/Data/Text/ParagraphLayout/Internal/ParagraphExtents.hs b/src/Data/Text/ParagraphLayout/Internal/ParagraphExtents.hs index bc6ca9a..25124ad 100644 --- a/src/Data/Text/ParagraphLayout/Internal/ParagraphExtents.hs +++ b/src/Data/Text/ParagraphLayout/Internal/ParagraphExtents.hs @@ -23,4 +23,4 @@ emptyRect = Rect } containRects :: (Ord a, Num a) => [Rect a] -> Rect a -containRects = foldr union emptyRect +containRects = foldr (union LH) emptyRect diff --git a/src/Data/Text/ParagraphLayout/Internal/Rect.hs b/src/Data/Text/ParagraphLayout/Internal/Rect.hs index b1a0b59..ec5b9cd 100644 --- a/src/Data/Text/ParagraphLayout/Internal/Rect.hs +++ b/src/Data/Text/ParagraphLayout/Internal/Rect.hs @@ -1,7 +1,8 @@ -- | Representation of an axis-aligned rectangle on a 2D plane, with one of its -- corners being a designated origin point. module Data.Text.ParagraphLayout.Internal.Rect - ( Rect (Rect, x_origin, y_origin, x_size, y_size) + ( Bias (LL, LH, HL, HH) + , Rect (Rect, x_origin, y_origin, x_size, y_size) , height , union , width @@ -59,17 +60,44 @@ x_max r = x_origin r `max` x_terminus r y_max :: (Num a, Ord a) => Rect a -> a y_max r = y_origin r `max` y_terminus r --- | Calculate the smallest rectangle that completely contains the given two --- rectangles. +-- | Determines which corner of a calculated rectangle should be its origin. +data Bias + = LL + -- ^ Set the origin as the corner with low X and low Y coordinates. + | LH + -- ^ Set the origin as the corner with low X and high Y coordinates. + | HL + -- ^ Set the origin as the corner with high X and low Y coordinates. + | HH + -- ^ Set the origin as the corner with high X and high Y coordinates. + +-- | The smallest rectangle completely containing the given two rectangles. +-- +-- The origin of the output rectangle will be set according to `Bias`, +-- regardless of which corners of the input rectangles are designated +-- as their origins. +-- +-- Note that this operation has no identity element. A rectangle whose +-- `x_size` and/or `y_size` are zero is not considered null or neutral, +-- but effectively acts as a point, which will be contained in the union. +-- +-- You can use `Nothing` as an identity element if you lift this operation +-- over the `Maybe` applicative functor: -- --- The origin of the resulting rectangle will be the corner with the lowest --- X coordinate and the highest Y coordinate, regardless of the origin of the --- input rectangles. -union :: (Num a, Ord a) => Rect a -> Rect a -> Rect a -union a b = Rect x_low y_high dx (-dy) where - x_low = x_min a `min` x_min b - y_low = y_min a `min` y_min b - x_high = x_max a `max` x_max b - y_high = y_max a `max` y_max b - dx = x_high - x_low - dy = y_high - y_low +-- @ +-- `Control.Applicative.liftA2` (`union` bias) +-- @ +union :: (Num a, Ord a) => Bias -> Rect a -> Rect a -> Rect a +union bias a b = + case bias of + LL -> Rect lx ly dx dy + LH -> Rect lx hy dx (-dy) + HL -> Rect hx ly (-dx) dy + HH -> Rect hx hy (-dx) (-dy) + where + lx = x_min a `min` x_min b + ly = y_min a `min` y_min b + hx = x_max a `max` x_max b + hy = y_max a `max` y_max b + dx = hx - lx + dy = hy - ly diff --git a/test/Data/Text/ParagraphLayout/RectSpec.hs b/test/Data/Text/ParagraphLayout/RectSpec.hs index a5939d5..012b854 100644 --- a/test/Data/Text/ParagraphLayout/RectSpec.hs +++ b/test/Data/Text/ParagraphLayout/RectSpec.hs @@ -13,17 +13,60 @@ negativeRect = Rect 80 (-75) (-15) (-15) spec :: Spec spec = do - describe "union of two rects" $ do - let r = union positiveRect negativeRect - it "has origin at 50,-60" $ - (x_origin r, y_origin r) `shouldBe` (50, -60) - it "has minimum coordinates at at 50,-90" $ - (x_min r, y_min r) `shouldBe` (50, -90) - it "has terminus at 80,-90" $ - (x_terminus r, y_terminus r) `shouldBe` (80, -90) - it "has maximum coordinates at 80,-60" $ - (x_max r, y_max r) `shouldBe` (80, -60) - it "has size 30,-30" $ - (x_size r, y_size r) `shouldBe` (30, -30) - it "has absolute size 30,30" $ - (width r, height r) `shouldBe` (30, 30) + describe "union of two rects (low X, low Y)" $ + llSpec $ union LL positiveRect negativeRect + describe "union of two rects (low X, high Y)" $ + lhSpec $ union LH positiveRect negativeRect + describe "union of two rects (high X, low Y)" $ + hlSpec $ union HL positiveRect negativeRect + describe "union of two rects (high X, high Y)" $ + hhSpec $ union HH positiveRect negativeRect + +llSpec :: Rect Int32 -> SpecWith () +llSpec r = do + commonSpec r + it "has origin at 50,-90" $ + (x_origin r, y_origin r) `shouldBe` (50, -90) + it "has terminus at 80,-60" $ + (x_terminus r, y_terminus r) `shouldBe` (80, -60) + it "has size 30,30" $ + (x_size r, y_size r) `shouldBe` (30, 30) + +lhSpec :: Rect Int32 -> SpecWith () +lhSpec r = do + commonSpec r + it "has origin at 50,-60" $ + (x_origin r, y_origin r) `shouldBe` (50, -60) + it "has terminus at 80,-90" $ + (x_terminus r, y_terminus r) `shouldBe` (80, -90) + it "has size 30,-30" $ + (x_size r, y_size r) `shouldBe` (30, -30) + +hlSpec :: Rect Int32 -> SpecWith () +hlSpec r = do + commonSpec r + it "has origin at 80,-90" $ + (x_origin r, y_origin r) `shouldBe` (80, -90) + it "has terminus at 50,-60" $ + (x_terminus r, y_terminus r) `shouldBe` (50, -60) + it "has size -30,30" $ + (x_size r, y_size r) `shouldBe` (-30, 30) + +hhSpec :: Rect Int32 -> SpecWith () +hhSpec r = do + commonSpec r + it "has origin at 80,-60" $ + (x_origin r, y_origin r) `shouldBe` (80, -60) + it "has terminus at 50,-90" $ + (x_terminus r, y_terminus r) `shouldBe` (50, -90) + it "has size -30,-30" $ + (x_size r, y_size r) `shouldBe` (-30, -30) + +commonSpec :: Rect Int32 -> SpecWith () +commonSpec r = do + it "has minimum coordinates at at 50,-90" $ + (x_min r, y_min r) `shouldBe` (50, -90) + it "has maximum coordinates at 80,-60" $ + (x_max r, y_max r) `shouldBe` (80, -60) + it "has absolute size 30,30" $ + (width r, height r) `shouldBe` (30, 30) -- 2.30.2