diagrams-0.2: Graphics/Rendering/Diagrams/Types.hs
{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- 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(..), SomeColor(..)
, Point, Vec
, (*.), (.+.), (.-.), (.*.)
, Path(..)
, PathType(..)
, PathStyle(..)
-- * Shapes, attributes, and layouts
, ShapeClass(..), Shape(..)
, AttrClass(..), Attr(..)
, LayoutClass(..), Layout(..)
-- * Rendering
, DiaRenderEnv(..)
, defaultDiaRenderEnv
, setEnvFillColor, setEnvStrokeColor, setEnvStrokeWidth
, DiaRenderM(..)
, runDiaRenderM
, c
, SizeSpec(..)
, OutputType(..)
) where
import qualified Graphics.Rendering.Cairo as C
import Control.Monad.Reader
import Data.Colour
import Data.Colour.Names (black)
import qualified Data.Colour.SRGB.Linear as RGB
-- Diagrams ----------------------------------------------------------
-- | '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.
-- Colors ------------------------------------------------------------
-- | The 'Color' type class encompasses color representations which
-- can be used by the Diagrams library; that is, every function in
-- the Diagrams library which expects a color can take any type
-- which is an instance of 'Color'. Instances are provided for both
-- the 'Data.Colour.Colour' and 'Data.Colour.AlphaColour' types from
-- the "Data.Colour" library.
class Color c where
colorToRGBA :: c -> (Double,Double,Double,Double)
-- | Existential wrapper for instances of the 'Color' class.
data SomeColor = forall c. Color c => SomeColor c
-- Note: we would like to just be able to say 'instance Color (Colour
-- Double)' and so on, but the problem is that the named color
-- constants in Data.Colour.Names are polymorphic with type (Floating
-- a, Ord a) => Colour a, so trying to pass one of these constants to
-- a function like 'lc' gives an error that there is no instance for
-- Color (Colour a). Adding a type annotation like 'lc (black ::
-- Colour Double)' works, but this is a pain for the user. The
-- (admittedly hackish) solution is to make general instances which
-- require Floating and Real (so that we can convert to Double with
-- fromRational . toRational), and let type defaulting figure out that
-- in the expression 'lc black', black should have type Colour Double.
-- This is still unsatisfactory, though---even though we know we will
-- (almost) always be getting (Colour Doubles), we still run the
-- values through fromRational . toRational!
instance (Floating a, Real a) => Color (Colour a) where
colorToRGBA col = (r,g,b,1)
where c' = RGB.toRGB col
r = toDouble $ RGB.channelRed c'
g = toDouble $ RGB.channelGreen c'
b = toDouble $ RGB.channelBlue c'
instance (Floating a, Real a) => Color (AlphaColour a) where
colorToRGBA col = (r,g,b,a)
where a = toDouble $ alphaChannel col
c' = RGB.toRGB $ alphaToColour col
r = toDouble $ RGB.channelRed c'
g = toDouble $ RGB.channelGreen c'
b = toDouble $ RGB.channelBlue c'
toDouble :: (Real a) => a -> Double
toDouble = fromRational . toRational
instance Color SomeColor where
colorToRGBA (SomeColor col) = colorToRGBA col
alphaToColour :: (Floating a, Ord a, Fractional a) => AlphaColour a -> Colour a
alphaToColour ac = darken (recip (alphaChannel ac)) (ac `over` black)
-- Points ------------------------------------------------------------
-- | Basic 2D points/vectors.
type Point = (Double,Double)
type Vec = Point
-- | Scalar multiplication.
(*.) :: Double -> Point -> Point
s *. (x,y) = (s*x, s*y)
-- | Elementwise addition, subtraction and multiplication for 'Point's.
(.+.), (.-.), (.*.) :: Point -> Point -> Point
(x1,y1) .+. (x2,y2) = (x1 + x2, y1 + y2)
(x1,y1) .*. (x2,y2) = (x1 * x2, y1 * y2)
a .-. b = a .+. ((-1) *. b)
-- Paths -------------------------------------------------------------
-- | A path can be open (normal) or closed (first and last vertices
-- connected automatically).
data PathType = Open | Closed
deriving (Eq, Show, Read)
-- | A path is a series of edges which can be stroked, filled, etc.
-- It can be either open (the default) or closed (i.e. the first and
-- last vertices are connected).
data Path = Path PathType
[Vec]
deriving (Eq, Show, Read)
-- | The styles in which a path can be rendered.
data PathStyle = Straight | Bezier Double deriving (Eq, Show, Read)
-- Attributes --------------------------------------------------------
-- | 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)
-- Shapes ------------------------------------------------------------
-- | 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 ()
-- Layouts -----------------------------------------------------------
-- | 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])
-- Rendering ---------------------------------------------------------
-- | 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 :: SomeColor
, envStrokeColor :: SomeColor
, envStrokeWidth :: Double
}
setEnvFillColor :: Color c => c -> DiaRenderEnv -> DiaRenderEnv
setEnvFillColor col d = d { envFillColor = SomeColor col }
setEnvStrokeColor :: Color c => c -> DiaRenderEnv -> DiaRenderEnv
setEnvStrokeColor col d = d { envStrokeColor = SomeColor col }
setEnvStrokeWidth :: Double -> DiaRenderEnv -> DiaRenderEnv
setEnvStrokeWidth w d = d { envStrokeWidth = w }
-- | The default rendering environment: transparent fill with 1-pixel
-- black strokes.
defaultDiaRenderEnv :: DiaRenderEnv
defaultDiaRenderEnv = DREnv { envFillColor = SomeColor (transparent :: AlphaColour Double)
, envStrokeColor = SomeColor (black :: Colour Double)
, envStrokeWidth = 1
}
-- | The custom rendering monad: ReaderT 'DiaRenderEnv' on top of
-- cairo's Render monad.
newtype DiaRenderM a = DRM (ReaderT DiaRenderEnv C.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 -> C.Render a
runDiaRenderM (DRM m) e = runReaderT m e
-- | Lift a cairo @Render@ action into a 'DiaRenderM' action.
c :: C.Render a -> DiaRenderM a
c = DRM . lift
-- | A specification of the size of a rendered 'Diagram'.
data SizeSpec = Width Double -- ^ an explicit width; the height is determined automatically
| Height Double -- ^ an explicit height; the width is determined automatically
| Auto -- ^ determine the size automatically
-- (do not scale)
-- | The supported output file types for rendered diagrams.
data OutputType = PNG | PS | PDF | SVG