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 :: 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))
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 :: Double -> Diagram
circle r = scale r $ Prim (Shape Circle)
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 .. (nd1)*2*pi/nd]
c $ C.closePath
draw
where nd = fromIntegral n
poly :: Int -> Double -> Diagram
poly n r = scale r $ Prim (Shape (RPoly n))
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 :: Double -> Double -> Diagram
rect w h = scale (h/2) $ Prim (Shape (Rect (w/h)))