Shapes.hs

-----------------------------------------------------------------------------
-- |
-- 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
  , poly
  , rect

  , draw
  ) where

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

import qualified Graphics.Rendering.Cairo as C
import Control.Arrow ((&&&), (***))
import Control.Monad.Reader

-- | 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
          (RGBA r g b a) <- asks envFillColor
          c $ C.setSourceRGBA r g b a
          c $ C.fillPreserve

          (RGBA r g b a) <- asks envStrokeColor
          c $ C.setSourceRGBA r g b a
          sw <- asks envStrokeWidth
          c $ fmap dist (C.deviceToUserDistance sw 0) >>= C.setLineWidth
          c $ C.stroke
          c $ C.restore
  where dist = sqrt . uncurry (+) . ((^2) *** (^2))

-- | A unit circle centered at the origin.
data Circle = Circle  deriving (Eq, Show, Read)
instance ShapeClass Circle where
  shapeSize _   = (2,2)
  renderShape _ = do
    c $ C.arc 0 0 1 0 (2*pi)
    draw

-- | @circle r@ is a circle with radius @r@.
circle :: Double -> Diagram
circle r = scale r $ Prim (Shape Circle)



-- | @RPoly n@ is a regular n-gon centered at the origin, with a
--   vertex at (1,0).
data RPoly = RPoly Int  deriving (Eq, Show, Read)
instance ShapeClass RPoly where
  shapeSize _ = (2,2)
  renderShape (RPoly n) = do
      c $ C.moveTo 1 0
      c $ mapM_ (uncurry C.lineTo . (cos &&& sin)) $
        tail [0,2*pi/nd .. (nd-1)*2*pi/nd]
      c $ C.closePath
      draw
    where nd = fromIntegral n

-- | @poly n r@ is a regular n-gon, with a circumcircle of radius @r@.
--   One vertex is oriented along the positive x-axis.  Note that the
--   bounding box is the square circumscribed around the circumcircle.
poly :: Int -> Double -> Diagram
poly n r = scale r $ Prim (Shape (RPoly n))



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

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