-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Diagrams.Engine
-- Copyright   :  (c) Brent Yorgey 2008
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- The core rendering engine for "Graphics.Rendering.Diagrams", an
-- embedded domain-specific language (EDSL) for creating simple
-- diagrams.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.Diagrams.Engine
  (
    -- * Preprocessing
    -- $preproc

    sizeAndPos

    -- * Rendering
    -- $render

    -- ** User interface

  , compose
  , writePNG, writePS, writePDF, writeSVG
  , renderWithBackend
  , renderOverlayPNG
  , chooseBackend

  , writePagesPS, writePagesPDF
  , renderPagesWithBackend
  , choosePagesBackend

    -- ** Internals

  , atomic
  , render

  ) where

import Graphics.Rendering.Diagrams.Types

import qualified Graphics.Rendering.Cairo as C
import Control.Monad.Reader
import Data.List (intersperse)

-- $preproc
-- These functions take a user-generated 'Diagram' object and
-- preprocess it in preparation for final rendering.  The
-- preprocessing includes calculating diagram sizes and positioning
-- diagrams by the addition of appropriate translate annotations.

-- | Given a 'Diagram', compute its total size, and produce a new
--   version of the 'Diagram' with all sub-'Diagram's positioned
--   properly.
sizeAndPos :: Diagram -> (Point,Diagram)

-- the empty diagram takes up no space.
sizeAndPos Empty = ((0,0), Empty)

sizeAndPos d@(Prim (Shape s)) = (shapeSize s, d)

-- ignore the size calculated by the recursive call, and use the given
-- size instead.
sizeAndPos (Sized s d) = (s, snd $ sizeAndPos d)

-- attributes may affect the size of a diagram.
sizeAndPos (Ann a@(Attr attr) d) = (attrSize attr s, (Ann a d'))
  where (s, d') = sizeAndPos d

sizeAndPos (Compound (Layout l ds)) = (s, Union ds')
  where (s, ds') = layoutSizeAndPos l (fmap sizeAndPos ds)

sizeAndPos (Union _) = error "sizeAndPos (Union _): This should never happen!"

-- $render
-- The rendering code takes a 'Diagram' and turns it into
-- actual graphics output, using the Cairo library to perform the low-level
-- drawing operations.

-- | Given a target width or height and a user-constructed 'Diagram',
--   render it using the Cairo rendering library.  Note that 'compose'
--   takes care of all the rendering details, including preprocessing
--   of the 'Diagram', and scaling/translating the final output so
--   that it fits within the given width or height.  'compose' also
--   produces the size of the final diagram; the width or height will
--   be equal to that specified in the input, and the other dimension
--   will be determined by the aspect ratio of the diagram.
--
--   The background of the output diagram will be opaque white.
--
--   In order to produce a physical output, the output of 'compose'
--   must be given as input to an output adapter such as 'writePng'.
--   Normally, however, a user of the diagrams library should not need
--   to call 'compose' directly.
compose :: SizeSpec      -- ^ output width or height
        -> Diagram       -- ^ 'Diagram' to render
        -> (Point, C.Render ())
                         -- ^ Output width and height, and Cairo action
                         --   to render it
compose size d = compose' 1 size d

compose' :: Double -> SizeSpec -> Diagram -> (Point, C.Render ())
compose' opacity size d =

  -- Preprocess the diagram, and use the global bounding box size to
  -- scale and translate the output so that it fits within the target
  -- output width and height.
  let ((x,y), d') = sizeAndPos d
      (s,sx,sy)   = case (size,x,y) of
                      (Width  w,0,0) -> (1,w,w)
                      (Height h,0,0) -> (1,h,h)
                      (Width  w,0,_) -> (1,w,y)
                      (Height h,_,0) -> (1,x,h)
                      (Width  w,_,_) -> (w/x, w, y * w/x)
                      (Height h,_,_) -> (h/y, x * h/y, h)
                      (Auto,    0,0) -> (1,1,1)
                      (Auto,    0,_) -> (1,y,y)
                      (Auto,    _,0) -> (1,x,x)
                      (Auto,    _,_) -> (1,x,y)
  in (,) (sx, sy) $ do
    C.scale s s
    C.translate (x/2) (y/2)

    -- Set the output background to opaque white.
    C.save
    C.setSourceRGBA 1 1 1 opacity
    C.paint
    C.restore

    -- render the final diagram.
    flip runDiaRenderM defaultDiaRenderEnv . render $ d'

-- | Given a rendered diagram, output it to a file in PNG format with
--   the given width and height.
writePNG :: String -> Point -> C.Render () -> IO ()
writePNG dstfile wh r = usingBackground wh
  (\surface -> writeSurfaceToPNG surface dstfile r)

-- | Given a rendered diagram, output it to a file in PNG format with
--   the size and background of the PNG image @srcfile@.
overlayPNG :: String -> String -> C.Render () -> IO ()
overlayPNG srcfile dstfile r = usingPNG srcfile
  (\surface -> writeSurfaceToPNG surface dstfile r)

writeSurfaceToPNG :: C.Surface -> FilePath -> C.Render () -> IO ()
writeSurfaceToPNG surface dstfile r = do
  C.renderWith surface r
  C.surfaceWriteToPNG surface dstfile

usingPNG :: FilePath -> (C.Surface -> IO ()) -> IO ()
usingPNG srcfile = C.withImageSurfaceFromPNG srcfile
usingBackground :: Point -> (C.Surface -> IO ()) -> IO ()
usingBackground (w,h) = C.withImageSurface C.FormatARGB32 (ceiling w) (ceiling h)

writeSurface :: (String -> Double -> Double -> (C.Surface -> IO a) -> IO a)
             -> String
             -> Point
             -> C.Render a
             -> IO a
writeSurface withSurface fileName (w,h) r =
  withSurface fileName w h $ \surface ->
    C.renderWith surface r

writePagesSurface :: (String -> Double -> Double -> (C.Surface -> IO ()) -> IO ())
                  -> (C.Surface -> Double -> Double -> C.Render ())
                  -> String
                  -> [(Point, C.Render ())]
                  -> IO ()
writePagesSurface withSurface surfaceSetSize fileName pages =
  withSurface fileName 0 0 $ \surface -> C.renderWith surface $
    sequence_ $ concat $ intersperse [C.showPage] $
        [[C.save, surfaceSetSize surface w h, r, C.restore] | ((w,h),r) <- pages]

-- | Given a rendered diagram, output it to a file in PostScript
--   format with the given width and height.
writePS  :: String -> Point -> C.Render () -> IO ()
writePS = writeSurface C.withPSSurface

-- | Given a list of rendered diagrams with their height and width,
--   output them as separate pages to a file in PostScript format
writePagesPS :: String -> [(Point, C.Render ())] -> IO ()
writePagesPS = writePagesSurface C.withPSSurface C.psSurfaceSetSize

-- | Given a rendered diagram, output it to a file in PDF
--   format with the given width and height.
writePDF :: String -> Point -> C.Render () -> IO ()
writePDF = writeSurface C.withPDFSurface

-- | Given a list of rendered diagrams with their height and width,
--   output them as separate pages to a file in DFt format
writePagesPDF :: String -> [(Point, C.Render ())] -> IO ()
writePagesPDF = writePagesSurface C.withPDFSurface C.pdfSurfaceSetSize

-- | Given a rendered diagram, output it to a file in SVG
--   format with the given width and height.
writeSVG :: String -> Point -> C.Render () -> IO ()
writeSVG = writeSurface C.withSVGSurface

-- | Given a file name, an output size specification, and a 'Diagram',
--   use a \"backend\" to render the 'Diagram' to an actual physical
--   output.
renderWithBackend :: (String -> Point -> C.Render () -> IO ())  -- ^ backend
                  -> String      -- ^ file name
                  -> SizeSpec    -- ^ output size specification
                  -> Diagram     -- ^ the diagram to render
                  -> IO ()
renderWithBackend backend name size dia = backend name wh r
  where (wh, r) = compose size dia

-- | Given a file name, an output size specification, and a list of
--   'Diagram's, use a \"backend\" to render the 'Diagram's as separate
--   pages to an actual physical output.
renderPagesWithBackend :: (String -> [(Point, C.Render ())] -> IO ())
                       -> String
                       -> SizeSpec
                       -> [Diagram]
                       -> IO ()
renderPagesWithBackend backend name size dias
  = backend name (map (compose size) dias)

renderOverlayPNG :: FilePath -> FilePath -> Diagram -> IO ()
renderOverlayPNG srcfile dstfile dia = overlayPNG srcfile dstfile r
  where r = snd $ compose' 0 Auto dia

chooseBackend :: OutputType -> (String -> Point -> C.Render () -> IO ())
chooseBackend PNG = writePNG
chooseBackend PS  = writePS
chooseBackend PDF = writePDF
chooseBackend SVG = writeSVG

choosePagesBackend :: OutputType -> (String -> [(Point, C.Render ())] -> IO ())
choosePagesBackend PS  = writePagesPS
choosePagesBackend PDF = writePagesPDF
choosePagesBackend PNG = error "PNG doesn't support multiple pages"
choosePagesBackend SVG = error "SVG doesn't support multiple pages"

-- | Perform a rendering operation atomically, by saving the state and
--   restoring it afterwards.
atomic :: DiaRenderM () -> DiaRenderM ()
atomic r = (c C.save) >> r >> (c C.restore)

-- | Render a diagram.
render :: Diagram -> DiaRenderM ()
render Empty = return ()
render (Prim (Shape s)) = renderShape s
render (Ann (Attr a) d) = atomic $ renderAttr a >>= flip local (render d)
render (Union ds) = mapM_ render ds
render (Sized _ d) = render d
render d@(Compound _) = render $ snd $ sizeAndPos d