module Wumpus.Core.BoundingBox
(
BoundingBox(..)
, DBoundingBox
, Boundary(..)
, bbox
, obbox
, destBoundingBox
, boundaryUnion
, traceBoundary
, retraceBoundary
, boundaryCorners
, withinBoundary
, boundaryWidth
, boundaryHeight
) where
import Wumpus.Core.AffineTrans
import Wumpus.Core.FormatCombinators
import Wumpus.Core.Geometry
import Wumpus.Core.Utils ( PSUnit(..) )
import Data.Semigroup
data BoundingBox u = BBox
{ ll_corner :: Point2 u
, ur_corner :: Point2 u
}
deriving (Eq,Show)
type DBoundingBox = BoundingBox Double
instance Ord u => Semigroup (BoundingBox u) where
append = boundaryUnion
instance PSUnit u => Format (BoundingBox u) where
format (BBox p0 p1) = parens (text "BBox" <+> text "ll=" <> format p0
<+> text "ur=" <> format p1)
type instance DUnit (BoundingBox u) = u
pointTransform :: (Num u , Ord u)
=> (Point2 u -> Point2 u) -> BoundingBox u -> BoundingBox u
pointTransform fn bb = traceBoundary $ map fn $ [bl,br,tr,tl]
where
(bl,br,tr,tl) = boundaryCorners bb
instance (Num u, Ord u) => Transform (BoundingBox u) where
transform mtrx = pointTransform (mtrx *#)
instance (Real u, Floating u) => Rotate (BoundingBox u) where
rotate theta = pointTransform (rotate theta)
instance (Real u, Floating u) => RotateAbout (BoundingBox u) where
rotateAbout theta pt = pointTransform (rotateAbout theta pt)
instance (Num u, Ord u) => Scale (BoundingBox u) where
scale sx sy = pointTransform (scale sx sy)
instance (Num u, Ord u) => Translate (BoundingBox u) where
translate dx dy = pointTransform (translate dx dy)
class Boundary t where
boundary :: u ~ DUnit t => t -> BoundingBox u
bbox :: Ord u => Point2 u -> Point2 u -> BoundingBox u
bbox ll@(P2 x0 y0) ur@(P2 x1 y1)
| x0 <= x1 && y0 <= y1 = BBox ll ur
| otherwise = error "Wumpus.Core.BoundingBox.bbox - malformed."
obbox :: Num u => u -> u -> BoundingBox u
obbox w h = BBox zeroPt (P2 w h)
destBoundingBox :: BoundingBox u -> (u,u,u,u)
destBoundingBox (BBox (P2 llx lly) (P2 urx ury)) = (llx, lly, urx, ury)
boundaryUnion :: Ord u => BoundingBox u -> BoundingBox u -> BoundingBox u
BBox ll ur `boundaryUnion` BBox ll' ur' = BBox (minPt ll ll') (maxPt ur ur')
traceBoundary :: (Num u, Ord u) => [Point2 u] -> BoundingBox u
traceBoundary (p:ps) =
uncurry BBox $ foldr (\z (a,b) -> (minPt z a, maxPt z b) ) (p,p) ps
traceBoundary [] = error $ "BoundingBox.trace called in empty list"
retraceBoundary :: (Num u, Ord u)
=> (Point2 u -> Point2 u) -> BoundingBox u -> BoundingBox u
retraceBoundary f = traceBoundary . map f . fromCorners . boundaryCorners
where
fromCorners (bl,br,tr,tl) = [bl,br,tr,tl]
boundaryCorners :: BoundingBox u -> (Point2 u, Point2 u, Point2 u, Point2 u)
boundaryCorners (BBox bl@(P2 x0 y0) tr@(P2 x1 y1)) = (bl, br, tr, tl) where
br = P2 x1 y0
tl = P2 x0 y1
withinBoundary :: Ord u => Point2 u -> BoundingBox u -> Bool
withinBoundary p (BBox ll ur) = (minPt p ll) == ll && (maxPt p ur) == ur
boundaryWidth :: Num u => BoundingBox u -> u
boundaryWidth (BBox (P2 xmin _) (P2 xmax _)) = xmax xmin
boundaryHeight :: Num u => BoundingBox u -> u
boundaryHeight (BBox (P2 _ ymin) (P2 _ ymax)) = ymax ymin