Vivian McPhail 45a55dbc5e initial repository
darcs-hash:20100901145450-af16d-11f5ac7750d938d81276e005e7b4a63d27620fb0.gz
2010-09-02 02:54:50 +12:00

120 lines
4.9 KiB
Haskell

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Plot.Figure.Point
-- Copyright : (c) A. V. H. McPhail 2010
-- License : BSD3
--
-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com
-- Stability : provisional
-- Portability : portable
--
-- 'Point' operations
--
-----------------------------------------------------------------------------
module Graphics.Rendering.Plot.Figure.Point (
Point, PointFormat(..)
, PointSize
-- , clearPointFormat
, setGlyph
, setPointSize
, setPointColour
, getPointColour
) where
-----------------------------------------------------------------------------
--import Data.Word
import Data.Colour
--import Data.Colour.SRGB
--import Data.Colour.Names
--import qualified Graphics.Rendering.Cairo as C
--import qualified Graphics.Rendering.Pango as P
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Supply
import Graphics.Rendering.Plot.Types
-----------------------------------------------------------------------------
changePointSize :: PointSize -> PointOptions -> PointOptions
changePointSize sz (PointOptions _ c) = PointOptions sz c
changePointColour :: Color -> PointOptions -> PointOptions
changePointColour c (PointOptions sz _) = PointOptions sz c
getPointColour :: PointType -> Color
getPointColour (FullPoint (PointOptions _ c) _) = c
changePointGlyph :: Glyph -> PointType -> PointType
--changePointGlyph gt s (BarePoint _) = BarePoint (Glyph gt s)
changePointGlyph g (FullPoint po _) = FullPoint po g
-----------------------------------------------------------------------------
{-
-- | clear the formatting of a point
clearPointFormat :: Point ()
clearPointFormat = do
pt <- get
case pt of
g@(BarePoint _) -> put g
(FullPoint _ g) -> put $ BarePoint g
-}
changePointOptions :: (PointOptions -> PointOptions) -> PointType -> Point ()
--changePointOptions o (BarePoint g) = do
-- po <- ask
-- put $ FullPoint (o po) g
changePointOptions o (FullPoint po g) = put $ FullPoint (o po) g
-- | change the glyph of a point
setGlyph :: Glyph -> Point ()
setGlyph g = modify $ \s -> changePointGlyph g s
-- | change the size of a point
setPointSize :: PointSize -> Point ()
setPointSize sz = get >>= changePointOptions (changePointSize sz)
-- | change the colour of a point
setPointColour :: Color -> Point ()
setPointColour c = get >>= changePointOptions (changePointColour c)
-----------------------------------------------------------------------------
class PointFormat a where
toPoint :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m PointType
instance PointFormat Glyph where toPoint g = do
po <- asks _pointoptions
c <- supply
return $ FullPoint (changePointColour c po) g
--instance PointFormat GlyphType where toPoint g = return $ BarePoint g
instance Real a => PointFormat (Colour a) where toPoint c = do
po <- asks _pointoptions
g <- supply
return $ FullPoint (changePointColour (colourConvert c) po) g
instance PointFormat (Glyph,PointSize) where toPoint (g,s) = do
po <- asks _pointoptions
c <- supply
return $ FullPoint (changePointSize s $ changePointColour c po) g
instance Real a => PointFormat (Glyph,Colour a) where toPoint (g,c) = do
po <- asks _pointoptions
return $ FullPoint (changePointColour (colourConvert c) po) g
instance Real a => PointFormat (Glyph,PointSize,Colour a) where toPoint (g,s,c) = return $ FullPoint (PointOptions s (colourConvert c)) g
-----------------------------------------------------------------------------
{- TODO
fix Glyph/GlyphType differences
NoPoint option?
-}