{-# 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

  , position, positionA
  , positionAlong, positionAlongA

  , grid, gridA, gridAs

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

    -- * Tree

  , tree

    -- * Miscellaneous

  , pad, padA
  , showBBox, showBBoxes
  , withSize

  ) where

import Graphics.Rendering.Diagrams.Types
import Graphics.Rendering.Diagrams.Attributes
import Graphics.Rendering.Diagrams.Shapes
import Graphics.Rendering.Diagrams.Paths
import Graphics.Rendering.Diagrams.Engine (sizeAndPos)
import Control.Arrow (first)
import Control.Monad.Cont
import Control.Monad.Identity

import Data.List (transpose)
import Data.Tree

-- 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'               = aligns halign w xs
          ys'               = aligns 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.
aligns :: Alignment    -- ^ the alignment to use
       -> Double       -- ^ the total height (resp. width) we're working with
       -> [Double]     -- ^ the individual heights (resp. widths) of
                       --   the diagrams to align
       -> [Double]     -- ^ the amount to translate each diagram in
                       --   order to be properly aligned
aligns a h hs = map (align a h) hs

-- | Given a requested alignment, the total width (resp. height) of
--   the enclosing bounding box, and the width (resp. height) of a
--   diagram, compute the offset needed to properly align the diagram.
align :: Alignment    -- ^ the alignment to use
      -> Double       -- ^ the total height (resp. width) we're working with
      -> Double       -- ^ the height (resp. widths) of the diagram to
                      --   align
      -> Double       -- ^ the offset needed to align the diagram
align a h x = alignOffset a (h - x)

-- | Compute an offset corresponding to a given alignment and width.
alignOffset :: Alignment -> Double -> Double
alignOffset TopLeft x     = -x/2
alignOffset Center  _     = 0
alignOffset BottomRight x = x/2


-- | 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         = aligns 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         = aligns 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', 'vcenter', 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 algn = Compound . Layout (List lt algn (Sep sep))

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


-- Explicit subdiagram positioning ---------------------

data Positioned = Positioned [Point] HAlignment VAlignment
instance LayoutClass Positioned [] where
  layoutSizeAndPos _ [] = ((0,0), [])
  layoutSizeAndPos (Positioned ps ha va) dss = ((w,h), pds)
    where (sizes, diagrams) = unzip dss
          (ws, hs) = unzip sizes
          (pxs, pys) = unzip ps

          xs' = zipWith (\x w1 -> x - alignOffset ha w1) pxs ws
          ys' = zipWith (\y h1 -> y - alignOffset va h1) pys hs

          hws = map (/2) ws
          hhs = map (/2) hs
          xmax = maximum (zipWith (+) xs' hws)
          xmin = minimum (zipWith (-) xs' hws)
          w = xmax - xmin
          ymax = maximum (zipWith (+) ys' hhs)
          ymin = minimum (zipWith (-) ys' hhs)
          h = ymax - ymin

          xs'norm = map (subtract (xmin + w/2)) xs'
          ys'norm = map (subtract (ymin + h/2)) ys'

          pds = zipWith3 translate xs'norm ys'norm diagrams

-- | Create a diagram from a list of subdiagrams with explicit
--   positions in a local coordinate system.  Each subdiagram will be
--   positioned with its center at the corresponding
--   position. @position@ is equivalent to @positionA hcenter
--   vcenter@.
position :: [(Point, Diagram)] -> Diagram
position = positionA hcenter vcenter

-- | Create a diagram from a list of subdiagrams with explicit
--   positions in a local coordinate system.  The alignment options
--   specify what part of each subdiagram should be placed on the
--   corresponding position.  For example, @positionA left top@ will
--   position the top left corner of each subdiagram at the
--   corresponding point.
positionA :: HAlignment -> VAlignment -> [(Point,Diagram)] -> Diagram
positionA ha va pds = Compound (Layout (Positioned ps ha va) ds)
  where (ps, ds) = unzip pds

-- | Create a diagram from a list of subdiagrams and a given path, by
--   positioning the subdiagrams at successive vertices of the path.
--   If there are more diagrams than path vertices, the extra diagrams
--   will be discarded.
positionAlong :: [Diagram] -> Path -> Diagram
positionAlong = positionAlongA hcenter vcenter

-- | A version of 'positionAlong' with explicit alignment.
positionAlongA :: HAlignment -> VAlignment -> [Diagram] -> Path -> Diagram
positionAlongA ha va ds p = positionA ha va $ zip (pathToVertices (0,0) p) ds

-- Tree ------------------------------------------

-- | Lay out a 'Tree' (from "Data.Tree") of 'Diagram's in a top-down
--   fashion.  This layout is experimental; future releases of the
--   Diagrams library are planned which will be able to automatically
--   draw edges between nodes in the tree.
tree :: Double    -- ^ separation between layers
     -> Double    -- ^ separation between siblings
     -> Tree Diagram
     -> Diagram
tree _  _  (Node d []) = d
tree ls ss (Node d ts) = vsepA ls hcenter [ d, hsep ss (map (tree ls ss) ts) ]

-- Miscellaneous ---------------------------------

data Padded = Padded Double Double HAlignment VAlignment
instance LayoutClass Padded Identity where
  layoutSizeAndPos (Padded dw dh ha va) (Identity ((w,h), d))
      = ((w', h'), [translate (align ha w' w) (align va h' h) d])
    where w' = w + dw
          h' = h + dh

-- | Add extra padding to a diagram.  @pad w h d@ is a diagram which
--   is the same as @d@, but with @w@ units added to the width and @h@
--   units added to the height, with @d@ centered in the available
--   space.  Thus @pad w h@ is equivalent to @padA w h hcenter vcenter@.
pad :: Double -> Double -> Diagram -> Diagram
pad pw ph d = padA pw ph hcenter vcenter d

-- | Add extra padding to a diagram, aligning the diagram as indicated
--   within the avilable space.
padA :: Double -> Double -> HAlignment -> VAlignment -> Diagram -> Diagram
padA pw ph aw ah d = Compound (Layout (Padded pw ph aw ah) (Identity d))



data ShowBBox = ShowBBox
instance LayoutClass ShowBBox Identity where
  layoutSizeAndPos _ (Identity ((w,h), d))
      = ((w,h), [defaultAttributes $ rect w h, d])

-- | Show a rectangle denoting a diagram's bounding box, in addition
--   to the diagram itself.
showBBox :: Diagram -> Diagram
showBBox Empty = Empty
showBBox d = Compound . Layout ShowBBox . Identity $ d

-- | Show the bounding boxes of a diagram and all its subdiagrams.
showBBoxes :: Diagram -> Diagram
showBBoxes Empty = Empty
showBBoxes d@(Prim _) = showBBox d
showBBoxes (Ann a d) = showBBox (Ann a (showBBoxes d))
showBBoxes (Compound (Layout l ds)) = showBBox (Compound (Layout l (fmap showBBoxes ds)))
showBBoxes (Union ds) = showBBox (Union (map showBBoxes ds))
showBBoxes (Sized p d) = showBBox (Sized p (showBBoxes d))

data FromSize = FromSize (Double -> Double -> Diagram)
instance LayoutClass FromSize Identity where
  layoutSizeAndPos (FromSize f) (Identity  ((w,h),_))
    = let d = f w h in (fst (sizeAndPos d), [d])

-- | Create one diagram using the current size of another.
--   The new diagram is returned, the old one is discarded.
withSize :: (Double -> Double -> Diagram) -- ^ Function for new diagram
         -> Diagram                       -- ^ Old diagram
         -> Diagram
withSize f dia = Compound (Layout (FromSize f) (Identity dia))

diagSize :: Diagram -> Cont Diagram (Double, Double)
diagSize d = ContT { runContT = \f -> Identity . flip withSize d $
                                      \w h -> runIdentity (f (w, h)) }

-- | Align diagrams into a grid, specifying individual alignments for each item.
--   Warning: there is currently an exponential performace blowup if you nest grids
--   (exponential in how deep the nesting is).
gridAs :: [[(HAlignment, VAlignment)]] -> [[Diagram]] -> Diagram

-- | Align diagrams into a grid with each item aligned as specified.
--   Warning: there is currently an exponential performace blowup if you nest grids
--   (exponential in how deep the nesting is).
gridA :: HAlignment -> VAlignment -> [[Diagram]] -> Diagram

-- | Align diagrams into a grid, with each item centered horizontally and vertically
--   Warning: there is currently an exponential performace blowup if you nest grids.
--   (exponential in how deep the nesting is).
grid :: [[Diagram]] -> Diagram

grid = gridA hcenter vcenter
gridA h v = gridAs (repeat (repeat (h, v)))
gridAs alignss diagss
  = flip runCont id $
     do sizess <- mapM (mapM diagSize) diagss
        let widths = map (maximum . map fst) (transpose sizess)
            heights = map (maximum . map snd) sizess
            newsizess = [[(w, h) | w <- widths] | h <- heights]
            adjss = zipWith (zipWith (\ (nw, nh) (ow, oh) -> (nw - ow, nh - oh))) newsizess sizess
            padTo (width, height) (halign, valign) = padA width height halign valign
        return $ vcat $ map hcat $ zipWith3 (zipWith3 padTo) adjss alignss diagss