Types.hs

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

module Graphics.Rendering.Diagrams.Types
  (

  -- * Primitive types

    Diagram(..)

  , Color(..), rgb, rgba
  , Point
  , (.+), (.*)

  -- * Shapes, attributes, and layouts

  , ShapeClass(..), Shape(..)
  , AttrClass(..), Attr(..)
  , LayoutClass(..), Layout(..)

  -- * Rendering

  , DiaRenderEnv(..)
  , defaultDiaRenderEnv
  , setEnvFillColor, setEnvStrokeColor, setEnvStrokeWidth
  , DiaRenderM(..)
  , runDiaRenderM
  , c

  ) where

import Graphics.Rendering.Cairo
import Control.Monad.Reader

-- | 'Diagram' is the core data type which describes a diagram.
--   'Diagram's may be constructed, transformed, combined, and
--   ultimately rendered as an image.
data Diagram = Empty                -- ^ The empty diagram
             | Prim Shape           -- ^ A primitive shape
             | Ann Attr Diagram     -- ^ An annotated diagram
             | Compound Layout      -- ^ A compound diagram
             | Union [Diagram]      -- ^ A fully processed compound
                                    --   diagram, ready for rendering
             | Sized Point Diagram
               -- ^ An explicitly sized diagram whose bounding box
               --   takes up a particular amount of space.

-- | An existential wrapper type for layouts.  A layout consists of a
--   (possibly parameterized) layout type, along with a container of
--   'Diagram's.
data Layout = forall l f. (LayoutClass l f) => Layout l (f Diagram)

-- | All layouts must be instances of 'LayoutClass', along with an
--   appropriate container type which must be an instance of Functor.
class (Functor f) => LayoutClass l f where
  -- | Given a layout and a container of @(size, diagram)@ pairs (which
  --   have already had all subdiagrams appropriately positioned),
  --   compute the overall bounding box size for this layout, as well
  --   as a list of positioned subdiagrams.
  layoutSizeAndPos :: l -> f (Point,Diagram) -> (Point, [Diagram])

-- | The 'Color' type represents colors in red-green-blue-alpha
--   format, with each channel in the range 0-1.  For a large list of
--   predefined colors, see "Graphics.Rendering.Diagrams.Colors".
data Color = RGBA Double Double Double Double
  deriving (Eq, Show, Read)

-- | Construct an opaque (alpha = 1) color from RGB values specified
--   as Doubles in the range 0-1.
rgb :: Double    -- ^ red channel
    -> Double    -- ^ green channel
    -> Double    -- ^ blue channel
    -> Color
rgb r g b = rgba r g b 1

-- | Construct a color from RGBA values, specified as Doubles in the
--   range 0-1.
rgba :: Double    -- ^ red channel
     -> Double    -- ^ green channel
     -> Double    -- ^ blue channel
     -> Double    -- ^ alpha (transparency) channel
     -> Color
rgba = RGBA

-- | Basic 2D points/vectors.
type Point = (Double,Double)

-- | Elementwise addition and multiplication for 'Point's.
(.+), (.*) :: Point -> Point -> Point
(x1,y1) .+ (x2,y2) = (x1 + x2, y1 + y2)
(x1,y1) .* (x2,y2) = (x1 * x2, y1 * y2)

-- | Existential wrapper type for attributes.
data Attr = forall a. AttrClass a => Attr a

-- | Attributes which can be applied as annotations to a 'Diagram',
--   and change the way the 'Diagram' is interpreted or rendered.
--   Every attribute must be an instance of 'AttrClass'.
class AttrClass a where

  -- | Given an attribute and the size of the diagram to which it is
  --   an annotation, return a new size for the diagram.  The default
  --   implementation is to simply return the size unchanged.
  attrSize :: a -> Point -> Point
  attrSize _ p = p

  -- | In order to implement this attribute, 'renderAttr' may perform
  --    an action in the DiaRenderM monad, and return a function which
  --    produces a local modification to the render environment. The
  --    change produced by this function will only remain in effect
  --    for any sub-diagrams, and the environment will return to its
  --    former state afterwards.
  renderAttr :: a -> DiaRenderM (DiaRenderEnv -> DiaRenderEnv)

-- | Existential wrapper type for shapes.
data Shape = forall s. ShapeClass s => Shape s

-- | The primitive shapes which can be used to build up a diagram.
--   Every primitive shape must be an instance of 'ShapeClass'.
--
--   Given a shape @s@, if @shapeSize s@ evaluates to @(w,h)@, then
--   the drawing rendered by @renderShape s@ should fit within a @w@
--   by @h@ rectangle centered at the origin.
--
--   You can create your own shape primitives by creating a new data
--   type and making it an instance of 'ShapeClass'.  If you do so,
--   you must be sure that your 'ShapeClass' instance satisfies the
--   law described above, on which the rendering engine relies in
--   order to compute the proper positions for objects in a diagram.
--   Otherwise, instances of your object in a diagram may extend
--   outside the boundaries of the rendered image, or inadvertently
--   overlap or be overlapped by other diagram elements.  Of course,
--   you are free to ignore this \"law\" as well; it will cause
--   unexpected output at worst, and at best you may find some clever
--   way to bend the system to your will. =)
--
class ShapeClass s where

  -- | Calculate the size (the dimensions of a bounding box centered
  --   at the origin) of a shape.
  shapeSize   :: s -> Point

  -- | Calculate a cairo Render action to render a shape.
  renderShape :: s -> DiaRenderM ()

-- | An environment containing additional parameters to be made
--   available while rendering, which for one reason or another are
--   not or cannot be provided by the cairo 'Render' monad itself.
--   For example, cairo only tracks one current color, so we must
--   track a fill color and stroke color separately.
data DiaRenderEnv = DREnv { envFillColor   :: Color
                          , envStrokeColor :: Color
                          , envStrokeWidth :: Double
                          }
  deriving (Show)

setEnvFillColor :: Color -> DiaRenderEnv -> DiaRenderEnv
setEnvFillColor c d = d { envFillColor = c }

setEnvStrokeColor :: Color -> DiaRenderEnv -> DiaRenderEnv
setEnvStrokeColor c d = d { envStrokeColor = c }

setEnvStrokeWidth :: Double -> DiaRenderEnv -> DiaRenderEnv
setEnvStrokeWidth c d = d { envStrokeWidth = c }

-- | The default rendering environment: transparent fill with 1-pixel
--   black strokes.
defaultDiaRenderEnv :: DiaRenderEnv
defaultDiaRenderEnv = DREnv { envFillColor   = RGBA 1 1 1 0
                            , envStrokeColor = RGBA 0 0 0 1
                            , envStrokeWidth = 1
                            }

-- | The custom rendering monad: ReaderT 'DiaRenderEnv' on top of
--   cairo's Render monad.
newtype DiaRenderM a = DRM (ReaderT DiaRenderEnv Render a)
  deriving (Functor, Monad, MonadReader DiaRenderEnv)

-- | Run a 'DiaRenderM' action, given an initial rendering
--   environment, to produce a cairo @Render@ action.
runDiaRenderM :: DiaRenderM a -> DiaRenderEnv -> Render a
runDiaRenderM (DRM m) e = runReaderT m e

-- | Lift a cairo @Render@ action into a 'DiaRenderM' action.
c :: Render a -> DiaRenderM a
c = DRM . lift