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 -> Double -> g -> F c d -> F c d
tieLabelF Orientation
orient Double
align g
text F c d
fudget =
    let disp :: F a b
disp = g -> F a b
forall g a b. Graphic g => g -> F a b
labelF g
text
        fv :: Bool
fv = Orientation
orient Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Above Bool -> Bool -> Bool
|| Orientation
orient Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Below
        fh :: Bool
fh = Bool -> Bool
not Bool
fv
        lblF :: F a b
lblF = Bool -> Bool -> F a b -> F a b
forall a b. Bool -> Bool -> F a b -> F a b
noStretchF Bool
fh Bool
fv (Distance -> Double -> Double -> F a b -> F a b
forall a b. Distance -> Double -> Double -> F a b -> F a b
marginHVAlignF Distance
0 Double
align Double
align F a b
forall a b. F a b
disp)
    in  (Either d d -> d
forall p. Either p p -> p
stripEither (Either d d -> d)
-> F (Either Any c) (Either d d) -> F (Either Any c) d
forall a b e. (a -> b) -> F e a -> F e b
>^=< ((F Any d
forall a b. F a b
lblF,Orientation
orient) (F Any d, Orientation) -> F c d -> F (Either Any c) (Either d d)
forall a b c d.
(F a b, Orientation) -> F c d -> F (Either a c) (Either b d)
>#+< F c d
fudget)) F (Either Any c) d -> (c -> Either Any c) -> F c d
forall c d e. F c d -> (e -> c) -> F e d
>=^< c -> Either Any c
forall a b. b -> Either a b
Right


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

-- eta expanded because of monomorphism restriction