-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Diagrams.Shapes
-- Copyright   :  (c) Brent Yorgey 2008
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Primitive shapes out of which 'Diagram's can be built, implemented
-- via instances of 'ShapeClass'.
--
-----------------------------------------------------------------------------
module Graphics.Rendering.Diagrams.Shapes
  ( circle
  , arc

  , regPolyPath
  , regPoly
  , rotRegPoly

  , rect
  , rectPath
  , roundRect
  , roundRectF

  , straight
  , curved

  , textPath

  , rawCairo

  ) where

import Graphics.Rendering.Diagrams.Types
import Graphics.Rendering.Diagrams.Attributes (scale)
import Graphics.Rendering.Diagrams.Paths

import qualified Graphics.Rendering.Cairo as C
import qualified Graphics.Rendering.Cairo.Internal as CI
import Control.Arrow ((&&&))
import Control.Monad.Reader
import System.IO.Unsafe (unsafePerformIO)
import Control.Exception (bracket)

-- | Draw the shape defined by the current cairo path, using the
--   current fill color, stroke color, and stroke width settings.
draw :: DiaRenderM ()
draw = do c $ C.save
          (rf,gf,bf,af) <- asks (colorToRGBA . envFillColor)
          c $ C.setSourceRGBA rf gf bf af
          c $ C.fillPreserve

          (rs,gs,bs,as) <- asks (colorToRGBA . envStrokeColor)
          c $ C.setSourceRGBA rs gs bs as
          sw <- asks envStrokeWidth
          c $ fmap dist (C.deviceToUserDistance sw 0) >>= C.setLineWidth
          c $ C.stroke
          c $ C.restore
  where dist (x,y) = sqrt (x*x + y*y)

-- | A unit arc centered at the origin, with a given start and end
--   angle in radians.
data Arc = Arc Double Double  deriving (Eq, Show, Read)
instance ShapeClass Arc where
  shapeSize _ = (2,2)
  renderShape (Arc a1 a2) = do
    c $ C.arc 0 0 1 a1 a2
    draw

-- | @circle r@ is a circle with radius @r@.
circle :: Double -> Diagram
circle r = arc r 0 1

-- | @arc r a1 a2@ is a circular arc with radius @r@, starting at
--   angle @a1*2*pi@ and proceeding in a direction of increasing angle
--   to @a2*2*pi@.
arc :: Double -> Double -> Double -> Diagram
arc r a1 a2 = scale r $ Prim (Shape (Arc (a1*2*pi) (a2*2*pi)))

-- | A path-based shape.
data PathShape = PathShape PathStyle Path  deriving (Eq, Show, Read)
instance ShapeClass PathShape where
  shapeSize (PathShape _ p) = fst $ pathSizeAndOffset p
  renderShape (PathShape style p) = c (renderPath style p) >> draw

-- | @straight@ creates a 'Diagram' from a path, by drawing straight
--   lines along the path edges.
straight :: Path -> Diagram
straight = Prim . Shape . PathShape Straight

-- | @curved d p@ is a curved path which follows generally the path
--   @p@.  The parameter @d@ specifies the amount of corner rounding.
--   In particular, @d@ should be a value between 0 and 1, which
--   specifies what fraction of the path segments should be rounded
--   off with bezier curves, using the path vertices as control
--   points.  Thus @d = 0@ produces the polygonal path itself, with no
--   curved segments; @d = 1@ produces a continuously curving path
--   tangent to the midpoints of the path segments; and intermediate
--   values of @d@ interpolate between the two. The curved path
--   produced will be everywhere differentiable as long as @d > 0@.
--   If the path is not closed, the curve will begin and end at the
--   first and last path vertices (no rounding will take place at
--   these vertices).
curved :: Double -> Path -> Diagram
curved d = Prim . Shape . PathShape (Bezier d)

-- | @regPolyPath n r@ is an open path corresponding to a regular
--   polygon, with the first vertex oriented along the positive
--   x-axis and proceeding clockwise.
regPolyPath :: Int -> Double -> Path
regPolyPath n r = pathFromVertices verts
  where verts = map (((*r) . cos) &&& ((*r) . sin))
                    [0,2*pi/nd .. (nd-1)*2*pi/nd]
        nd = fromIntegral n

-- | @regPoly n r@ is a regular n-gon, with a circumcircle of radius
--   @r@.  One vertex is oriented along the positive x-axis.
regPoly :: Int -> Double -> Diagram
regPoly n r = straight . closed $ regPolyPath n r

-- | @rotRegPoly n r a@ is the same as @'regPoly' n r@ but rotated
--   through an angle of @a*2*pi@ radians (i.e., @a@ represents a
--   fraction of an entire revolution).  This is different than
--   @'rotate' a $ 'regPoly' n r@; @rotRegPoly@ will adjust the
--   bounding box correctly (using 'rotPath'), whereas the
--   construction using @rotate@ will still have a bounding box
--   corresponding to the unrotated polygon.
rotRegPoly :: Int -> Double -> Double -> Diagram
rotRegPoly n r a = straight . closed . rotPath a $ regPolyPath n r

-- -- | @Rect w@ is a 2w (width) by 2 (height) rectangle, centered at the
-- --   origin.
-- data Rect = Rect Double  deriving (Eq, Show, Read)
-- instance ShapeClass Rect where
--   shapeSize (Rect w) = (2*w,2)
--   renderShape (Rect w) = do
--     c $ C.rectangle (-w) (-1) (2*w) 2
--     draw

-- | @rectPath w h@ is a closed path describing a rectangle of width
--   @w@ and height @h@.
rectPath :: Double -> Double -> Path
rectPath w h = closed $ pathFromVertices [(0,0), (w,0), (w,h), (0,h)]

-- | @rect w h@ is a rectangle of width @w@ and height @h@.
rect :: Double -> Double -> Diagram
rect w h = straight $ rectPath w h

-- -- | @rect w h@ is a rectangle of width @w@ and height @h@.
-- rect :: Double -> Double -> Diagram
-- rect w h = scale (h/2) $ Prim (Shape (Rect (w/h)))

-- | @RoundRect w h f@ is a rectangle with rounded corners taking up a
--   fraction @f@ of the smaller side.  Both dimensions are given to
--   avoid unnecessary distortion in the curves when scaling.
data RoundRect = RoundRect Double Double Double deriving (Eq, Show, Read)
instance ShapeClass RoundRect where
  shapeSize (RoundRect w h _) = (w,h)
  renderShape (RoundRect w h f) = do
    let (x,y) = (w/2, h/2)
        r     = min (w * f) (h * f)
    c $ do C.arc (r-x) (r-y) r pi (-pi/2)
           C.lineTo (x-r) (-y)
           C.arc (x-r) (r-y) r (-pi/2) 0
           C.lineTo (x) (y-r)
           C.arc (x-r) (y-r) r 0 (pi/2)
           C.lineTo (r-x) (y)
           C.arc (r-x) (y-r) r (pi/2) pi
           C.closePath
    draw

-- | @roundRect w h@ is a rectangle of width @w@ and height @h@ with
--   rounded corners having a radius one third the length of the
--   shortest edge.
roundRect :: Double -> Double -> Diagram
roundRect w h = Prim . Shape $ RoundRect w h (1/3)

-- | @roundRect w h f@ is a rectangle of width @w@ and height @h@ with
--   rounded corners having a radius @f@ times the length of the
--   shortest edge.
roundRectF :: Double -> Double -> Double -> Diagram
roundRectF w h f = Prim . Shape $ RoundRect w h f

-- | @Text s t@ is a text string @t@ at size @s@.
data Text = Text Double String deriving (Eq, Show, Read)
instance ShapeClass Text where
    shapeSize t = (x,y)
        where x     = C.textExtentsWidth e + C.textExtentsXbearing e
              y     = C.fontExtentsHeight f
              (f,e) = unsafeExtents t
    renderShape (Text s t) = do
        c $ do C.setFontSize s
               (x,y) <- C.getCurrentPoint
               te <- C.textExtents t
               fe <- C.fontExtents
               C.moveTo
                (x - (C.textExtentsWidth te/2) - C.textExtentsXbearing te)
                (y + (C.fontExtentsHeight fe/2) - C.fontExtentsDescent fe)
               C.textPath t
        draw

{-# NOINLINE unsafeExtents #-}
unsafeExtents :: Text -> (CI.FontExtents, CI.TextExtents)
unsafeExtents (Text s t) = unsafePerformIO $ do
            bracket
                (CI.create =<< C.createImageSurface C.FormatARGB32 1 1)
                (CI.destroy)
                (\cxt -> do CI.setFontSize cxt s
                            te <- CI.textExtents cxt t
                            fe <- CI.fontExtents cxt
                            return (fe, te))

-- | @textPath s t@ is a string of text @t@ at size @s@,
--   represented as an outline with separate stroke and fill.
textPath :: Double -> String -> Diagram
textPath s t = Prim (Shape (Text s t))

data RawCairo = RawCairo Point (C.Render ())
instance ShapeClass RawCairo where
  shapeSize (RawCairo s _) = s
  renderShape (RawCairo _ r) = c r

-- | @rawCairo s r@ is a diagram with bounding box size @s@, rendered
--   by executing Cairo 'Render' action @r@. Import
--   "Graphics.Rendering.Cairo" to access Cairo operations.
rawCairo :: Point -> C.Render () -> Diagram
rawCairo s r = Prim (Shape (RawCairo s r))