{-# LANGUAGE TypeFamilies #-}

-- | Combinators to allow writing Metafont-style paths embedded in
-- Haskell, with the usual Diagrams types for points and directions.

module Diagrams.TwoD.Path.Metafont.Combinators
       (
           (.-), (-.), (.--.)
       , endpt, cyclePath
       , simpleJoin -- is this actually needed?
       , tension, tensions, controls
       , leaving, arriving
       ) where

import           Diagrams.Prelude
import           Diagrams.TwoD.Path.Metafont.Types

-- internal alias to keep the signatures readable
type Join n = PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))

-- | /point/ @.-@ /join/ @-.@ /path/ adds /point/ to the
-- left end of the metafont /path/, connected by /join/.
(.-) :: P2 n -> MFPathData J n -> MFPathData P n
.- :: forall n. P2 n -> MFPathData J n -> MFPathData P n
(.-) = P2 n -> MFPathData J n -> MFPathData P n
forall n. P2 n -> MFPathData J n -> MFPathData P n
MFPathPt

-- | See @.-@ above.
(-.) :: Join n -> MFPathData P n -> MFPathData J n
-. :: forall n. Join n -> MFPathData P n -> MFPathData J n
(-.) = PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> MFPathData P n -> MFPathData J n
forall n. Join n -> MFPathData P n -> MFPathData J n
MFPathJoin

infixr 5 .-
infixr 5 -.

-- | Terminate the right-end of a Metafont path at the given point.
endpt :: P2 n -> MFPathData P n
endpt :: forall n. P2 n -> MFPathData P n
endpt = P2 n -> MFPathData P n
forall n. P2 n -> MFPathData P n
MFPathEnd

-- | Wrap the right-end of the Metafont path back to the left-end.
-- When converted to a Diagrams 'Trail'', this will be a Loop.
cyclePath :: MFPathData P n
cyclePath :: forall n. MFPathData P n
cyclePath = MFPathData P n
forall n. MFPathData P n
MFPathCycle

-- | Add a point to the left of a Metafont path using a simple join.
-- That is, neither direction is specified, and both tensions are 1.
(.--.) :: P2 n -> MFPathData P n -> MFPathData P n
P2 n
p .--. :: forall n. P2 n -> MFPathData P n -> MFPathData P n
.--. MFPathData P n
q = P2 n
p P2 n -> MFPathData J n -> MFPathData P n
forall n. P2 n -> MFPathData J n -> MFPathData P n
.- Join n
forall a. Monoid a => a
mempty Join n -> MFPathData P n -> MFPathData J n
forall n. Join n -> MFPathData P n -> MFPathData J n
-. MFPathData P n
q

infixr 5 .--.

-- | simpleJoin is the same as mempty, with a more specific type.  It
-- is provided for convenience in situations where explicit type
-- signatures would otherwise be needed, such as when building up a
-- join using lenses.
simpleJoin :: Join n
simpleJoin :: forall n. Join n
simpleJoin = Join n
forall a. Monoid a => a
mempty

-- | A join with both tensions the same.
tension :: n -> Join n
tension :: forall n. n -> Join n
tension n
t = Maybe (PathDir n)
-> Maybe (BasicJoin n)
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall d j. d -> j -> d -> PathJoin d j
PJ Maybe (PathDir n)
forall a. Maybe a
Nothing (BasicJoin n -> Maybe (BasicJoin n)
forall a. a -> Maybe a
Just (BasicJoin n -> Maybe (BasicJoin n))
-> (TensionJoin n -> BasicJoin n)
-> TensionJoin n
-> Maybe (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (TensionJoin n -> Maybe (BasicJoin n))
-> TensionJoin n -> Maybe (BasicJoin n)
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ (n -> Tension n
forall n. n -> Tension n
TensionAmt n
t) (n -> Tension n
forall n. n -> Tension n
TensionAmt n
t)) Maybe (PathDir n)
forall a. Maybe a
Nothing

-- | A join with two tension values.
tensions :: n -> n -> Join n
tensions :: forall n. n -> n -> Join n
tensions n
tl n
tr = Maybe (PathDir n)
-> Maybe (BasicJoin n)
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall d j. d -> j -> d -> PathJoin d j
PJ Maybe (PathDir n)
forall a. Maybe a
Nothing (BasicJoin n -> Maybe (BasicJoin n)
forall a. a -> Maybe a
Just (BasicJoin n -> Maybe (BasicJoin n))
-> (TensionJoin n -> BasicJoin n)
-> TensionJoin n
-> Maybe (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (TensionJoin n -> Maybe (BasicJoin n))
-> TensionJoin n -> Maybe (BasicJoin n)
forall a b. (a -> b) -> a -> b
$ Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ (n -> Tension n
forall n. n -> Tension n
TensionAmt n
tl) (n -> Tension n
forall n. n -> Tension n
TensionAmt n
tr)) Maybe (PathDir n)
forall a. Maybe a
Nothing

-- | A join with explicit control points.  Note that these are in the
-- same coordinate system as the endpoints, not relative to the latter.
controls :: P2 n -> P2 n -> Join n
controls :: forall n. P2 n -> P2 n -> Join n
controls P2 n
u P2 n
v = Join n
forall n. Join n
simpleJoin Join n -> (Join n -> Join n) -> Join n
forall a b. a -> (a -> b) -> b
& (Maybe (BasicJoin n) -> Identity (Maybe (BasicJoin n)))
-> Join n -> Identity (Join n)
forall d j1 j2 (f :: * -> *).
Functor f =>
(j1 -> f j2) -> PathJoin d j1 -> f (PathJoin d j2)
j((Maybe (BasicJoin n) -> Identity (Maybe (BasicJoin n)))
 -> Join n -> Identity (Join n))
-> Maybe (BasicJoin n) -> Join n -> Join n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (BasicJoin n -> Maybe (BasicJoin n)
forall a. a -> Maybe a
Just (BasicJoin n -> Maybe (BasicJoin n))
-> (ControlJoin n -> BasicJoin n)
-> ControlJoin n
-> Maybe (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlJoin n -> BasicJoin n
forall a b. b -> Either a b
Right (ControlJoin n -> Maybe (BasicJoin n))
-> ControlJoin n -> Maybe (BasicJoin n)
forall a b. (a -> b) -> a -> b
$ P2 n -> P2 n -> ControlJoin n
forall n. P2 n -> P2 n -> ControlJoin n
CJ P2 n
u P2 n
v)

-- | A join with the left-end direction specified.
leaving :: V2 n -> Join n
leaving :: forall n. V2 n -> Join n
leaving V2 n
d = PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall a. Monoid a => a
mempty PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
    -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n)))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall a b. a -> (a -> b) -> b
& (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> Identity (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n)))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
 -> Identity (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))))
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just (PathDir n -> Maybe (PathDir n))
-> (V2 n -> PathDir n) -> V2 n -> Maybe (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir n -> PathDir n
forall n. Dir n -> PathDir n
PathDirDir (Dir n -> PathDir n) -> (V2 n -> Dir n) -> V2 n -> PathDir n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Dir n
forall (v :: * -> *) n. v n -> Direction v n
direction (V2 n -> Maybe (PathDir n)) -> V2 n -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ V2 n
d)

-- | A join with the right-end direction specified.
arriving :: V2 n -> Join n
arriving :: forall n. V2 n -> Join n
arriving V2 n
d = PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall a. Monoid a => a
mempty PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
    -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n)))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall a b. a -> (a -> b) -> b
& (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> Identity (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n)))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
 -> Identity (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))))
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just (PathDir n -> Maybe (PathDir n))
-> (V2 n -> PathDir n) -> V2 n -> Maybe (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir n -> PathDir n
forall n. Dir n -> PathDir n
PathDirDir (Dir n -> PathDir n) -> (V2 n -> Dir n) -> V2 n -> PathDir n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Dir n
forall (v :: * -> *) n. v n -> Direction v n
direction (V2 n -> Maybe (PathDir n)) -> V2 n -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ V2 n
d)