{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-----------------------------------------------------------------------------
-- |
-- 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, illustrations, and other types of graphics, built on top
-- of the Cairo rendering engine.
--
-----------------------------------------------------------------------------

module Graphics.Rendering.Diagrams
  (

  -- * Introduction

  -- $intro

  -- * Primitives

    Diagram, nil

  -- ** Shapes

  , circle
  , arc
  , rectPath
  , rect
  , roundRect
  , roundRectF

  , regPolyPath
  , regPoly
  , rotRegPoly

  , shape
  , rawCairo
  , text
  , textPath

  -- ** Spacers

  , hspace
  , vspace
  , empty

  -- ** Paths

  , Path
  , emptyPath
  , pathFromVertices, pathFromVectors
  , pathToVertices, pathToVectors
  , pathConcat
  , closed, isClosed
  , rotPath

  , straight
  , curved

  -- * Combinators
  -- $comb

  -- ** Union

  , (##), union, unionA

  -- ** Lists

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

  , position, positionA
  , positionAlong, positionAlongA

  , grid, gridA, gridAs

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

  -- ** Complex layouts

  , tree

  -- ** Miscellaneous

  , pad, padA
  , showBBox, showBBoxes
  , withSize

  -- * Transformations
  -- $transf

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

  , view

  -- * Attributes
  -- $attr

  -- ** Colors
  -- $color

  , Color
  , module Data.Colour.Names
  , fillColor, fc
  , lineColor, lc

  -- ** Other attributes

  , lineWidth, lw

  , lineCap, LineCap(..)
  , lineJoin, LineJoin(..)
  , dashing

  , typeface, tf

  -- * Rendering
  -- $render

  , renderAs
  , renderPagesAs
  , OutputType(..)
  , SizeSpec(..)
  , renderOverPNG

  ) where

import Graphics.Rendering.Diagrams.Types
import Graphics.Rendering.Diagrams.Shapes
import Graphics.Rendering.Diagrams.Paths
import Graphics.Rendering.Diagrams.Attributes
import Graphics.Rendering.Diagrams.Layouts
import Graphics.Rendering.Diagrams.Engine
import Data.Colour.Names

{- $intro

"Graphics.Rendering.Diagrams" is an embedded domain-specific language
(EDSL) for creating simple graphics.  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, although each diagram does have a local
    coordinate system.

  * 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.  To visualize bounding boxes,
    you can use the 'showBBox' and 'showBBoxes' functions.

  * The positive y-axis points downwards.  This also means that
    positive rotations are clockwise.

For some simple examples, see <http://code.haskell.org/diagrams/>.

Enjoy!  Please send comments, suggestions, bug reports, or patches to
byorgey at cis dot upenn dot edu.

-}

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

-- | Create text with black fill, no outline, and a default font.
text :: Double -> String -> Diagram
text sz str = fc black $ lw 0 $ textPath sz str

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

-- $comb
-- Various ways to combine 'Diagram's into larger 'Diagram's.

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

-- | Explicitly set a diagram's bounding box, by giving the
--   coordinates of the upper left and lower right corners (keeping in
--   mind that the positive y-axis points downwards).  Particularly
--   useful for applying to the top-level diagram in order to only
--   view a portion of it in the rendered output.
view :: Point -> Point -> Diagram -> Diagram
view (x1,y1) (x2,y2) = Sized (x2-x1, y2-y1) . translate ((x1-x2)/2 - x1)
                                                        ((y1-y2)/2 - y1)

-- $attr
-- Attributes which affect the way in which a 'Diagram' is rendered.

-- $color
-- Diagrams depends on the "Data.Colour" library (available on Hackage
-- as the \"colour\" package) for colo(u)r. Any functions expecting a
-- color can take any instance of the 'Color' type class, which has
-- instances for both the 'Data.Colour.Colour' and
-- 'Data.Colour.AlphaColour' types from "Data.Colour".
--
-- For normal use, you can just use color names from
-- "Data.Colour.Names", which is re-exported by
-- "Graphics.Rendering.Diagrams" for convenience. For more
-- sophisticated color manipulation, use the facilities provided by
-- the "Data.Colour" library.  For example, to create a color directly
-- from RGB values, you can use the @rgb@ function from
-- "Data.Colour.SRGB.Linear".

-- $render
-- Rendering diagrams to a file is accomplished with the 'renderAs'
-- function.  'renderPagesAs' renders multiple diagrams as multiple
-- pages for suitable backends.  'renderOverPNG' also provides a
-- specialized rendering method, which overlays a rendererd diagram on
-- top of an existing PNG.

-- | Render a diagram to a file.
renderAs :: OutputType -- ^ The output type to use (PNG, PS, PDF, or SVG)
         -> String     -- ^ The name of the file to create.
         -> SizeSpec   -- ^ The desired width or height of the image.
         -> Diagram    -- ^ The diagram to render.
         -> IO ()
renderAs otype = renderWithBackend (chooseBackend otype)

-- | Render a list of diagrams as separate pages to a file.
renderPagesAs :: OutputType -- ^ The output type to use (PS or PDF)
              -> String     -- ^ The name of the file to create.
              -> SizeSpec   -- ^ The desired width or height of the image.
              -> [Diagram]  -- ^ The diagram to render.
              -> IO ()
renderPagesAs otype = renderPagesWithBackend (choosePagesBackend otype)

-- | @renderOverPNG infile outfile d@ reads the PNG @infile@
--   and renders @d@ over this, saving the output as a PNG to @outfile@.
renderOverPNG :: FilePath -> FilePath -> Diagram -> IO ()
renderOverPNG srcfile dstfile dia = renderOverlayPNG srcfile dstfile dia