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

    -- ** Internals

  , atomic
  , render

  ) where

import Graphics.Rendering.Diagrams.Types
import Graphics.Rendering.Diagrams.Attributes
import Graphics.Rendering.Diagrams.Layouts

import qualified Graphics.Rendering.Cairo as C
import Control.Arrow ((***))
import Control.Monad.Reader
import Data.List (foldl1')

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

-- $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 and 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 and height.
--
--   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'.
compose :: Double      -- ^ output width
        -> Double      -- ^ output height
        -> Diagram     -- ^ 'Diagram' to render
        -> C.Render ()
compose w h d = do

  -- 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           = min (w/x) (w/y)
  C.scale s s
  C.translate (x/2) (y/2)

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

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

-- | Given a rendered diagram, output it to a .png file with the given
--   width and height.
writePng :: String -> Int -> Int -> C.Render () -> IO ()
writePng fileName w h render =
  C.withImageSurface C.FormatARGB32 w h $ \surface -> do
    C.renderWith surface render
    C.surfaceWriteToPNG surface fileName

-- | Perform a rendering operation atomically, by saving the state and
--   restoring it afterwards.
atomic :: DiaRenderM () -> DiaRenderM ()
atomic render = (c C.save) >> render >> (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