module Wumpus.Drawing.Text.Base.Label
(
locImageLabel
, label_center_of
, label_left_of
, label_right_of
, label_above
, label_below
, connectorPathLabel
, label_midway_of
, label_atstart_of
, label_atend_of
, centerRelative
, right_of
, left_of
, above_right_of
, below_right_of
, above_left_of
, below_left_of
) where
import Wumpus.Drawing.Paths
import Wumpus.Basic.Kernel
import Wumpus.Core
type BoundedLocRectGraphic u = RectAddress -> LocImage u (BoundingBox u)
locImageLabel :: InterpretUnit u
=> (a -> Anchor u)
-> RectAddress
-> (RectAddress -> LocImage u (BoundingBox u))
-> LocImage u a
-> LocImage u a
locImageLabel fn rpos mklabel obj = promoteLoc $ \pt ->
selaborate (obj `at` pt) (\a -> ignoreAns $ mklabel rpos `at` fn a)
label_center_of :: (InterpretUnit u, CenterAnchor a, u ~ DUnit a)
=> BoundedLocRectGraphic u -> LocImage u a -> LocImage u a
label_center_of = locImageLabel center CENTER
label_left_of :: (InterpretUnit u, CardinalAnchor a, u ~ DUnit a)
=> BoundedLocRectGraphic u -> LocImage u a -> LocImage u a
label_left_of = locImageLabel west EE
label_right_of :: (InterpretUnit u, CardinalAnchor a, u ~ DUnit a)
=> BoundedLocRectGraphic u -> LocImage u a -> LocImage u a
label_right_of = locImageLabel east WW
label_above :: (InterpretUnit u, CardinalAnchor a, u ~ DUnit a)
=> BoundedLocRectGraphic u -> LocImage u a -> LocImage u a
label_above = locImageLabel north SS
label_below :: (InterpretUnit u, CardinalAnchor a, u ~ DUnit a)
=> BoundedLocRectGraphic u -> LocImage u a -> LocImage u a
label_below = locImageLabel south NN
connectorPathLabel :: InterpretUnit u
=> (AbsPath u -> Point2 u)
-> RectAddress
-> BoundedLocRectGraphic u
-> Image u (AbsPath u)
-> Image u (AbsPath u)
connectorPathLabel fn rpos lbl img =
selaborate img (\a -> ignoreAns $ lbl rpos `at` (fn a))
label_midway_of :: (Real u, Floating u, InterpretUnit u)
=> RectAddress
-> BoundedLocRectGraphic u
-> Image u (AbsPath u) -> Image u (AbsPath u)
label_midway_of = connectorPathLabel midway_
label_atstart_of :: (Real u, Floating u, InterpretUnit u)
=> RectAddress
-> BoundedLocRectGraphic u
-> Image u (AbsPath u) -> Image u (AbsPath u)
label_atstart_of = connectorPathLabel atstart_
label_atend_of :: (Real u, Floating u, InterpretUnit u)
=> RectAddress
-> BoundedLocRectGraphic u
-> Image u (AbsPath u) -> Image u (AbsPath u)
label_atend_of = connectorPathLabel atend_
centerRelative :: (CenterAnchor a, Fractional u, InterpretUnit u, u ~ DUnit a)
=> (Int,Int) -> a -> Query u (Anchor u)
centerRelative coord a =
snapmove coord >>= \v -> return $ displace v (center a)
right_of :: (CenterAnchor a, Fractional u, InterpretUnit u, u ~ DUnit a)
=> a -> Query u (Anchor u)
right_of = centerRelative (1,0)
left_of :: (CenterAnchor a, Fractional u, InterpretUnit u, u ~ DUnit a)
=> a -> Query u (Anchor u)
left_of = centerRelative ((1),0)
above_right_of :: (CenterAnchor a, Fractional u, InterpretUnit u, u ~ DUnit a)
=> a -> Query u (Anchor u)
above_right_of = centerRelative (1,1)
below_right_of :: (CenterAnchor a, Fractional u, InterpretUnit u, u ~ DUnit a)
=> a -> Query u (Anchor u)
below_right_of = centerRelative (1, (1))
above_left_of :: (CenterAnchor a, Fractional u, InterpretUnit u, u ~ DUnit a)
=> a -> Query u (Anchor u)
above_left_of = centerRelative ((1),1)
below_left_of :: (CenterAnchor a, Fractional u, InterpretUnit u, u ~ DUnit a)
=> a -> Query u (Anchor u)
below_left_of = centerRelative ((1),(1))