module Graphics.Rendering.Plot.Figure.Point (
Point, PointFormat(..)
, PointSize
, setGlyph
, setPointSize
, setPointColour
, getPointColour
) where
import Data.Colour
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 g (FullPoint po _) = FullPoint po g
changePointOptions :: (PointOptions -> PointOptions) -> PointType -> Point ()
changePointOptions o (FullPoint po g) = put $ FullPoint (o po) g
setGlyph :: Glyph -> Point ()
setGlyph g = modify $ \s -> changePointGlyph g s
setPointSize :: PointSize -> Point ()
setPointSize sz = get >>= changePointOptions (changePointSize sz)
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 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