-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Diagrams
-- Copyright   :  (c) Brent Yorgey 2008
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- An embedded domain-specific language (EDSL) for creating simple
-- diagrams, built on top of the Cairo rendering engine.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.Diagrams
  (

  -- * Introduction

  -- $intro

  -- * Primitives

    Diagram, nil

  -- ** Shapes

  , circle
  , poly
  , rect
  , shape

  -- ** Spacers

  , hspace
  , vspace
  , empty

  -- * Combinators
  -- $comb

  -- ** Union

  , (##), union, unionA

  -- ** Lists

  , (<>), (//)
  , hcat, vcat
  , hcatA, vcatA
  , hsep, vsep
  , hsepA, vsepA
  , hdistrib, vdistrib
  , hdistribA, vdistribA

  , VAlignment
  , top, vcenter, bottom
  , HAlignment
  , left, hcenter, right

  -- * Transformations
  -- $transf

  , stretch, scale, scaleX, scaleY
  , translate, translateX, translateY
  , rotate, rotateR

  , view

  -- * Attributes
  -- $attr

  , fillColor, fc
  , fillTransparency, ft
  , lineColor, lc
  , lineWidth, lw

  , Color
  , rgb
  , rgba
  , module Graphics.Rendering.Diagrams.Colors


  -- * Rendering

  , renderToPng
  , compose

  ) where

import Graphics.Rendering.Diagrams.Types
import Graphics.Rendering.Diagrams.Shapes
import Graphics.Rendering.Diagrams.Attributes
import Graphics.Rendering.Diagrams.Colors
import Graphics.Rendering.Diagrams.Layouts
import Graphics.Rendering.Diagrams.Engine

{- $intro

"Graphics.Rendering.Diagrams" is an embedded domain-specific language
(EDSL) for creating simple diagrams.  It is compositional; starting
with some basic shapes, you can build up complex diagrams by combining
simpler diagrams in various ways.

A few fundamental concepts to keep in mind:

  * When constructing diagrams, there is no concept of an absolute
    coordinate system; everything is relative.  You cannot say \"this
    diagram should go at (2,1)\"; you can only say \"this diagram should
    go to the right of this other one\", or \"this diagram should go two
    units to the right and one unit above where it would otherwise
    be\".

  * Every diagram has an associated rectangular bounding box, which
    determines its positioning and alignment relative to other
    diagrams.  Usually this makes no difference but there are times
    when it's nice to be aware of it. For example, translating a
    diagram works by moving the diagram relative to its bounding box;
    positioning the bounding box where it would have gone means the
    diagram itself ends up elsewhere.  Also, some shapes have
    non-obvious bounding boxes; for example, regular polygons have a
    bounding box that fits their circumcircle.

  * The positive y-axis points downwards.

For some simple examples, see
<http://byorgey.wordpress.com/2008/04/30/new-haskell-diagrams-library/>.

Enjoy!  Please send comments, suggestions, bug reports, or patches to
byorgey at gmail dot com.

-}

-- | The nil diagram, which takes up no space and produces no output.
nil :: Diagram
nil = Empty

-- | Create a 'Diagram' out of any instance of 'ShapeClass'.
shape :: (ShapeClass s) => s -> Diagram
shape = Prim . Shape

-- | @hspace w@ is a 'Diagram' which produces no output but takes up
--   @w@ amount of space horizontally.  Useful for manually creating
--   horizontal separation between two diagrams.  A negative value
--   of @w@ can also be used to move two diagrams closer to one
--   another. @hspace w@ is equivalent to @empty w 0@.
hspace :: Double -> Diagram
hspace w = empty w 0

-- | @vspace h@ is a 'Diagram' which produces no output but takes up
--   @h@ amount of space vertically.  Useful for manually creating
--   vertical separation between two diagrams.  A negative value of
--   @h@ can also be used to move two diagrams closer to one
--   another. @vspace h@ is equivalent to @empty 0 h@.
vspace :: Double -> Diagram
vspace h = empty 0 h

-- | @empty w h@ is an empty diagram which produces no output, but
--   takes up an amount of space equal to a @w@ by @h@ rectangle.
empty :: Double -> Double -> Diagram
empty w h = Sized (w, h) Empty

-- $transf
-- Various ways to modify and transform 'Diagram's.

-- | XXX comment me
view :: Point -> Point -> Diagram -> Diagram
view (x1,y1) (x2,y2) d = Sized (x2-x1, y2-y1) . translate ((x1-x2)/2) ((y1-y2)/2) $ d

-- $attr
-- Attributes which affect the way in which a 'Diagram' is rendered.
-- For a large list of predefined 'Color' values, see
-- "Graphics.Rendering.Diagrams.Colors".

-- | Render a diagram to a file in PNG format.
renderToPng :: String     -- ^ The name of the file to create.
            -> Int        -- ^ The desired width of the image, in pixels.
            -> Int        -- ^ The desired height of the image.
            -> Diagram    -- ^ The diagram to render.
            -> IO ()
renderToPng name w h dia = writePng name w h $
                             compose (fromIntegral w) (fromIntegral h) dia