module Wumpus.Basic.Kernel.Objects.Bounded
(
BoundedGraphic
, DBoundedGraphic
, BoundedLocGraphic
, DBoundedLocGraphic
, BoundedLocThetaGraphic
, DBoundedLocThetaGraphic
, emptyBoundedLocGraphic
, emptyBoundedLocThetaGraphic
, centerOrthoBBox
, illustrateBoundedGraphic
, illustrateBoundedLocGraphic
, illustrateBoundedLocThetaGraphic
, bbrectangle
) where
import Wumpus.Basic.Kernel.Base.BaseDefs
import Wumpus.Basic.Kernel.Base.ContextFun
import Wumpus.Basic.Kernel.Base.DrawingContext
import Wumpus.Basic.Kernel.Base.UpdateDC
import Wumpus.Basic.Kernel.Objects.BaseObjects
import Wumpus.Basic.Kernel.Objects.DrawingPrimitives
import Wumpus.Basic.Kernel.Objects.Graphic
import Wumpus.Core
import Control.Applicative
type BoundedGraphic u = Image u (BoundingBox u)
type DBoundedGraphic = BoundedGraphic Double
type BoundedLocGraphic u = LocImage u (BoundingBox u)
type DBoundedLocGraphic = BoundedLocGraphic Double
type BoundedLocThetaGraphic u = LocThetaImage u (BoundingBox u)
type DBoundedLocThetaGraphic = BoundedLocThetaGraphic Double
centerOrthoBBox :: (Real u, Floating u)
=> Radian -> BoundingBox u -> BoundingBox u
centerOrthoBBox theta bb =
traceBoundary $ map (rotateAbout theta ctr) ps
where
ps = boundaryCornerList bb
ctr = boundaryCenter bb
emptyBoundedLocGraphic :: Num u => BoundedLocGraphic u
emptyBoundedLocGraphic = intoLocImage fn emptyLocGraphic
where
fn = promoteR1 $ \pt -> pure (BBox pt pt)
emptyBoundedLocThetaGraphic :: Num u => BoundedLocThetaGraphic u
emptyBoundedLocThetaGraphic = lift1R2 emptyBoundedLocGraphic
illustrateBoundedGraphic :: Fractional u => BoundedGraphic u -> BoundedGraphic u
illustrateBoundedGraphic mf =
mf >>= \(bb,g1) -> bbrectangle bb >>= \(_,g0) -> return (bb, g0 `oplus` g1)
illustrateBoundedLocGraphic :: Fractional u
=> BoundedLocGraphic u -> BoundedLocGraphic u
illustrateBoundedLocGraphic mf =
promoteR1 $ \pt -> illustrateBoundedGraphic $ apply1R1 mf pt
illustrateBoundedLocThetaGraphic :: Fractional u
=> BoundedLocThetaGraphic u -> BoundedLocThetaGraphic u
illustrateBoundedLocThetaGraphic mf =
promoteR2 $ \pt theta-> illustrateBoundedGraphic $ apply2R2 mf pt theta
bbrectangle :: Fractional u => BoundingBox u -> Graphic u
bbrectangle (BBox p1@(P2 llx lly) p2@(P2 urx ury))
| llx == urx && lly == ury = emptyLocGraphic `at` p1
| otherwise =
localize drawing_props $ rect1 `oplus` cross
where
drawing_props = capRound . dashPattern (Dash 0 [(1,2)])
rect1 = strokedRectangle (urxllx) (urylly) `at` p1
cross = straightLineGraphic p1 p2
`oplus` straightLineGraphic (P2 llx ury) (P2 urx lly)