{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Diagrams.Types
-- Copyright   :  (c) Brent Yorgey 2008
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Layout definitions for "Graphics.Rendering.Diagrams", an embedded
-- domain-specific language (EDSL) for creating simple diagrams.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.Diagrams.Layouts
  ( -- * Union

    (##)
  , union, unionA

    -- * Lists

  , (<>), (//)
  , hcat, vcat
  , hcatA, vcatA
  , hsep, vsep
  , hsepA, vsepA
  , hdistrib, vdistrib
  , hdistribA, vdistribA

  , VAlignment
  , top, vcenter, bottom
  , HAlignment
  , left, hcenter, right

  ) where

import Graphics.Rendering.Diagrams.Types
import Graphics.Rendering.Diagrams.Attributes
import Control.Arrow ((***), first, (>>>))

-- Union -----------------------------------------------

-- | The union layout, which lays out diagrams superimposed on one
--   another.  The diagrams can be aligned both vertically and
--   horizontally.  A union layout with centered alignment in both
--   axes is simply the identity layout which does no repositioning of
--   subdiagrams.
data UnionLayout = UnionL HAlignment VAlignment
instance LayoutClass UnionLayout [] where
  layoutSizeAndPos _ [] = ((0,0), [])
  layoutSizeAndPos (UnionL halign valign) pds = ((w,h), positionedDs)
    where (sizes, diagrams) = unzip pds
          (xs, ys)          = unzip sizes
          (w,h)             = (maximum xs, maximum ys)
          xs'               = align halign w xs
          ys'               = align valign h ys
          positionedDs      = zipWith3 translate xs' ys' diagrams

-- | Create a 'Diagram' as a union of subdiagrams which will not be
--   repositioned.  If the subdiagrams overlap, they will appear with
--   the first 'Diagram' on the bottom, and the last on top.
union :: [Diagram] -> Diagram
union = unionA hcenter vcenter

-- | Superimpose one diagram atop another.  @d1 ## d2@ results in a
--   diagram in which @d2@ is on top of @d1@ (i.e., @d1@ is drawn
--   first, then @d2@).
(##) :: Diagram -> Diagram -> Diagram
d1 ## d2 = union [d1, d2]

-- | Create a 'Diagram' as a union of subdiagrams superimposed on one
--   another, aligned vertically and/or horizontally.
unionA :: HAlignment -> VAlignment -> [Diagram] -> Diagram
unionA ha va = Compound . Layout (UnionL ha va)

-- Lists -----------------------------------------------

-- | The possible ways to arrange a list of diagrams.
data ListType = H    -- ^ in a horizontal row, left to right
              | V    -- ^ in a vertical column, top to bottom
  deriving (Eq, Show, Read)

-- | A list of 'Diagram's can be aligned in one of several ways.
data Alignment = TopLeft      -- ^ Align along top/left edges, i.e. in
                              --   the negative direction
               | Center       -- ^ Align centers
               | BottomRight  -- ^ Align bottom/right edges, i.e. in
                              --   the positive direction
  deriving (Eq, Show, Read)

-- | Vertical alignment.
type VAlignment = Alignment

-- | Horizontal alignment.
type HAlignment = Alignment

top, vcenter, bottom :: VAlignment
left, hcenter, right :: HAlignment
top = TopLeft
bottom = BottomRight
left = TopLeft
right = BottomRight
vcenter = Center
hcenter = Center

-- | Compute new coordinates for the centers of the subdiagrams of a
--   list, based on the alignment.
align :: Alignment -> Double -> [Double] -> [Double]
align TopLeft     h hs = map ((/2) . (subtract h)) hs
align Center      h hs = repeat 0
align BottomRight h hs = map negate (align TopLeft h hs)

-- | A list of 'Diagram's can be distributed in one of several ways.
data Distribution = Sep Double  -- ^ Put a constant separation between
                                --   each pair of diagrams
                  | Distrib Alignment Double
                                -- ^ @Distrib align sep@ represents
                                --   evenly spaced diagrams,
                                --   distributed with the @align@ of a
                                --   diagram placed every @sep@ units.
                                --   For example, @Distrib TopLeft 50@
                                --   means that the top/left of a
                                --   diagram will occur every 50
                                --   units.
  deriving (Eq, Show, Read)

-- | A horizontal or vertical list of diagrams, with configurable
--   alignment and distribution.
data List = List ListType Alignment Distribution
instance LayoutClass List [] where
  layoutSizeAndPos _ [] = ((0,0), [])
  layoutSizeAndPos (List typ algn dist) dss =

        -- unzip sizes and diagrams, flipping sizes for a vertical layout
    let (sizes, diagrams) = first (map (mswap typ)) $ unzip dss

        -- calculate the total size, given the method of distribution
        size  = listSize  dist sizes

        -- calculate new positions for the subdiagrams, flipping
        --   positions back for a vertical layout
        pos   = map (mswap typ) $ listPosns algn dist size sizes

        -- apply appropriate translates, and flip the final size for a
        --   vertical layout
    in  (mswap typ size, zipWith (uncurry translate) pos diagrams)

-- | Conditionally swap points, so vertical lists can be laid out
--   using the same code as horizontal lists, with appropriate swaps
--   before and after layout processing.
mswap :: ListType -> Point -> Point
mswap H (x,y) = (x,y)
mswap V (x,y) = (y,x)

-- | Given a method of distribution and the sizes of the subdiagrams
--   for a horizontal list, compute the total size of the entire list
listSize :: Distribution -> [Point] -> Point
listSize (Sep sep) ss = (x,y)
  where (xs,ys) = unzip ss
        x = sum xs + (sep * fromIntegral (length ss - 1))
        y = maximum ys
listSize (Distrib _ sep) ss = (x,y)
  where x = sep * fromIntegral (length ss)
        y = maximum (map snd ss)

-- | Calculate the final positions for the centers of the subdiagrams
--   of a horizontal list, based on the alignment and distribution.
listPosns :: Alignment      -- ^ vertical alignment of list elements
          -> Distribution   -- ^ horizontal distribution
          -> Point          -- ^ pre-calculated total size of the list
          -> [Point]        -- ^ sizes of individual elements
          -> [Point]        -- ^ new coordinates for the center of
                            --   each list element
listPosns a (Sep sep) (w,h) sizes = zip xs ys
  where (ws,hs)    = unzip sizes
        offsets    = scanl (+) 0 ws
        offsWSeps  = zipWith (+) offsets (zipWith (*) [0..] (repeat sep))
        centers    = zipWith (+) (init offsWSeps) (map (/2) ws)
        xs         = map (subtract (w/2)) centers
        ys         = align a h hs

listPosns a (Distrib da sep) (w,h) sizes = zip xs ys
  where (ws,hs)    = unzip sizes
        offsets    = zipWith (*) [0..] (repeat sep)
        centers    = zipWith (+) offsets (map (centerOffs da) ws)
        centerOffs TopLeft width = width/2
        centerOffs Center  _     = sep/2
        centerOffs BottomRight width = sep - width/2
        xs         = map (subtract (w/2)) centers
        ys         = align a h hs

-- | Lay out a list of 'Diagram's horizontally from left to right,
--   aligned along their top edges.
hcat :: [Diagram] -> Diagram
hcat = hsep 0

-- | @d1 <> d2@ is a 'Diagram' with @d1@ to the left of @d2@, aligned
--   along their top edges.
(<>) :: Diagram -> Diagram -> Diagram
d1 <> d2 = hcat [d1, d2]

-- | Lay out a list of 'Diagram's horizontally from left to right,
--   with the given vertical alignment ('top', 'vcenter', or 'bottom').
hcatA :: VAlignment -> [Diagram] -> Diagram
hcatA = hsepA 0

-- | Lay out a list of 'Diagram's horizontally, aligned along their
--   top edges, with a given amount of separation in between each pair.
hsep :: Double        -- ^ amount of separation between each pair of diagrams
     -> [Diagram] -> Diagram
hsep sep = hsepA sep top

-- | Lay out a list of 'Diagram's horizontally, with the given
--   amount of separation in between each pair, using the given
--   vertical alignment ('top', 'center', or 'bottom').
hsepA :: Double       -- ^ amount of separation between each pair of diagrams
      -> VAlignment   -- ^ alignment to use ('top', 'vcenter', or 'bottom')
      -> [Diagram] -> Diagram
hsepA = sepA H

-- | Distribute a list of 'Diagram's horizontally according to a
--   regular spacing, aligned along their top edges.
hdistrib :: Double      -- ^ How far from one diagram to the next?
         -> HAlignment  -- ^ Distribute according to which parts of
                        --   the diagrams ('left', 'hcenter', 'right')?
         -> [Diagram] -> Diagram
hdistrib sep alignD = hdistribA sep alignD top

-- | Distribute a list of 'Diagram's horizontally according to a
--   regular spacing, with the given alignment.
hdistribA :: Double     -- ^ How far from one diagram to the next?
          -> HAlignment -- ^ Distribute according to which parts of
                        --   the diagrams ('left', 'hcenter', 'right')?
          -> VAlignment -- ^ alignment to use ('top', 'vcenter', 'bottom')
          -> [Diagram] -> Diagram
hdistribA = distribA H

-- | Lay out a list of 'Diagram's vertically from top to bottom,
--   aligned along their left edges.
vcat :: [Diagram] -> Diagram
vcat = vsep 0

-- | @d1 <> d2@ is a 'Diagram' with @d1@ above @d2@, aligned
--   along their left edges.
(//) :: Diagram -> Diagram -> Diagram
d1 // d2 = vcat [d1, d2]

-- | Lay out a list of 'Diagram's vertically from top to bottom,
--   with the given horizontal alignment ('left', 'hcenter', or 'right').
vcatA :: HAlignment -> [Diagram] -> Diagram
vcatA = vsepA 0

-- | Lay out a list of 'Diagram's vertically, aligned along their
--   left edges, with a given amount of separation in between each pair.
vsep :: Double       -- ^ amount of separation between each pair of diagrams
     -> [Diagram] -> Diagram
vsep sep = vsepA sep left

-- | Lay out a list of 'Diagram's vertically, with the given
--   amount of separation in between each pair, using the given
--   horizontal alignment ('left', 'hcenter', or 'right').

vsepA :: Double       -- ^ amount of separation between each pair of diagrams
      -> HAlignment   -- ^ alignment to use ('left', 'hcenter', or 'right')
      -> [Diagram] -> Diagram
vsepA = sepA V

-- | Distribute a list of 'Diagram's vertically according to a regular
--   spacing, aligned along their left edges.
vdistrib :: Double     -- ^ How far from one diagram to the next?
         -> VAlignment -- ^ Distribute according to which parts of
                       --   the diagrams ('top', 'vcenter', 'bottom')?
         -> [Diagram] -> Diagram
vdistrib sep alignD = vdistribA sep alignD left

-- | Distribute a list of 'Diagram's vertically according to a
--   regular spacing, with the given alignment.
vdistribA :: Double     -- ^ How far from one diagram to the next?
          -> VAlignment -- ^ Distribute according to which parts of
                        --   the diagrams ('top', 'vcenter', 'bottom')?
          -> HAlignment -- ^ alignment to use ('left', 'hcenter', 'right')
          -> [Diagram] -> Diagram
vdistribA = distribA V

-- | The mother-combinator for all the @sep@ functions, used
--   internally.
sepA :: ListType -> Double -> Alignment -> [Diagram] -> Diagram
sepA lt sep align = Compound . Layout (List lt align (Sep sep))

-- | The mother-combinator for all the @distrib@ functions, used
--   internally.
distribA :: ListType -> Double -> Alignment -> Alignment -> [Diagram] -> Diagram
distribA lt sep alignD align =
  Compound . Layout (List lt align (Distrib alignD sep))