    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE UndecidableInstances  #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Combinators
    -- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Higher-level tools for combining diagrams.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Combinators
           ( -- * Unary operations

             withEnvelope, withTrace
           , phantom, strut
           , pad
           , extrudeEnvelope, intrudeEnvelope

             -- * Binary operations
           , atop
           , beneath
           , beside

             -- * n-ary operations
           , appends
           , position, decorateTrail, decorateLocatedTrail, decoratePath
           , cat, cat', CatOpts(..), CatMethod(..)

           ) where

    import           Data.AdditiveGroup
    import           Data.AffineSpace   ((.+^))
    import           Data.Default.Class
    import           Data.Semigroup
    import           Data.VectorSpace

    import           Diagrams.Core
    import           Diagrams.Located
    import           Diagrams.Path
    import           Diagrams.Segment   (Segment (..), straight)
    import           Diagrams.Trail     (Trail, trailVertices)
    import           Diagrams.TrailLike (fromOffsets)
    import           Diagrams.Util

    ------------------------------------------------------------
    -- Working with envelopes
    ------------------------------------------------------------

    -- | Use the envelope from some object as the envelope for a
    --   diagram, in place of the diagram's default envelope.
    withEnvelope :: (HasLinearMap (V a), Enveloped a, Monoid' m)
               => a -> QDiagram b (V a) m -> QDiagram b (V a) m
    withEnvelope = setEnvelope . getEnvelope

    -- | Use the trace from some object as the trace for a diagram, in
    --   place of the diagram's default trace.
    withTrace :: (HasLinearMap (V a), Traced a, OrderedField (Scalar (V a)), InnerSpace (V a), Monoid' m)
              => a -> QDiagram b (V a) m -> QDiagram b (V a) m
    withTrace = setTrace . getTrace

    -- | @phantom x@ produces a \"phantom\" diagram, which has the same
    --   envelope and trace as @x@ but produces no output.
    phantom :: (Backend b (V a), Enveloped a, Traced a, Monoid' m) => a -> QDiagram b (V a) m
    phantom a = mkQD nullPrim (getEnvelope a) (getTrace a) mempty mempty

    -- | @pad s@ \"pads\" a diagram, expanding its envelope by a factor of
    --   @s@ (factors between 0 and 1 can be used to shrink the envelope).
    --   Note that the envelope will expand with respect to the local
    --   origin, so if the origin is not centered the padding may appear
    --   \"uneven\".  If this is not desired, the origin can be centered
    --   (using, e.g., 'centerXY' for 2D diagrams) before applying @pad@.
    pad :: ( Backend b v
           , InnerSpace v, OrderedField (Scalar v)
           , Monoid' m )
        => Scalar v -> QDiagram b v m -> QDiagram b v m
    pad s d = withEnvelope (d # scale s) d

    -- | @strut v@ is a diagram which produces no output, but with respect
    --   to alignment and envelope acts like a 1-dimensional segment
    --   oriented along the vector @v@, with local origin at its
    --   center. (Note, however, that it has an empty trace; for 2D struts
    --   with a nonempty trace see 'strutR2', 'strutX', and 'strutY' from
    --   "Diagrams.TwoD.Combinators".) Useful for manually creating
    --   separation between two diagrams.
    strut :: ( Backend b v, InnerSpace v
             , OrderedField (Scalar v)
             , Monoid' m
             )
          => v -> QDiagram b v m
    strut v = mkQD nullPrim env mempty mempty mempty
      where env = translate ((-0.5) *^ v) . getEnvelope $ straight v
      -- note we can't use 'phantom' here because it tries to construct a
      -- trace as well, and segments do not have a trace in general (only
      -- in 2D; see Diagrams.TwoD.Segment).  This is a good reason to have
      -- a special 'strut' combinator (before the introduction of traces
      -- it was mostly just for convenience).
      --
      -- also note that we can't remove the call to getEnvelope, since
      -- translating a segment has no effect.

    -- | @extrudeEnvelope v d@ asymmetrically \"extrudes\" the envelope of
    --   a diagram in the given direction.  All parts of the envelope
    --   within 90 degrees of this direction are modified, offset outwards
    --   by the magnitude of the vector.
    --
    --   This works by offsetting the envelope distance proportionally to
    --   the cosine of the difference in angle, and leaving it unchanged
    --   when this factor is negative.
    extrudeEnvelope
      :: ( Ord (Scalar v), Num (Scalar v), AdditiveGroup (Scalar v)
         , Floating (Scalar v), HasLinearMap v, InnerSpace v, Monoid' m )
      => v -> QDiagram b v m -> QDiagram b v m
    extrudeEnvelope = deformEnvelope 0.5

    -- | @intrudeEnvelope v d@ asymmetrically \"intrudes\" the envelope of
    --   a diagram away from the given direction.  All parts of the envelope
    --   within 90 degrees of this direction are modified, offset inwards
    --   by the magnitude of the vector.
    --
    --   Note that this could create strange inverted envelopes, where
    --   @ diameter v d < 0 @.
    intrudeEnvelope
      :: ( Ord (Scalar v), Num (Scalar v), AdditiveGroup (Scalar v)
         , Floating (Scalar v), HasLinearMap v, InnerSpace v, Monoid' m )
      => v -> QDiagram b v m -> QDiagram b v m
    intrudeEnvelope = deformEnvelope (-0.5)

    -- Utility for extrudeEnvelope / intrudeEnvelope
    deformEnvelope
      :: ( Ord (Scalar v), Num (Scalar v), AdditiveGroup (Scalar v)
         , Floating (Scalar v), HasLinearMap v, InnerSpace v, Monoid' m )
      => (Scalar v) -> v -> QDiagram b v m -> QDiagram b v m
    deformEnvelope s v d = setEnvelope (inEnvelope deform $ getEnvelope d) d
      where
        deform = Option . fmap deform' . getOption
        deform' env v'
            | dot > 0 = Max $ getMax (env v') + (dot * s) / magnitude v'
            | otherwise = env v'
          where
            dot = v' <.> v

    ------------------------------------------------------------
    -- Combining two objects
    ------------------------------------------------------------

    -- | @beneath@ is just a convenient synonym for @'flip' 'atop'@; that is,
    --   @d1 \`beneath\` d2@ is the diagram with @d2@ superimposed on top of
    --   @d1@.
    beneath :: (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Monoid' m)
         => QDiagram b v m -> QDiagram b v m -> QDiagram b v m
    beneath = flip atop

    infixl 6 `beneath`

    -- | Place two monoidal objects (/i.e./ diagrams, paths,
    --   animations...) next to each other along the given vector.  In
    --   particular, place the second object so that the vector points
    --   from the local origin of the first object to the local origin of
    --   the second object, at a distance so that their envelopes are just
    --   tangent.  The local origin of the new, combined object is the
    --   local origin of the first object (unless the first object is the
    --   identity element, in which case the second object is returned
    --   unchanged).
    --
    --   <<diagrams/besideEx.svg#diagram=besideEx&height=200>>
    --
    --   > besideEx = beside (r2 (20,30))
    --   >                   (circle 1 # fc orange)
    --   >                   (circle 1.5 # fc purple)
    --   >            # showOrigin
    --   >            # centerXY # pad 1.1
    --
    --   Note that @beside v@ is associative, so objects under @beside v@
    --   form a semigroup for any given vector @v@.  In fact, they also
    --   form a monoid: 'mempty' is clearly a right identity (@beside v d1
    --   mempty === d1@), and there should also be a special case to make
    --   it a left identity, as described above.
    --
    --   In older versions of diagrams, @beside@ put the local origin of
    --   the result at the point of tangency between the two inputs.  That
    --   semantics can easily be recovered by performing an alignment on
    --   the first input before combining.  That is, if @beside'@ denotes
    --   the old semantics,
    --
    --   > beside' v x1 x2 = beside v (x1 # align v) x2
    --
    --   To get something like @beside v x1 x2@ whose local origin is
    --   identified with that of @x2@ instead of @x1@, use @beside
    --   (negateV v) x2 x1@.
    beside :: (Juxtaposable a, Semigroup a) => V a -> a -> a -> a
    beside v d1 d2 = d1 <> juxtapose v d1 d2

    ------------------------------------------------------------
    -- Combining multiple objects
    ------------------------------------------------------------

    -- | @appends x ys@ appends each of the objects in @ys@ to the object
    --   @x@ in the corresponding direction.  Note that each object in
    --   @ys@ is positioned beside @x@ /without/ reference to the other
    --   objects in @ys@, so this is not the same as iterating 'beside'.
    appends :: (Juxtaposable a, Monoid' a) => a -> [(V a,a)] -> a
    appends d1 apps = d1 <> mconcat (map (\(v,d) -> juxtapose v d1 d) apps)

    -- | Position things absolutely: combine a list of objects
    --   (e.g. diagrams or paths) by assigning them absolute positions in
    --   the vector space of the combined object.
    position :: (HasOrigin a, Monoid' a) => [(Point (V a), a)] -> a
    position = mconcat . map (uncurry moveTo)

    -- | Combine a list of diagrams (or paths) by using them to
    --   \"decorate\" a trail, placing the local origin of one object at
    --   each successive vertex of the trail.  The first vertex of the
    --   trail is placed at the origin.  If the trail and list of objects
    --   have different lengths, the extra tail of the longer one is
    --   ignored.
    decorateTrail :: (InnerSpace (V a), OrderedField (Scalar (V a)), HasOrigin a, Monoid' a)
                  => Trail (V a) -> [a] -> a
    decorateTrail = decorateLocatedTrail . (`at` origin)

    -- | Combine a list of diagrams (or paths) by using them to
    --   \"decorate\" a concretely located trail, placing the local origin
    --   of one object at each successive vertex of the trail. If the
    --   trail and list of objects have different lengths, the extra tail
    --   of the longer one is ignored.
    decorateLocatedTrail :: (InnerSpace (V a), OrderedField (Scalar (V a)), HasOrigin a, Monoid' a)
                  => Located (Trail (V a)) -> [a] -> a
    decorateLocatedTrail t = position . zip (trailVertices t)

    -- | Combine a list of diagrams (or paths) by using them to
    --   \"decorate\" a path, placing the local origin of one object at
    --   each successive vertex of the path.  If the path and list of objects
    --   have different lengths, the extra tail of the longer one is
    --   ignored.
    decoratePath :: (InnerSpace (V a), OrderedField (Scalar (V a)), HasOrigin a, Monoid' a)
                 => Path (V a) -> [a] -> a
    decoratePath p = position . zip (concat $ pathVertices p)

    -- | Methods for concatenating diagrams.
    data CatMethod = Cat     -- ^ Normal catenation: simply put diagrams
                             --   next to one another (possibly with a
                             --   certain distance in between each). The
                             --   distance between successive diagram
                             --   /envelopes/ will be consistent; the
                             --   distance between /origins/ may vary if
                             --   the diagrams are of different sizes.
                   | Distrib -- ^ Distribution: place the local origins of
                             --   diagrams at regular intervals.  With
                             --   this method, the distance between
                             --   successive /origins/ will be consistent
                             --   but the distance between envelopes may
                             --   not be.  Indeed, depending on the amount
                             --   of separation, diagrams may overlap.

    -- | Options for 'cat''.
    data CatOpts v = CatOpts { catMethod       :: CatMethod
                                 -- ^ Which 'CatMethod' should be used:
                                 --   normal catenation (default), or
                                 --   distribution?
                             , sep             :: Scalar v
                                 -- ^ How much separation should be used
                                 --   between successive diagrams
                                 --   (default: 0)?  When @catMethod =
                                 --   Cat@, this is the distance between
                                 --   /envelopes/; when @catMethod =
                                 --   Distrib@, this is the distance
                                 --   between /origins/.
                             , catOptsvProxy__ :: Proxy v
                                 -- ^ This field exists solely to aid type inference;
                                 --   please ignore it.
                             }

    -- The reason the proxy field is necessary is that without it,
    -- altering the sep field could theoretically change the type of a
    -- CatOpts record.  This causes problems when writing an expression
    -- like @with { sep = 10 }@, because knowing the type of the whole
    -- expression does not tell us anything about the type of @with@, and
    -- therefore the @Num (Scalar v)@ constraint cannot be satisfied.
    -- Adding the Proxy field constrains the type of @with@ in @with {sep
    -- = 10}@ to be the same as the type of the whole expression.

    instance Num (Scalar v) => Default (CatOpts v) where
      def = CatOpts { catMethod       = Cat
                    , sep             = 0
                    , catOptsvProxy__ = Proxy
                    }

    -- | @cat v@ positions a list of objects so that their local origins
    --   lie along a line in the direction of @v@.  Successive objects
    --   will have their envelopes just touching.  The local origin
    --   of the result will be the same as the local origin of the first
    --   object.
    --
    --   See also 'cat'', which takes an extra options record allowing
    --   certain aspects of the operation to be tweaked.
    cat :: ( Juxtaposable a, Monoid' a, HasOrigin a
           , InnerSpace (V a), OrderedField (Scalar (V a))
           )
           => V a -> [a] -> a
    cat v = cat' v def

    -- | Like 'cat', but taking an extra 'CatOpts' arguments allowing the
    --   user to specify
    --
    --   * The spacing method: catenation (uniform spacing between
    --     envelopes) or distribution (uniform spacing between local
    --     origins).  The default is catenation.
    --
    --   * The amount of separation between successive diagram
    --     envelopes/origins (depending on the spacing method).  The
    --     default is 0.
    --
    --   'CatOpts' is an instance of 'Default', so 'with' may be used for
    --   the second argument, as in @cat' (1,2) with {sep = 2}@.
    --
    --   Note that @cat' v with {catMethod = Distrib} === mconcat@
    --   (distributing with a separation of 0 is the same as
    --   superimposing).
    cat' :: ( Juxtaposable a, Monoid' a, HasOrigin a
            , InnerSpace (V a), OrderedField (Scalar (V a))
            )
         => V a -> CatOpts (V a) -> [a] -> a
    cat' v (CatOpts { catMethod = Cat, sep = s }) = foldB comb mempty
      where comb d1 d2 = d1 <> (juxtapose v d1 d2 # moveOriginBy vs)
            vs = s *^ normalized (negateV v)

    cat' v (CatOpts { catMethod = Distrib, sep = s }) =
      position . zip (iterate (.+^ (s *^ normalized v)) origin)