mirror of
https://github.com/codedownio/haskell-plot.git
synced 2025-04-17 11:56:19 +00:00
137 lines
5.9 KiB
Haskell
137 lines
5.9 KiB
Haskell
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : Graphics.Rendering.Plot.Figure.Line
|
|
-- Copyright : (c) A. V. H. McPhail 2010
|
|
-- License : BSD3
|
|
--
|
|
-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com
|
|
-- Stability : provisional
|
|
-- Portability : portable
|
|
--
|
|
-- 'Text' operations
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
|
|
module Graphics.Rendering.Plot.Figure.Line (
|
|
Line, LineFormat(..)
|
|
, DashStyle,Dash(..),LineWidth
|
|
, clearLineFormat
|
|
, setDashStyle
|
|
, setLineWidth
|
|
, setLineColour
|
|
, getLineColour
|
|
) where
|
|
|
|
-----------------------------------------------------------------------------
|
|
|
|
--import Data.Word
|
|
import Data.Colour
|
|
--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
|
|
|
|
-----------------------------------------------------------------------------
|
|
|
|
changeDashStyle :: DashStyle -> LineOptions -> LineOptions
|
|
changeDashStyle ds (LineOptions _ lw) = LineOptions ds lw
|
|
|
|
changeLineWidth :: LineWidth -> LineOptions -> LineOptions
|
|
changeLineWidth lw (LineOptions ds _) = LineOptions ds lw
|
|
|
|
{-changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> LineType
|
|
changeLineOptions f (LineType ls c) = LineType (f ls) c
|
|
|
|
changeDashStyle :: DashStyle -> LineType -> LineType
|
|
changeDashStyle ds = changeLineOptions (changeDashStyleStyle ds)
|
|
|
|
changeLineWidth :: LineWidth -> LineType -> LineType
|
|
changeLineWidth lw = changeLineOptions (changeLineWidthStyle lw)
|
|
-}
|
|
changeLineColour :: Color -> LineType -> LineType
|
|
changeLineColour c NoLine = ColourLine c
|
|
changeLineColour c (ColourLine _) = ColourLine c
|
|
changeLineColour c (TypeLine lo _) = TypeLine lo c
|
|
|
|
clearLineFormatting :: LineType -> LineType
|
|
clearLineFormatting NoLine = NoLine
|
|
clearLineFormatting l@(ColourLine _) = l
|
|
clearLineFormatting (TypeLine _ c) = ColourLine c
|
|
|
|
clearLine :: LineType -> LineType
|
|
clearLine _ = NoLine
|
|
|
|
getLineColour :: LineType -> Maybe Color
|
|
getLineColour NoLine = Nothing
|
|
getLineColour (ColourLine c) = Just c
|
|
getLineColour (TypeLine _ c) = Just c
|
|
|
|
-----------------------------------------------------------------------------
|
|
|
|
-- | clear the formatting of a line
|
|
clearLineFormat :: Line ()
|
|
clearLineFormat = do
|
|
lt <- get
|
|
case lt of
|
|
NoLine -> put NoLine
|
|
c@(ColourLine _) -> put c
|
|
(TypeLine _ c) -> put $ ColourLine c
|
|
|
|
changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> Line ()
|
|
changeLineOptions o NoLine = do
|
|
lo <- ask
|
|
put $ TypeLine (o lo) black
|
|
changeLineOptions o (ColourLine c) = do
|
|
lo <- ask
|
|
put $ TypeLine (o lo) c
|
|
changeLineOptions o (TypeLine lo c) = put $ TypeLine (o lo) c
|
|
|
|
-- | change the dash style of a line
|
|
setDashStyle :: DashStyle -> Line ()
|
|
setDashStyle ds = get >>= changeLineOptions (changeDashStyle ds)
|
|
|
|
-- | change the line width of a line
|
|
setLineWidth :: LineWidth -> Line ()
|
|
setLineWidth lw = get >>= changeLineOptions (changeLineWidth lw)
|
|
|
|
-- | change the line colour of a line
|
|
setLineColour :: Color -> Line ()
|
|
setLineColour c = modify (changeLineColour c)
|
|
|
|
-----------------------------------------------------------------------------
|
|
|
|
class LineFormat a where
|
|
toLine :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m LineType
|
|
|
|
instance Real a => LineFormat (Colour a) where toLine c = return $ ColourLine $ colourConvert c
|
|
instance LineFormat DashStyle where toLine ds = do
|
|
lo <- asks _lineoptions
|
|
c <- supply
|
|
return $ TypeLine (changeDashStyle ds lo) c
|
|
instance LineFormat LineWidth where toLine lw = do
|
|
lo <- asks _lineoptions
|
|
c <- supply
|
|
return $ TypeLine (changeLineWidth lw lo) c
|
|
instance Real a => LineFormat (DashStyle,Colour a) where toLine (ds,c) = do
|
|
lo <- asks _lineoptions
|
|
return $ TypeLine (changeDashStyle ds lo) $ colourConvert c
|
|
instance Real a => LineFormat (LineWidth,Colour a) where toLine (lw,c) = do
|
|
lo <- asks _lineoptions
|
|
return $ TypeLine (changeLineWidth lw lo) $ colourConvert c
|
|
instance LineFormat (DashStyle,LineWidth) where toLine (ds,lw) = do
|
|
c <- supply
|
|
return $ TypeLine (LineOptions ds lw) c
|
|
instance Real a => LineFormat (DashStyle,LineWidth,Colour a) where toLine (ds,lw,c) = return $ TypeLine (LineOptions ds lw) $ colourConvert c
|
|
|
|
-----------------------------------------------------------------------------
|
|
|