Engine.hs

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

    -- ** Internals

  , atomic
  , render

  ) where

import Graphics.Rendering.Diagrams.Types

import qualified Graphics.Rendering.Cairo as C
import Control.Monad.Reader

-- $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           = case size of
                      Width  w -> w/x    -- scale so width is as desired
                      Height h -> h/y    -- scale so height is as desired
                      Auto     -> 1      -- do not scale
  in (,) (s*x,s*y) $ 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

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

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

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