module LabelF(labRightOfF, labLeftOfF, labBelowF, labAboveF, tieLabelF) where
import Spacer(noStretchF,marginHVAlignF)
import Alignment
import CompOps((>=^<), (>^=<))
import DDisplayF(labelF)
--import Fudget
--import Geometry
import LayoutDir(Orientation(..))
import LayoutOps
import EitherUtils(stripEither)
--import Xtypes

--tieLabelF :: Orientation -> Alignment -> String -> F a b -> F a b
tieLabelF :: Orientation -> Alignment -> p -> F c d -> F c d
tieLabelF Orientation
orient Alignment
align p
text F c d
fudget =
    let disp :: F a2 b
disp = forall {a1} {a2} {b}. Graphic a1 => a1 -> F a2 b
labelF p
text
        fv :: Bool
fv = Orientation
orient forall a. Eq a => a -> a -> Bool
== Orientation
Above Bool -> Bool -> Bool
|| Orientation
orient forall a. Eq a => a -> a -> Bool
== Orientation
Below
        fh :: Bool
fh = Bool -> Bool
not Bool
fv
        lblF :: F a b
lblF = forall {a} {b}. Bool -> Bool -> F a b -> F a b
noStretchF Bool
fh Bool
fv (forall {a} {b}.
Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
align Alignment
align forall {a2} {b}. F a2 b
disp)
    in  (forall {a}. Either a a -> a
stripEither forall a b e. (a -> b) -> F e a -> F e b
>^=< ((forall {a2} {b}. F a2 b
lblF,Orientation
orient) forall {a} {b} {c} {d}.
(F a b, Orientation) -> F c d -> F (Either a c) (Either b d)
>#+< F c d
fudget)) forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. b -> Either a b
Right


labF :: Orientation -> p -> F c d -> F c d
labF Orientation
orient = forall {p} {c} {d}.
Graphic p =>
Orientation -> Alignment -> p -> F c d -> F c d
tieLabelF Orientation
orient Alignment
aCenter
labAboveF :: p -> F c d -> F c d
labAboveF   p
x = forall {p} {c} {d}. Graphic p => Orientation -> p -> F c d -> F c d
labF Orientation
Above p
x
labBelowF :: p -> F c d -> F c d
labBelowF   p
x = forall {p} {c} {d}. Graphic p => Orientation -> p -> F c d -> F c d
labF Orientation
Below p
x
labLeftOfF :: p -> F c d -> F c d
labLeftOfF  p
x = forall {p} {c} {d}. Graphic p => Orientation -> p -> F c d -> F c d
labF Orientation
LeftOf p
x
labRightOfF :: p -> F c d -> F c d
labRightOfF p
x = forall {p} {c} {d}. Graphic p => Orientation -> p -> F c d -> F c d
labF Orientation
RightOf p
x

-- eta expanded because of monomorphism restriction