{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Animation.Active
-- Copyright   :  (c) 2011 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@cis.upenn.edu
--
-- A few utilities and class instances for 'Active' (from the @active@
-- package).  In particular, this module defines
--
--   * An instance of 'V' for 'Active': @'V' ('Active' a) = 'V' a@
--
--   * 'HasOrigin', 'Transformable', and 'HasStyle' instances for
--     'Active' which all work pointwise.
--
--   * A 'TrailLike' instance for @'Active' p@ where @p@ is also
--     'TrailLike', which simply lifts a pathlike thing to a constant
--     active value.
--
--   * A 'Juxtaposable' instance for @'Active' a@ where @a@ is also
--     'Juxtaposable'.  An active value can be juxtaposed against
--     another by doing the juxtaposition pointwise over time.  The
--     era of @juxtapose v a1 a2@ will be the same as the era of @a2@,
--     unless @a2@ is constant, in which case it will be the era of
--     @a1@.  (Note that @juxtapose v a1 a2@ and @liftA2 (juxtapose v)
--     a1 a2@ therefore have different semantics: the second is an
--     active value whose era is the /combination/ of the eras of @a1@
--     and @a2@).
--
--   * An 'Alignable' instance for @'Active' a@ where @a@ is also
--     'Alignable'; the active value is aligned pointwise over time.

-----------------------------------------------------------------------------

module Diagrams.Animation.Active where

import           Diagrams.Core
import           Diagrams.TrailLike

import           Data.Active

type instance V (Active a) = V a
type instance N (Active a) = N a

-- Yes, these are all orphan instances. Get over it.  We don't want to
-- put them in the 'active' package because 'active' is supposed to be
-- generally useful and shouldn't depend on diagrams.  We'd also
-- rather not put them in diagrams-core so that diagrams-core doesn't
-- have to depend on active.

instance HasOrigin a => HasOrigin (Active a) where
  moveOriginTo :: Point (V (Active a)) (N (Active a)) -> Active a -> Active a
moveOriginTo = (a -> a) -> Active a -> Active a
forall a b. (a -> b) -> Active a -> Active b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Active a -> Active a)
-> (Point (V a) (N a) -> a -> a)
-> Point (V a) (N a)
-> Active a
-> Active a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point (V a) (N a) -> a -> a
forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo

instance Transformable a => Transformable (Active a) where
  transform :: Transformation (V (Active a)) (N (Active a))
-> Active a -> Active a
transform = (a -> a) -> Active a -> Active a
forall a b. (a -> b) -> Active a -> Active b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Active a -> Active a)
-> (Transformation (V a) (N a) -> a -> a)
-> Transformation (V a) (N a)
-> Active a
-> Active a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (V a) (N a) -> a -> a
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform

instance HasStyle a => HasStyle (Active a) where
  applyStyle :: Style (V (Active a)) (N (Active a)) -> Active a -> Active a
applyStyle = (a -> a) -> Active a -> Active a
forall a b. (a -> b) -> Active a -> Active b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Active a -> Active a)
-> (Style (V a) (N a) -> a -> a)
-> Style (V a) (N a)
-> Active a
-> Active a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style (V a) (N a) -> a -> a
forall a. HasStyle a => Style (V a) (N a) -> a -> a
applyStyle

instance TrailLike t => TrailLike (Active t) where
  trailLike :: Located (Trail (V (Active t)) (N (Active t))) -> Active t
trailLike = t -> Active t
forall a. a -> Active a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Active t)
-> (Located (Trail (V t) (N t)) -> t)
-> Located (Trail (V t) (N t))
-> Active t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike

-- | An active value can be juxtaposed against another by doing the
--   juxtaposition pointwise over time.  The era of @juxtapose v a1
--   a2@ will be the same as the era of @a2@, unless @a2@ is constant,
--   in which case it will be the era of @a1@.  (Note that @juxtapose
--   v a1 a2@ and @liftA2 (juxtapose v) a1 a2@ therefore have
--   different semantics: the second is an active value whose era is
--   the /combination/ of the eras of @a1@ and @a2@).
instance Juxtaposable a => Juxtaposable (Active a) where

  juxtapose :: Vn (Active a) -> Active a -> Active a -> Active a
juxtapose Vn (Active a)
v Active a
a1 Active a
a2 =
    (a -> Active a) -> (Dynamic a -> Active a) -> Active a -> Active a
forall a b. (a -> b) -> (Dynamic a -> b) -> Active a -> b
onActive       -- a1
      (\a
c1 ->        -- if a1 is constant, just juxtapose a2 pointwise with its value
        Vn a -> a -> a -> a
forall a. Juxtaposable a => Vn a -> a -> a -> a
juxtapose Vn a
Vn (Active a)
v a
c1 (a -> a) -> Active a -> Active a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Active a
a2
      )
                     -- if a1 is dynamic...
      ((Time Rational
 -> Time Rational -> (Time Rational -> a) -> Active a)
-> Dynamic a -> Active a
forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic ((Time Rational
  -> Time Rational -> (Time Rational -> a) -> Active a)
 -> Dynamic a -> Active a)
-> (Time Rational
    -> Time Rational -> (Time Rational -> a) -> Active a)
-> Dynamic a
-> Active a
forall a b. (a -> b) -> a -> b
$ \Time Rational
s1 Time Rational
e1 Time Rational -> a
d1 ->
        (a -> Active a) -> (Dynamic a -> Active a) -> Active a -> Active a
forall a b. (a -> b) -> (Dynamic a -> b) -> Active a -> b
onActive      -- a2
          (\a
c2 ->      -- if a2 is constant, juxtapose pointwise with a1.  Since
                       --   the result will no longer be constant, the result
                       --   needs an era: we use a1's.
            Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
mkActive Time Rational
s1 Time Rational
e1 (\Time Rational
t -> Vn a -> a -> a -> a
forall a. Juxtaposable a => Vn a -> a -> a -> a
juxtapose Vn a
Vn (Active a)
v (Time Rational -> a
d1 Time Rational
t) a
c2)
          )

                       -- otherwise, juxtapose pointwise, without changing a2's era
          ((Time Rational
 -> Time Rational -> (Time Rational -> a) -> Active a)
-> Dynamic a -> Active a
forall a b.
(Time Rational -> Time Rational -> (Time Rational -> a) -> b)
-> Dynamic a -> b
onDynamic ((Time Rational
  -> Time Rational -> (Time Rational -> a) -> Active a)
 -> Dynamic a -> Active a)
-> (Time Rational
    -> Time Rational -> (Time Rational -> a) -> Active a)
-> Dynamic a
-> Active a
forall a b. (a -> b) -> a -> b
$ \Time Rational
s2 Time Rational
e2 Time Rational -> a
d2 ->
            Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
forall a.
Time Rational -> Time Rational -> (Time Rational -> a) -> Active a
mkActive Time Rational
s2 Time Rational
e2 (\Time Rational
t -> Vn a -> a -> a -> a
forall a. Juxtaposable a => Vn a -> a -> a -> a
juxtapose Vn a
Vn (Active a)
v (Time Rational -> a
d1 Time Rational
t) (Time Rational -> a
d2 Time Rational
t))
          )
          Active a
a2
      )
      Active a
a1

-- instance Alignable a => Alignable (Active a) where
--   alignBy v d a = alignBy v d <$> a