{-# 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 qualified Data.Colour.SRGB 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.

instance (Floating a, Real a) => Color (Colour a) where
  colorToRGBA col = (r,g,b,1)
    where c' = RGB.toSRGB . colourConvert $ col
          r  = RGB.channelRed c'
          g  = RGB.channelGreen c'
          b  = RGB.channelBlue c'

instance (Floating a, Real a) => Color (AlphaColour a) where
  colorToRGBA col = (r,g,b,a)
    where col' = alphaColourConvert col
          a  = alphaChannel col'
          c' = RGB.toSRGB . alphaToColour $ col'
          r  = RGB.channelRed c'
          g  = RGB.channelGreen c'
          b  = RGB.channelBlue c'

instance Color SomeColor where
  colorToRGBA (SomeColor col) = colorToRGBA col

alphaToColour :: (Floating a, Ord a, Fractional a) => AlphaColour a -> Colour a
alphaToColour ac | alphaChannel ac == 0 = ac `over` black
                 | otherwise = 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