{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Path.Follow
-- Copyright   :  (c) 2016 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@gmail.com
--
-- An alternative monoid for trails which rotates trails so their
-- starting and ending tangents match at join points.
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Path.Follow
    ( Following, follow, unfollow
    ) where

import           Diagrams.Prelude

import           Data.Monoid.SemiDirectProduct.Strict

-- | @Following@ is just like @Trail' Line V2@, except that it has a
--   different 'Monoid' instance.  @Following@ values are
--   concatenated, just like regular lines, except that they are also
--   rotated so the tangents match at the join point.  In addition,
--   they are normalized so the tangent at the start point is in the
--   direction of the positive x axis (essentially we are considering
--   trails equivalent up to rotation).
--
--   Pro tip: you can concatenate a list of trails so their tangents
--   match using 'ala' from "Control.Lens", like so:
--
--     @ala follow foldMap :: [Trail' Line V2 n] -> Trail' Line V2 n@
--
--   This is illustrated in the example below.
--
--   <<diagrams/src_Diagrams_TwoD_Path_Follow_followExample.svg#diagram=followExample&width=400>>
--
--   > import Control.Lens (ala)
--   > import Diagrams.TwoD.Path.Follow
--   >
--   > wibble :: Trail' Line V2 Double
--   > wibble = hrule 1 <> hrule 0.5 # rotateBy (1/6) <> hrule 0.5 # rotateBy (-1/6) <> a
--   >   where a = arc (xDir # rotateBy (-1/4)) (1/5 @@ turn)
--   >           # scale 0.7
--   >
--   > followExample =
--   >   [ wibble
--   >   , wibble
--   >     # replicate 5
--   >     # ala follow foldMap
--   >   ]
--   >   # map stroke
--   >   # map centerXY
--   >   # vsep 1
--   >   # frame 0.5
--
newtype Following n
  = Following { forall n. Following n -> Semi (Trail' Line V2 n) (Angle n)
unFollowing :: Semi (Trail' Line V2 n) (Angle n) }
  deriving (Following n
[Following n] -> Following n
Following n -> Following n -> Following n
forall {n}. (Floating n, Ord n) => Semigroup (Following n)
forall n. (Floating n, Ord n) => Following n
forall n. (Floating n, Ord n) => [Following n] -> Following n
forall n.
(Floating n, Ord n) =>
Following n -> Following n -> Following n
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Following n] -> Following n
$cmconcat :: forall n. (Floating n, Ord n) => [Following n] -> Following n
mappend :: Following n -> Following n -> Following n
$cmappend :: forall n.
(Floating n, Ord n) =>
Following n -> Following n -> Following n
mempty :: Following n
$cmempty :: forall n. (Floating n, Ord n) => Following n
Monoid, NonEmpty (Following n) -> Following n
Following n -> Following n -> Following n
forall n.
(Floating n, Ord n) =>
NonEmpty (Following n) -> Following n
forall n.
(Floating n, Ord n) =>
Following n -> Following n -> Following n
forall n b.
(Floating n, Ord n, Integral b) =>
b -> Following n -> Following n
forall b. Integral b => b -> Following n -> Following n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Following n -> Following n
$cstimes :: forall n b.
(Floating n, Ord n, Integral b) =>
b -> Following n -> Following n
sconcat :: NonEmpty (Following n) -> Following n
$csconcat :: forall n.
(Floating n, Ord n) =>
NonEmpty (Following n) -> Following n
<> :: Following n -> Following n -> Following n
$c<> :: forall n.
(Floating n, Ord n) =>
Following n -> Following n -> Following n
Semigroup)

-- | Note this is only an iso when considering trails equivalent up to
--   rotation.
instance RealFloat n => Wrapped (Following n) where
  type Unwrapped (Following n) = Trail' Line V2 n

  _Wrapped' :: Iso' (Following n) (Unwrapped (Following n))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall n. Following n -> Trail' Line V2 n
unfollow forall n. RealFloat n => Trail' Line V2 n -> Following n
follow

instance RealFloat n => Rewrapped (Following n) (Following n')

-- | Create a @Following@ from a line, normalizing it (by rotation)
--   so that it starts in the positive x direction.
follow :: RealFloat n => Trail' Line V2 n -> Following n
follow :: forall n. RealFloat n => Trail' Line V2 n -> Following n
follow Trail' Line V2 n
t = forall n. Semi (Trail' Line V2 n) (Angle n) -> Following n
Following forall a b. (a -> b) -> a -> b
$ (Trail' Line V2 n
t forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX Vn (Trail' Line V2 n)
s)) forall s m. s -> m -> Semi s m
`tag` Angle n
theta
  where
    s :: Vn (Trail' Line V2 n)
s     = forall t. EndValues (Tangent t) => t -> Vn t
tangentAtStart Trail' Line V2 n
t
    e :: Vn (Trail' Line V2 n)
e     = forall t. EndValues (Tangent t) => t -> Vn t
tangentAtEnd Trail' Line V2 n
t
    theta :: Angle n
theta = forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween Vn (Trail' Line V2 n)
e Vn (Trail' Line V2 n)
s

-- | Project out the line from a `Following`.
--
--   If trails are considered equivalent up to rotation, then
--   'unfollow' and 'follow' are inverse.
unfollow :: Following n -> Trail' Line V2 n
unfollow :: forall n. Following n -> Trail' Line V2 n
unfollow = forall s m. Semi s m -> s
untag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Following n -> Semi (Trail' Line V2 n) (Angle n)
unFollowing