{-# LANGUAGE DefaultSignatures         #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE DeriveDataTypeable        #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Anchors
-- Copyright   :  (c) 2016 Bradley Hardy
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  bradleyhardy@live.com
--
-- An /anchor/ is a point on an object which can be used for alignment
-- by naming it, offering easier control over alignment compared to the
-- 'Diagrams.Align' module when aligning many objects.
--
-----------------------------------------------------------------------------

module Diagrams.Anchors
       (
         -- * Anchors
         Anchor
         -- * Anchored objects
       , Anchored
       , withAnchors
       , noAnchors
       , addAnchor
       , deleteAnchor
       , getAnchorOffset
       , alignAnchor
       , hasAnchor
       , unanchor
         -- * Positional anchors
       , PositionalAnchor (..)
       , rotateAnchors
       , rotatePosAnchors
         -- * Easily concatenate many anchored objects
       , anchorMany
       , anchorMany_
         -- * Debugging
       , showAnchor
       , showAnchor_)
       where

import           Diagrams.Names
import           Diagrams.Core
import           Diagrams.Path
import           Diagrams.TwoD.Model

import qualified Control.Lens     as Lens
import           Control.Lens     hiding (transform, (.>))
import           Data.List        (foldl')
import           Data.Map         (Map)
import qualified Data.Map         as Map
import           Data.Maybe       (fromJust, fromMaybe)
import qualified Data.Set         as Set
import           Data.Typeable    (Typeable)

import           Linear.Vector
import           Linear.V2
import           Linear.Affine

--------------------------------------------------------------------------------
--  Anchors
--------------------------------------------------------------------------------

type Anchor = Name

--------------------------------------------------------------------------------
--  Anchored objects
--------------------------------------------------------------------------------

-- | An 'Anchored' object which can be aligned to anchor points before
-- concatenating with other 'Anchored' objects. Note that when concatenating,
-- any anchors with the same names in each of the left and right operands will
-- be retained in the left operand, and lost in the right. To avoid this, qualify
-- anchors in each object using '(\>>/)'.
data Anchored t =
  Anchored
  { forall t. Anchored t -> Maybe Anchor
_currentAnchor :: Maybe Anchor
  , forall t. Anchored t -> Map Anchor (V t (N t))
_anchors :: Map Anchor (V t (N t))
  , forall t. Anchored t -> t
_anchoredObj :: t
  }

makeLenses ''Anchored

type instance N (Anchored t) = N t
type instance V (Anchored t) = V t

instance (HasOrigin t, Additive (V t), Num (N t)) => HasOrigin (Anchored t) where
  moveOriginTo :: Point (V (Anchored t)) (N (Anchored t)) -> Anchored t -> Anchored t
moveOriginTo p :: Point (V (Anchored t)) (N (Anchored t))
p@(P V (Anchored t) (N (Anchored t))
v) =
    ((t -> Identity t) -> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj ((t -> Identity t) -> Anchored t -> Identity (Anchored t))
-> (t -> t) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point (V t) (N t) -> t -> t
forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point (V t) (N t)
Point (V (Anchored t)) (N (Anchored t))
p) (Anchored t -> Anchored t)
-> (Anchored t -> Anchored t) -> Anchored t -> Anchored t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> ((V t (N t) -> Identity (V t (N t)))
    -> Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> (V t (N t) -> Identity (V t (N t)))
-> Anchored t
-> Identity (Anchored t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V t (N t) -> Identity (V t (N t)))
-> Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Anchor a -> f (Map Anchor b)
traverse ((V t (N t) -> Identity (V t (N t)))
 -> Anchored t -> Identity (Anchored t))
-> (V t (N t) -> V t (N t)) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (V (Anchored t) (N (Anchored t))
-> V (Anchored t) (N (Anchored t))
-> V (Anchored t) (N (Anchored t))
forall a.
Num a =>
V (Anchored t) a -> V (Anchored t) a -> V (Anchored t) a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V (Anchored t) (N (Anchored t))
v))

instance (Transformable t) => Transformable (Anchored t) where
  transform :: Transformation (V (Anchored t)) (N (Anchored t))
-> Anchored t -> Anchored t
transform Transformation (V (Anchored t)) (N (Anchored t))
t =
    ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> ((V t (N t) -> Identity (V t (N t)))
    -> Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> (V t (N t) -> Identity (V t (N t)))
-> Anchored t
-> Identity (Anchored t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V t (N t) -> Identity (V t (N t)))
-> Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Anchor a -> f (Map Anchor b)
traverse ((V t (N t) -> Identity (V t (N t)))
 -> Anchored t -> Identity (Anchored t))
-> (V t (N t) -> V t (N t)) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Transformation (V t) (N t) -> V t (N t) -> V t (N t)
forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply Transformation (V t) (N t)
Transformation (V (Anchored t)) (N (Anchored t))
t) (Anchored t -> Anchored t)
-> (Anchored t -> Anchored t) -> Anchored t -> Anchored t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((t -> Identity t) -> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj ((t -> Identity t) -> Anchored t -> Identity (Anchored t))
-> (t -> t) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V t) (N t)
Transformation (V (Anchored t)) (N (Anchored t))
t)

instance (Additive (V t), Num (N t), HasOrigin t, Semigroup t) => Semigroup (Anchored t) where
  Anchored t
o1 <> :: Anchored t -> Anchored t -> Anchored t
<> Anchored t
o2 =
    let updateObj :: Anchored t -> Anchored t
updateObj Anchored t
obj
          | Just Anchor
anchor <- Anchored t
objAnchored t
-> Getting (Maybe Anchor) (Anchored t) (Maybe Anchor)
-> Maybe Anchor
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Anchor) (Anchored t) (Maybe Anchor)
forall t (f :: * -> *).
Functor f =>
(Maybe Anchor -> f (Maybe Anchor)) -> Anchored t -> f (Anchored t)
currentAnchor
            = V t (N t) -> Anchored t -> Anchored t
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, HasOrigin t) =>
v n -> t -> t
moveOriginBy (Anchor -> Anchored t -> V t (N t)
forall t a.
(Num (N t), Additive (V t), IsName a) =>
a -> Anchored t -> V t (N t)
getAnchorOffset Anchor
anchor Anchored t
obj)
            (Anchored t -> Anchored t)
-> (Anchored t -> Anchored t) -> Anchored t -> Anchored t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchor -> Anchored t -> Anchored t
forall anchor t.
IsName anchor =>
anchor -> Anchored t -> Anchored t
deleteAnchor Anchor
anchor
            (Anchored t -> Anchored t) -> Anchored t -> Anchored t
forall a b. (a -> b) -> a -> b
$ Anchored t
obj
          | Bool
otherwise = Anchored t
obj

        Anchored t
a1 <+> :: Anchored t -> Anchored t -> Anchored t
<+> Anchored t
a2 = Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
forall t. Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
Anchored Maybe Anchor
forall a. Maybe a
Nothing
                             ((Anchored t
a1 Anchored t
-> Getting
     (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
-> Map Anchor (V t (N t))
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors) Map Anchor (V t (N t))
-> Map Anchor (V t (N t)) -> Map Anchor (V t (N t))
forall a. Semigroup a => a -> a -> a
<> (Anchored t
a2 Anchored t
-> Getting
     (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
-> Map Anchor (V t (N t))
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors))
                             ((Anchored t
a1 Anchored t -> Getting t (Anchored t) t -> t
forall s a. s -> Getting a s a -> a
^. Getting t (Anchored t) t
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj) t -> t -> t
forall a. Semigroup a => a -> a -> a
<> (Anchored t
a2 Anchored t -> Getting t (Anchored t) t -> t
forall s a. s -> Getting a s a -> a
^. Getting t (Anchored t) t
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj))
    in Anchored t -> Anchored t
forall {t}.
(HasOrigin t, Additive (V t), Num (N t)) =>
Anchored t -> Anchored t
updateObj Anchored t
o1 Anchored t -> Anchored t -> Anchored t
forall {t}. Semigroup t => Anchored t -> Anchored t -> Anchored t
<+> Anchored t -> Anchored t
forall {t}.
(HasOrigin t, Additive (V t), Num (N t)) =>
Anchored t -> Anchored t
updateObj Anchored t
o2

instance (Additive (V t), Num (N t), HasOrigin t, Monoid' t) => Monoid (Anchored t) where
  mempty :: Anchored t
mempty = Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
forall t. Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
Anchored Maybe Anchor
forall a. Maybe a
Nothing Map Anchor (V t (N t))
forall a. Monoid a => a
mempty t
forall a. Monoid a => a
mempty
  mappend :: Anchored t -> Anchored t -> Anchored t
mappend = Anchored t -> Anchored t -> Anchored t
forall a. Semigroup a => a -> a -> a
(<>)

instance (Show (V t (N t)), Show t) => Show (Anchored t) where
  showsPrec :: Int -> Anchored t -> ShowS
showsPrec Int
p Anchored t
anch =
    Int -> Map Anchor (V t (N t)) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Anchored t
anchAnchored t
-> Getting
     (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
-> Map Anchor (V t (N t))
forall s a. s -> Getting a s a -> a
^.Getting
  (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Anchored t
anchAnchored t -> Getting t (Anchored t) t -> t
forall s a. s -> Getting a s a -> a
^.Getting t (Anchored t) t
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj)

-- | Add another anchor to an already 'Anchored' object.
addAnchor :: IsName anchor => anchor -> V t (N t) -> Anchored t -> Anchored t
addAnchor :: forall anchor t.
IsName anchor =>
anchor -> V t (N t) -> Anchored t -> Anchored t
addAnchor anchor
anchor V t (N t)
val = (Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> ((Maybe (V t (N t)) -> Identity (Maybe (V t (N t))))
    -> Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> (Maybe (V t (N t)) -> Identity (Maybe (V t (N t))))
-> Anchored t
-> Identity (Anchored t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Anchor (V t (N t)))
-> Lens'
     (Map Anchor (V t (N t))) (Maybe (IxValue (Map Anchor (V t (N t)))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
Lens.at (anchor -> Anchor
forall a. IsName a => a -> Anchor
toName anchor
anchor) ((Maybe (V t (N t)) -> Identity (Maybe (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> Maybe (V t (N t)) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ V t (N t) -> Maybe (V t (N t))
forall a. a -> Maybe a
Just V t (N t)
val

-- | Attach a list of anchors to an object, making it 'Anchored'.
withAnchors :: IsName anchor => [(anchor, V t (N t))] -> t -> Anchored t
withAnchors :: forall anchor t.
IsName anchor =>
[(anchor, V t (N t))] -> t -> Anchored t
withAnchors = Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
forall t. Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
Anchored Maybe Anchor
forall a. Maybe a
Nothing (Map Anchor (V t (N t)) -> t -> Anchored t)
-> ([(anchor, V t (N t))] -> Map Anchor (V t (N t)))
-> [(anchor, V t (N t))]
-> t
-> Anchored t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Anchor, V t (N t))] -> Map Anchor (V t (N t))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Anchor, V t (N t))] -> Map Anchor (V t (N t)))
-> ([(anchor, V t (N t))] -> [(Anchor, V t (N t))])
-> [(anchor, V t (N t))]
-> Map Anchor (V t (N t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter [(anchor, V t (N t))] [(Anchor, V t (N t))] anchor Anchor
-> (anchor -> Anchor)
-> [(anchor, V t (N t))]
-> [(Anchor, V t (N t))]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((anchor, V t (N t)) -> Identity (Anchor, V t (N t)))
-> [(anchor, V t (N t))] -> Identity [(Anchor, V t (N t))]
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  [(anchor, V t (N t))]
  [(Anchor, V t (N t))]
  (anchor, V t (N t))
  (Anchor, V t (N t))
each (((anchor, V t (N t)) -> Identity (Anchor, V t (N t)))
 -> [(anchor, V t (N t))] -> Identity [(Anchor, V t (N t))])
-> ((anchor -> Identity Anchor)
    -> (anchor, V t (N t)) -> Identity (Anchor, V t (N t)))
-> ASetter
     [(anchor, V t (N t))] [(Anchor, V t (N t))] anchor Anchor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (anchor -> Identity Anchor)
-> (anchor, V t (N t)) -> Identity (Anchor, V t (N t))
forall s t a b. Field1 s t a b => Lens s t a b
Lens (anchor, V t (N t)) (Anchor, V t (N t)) anchor Anchor
_1) anchor -> Anchor
forall a. IsName a => a -> Anchor
toName

-- | Turn an object into a trivial 'Anchored' object with no anchors.
noAnchors :: t -> Anchored t
noAnchors :: forall t. t -> Anchored t
noAnchors = Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
forall t. Maybe Anchor -> Map Anchor (V t (N t)) -> t -> Anchored t
Anchored Maybe Anchor
forall a. Maybe a
Nothing Map Anchor (V t (N t))
forall a. Monoid a => a
mempty

-- | Delete an anchor from an anchored object. Does nothing if the object does
-- not have the specified anchor.
deleteAnchor :: IsName anchor => anchor -> Anchored t -> Anchored t
deleteAnchor :: forall anchor t.
IsName anchor =>
anchor -> Anchored t -> Anchored t
deleteAnchor anchor
anchor = (Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> ((Maybe (V t (N t)) -> Identity (Maybe (V t (N t))))
    -> Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> (Maybe (V t (N t)) -> Identity (Maybe (V t (N t))))
-> Anchored t
-> Identity (Anchored t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Anchor (V t (N t)))
-> Lens'
     (Map Anchor (V t (N t))) (Maybe (IxValue (Map Anchor (V t (N t)))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
Lens.at (anchor -> Anchor
forall a. IsName a => a -> Anchor
toName anchor
anchor) ((Maybe (V t (N t)) -> Identity (Maybe (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> Maybe (V t (N t)) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (V t (N t))
forall a. Maybe a
Nothing

-- | Get the offset from the origin of a particular anchor, or 'zero' if the object
-- does not have the specified anchor.
getAnchorOffset :: (Num (N t), Additive (V t), IsName a) => a -> Anchored t -> V t (N t)
getAnchorOffset :: forall t a.
(Num (N t), Additive (V t), IsName a) =>
a -> Anchored t -> V t (N t)
getAnchorOffset a
anchor = Getting (V t (N t)) (Anchored t) (V t (N t))
-> Anchored t -> V t (N t)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (V t (N t)) (Anchored t) (V t (N t))
 -> Anchored t -> V t (N t))
-> Getting (V t (N t)) (Anchored t) (V t (N t))
-> Anchored t
-> V t (N t)
forall a b. (a -> b) -> a -> b
$ (Map Anchor (V t (N t))
 -> Const (V t (N t)) (Map Anchor (V t (N t))))
-> Anchored t -> Const (V t (N t)) (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t))
  -> Const (V t (N t)) (Map Anchor (V t (N t))))
 -> Anchored t -> Const (V t (N t)) (Anchored t))
-> ((V t (N t) -> Const (V t (N t)) (V t (N t)))
    -> Map Anchor (V t (N t))
    -> Const (V t (N t)) (Map Anchor (V t (N t))))
-> Getting (V t (N t)) (Anchored t) (V t (N t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Anchor (V t (N t)))
-> Lens'
     (Map Anchor (V t (N t))) (Maybe (IxValue (Map Anchor (V t (N t)))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
Lens.at (a -> Anchor
forall a. IsName a => a -> Anchor
toName a
anchor) ((Maybe (V t (N t)) -> Const (V t (N t)) (Maybe (V t (N t))))
 -> Map Anchor (V t (N t))
 -> Const (V t (N t)) (Map Anchor (V t (N t))))
-> ((V t (N t) -> Const (V t (N t)) (V t (N t)))
    -> Maybe (V t (N t)) -> Const (V t (N t)) (Maybe (V t (N t))))
-> (V t (N t) -> Const (V t (N t)) (V t (N t)))
-> Map Anchor (V t (N t))
-> Const (V t (N t)) (Map Anchor (V t (N t)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (V t (N t)) -> V t (N t))
-> (V t (N t) -> Const (V t (N t)) (V t (N t)))
-> Maybe (V t (N t))
-> Const (V t (N t)) (Maybe (V t (N t)))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (V t (N t) -> Maybe (V t (N t)) -> V t (N t)
forall a. a -> Maybe a -> a
fromMaybe V t (N t)
forall a. Num a => V t a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)

-- | Align an anchored object to an anchor. Subsequently concatening with '(<>)'
-- will take this into account.
alignAnchor :: (IsName a) => a -> Anchored t -> Anchored t
alignAnchor :: forall anchor t.
IsName anchor =>
anchor -> Anchored t -> Anchored t
alignAnchor a
anch = (Maybe Anchor -> Identity (Maybe Anchor))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Maybe Anchor -> f (Maybe Anchor)) -> Anchored t -> f (Anchored t)
currentAnchor ((Maybe Anchor -> Identity (Maybe Anchor))
 -> Anchored t -> Identity (Anchored t))
-> Maybe Anchor -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (a -> Anchor
forall a. IsName a => a -> Anchor
toName a
anch)

-- | Does the given anchored object have the given anchor?
hasAnchor :: (IsName a) => a -> Anchored t -> Bool
hasAnchor :: forall a t. IsName a => a -> Anchored t -> Bool
hasAnchor a
anchor = Getting Bool (Anchored t) Bool -> Anchored t -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool (Anchored t) Bool -> Anchored t -> Bool)
-> Getting Bool (Anchored t) Bool -> Anchored t -> Bool
forall a b. (a -> b) -> a -> b
$ (Map Anchor (V t (N t)) -> Const Bool (Map Anchor (V t (N t))))
-> Anchored t -> Const Bool (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t)) -> Const Bool (Map Anchor (V t (N t))))
 -> Anchored t -> Const Bool (Anchored t))
-> ((Bool -> Const Bool Bool)
    -> Map Anchor (V t (N t)) -> Const Bool (Map Anchor (V t (N t))))
-> Getting Bool (Anchored t) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Anchor (V t (N t)) -> Bool)
-> (Bool -> Const Bool Bool)
-> Map Anchor (V t (N t))
-> Const Bool (Map Anchor (V t (N t)))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Anchor -> Map Anchor (V t (N t)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (a -> Anchor
forall a. IsName a => a -> Anchor
toName a
anchor))

-- | Throw away anchors and get the underlying object.
unanchor
  :: Anchored t -> t
unanchor :: forall t. Anchored t -> t
unanchor = Getting t (Anchored t) t -> Anchored t -> t
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting t (Anchored t) t
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj

--------------------------------------------------------------------------------
--  Positional Anchors
--------------------------------------------------------------------------------

-- | A convenient type of positional anchors.
data PositionalAnchor
  = AnchorL
  | AnchorTL
  | AnchorT
  | AnchorTR
  | AnchorR
  | AnchorBR
  | AnchorB
  | AnchorBL
  deriving (PositionalAnchor -> PositionalAnchor -> Bool
(PositionalAnchor -> PositionalAnchor -> Bool)
-> (PositionalAnchor -> PositionalAnchor -> Bool)
-> Eq PositionalAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PositionalAnchor -> PositionalAnchor -> Bool
== :: PositionalAnchor -> PositionalAnchor -> Bool
$c/= :: PositionalAnchor -> PositionalAnchor -> Bool
/= :: PositionalAnchor -> PositionalAnchor -> Bool
Eq, Eq PositionalAnchor
Eq PositionalAnchor =>
(PositionalAnchor -> PositionalAnchor -> Ordering)
-> (PositionalAnchor -> PositionalAnchor -> Bool)
-> (PositionalAnchor -> PositionalAnchor -> Bool)
-> (PositionalAnchor -> PositionalAnchor -> Bool)
-> (PositionalAnchor -> PositionalAnchor -> Bool)
-> (PositionalAnchor -> PositionalAnchor -> PositionalAnchor)
-> (PositionalAnchor -> PositionalAnchor -> PositionalAnchor)
-> Ord PositionalAnchor
PositionalAnchor -> PositionalAnchor -> Bool
PositionalAnchor -> PositionalAnchor -> Ordering
PositionalAnchor -> PositionalAnchor -> PositionalAnchor
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PositionalAnchor -> PositionalAnchor -> Ordering
compare :: PositionalAnchor -> PositionalAnchor -> Ordering
$c< :: PositionalAnchor -> PositionalAnchor -> Bool
< :: PositionalAnchor -> PositionalAnchor -> Bool
$c<= :: PositionalAnchor -> PositionalAnchor -> Bool
<= :: PositionalAnchor -> PositionalAnchor -> Bool
$c> :: PositionalAnchor -> PositionalAnchor -> Bool
> :: PositionalAnchor -> PositionalAnchor -> Bool
$c>= :: PositionalAnchor -> PositionalAnchor -> Bool
>= :: PositionalAnchor -> PositionalAnchor -> Bool
$cmax :: PositionalAnchor -> PositionalAnchor -> PositionalAnchor
max :: PositionalAnchor -> PositionalAnchor -> PositionalAnchor
$cmin :: PositionalAnchor -> PositionalAnchor -> PositionalAnchor
min :: PositionalAnchor -> PositionalAnchor -> PositionalAnchor
Ord, Int -> PositionalAnchor -> ShowS
[PositionalAnchor] -> ShowS
PositionalAnchor -> String
(Int -> PositionalAnchor -> ShowS)
-> (PositionalAnchor -> String)
-> ([PositionalAnchor] -> ShowS)
-> Show PositionalAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PositionalAnchor -> ShowS
showsPrec :: Int -> PositionalAnchor -> ShowS
$cshow :: PositionalAnchor -> String
show :: PositionalAnchor -> String
$cshowList :: [PositionalAnchor] -> ShowS
showList :: [PositionalAnchor] -> ShowS
Show, Typeable, Int -> PositionalAnchor
PositionalAnchor -> Int
PositionalAnchor -> [PositionalAnchor]
PositionalAnchor -> PositionalAnchor
PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
PositionalAnchor
-> PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
(PositionalAnchor -> PositionalAnchor)
-> (PositionalAnchor -> PositionalAnchor)
-> (Int -> PositionalAnchor)
-> (PositionalAnchor -> Int)
-> (PositionalAnchor -> [PositionalAnchor])
-> (PositionalAnchor -> PositionalAnchor -> [PositionalAnchor])
-> (PositionalAnchor -> PositionalAnchor -> [PositionalAnchor])
-> (PositionalAnchor
    -> PositionalAnchor -> PositionalAnchor -> [PositionalAnchor])
-> Enum PositionalAnchor
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PositionalAnchor -> PositionalAnchor
succ :: PositionalAnchor -> PositionalAnchor
$cpred :: PositionalAnchor -> PositionalAnchor
pred :: PositionalAnchor -> PositionalAnchor
$ctoEnum :: Int -> PositionalAnchor
toEnum :: Int -> PositionalAnchor
$cfromEnum :: PositionalAnchor -> Int
fromEnum :: PositionalAnchor -> Int
$cenumFrom :: PositionalAnchor -> [PositionalAnchor]
enumFrom :: PositionalAnchor -> [PositionalAnchor]
$cenumFromThen :: PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
enumFromThen :: PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
$cenumFromTo :: PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
enumFromTo :: PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
$cenumFromThenTo :: PositionalAnchor
-> PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
enumFromThenTo :: PositionalAnchor
-> PositionalAnchor -> PositionalAnchor -> [PositionalAnchor]
Enum)

instance IsName PositionalAnchor where

{-|
Given an 'Anchored' object containing the given list of anchors, rotate the
order of the given anchors clockwise by the given number of positions.

For example, given a diagram with positional anchors on it in these positions:

@
TL    T    TR

L          R

BL    B    BR
@

using @'rotatePosAnchors' 1 = 'rotateAnchors' (enumFrom AnchorL) 1@ will move
the anchors to these positions:

@
L     TL   T

BL         TR

B     BR   R
@

Using a parameter @n@ is equivalent to using @1@, @n@ times and a negative
number produces an anticlockwise rotation.

If any of the anchors do not exist, this function skips them.
-}
rotateAnchors :: (IsName anchor) => [anchor] -> Int -> Anchored t -> Anchored t
rotateAnchors :: forall anchor t.
IsName anchor =>
[anchor] -> Int -> Anchored t -> Anchored t
rotateAnchors [anchor]
allAnchorsList Int
n Anchored t
t =
  let allAnchorsSet :: Set Anchor
allAnchorsSet = [Anchor] -> Set Anchor
forall a. Ord a => [a] -> Set a
Set.fromList ([Anchor] -> Set Anchor)
-> ([anchor] -> [Anchor]) -> [anchor] -> Set Anchor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (anchor -> Anchor) -> [anchor] -> [Anchor]
forall a b. (a -> b) -> [a] -> [b]
map anchor -> Anchor
forall a. IsName a => a -> Anchor
toName ([anchor] -> Set Anchor) -> [anchor] -> Set Anchor
forall a b. (a -> b) -> a -> b
$ [anchor]
allAnchorsList
      allObjAnchors :: Map Anchor (V t (N t))
allObjAnchors = Anchored t
t Anchored t
-> Getting
     (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
-> Map Anchor (V t (N t))
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Anchor (V t (N t))) (Anchored t) (Map Anchor (V t (N t)))
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors
      presentAnchorsSet :: Set Anchor
presentAnchorsSet = Map Anchor (V t (N t)) -> Set Anchor
forall k a. Map k a -> Set k
Map.keysSet Map Anchor (V t (N t))
allObjAnchors Set Anchor -> Set Anchor -> Set Anchor
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set Anchor
allAnchorsSet
      presentAnchorsList :: [anchor]
presentAnchorsList = (anchor -> Bool) -> [anchor] -> [anchor]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Anchor -> Set Anchor -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Anchor
presentAnchorsSet) (Anchor -> Bool) -> (anchor -> Anchor) -> anchor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. anchor -> Anchor
forall a. IsName a => a -> Anchor
toName) [anchor]
allAnchorsList
      rotateList :: Int -> [a] -> [a]
rotateList Int
k [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
k [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
k [a]
xs
      rotatedList :: [anchor]
rotatedList = Int -> [anchor] -> [anchor]
forall a. Int -> [a] -> [a]
rotateList ((-Int
n) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [anchor] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [anchor]
presentAnchorsList) [anchor]
presentAnchorsList
      findOriginalPairing :: anchor -> V t (N t)
findOriginalPairing anchor
posAnch = Maybe (V t (N t)) -> V t (N t)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (V t (N t)) -> V t (N t)) -> Maybe (V t (N t)) -> V t (N t)
forall a b. (a -> b) -> a -> b
$ Anchor -> Map Anchor (V t (N t)) -> Maybe (V t (N t))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (anchor -> Anchor
forall a. IsName a => a -> Anchor
toName anchor
posAnch) Map Anchor (V t (N t))
allObjAnchors
      originalOffsets :: [V t (N t)]
originalOffsets = (anchor -> V t (N t)) -> [anchor] -> [V t (N t)]
forall a b. (a -> b) -> [a] -> [b]
map anchor -> V t (N t)
findOriginalPairing [anchor]
presentAnchorsList
      rotatedOffsets :: [(Anchor, V t (N t))]
rotatedOffsets = [Anchor] -> [V t (N t)] -> [(Anchor, V t (N t))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((anchor -> Anchor) -> [anchor] -> [Anchor]
forall a b. (a -> b) -> [a] -> [b]
map anchor -> Anchor
forall a. IsName a => a -> Anchor
toName [anchor]
rotatedList) [V t (N t)]
originalOffsets
      newObjAnchors :: Map Anchor (V t (N t))
newObjAnchors = [(Anchor, V t (N t))] -> Map Anchor (V t (N t))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Anchor, V t (N t))]
rotatedOffsets Map Anchor (V t (N t))
-> Map Anchor (V t (N t)) -> Map Anchor (V t (N t))
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Anchor (V t (N t))
allObjAnchors
  in Anchored t
t Anchored t -> (Anchored t -> Anchored t) -> Anchored t
forall a b. a -> (a -> b) -> b
& (Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> Map Anchor (V t (N t)) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Anchor (V t (N t))
newObjAnchors

-- | As 'rotateAnchors', but specialised to the list of all 'PositionalAnchor's.
rotatePosAnchors :: Int -> Anchored t -> Anchored t
rotatePosAnchors :: forall t. Int -> Anchored t -> Anchored t
rotatePosAnchors = [PositionalAnchor] -> Int -> Anchored t -> Anchored t
forall anchor t.
IsName anchor =>
[anchor] -> Int -> Anchored t -> Anchored t
rotateAnchors (PositionalAnchor -> [PositionalAnchor]
forall a. Enum a => a -> [a]
enumFrom PositionalAnchor
AnchorL)

--------------------------------------------------------------------------------
--  Qualifying Anchors
--------------------------------------------------------------------------------

instance Qualifiable t => Qualifiable (Anchored t) where
  .>> :: forall a. IsName a => a -> Anchored t -> Anchored t
(.>>) a
name =
    ((Maybe Anchor -> Identity (Maybe Anchor))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Maybe Anchor -> f (Maybe Anchor)) -> Anchored t -> f (Anchored t)
currentAnchor ((Maybe Anchor -> Identity (Maybe Anchor))
 -> Anchored t -> Identity (Anchored t))
-> ((Anchor -> Identity Anchor)
    -> Maybe Anchor -> Identity (Maybe Anchor))
-> (Anchor -> Identity Anchor)
-> Anchored t
-> Identity (Anchored t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Anchor -> Identity Anchor)
-> Maybe Anchor -> Identity (Maybe Anchor)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Anchor -> Identity Anchor)
 -> Anchored t -> Identity (Anchored t))
-> (Anchor -> Anchor) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a
name a -> Anchor -> Anchor
forall a1 a2. (IsName a1, IsName a2) => a1 -> a2 -> Anchor
.>)) (Anchored t -> Anchored t)
-> (Anchored t -> Anchored t) -> Anchored t -> Anchored t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
-> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(Map Anchor (V t (N t)) -> f (Map Anchor (V t (N t))))
-> Anchored t -> f (Anchored t)
anchors ((Map Anchor (V t (N t)) -> Identity (Map Anchor (V t (N t))))
 -> Anchored t -> Identity (Anchored t))
-> (Map Anchor (V t (N t)) -> Map Anchor (V t (N t)))
-> Anchored t
-> Anchored t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Anchor -> Anchor)
-> Map Anchor (V t (N t)) -> Map Anchor (V t (N t))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (a
name a -> Anchor -> Anchor
forall a1 a2. (IsName a1, IsName a2) => a1 -> a2 -> Anchor
.>)) (Anchored t -> Anchored t)
-> (Anchored t -> Anchored t) -> Anchored t -> Anchored t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((t -> Identity t) -> Anchored t -> Identity (Anchored t)
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj ((t -> Identity t) -> Anchored t -> Identity (Anchored t))
-> (t -> t) -> Anchored t -> Anchored t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (a
name a -> t -> t
forall q a. (Qualifiable q, IsName a) => a -> q -> q
forall a. IsName a => a -> t -> t
.>>))

--------------------------------------------------------------------------------
--  Easily concatenate many anchored objects
--------------------------------------------------------------------------------

{-|
Starting from a base anchored object, recursively concatenate more objects to
the structure built up so far. Be sure to qualify anchors in the input so that
names aren't overwritten.

In each @(thatAnchor, thisAnchor, obj)@ triple, @thatAnchor@ refers to the
anchor point in the structure already constructed, and @thisAnchor@ refers to
the anchor point in the new object being added.
-}
anchorMany
  :: (Num (N t), Semigroup t, Additive (V t), HasOrigin t,
      IsName anchor) =>
     Anchored t -> [(anchor, anchor, Anchored t)] -> Anchored t
anchorMany :: forall t anchor.
(Num (N t), Semigroup t, Additive (V t), HasOrigin t,
 IsName anchor) =>
Anchored t -> [(anchor, anchor, Anchored t)] -> Anchored t
anchorMany = (Anchored t -> (anchor, anchor, Anchored t) -> Anchored t)
-> Anchored t -> [(anchor, anchor, Anchored t)] -> Anchored t
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Anchored t -> (anchor, anchor, Anchored t) -> Anchored t
forall {t} {a} {a}.
(Additive (V t), Num (N t), HasOrigin t, Semigroup t, IsName a,
 IsName a) =>
Anchored t -> (a, a, Anchored t) -> Anchored t
go
  where
    go :: Anchored t -> (a, a, Anchored t) -> Anchored t
go Anchored t
base (a
thatAnch, a
thisAnch, Anchored t
obj)
      = a -> Anchored t -> Anchored t
forall anchor t.
IsName anchor =>
anchor -> Anchored t -> Anchored t
alignAnchor a
thatAnch Anchored t
base Anchored t -> Anchored t -> Anchored t
forall a. Semigroup a => a -> a -> a
<> a -> Anchored t -> Anchored t
forall anchor t.
IsName anchor =>
anchor -> Anchored t -> Anchored t
alignAnchor a
thisAnch Anchored t
obj

-- | As 'anchorMany', but call 'unanchor' on the result. Convenient when you're
-- not going to be doing any more alignment using anchors with the result.
anchorMany_
  :: (Num (N c), Semigroup c, Additive (V c), HasOrigin c,
      IsName anchor) =>
     Anchored c -> [(anchor, anchor, Anchored c)] -> c
anchorMany_ :: forall c anchor.
(Num (N c), Semigroup c, Additive (V c), HasOrigin c,
 IsName anchor) =>
Anchored c -> [(anchor, anchor, Anchored c)] -> c
anchorMany_ Anchored c
base = Anchored c -> c
forall t. Anchored t -> t
unanchor (Anchored c -> c)
-> ([(anchor, anchor, Anchored c)] -> Anchored c)
-> [(anchor, anchor, Anchored c)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchored c -> [(anchor, anchor, Anchored c)] -> Anchored c
forall t anchor.
(Num (N t), Semigroup t, Additive (V t), HasOrigin t,
 IsName anchor) =>
Anchored t -> [(anchor, anchor, Anchored t)] -> Anchored t
anchorMany Anchored c
base

--------------------------------------------------------------------------------
--  Debugging
--------------------------------------------------------------------------------

-- | Show a particular anchor in the 'Anchored' object.
showAnchor
  :: (RealFloat n, Typeable n, Monoid m, Semigroup m,
      Renderable (Path V2 n) b, IsName a) =>
     a -> Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
showAnchor :: forall n m b a.
(RealFloat n, Typeable n, Monoid m, Semigroup m,
 Renderable (Path V2 n) b, IsName a) =>
a -> Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
showAnchor a
anch = Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
moveFromAnchor (Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m))
-> (Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m))
-> Anchored (QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Anchored (QDiagram b V2 n m))
  (Anchored (QDiagram b V2 n m))
  (QDiagram b V2 n m)
  (QDiagram b V2 n m)
-> (QDiagram b V2 n m -> QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Anchored (QDiagram b V2 n m))
  (Anchored (QDiagram b V2 n m))
  (QDiagram b V2 n m)
  (QDiagram b V2 n m)
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj QDiagram b V2 n m -> QDiagram b V2 n m
forall n b m.
(TypeableFloat n, Renderable (Path V2 n) b, Monoid' m) =>
QDiagram b V2 n m -> QDiagram b V2 n m
showOrigin (Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m))
-> (Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m))
-> Anchored (QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
moveToAnchor
  where
    moveToAnchor :: Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
moveToAnchor   Anchored (QDiagram b V2 n m)
t = Anchored (QDiagram b V2 n m)
t Anchored (QDiagram b V2 n m)
-> (Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m))
-> Anchored (QDiagram b V2 n m)
forall a b. a -> (a -> b) -> b
& ASetter
  (Anchored (QDiagram b V2 n m))
  (Anchored (QDiagram b V2 n m))
  (QDiagram b V2 n m)
  (QDiagram b V2 n m)
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj ASetter
  (Anchored (QDiagram b V2 n m))
  (Anchored (QDiagram b V2 n m))
  (QDiagram b V2 n m)
  (QDiagram b V2 n m)
-> (QDiagram b V2 n m -> QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, HasOrigin t) =>
v n -> t -> t
moveOriginBy ( a
-> Anchored (QDiagram b V2 n m)
-> V (QDiagram b V2 n m) (N (QDiagram b V2 n m))
forall t a.
(Num (N t), Additive (V t), IsName a) =>
a -> Anchored t -> V t (N t)
getAnchorOffset a
anch Anchored (QDiagram b V2 n m)
t)
    moveFromAnchor :: Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
moveFromAnchor Anchored (QDiagram b V2 n m)
t = Anchored (QDiagram b V2 n m)
t Anchored (QDiagram b V2 n m)
-> (Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m))
-> Anchored (QDiagram b V2 n m)
forall a b. a -> (a -> b) -> b
& ASetter
  (Anchored (QDiagram b V2 n m))
  (Anchored (QDiagram b V2 n m))
  (QDiagram b V2 n m)
  (QDiagram b V2 n m)
forall t (f :: * -> *).
Functor f =>
(t -> f t) -> Anchored t -> f (Anchored t)
anchoredObj ASetter
  (Anchored (QDiagram b V2 n m))
  (Anchored (QDiagram b V2 n m))
  (QDiagram b V2 n m)
  (QDiagram b V2 n m)
-> (QDiagram b V2 n m -> QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
-> Anchored (QDiagram b V2 n m)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, HasOrigin t) =>
v n -> t -> t
moveOriginBy (-a
-> Anchored (QDiagram b V2 n m)
-> V (QDiagram b V2 n m) (N (QDiagram b V2 n m))
forall t a.
(Num (N t), Additive (V t), IsName a) =>
a -> Anchored t -> V t (N t)
getAnchorOffset a
anch Anchored (QDiagram b V2 n m)
t)

-- | Show a particular anchor in the 'Anchored' object, then 'unanchor'.
showAnchor_
  :: (RealFloat n, Typeable n, Monoid m, Semigroup m,
      Renderable (Path V2 n) b, IsName a) =>
     a -> Anchored (QDiagram b V2 n m) -> QDiagram b V2 n m
showAnchor_ :: forall n m b a.
(RealFloat n, Typeable n, Monoid m, Semigroup m,
 Renderable (Path V2 n) b, IsName a) =>
a -> Anchored (QDiagram b V2 n m) -> QDiagram b V2 n m
showAnchor_ a
anch = Anchored (QDiagram b V2 n m) -> QDiagram b V2 n m
forall t. Anchored t -> t
unanchor (Anchored (QDiagram b V2 n m) -> QDiagram b V2 n m)
-> (Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m))
-> Anchored (QDiagram b V2 n m)
-> QDiagram b V2 n m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
forall n m b a.
(RealFloat n, Typeable n, Monoid m, Semigroup m,
 Renderable (Path V2 n) b, IsName a) =>
a -> Anchored (QDiagram b V2 n m) -> Anchored (QDiagram b V2 n m)
showAnchor a
anch