diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -75,3 +75,11 @@ 0.1.4.2: * fixed bug in MinMax with error (logSeriesMinMax) + +0.1.5: + * changed Ticks datatype + * added linlog and loglin to Simple.hs + * fixed points with single error series (to under/over) + * fixed bug in location of `Value` axis + * added data labels to axes + * fix some warnings diff --git a/THANKS b/THANKS new file mode 100644 --- /dev/null +++ b/THANKS @@ -0,0 +1,1 @@ + * Nicolas Dudebout for linlog and loglin in Simple.hs diff --git a/lib/Graphics/Rendering/Plot/Defaults.hs b/lib/Graphics/Rendering/Plot/Defaults.hs --- a/lib/Graphics/Rendering/Plot/Defaults.hs +++ b/lib/Graphics/Rendering/Plot/Defaults.hs @@ -159,18 +159,20 @@ majorTickLength = 7.0 tickLabelScale = 0.75 -defaultMinorTicks :: Ticks -defaultMinorTicks = Ticks NoLine (Left 41) +defaultMinorTicks :: Maybe Ticks +defaultMinorTicks = Just $ Ticks NoLine (TickNumber 41) -defaultMajorTicks :: Ticks -defaultMajorTicks = Ticks NoLine (Left 5) +defaultMajorTicks :: Maybe Ticks +defaultMajorTicks = Just $ Ticks NoLine (TickNumber 5) defaultTickFormat :: TickFormat defaultTickFormat = "" defaultAxis :: AxisType -> AxisPosn -> AxisData -defaultAxis at axp = Axis at axp defaultLineType defaultMinorTicks defaultMajorTicks - defaultTickFormat NoText +defaultAxis at axp = Axis at axp + defaultLineType defaultMinorTicks defaultMajorTicks + defaultTickFormat + [] NoText defaultXAxis, defaultYAxis :: AxisData defaultXAxis = defaultAxis XAxis (Side Lower) diff --git a/lib/Graphics/Rendering/Plot/Figure.hs b/lib/Graphics/Rendering/Plot/Figure.hs --- a/lib/Graphics/Rendering/Plot/Figure.hs +++ b/lib/Graphics/Rendering/Plot/Figure.hs @@ -96,10 +96,12 @@ , setLegend , withLegendFormat -- ** Formatting - , Tick(..), TickValues, GridLines + , Tick(..), TickValues(..), GridLines , setTicks , setGridlines , setTickLabelFormat + , setDataLabels + , withDataLabelFormat , withAxisLabel , withAxisLine , withGridLine diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot.hs b/lib/Graphics/Rendering/Plot/Figure/Plot.hs --- a/lib/Graphics/Rendering/Plot/Figure/Plot.hs +++ b/lib/Graphics/Rendering/Plot/Figure/Plot.hs @@ -65,10 +65,12 @@ , setLegend , withLegendFormat -- ** Formatting - , Tick(..), TickValues, GridLines + , Tick(..), TickValues(..), GridLines , AX.setTicks , AX.setGridlines , AX.setTickLabelFormat + , AX.setDataLabels + , AX.withDataLabelFormat , AX.withAxisLabel , AX.withAxisLine , AX.withGridLine @@ -84,7 +86,7 @@ --import Data.Packed.Matrix import Numeric.Container -import Numeric.LinearAlgebra(eps) +--import Numeric.LinearAlgebra(eps) import qualified Data.Array.IArray as A @@ -164,7 +166,7 @@ clearAxis :: AxisType -> AxisPosn -> Plot () clearAxis at axp = do ax <- gets _axes - modify $ \s -> s { _axes = filter (\(Axis at' axp' _ _ _ _ _) -> not (at == at' && axp == axp')) ax } + modify $ \s -> s { _axes = filter (\(Axis at' axp' _ _ _ _ _ _) -> not (at == at' && axp == axp')) ax } -- | add an axis to the subplot addAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot () @@ -179,7 +181,7 @@ withAxis at axp m = do axes' <- gets _axes o <- ask - modify $ \s -> s { _axes = map (\a@(Axis at' ap' _ _ _ _ _) + modify $ \s -> s { _axes = map (\a@(Axis at' ap' _ _ _ _ _ _) -> if at == at' && axp == ap' then execAxis m o a else a) axes' } ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs --- a/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs @@ -15,10 +15,12 @@ module Graphics.Rendering.Plot.Figure.Plot.Axis ( Axis , AxisType(..),AxisSide(..),AxisPosn(..) - , Tick(..), TickValues, GridLines + , Tick(..), TickValues(..), GridLines , setTicks , setGridlines , setTickLabelFormat + , setDataLabels + , withDataLabelFormat , withAxisLabel , withAxisLine , withGridLine @@ -26,6 +28,8 @@ ----------------------------------------------------------------------------- +--import Data.Maybe + import Control.Monad.State import Control.Monad.Reader @@ -37,10 +41,10 @@ changeLineType :: LineType -> AxisData -> AxisData changeLineType lt ax = ax { _line_type = lt } -changeMinorTicks :: (Ticks -> Ticks) -> AxisData -> AxisData +changeMinorTicks :: (Maybe Ticks -> Maybe Ticks) -> AxisData -> AxisData changeMinorTicks t ax = ax { _minor_ticks = t (_minor_ticks ax) } -changeMajorTicks :: (Ticks -> Ticks) -> AxisData -> AxisData +changeMajorTicks :: (Maybe Ticks -> Maybe Ticks) -> AxisData -> AxisData changeMajorTicks t ax = ax { _major_ticks = t (_major_ticks ax) } changeTickFormat :: TickFormat -> AxisData -> AxisData @@ -49,6 +53,9 @@ changeLabel :: (TextEntry -> TextEntry) -> AxisData -> AxisData changeLabel f ax = ax { _label = f (_label ax) } +changeDataLabels :: ([TextEntry] -> [TextEntry]) -> AxisData -> AxisData +changeDataLabels f ax = ax { _data_labels = f (_data_labels ax) } + ----------------------------------------------------------------------------- -- | format the axis line @@ -65,20 +72,28 @@ lo <- asks _lineoptions (lt',v) <- case t of Minor -> do - (Ticks lt'' v') <- gets _minor_ticks + -- at this point can we guarantee there won't + -- be a Nothing? + (Just (Ticks lt'' v')) <- gets _minor_ticks return (lt'',v') Major -> do - (Ticks lt'' v') <- gets _major_ticks + (Just (Ticks lt'' v')) <- gets _major_ticks return (lt'',v') let lt = execLine m lo lt' case t of - Minor -> modify $ \s -> s { _minor_ticks = Ticks lt v } - Major -> modify $ \s -> s { _major_ticks = Ticks lt v } + Minor -> modify $ \s -> s { _minor_ticks = (Just (Ticks lt v)) } + Major -> modify $ \s -> s { _major_ticks = (Just (Ticks lt v)) } -- | format the axis ticks setTicks :: Tick -> TickValues -> Axis () -setTicks Minor ts = modify $ \s -> changeMinorTicks (setTickValues ts) s -setTicks Major ts = modify $ \s -> changeMajorTicks (setTickValues ts) s +setTicks Minor (TickNumber 0) = modify $ \s -> + changeMinorTicks (const Nothing) s +setTicks Minor ts = modify $ \s -> + changeMajorTicks (setTickValues ts) s +setTicks Major (TickNumber 0) = modify $ \s -> + changeMajorTicks (const Nothing) s +setTicks Major ts = modify $ \s -> + changeMajorTicks (setTickValues ts) s -- | should gridlines be displayed? setGridlines :: Tick -> GridLines -> Axis () @@ -88,6 +103,18 @@ -- | printf format that takes one argument, the tick value setTickLabelFormat :: String -> Axis () setTickLabelFormat tf = modify $ \s -> changeTickFormat tf s + +-- | a list of data labels +setDataLabels :: [String] -> Axis () +setDataLabels dl = modify $ \s -> + changeDataLabels (const (map BareText dl)) s + +-- | format the data labels +withDataLabelFormat :: Text () -> Axis () +withDataLabelFormat m = do + ax <- get + to <- asks _textoptions + put $ ax { _data_labels = map (execText m to) (_data_labels ax) } -- | operate on the axis label withAxisLabel :: Text () -> Axis () diff --git a/lib/Graphics/Rendering/Plot/Figure/Simple.hs b/lib/Graphics/Rendering/Plot/Figure/Simple.hs --- a/lib/Graphics/Rendering/Plot/Figure/Simple.hs +++ b/lib/Graphics/Rendering/Plot/Figure/Simple.hs @@ -15,7 +15,7 @@ module Graphics.Rendering.Plot.Figure.Simple ( -- * Plotting plot - , loglog, semilog + , loglog, semilog, linlog, loglin , parametric -- * Formatting , title @@ -55,14 +55,32 @@ -- | create a figure with a single linear-log plot -- with lower X and Y axes whose ranges are set from the data semilog :: Dataset d => d -> Figure () -semilog ds = do - setPlots 1 1 - withPlot (1,1) $ do - setDataset ds - addAxis XAxis (Side Lower) $ return () - addAxis YAxis (Side Lower) $ return () - setRangeFromData XAxis Lower Linear - setRangeFromData YAxis Lower Log +semilog = linlog +{-# DEPRECATED semilog "use linlog" #-} + +-- | create a figure with a single linear-log plot +-- with lower X and Y axes whose ranges are set from the data +linlog :: Dataset d => d -> Figure () +linlog ds = do + setPlots 1 1 + withPlot (1,1) $ do + setDataset ds + addAxis XAxis (Side Lower) $ return () + addAxis YAxis (Side Lower) $ return () + setRangeFromData XAxis Lower Linear + setRangeFromData YAxis Lower Log + +-- | create a figure with a single log-linear plot +-- with lower X and Y axes whose ranges are set from the data +loglin :: Dataset d => d -> Figure () +loglin ds = do + setPlots 1 1 + withPlot (1,1) $ do + setDataset ds + addAxis XAxis (Side Lower) $ return () + addAxis YAxis (Side Lower) $ return () + setRangeFromData XAxis Lower Log + setRangeFromData YAxis Lower Linear -- | create a figure with a single log-log plot -- with lower X and Y axes whose ranges are set from the data diff --git a/lib/Graphics/Rendering/Plot/Render/Plot.hs b/lib/Graphics/Rendering/Plot/Render/Plot.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot.hs @@ -61,33 +61,34 @@ ----------------------------------------------------------------------------- bbPlot :: Int -> Int -> (Int,Int) -> Render () -bbPlot r c (px,py) = modify (\(BoundingBox x y w h) -> let w' = w/(fromIntegral c) - h' = h/(fromIntegral r) - in (BoundingBox - (x+w'*((fromIntegral py)-1)) - (y+h'*((fromIntegral px)-1)) - w' h')) +bbPlot r c (px,py) = modify (\(BoundingBox x y w h) -> + let w' = w/(fromIntegral c) + h' = h/(fromIntegral r) + in (BoundingBox + (x+w'*((fromIntegral py)-1)) + (y+h'*((fromIntegral px)-1)) + w' h')) renderPlots :: Plots -> Render () renderPlots d = do - let ((x,y),(x',y')) = A.bounds d - rows = x'-x+1 - cols = y'-y+1 - bb <- get - mapM_ (\(i,e) -> do - case e of - Nothing -> return () - Just e' -> do - bbPlot rows cols i - renderPlot e' - put bb) (A.assocs d) + let ((x,y),(x',y')) = A.bounds d + rows = x'-x+1 + cols = y'-y+1 + bb <- get + mapM_ (\(i,e) -> do + case e of + Nothing -> return () + Just e' -> do + bbPlot rows cols i + renderPlot e' + put bb) (A.assocs d) renderPlot :: PlotData -> Render () renderPlot (Plot b p hd r a d l an) = do - tx <- bbCentreWidth - ty <- bbTopHeight - (_,th) <- renderText hd Centre TTop tx ty - bbLowerTop (th+textPad) + tx <- bbCentreWidth + ty <- bbTopHeight + (_,th) <- renderText hd Centre TTop tx ty + bbLowerTop (th+textPad) {- attempt to have different colour plot area (BoundingBox x y w h) <- get cairo $ do @@ -101,25 +102,24 @@ C.fill C.paint -} - - legend <- renderLegend l d - padding <- renderAxes p r a - renderBorder b - cairo C.save - clipBoundary - renderData r d - renderAnnotations r an - cairo C.restore - legend padding + legend <- renderLegend l d + padding <- renderAxes p r a + renderBorder b + cairo C.save + clipBoundary + renderData r d + renderAnnotations r an + cairo C.restore + legend padding renderBorder :: Border -> Render () renderBorder False = return () renderBorder True = do - (BoundingBox x y w h) <- get - cairo $ do - C.setLineWidth 0.5 - C.rectangle (x+0.5) (y+0.5) w h - C.stroke + (BoundingBox x y w h) <- get + cairo $ do + C.setLineWidth 0.5 + C.rectangle (x+0.5) (y+0.5) w h + C.stroke ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs @@ -25,6 +25,8 @@ import Data.Either +import Data.List + import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Pango as P @@ -67,139 +69,167 @@ addPadding :: Padding -> Padding -> Padding addPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (l0+l1) (r0+r1) (b0+b1) (t0+t1) -maxPadding :: Padding -> Padding -> Padding -maxPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (Prelude.max l0 l1) (Prelude.max r0 r1) (Prelude.max b0 b1) (Prelude.max t0 t1) +--maxPadding :: Padding -> Padding -> Padding +--maxPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (Prelude.max l0 l1) (Prelude.max r0 r1) (Prelude.max b0 b1) (Prelude.max t0 t1) -- first is plot padding, second is calculated padding isZeroPadding :: Padding -> Padding -> Render Padding isZeroPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = do - l <- if l1 == 0 then do - bbShiftLeft l0 - return l0 - else if l0 > l1 then do - bbShiftLeft (l0 - l1) - return l0 - else return l1 - r <- if r1 == 0 then do - bbShiftRight r0 - return r0 - else if r0 > r1 then do - bbShiftRight (r0 - r1) - return r0 - else return r1 - b <- if b1 == 0 then do - bbRaiseBottom b0 - return b0 - else if b0 > b1 then do - bbRaiseBottom (b0 - b1) - return b0 - else return b1 - t <- if t1 == 0 then do - bbLowerTop t0 - return t0 - else if t0 > t1 then do - bbLowerTop (t0 - t1) - return t0 - else return t1 - return $ Padding l r b t - + l <- if l1 == 0 then do + bbShiftLeft l0 + return l0 + else if l0 > l1 then do + bbShiftLeft (l0 - l1) + return l0 + else return l1 + r <- if r1 == 0 then do + bbShiftRight r0 + return r0 + else if r0 > r1 then do + bbShiftRight (r0 - r1) + return r0 + else return r1 + b <- if b1 == 0 then do + bbRaiseBottom b0 + return b0 + else if b0 > b1 then do + bbRaiseBottom (b0 - b1) + return b0 + else return b1 + t <- if t1 == 0 then do + bbLowerTop t0 + return t0 + else if t0 > t1 then do + bbLowerTop (t0 - t1) + return t0 + else return t1 + return $ Padding l r b t renderAxes :: Padding -> Ranges -> [AxisData] -> Render Padding renderAxes p r axes = do - lp <- foldM shiftForAxisLabel (Padding 0 0 0 0) axes - tp <- foldM (shiftForTicks r) (Padding 0 0 0 0) axes - let apd = addPadding lp tp - p' <- isZeroPadding p apd - mapM_ (renderAxisLabel p') axes - mapM_ (renderAxis r) axes - return p' + lp <- foldM shiftForAxisLabel (Padding 0 0 0 0) axes + tp <- foldM (shiftForTicks r) (Padding 0 0 0 0) axes + let apd = addPadding lp tp + p' <- isZeroPadding p apd + mapM_ (renderAxisLabel p') axes + mapM_ (renderAxis r) axes + return p' shiftForAxisLabel :: Padding -> AxisData -> Render Padding -shiftForAxisLabel p (Axis _ _ _ _ _ _ NoText) = return p -shiftForAxisLabel p (Axis ax sd _ _ _ _ lb) = do - (FontText to s) <- formatText lb - pc <- asks _pangocontext - (w,h) <- cairo $ do - lo <- pango $ P.layoutText pc s - setTextOptions to lo - case ax of - XAxis -> do - (_,(twh)) <- textSize lo Centre Middle 0 0 - return twh - YAxis -> do - (_,((w',h'))) <- textSizeVertical lo Centre Middle 0 0 - return (h',w') - shiftForAxisLabel' p ax sd w h - where shiftForAxisLabel' (Padding l r b t) XAxis (Side Lower) _ h' = do - bbRaiseBottom (h'+2*textPad) - return $ Padding l r (b+h'+2*textPad) t - shiftForAxisLabel' (Padding l r b t) XAxis (Side Upper) _ h' = do - bbLowerTop (h'+2*textPad) - return $ Padding l r b (t+h'+2*textPad) - shiftForAxisLabel' (Padding l r b t) YAxis (Side Lower) w' _ = do - bbShiftLeft (w'+2*textPad) - return $ Padding (l+w'+2*textPad) r b t - shiftForAxisLabel' (Padding l r b t) YAxis (Side Upper) w' _ = do - bbShiftRight (w'+2*textPad) - return $ Padding l (r+w'+2*textPad) b t - shiftForAxisLabel' p' _ (Value _) _ _ = return p' +shiftForAxisLabel p (Axis _ _ _ _ _ _ _ NoText) = return p +shiftForAxisLabel p (Axis ax sd _ _ _ _ _ lb) = do + (FontText to s) <- formatText lb + pc <- asks _pangocontext + (w,h) <- cairo $ do + lo <- pango $ P.layoutText pc s + setTextOptions to lo + case ax of + XAxis -> do + (_,(twh)) <- textSize lo Centre Middle 0 0 + return twh + YAxis -> do + (_,((w',h'))) <- textSizeVertical lo Centre Middle 0 0 + return (h',w') + shiftForAxisLabel' p ax sd w h + where shiftForAxisLabel' (Padding l r b t) XAxis (Side Lower) _ h' = do + bbRaiseBottom (h'+2*textPad) + return $ Padding l r (b+h'+2*textPad) t + shiftForAxisLabel' (Padding l r b t) XAxis (Side Upper) _ h' = do + bbLowerTop (h'+2*textPad) + return $ Padding l r b (t+h'+2*textPad) + shiftForAxisLabel' (Padding l r b t) YAxis (Side Lower) w' _ = do + bbShiftLeft (w'+2*textPad) + return $ Padding (l+w'+2*textPad) r b t + shiftForAxisLabel' (Padding l r b t) YAxis (Side Upper) w' _ = do + bbShiftRight (w'+2*textPad) + return $ Padding l (r+w'+2*textPad) b t + shiftForAxisLabel' p' _ (Value _) _ _ = return p' -- the padding is the tick padding that has been applied renderAxisLabel :: Padding -> AxisData -> Render () -renderAxisLabel _ (Axis _ _ _ _ _ _ NoText) = return () -renderAxisLabel (Padding _ _ b _) (Axis XAxis (Side Lower) _ _ _ _ la) = do - lx <- bbCentreWidth - ly <- bbBottomHeight - _ <- renderText la Centre TBottom lx (ly+b-textPad) - return () -renderAxisLabel (Padding _ _ _ t) (Axis XAxis (Side Upper) _ _ _ _ la) = do - lx <- bbCentreWidth - ly <- bbTopHeight - _ <- renderText la Centre TTop lx (ly-t+textPad) - return () -renderAxisLabel (Padding l _ _ _) (Axis YAxis (Side Lower) _ _ _ _ la) = do - lx <- bbLeftWidth - ly <- bbCentreHeight - _ <- renderTextVertical la TRight Middle (lx-l-2*textPad) ly - return () -renderAxisLabel (Padding _ r _ _) (Axis YAxis (Side Upper) _ _ _ _ la) = do - lx <- bbRightWidth - ly <- bbCentreHeight - _ <- renderTextVertical la TLeft Middle (lx+r+2*textPad) ly - return () -renderAxisLabel _ (Axis _ (Value _) _ _ _ _ _) = return () +renderAxisLabel _ (Axis _ _ _ _ _ _ _ NoText) = return () +renderAxisLabel (Padding _ _ b _) (Axis XAxis (Side Lower) _ _ _ _ _ la) = do + lx <- bbCentreWidth + ly <- bbBottomHeight + _ <- renderText la Centre TBottom lx (ly+b-textPad) + return () +renderAxisLabel (Padding _ _ _ t) (Axis XAxis (Side Upper) _ _ _ _ _ la) = do + lx <- bbCentreWidth + ly <- bbTopHeight + _ <- renderText la Centre TTop lx (ly-t+textPad) + return () +renderAxisLabel (Padding l _ _ _) (Axis YAxis (Side Lower) _ _ _ _ _ la) = do + lx <- bbLeftWidth + ly <- bbCentreHeight + _ <- renderTextVertical la TRight Middle (lx-l-2*textPad) ly + return () +renderAxisLabel (Padding _ r _ _) (Axis YAxis (Side Upper) _ _ _ _ _ la) = do + lx <- bbRightWidth + ly <- bbCentreHeight + _ <- renderTextVertical la TLeft Middle (lx+r+2*textPad) ly + return () +renderAxisLabel _ (Axis _ (Value _) _ _ _ _ _ _ ) = return () shiftForTicks :: Ranges -> Padding -> AxisData -> Render Padding shiftForTicks (Ranges (Left (Range _ xmin xmax)) _) - p (Axis XAxis (Side Lower) _ min maj tf _) - = shiftForTicks' p min maj XAxis (Side Lower) tf (negate $ Prelude.max (abs xmin) (abs xmax)) + p (Axis XAxis (Side Lower) _ min maj tf dl _) + = shiftForTicks' p min maj XAxis (Side Lower) tf dl (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges (Left (Range _ xmin xmax)) _) - p (Axis XAxis (Side Upper) _ min maj tf _) - = shiftForTicks' p min maj XAxis (Side Upper) tf (negate $ Prelude.max (abs xmin) (abs xmax)) + p (Axis XAxis (Side Upper) _ min maj tf dl _) + = shiftForTicks' p min maj XAxis (Side Upper) tf dl (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges (Right ((Range _ xmin xmax),_)) _) - p (Axis XAxis (Side Lower) _ min maj tf _) - = shiftForTicks' p min maj XAxis (Side Lower) tf (negate $ Prelude.max (abs xmin) (abs xmax)) + p (Axis XAxis (Side Lower) _ min maj tf dl _) + = shiftForTicks' p min maj XAxis (Side Lower) tf dl (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges (Right (_,(Range _ xmin xmax))) _) - p (Axis XAxis (Side Upper) _ min maj tf _) - = shiftForTicks' p min maj XAxis (Side Upper) tf (negate $ Prelude.max (abs xmin) (abs xmax)) + p (Axis XAxis (Side Upper) _ min maj tf dl _) + = shiftForTicks' p min maj XAxis (Side Upper) tf dl (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges _ (Left (Range _ ymin ymax))) - p (Axis YAxis (Side Lower) _ min maj tf _) - = shiftForTicks' p min maj YAxis (Side Lower) tf (negate $ Prelude.max (abs ymin) (abs ymax)) + p (Axis YAxis (Side Lower) _ min maj tf dl _) + = shiftForTicks' p min maj YAxis (Side Lower) tf dl (negate $ Prelude.max (abs ymin) (abs ymax)) shiftForTicks (Ranges _ (Left (Range _ ymin ymax))) - p (Axis YAxis (Side Upper) _ min maj tf _) - = shiftForTicks' p min maj YAxis (Side Upper) tf (negate $ Prelude.max (abs ymin) (abs ymax)) + p (Axis YAxis (Side Upper) _ min maj tf dl _) + = shiftForTicks' p min maj YAxis (Side Upper) tf dl (negate $ Prelude.max (abs ymin) (abs ymax)) shiftForTicks (Ranges _ (Right ((Range _ ymin ymax),_))) - p (Axis YAxis (Side Lower) _ min maj tf _) - = shiftForTicks' p min maj YAxis (Side Lower) tf (negate $ Prelude.max (abs ymin) (abs ymax)) + p (Axis YAxis (Side Lower) _ min maj tf dl _) + = shiftForTicks' p min maj YAxis (Side Lower) tf dl (negate $ Prelude.max (abs ymin) (abs ymax)) shiftForTicks (Ranges _ (Right (_,(Range _ ymin ymax)))) - p (Axis YAxis (Side Upper) _ min maj tf _) - = shiftForTicks' p min maj YAxis (Side Upper) tf (negate $ Prelude.max (abs ymin) (abs ymax)) -shiftForTicks _ p (Axis _ (Value _) _ _ _ _ _) + p (Axis YAxis (Side Upper) _ min maj tf dl _) + = shiftForTicks' p min maj YAxis (Side Upper) tf dl (negate $ Prelude.max (abs ymin) (abs ymax)) +shiftForTicks _ p (Axis _ (Value _) _ _ _ _ _ _) = return p -shiftForTicks' :: Padding -> Ticks -> Ticks -> AxisType -> AxisPosn -> TickFormat -> Double -> Render Padding -shiftForTicks' p (Ticks _ (Left 0)) (Ticks _ (Left 0)) _ _ _ _ = return p -shiftForTicks' p (Ticks _ (Left _)) (Ticks _ (Left 0)) _ _ _ _ = return p +shiftForTicks' :: Padding -> Maybe Ticks -> Maybe Ticks -> AxisType -> AxisPosn -> TickFormat -> [TextEntry] -> Double -> Render Padding +shiftForTicks' p Nothing Nothing _ _ _ _ _ = return p +shiftForTicks' p (Just (Ticks _ _)) Nothing _ _ _ _ _ = return p +shiftForTicks' p _ (Just (Ticks _ _)) ax sd tf dl v = do + to <- asks (_textoptions . _renderoptions) + pc <- asks _pangocontext + (tw,th) <- cairo $ do + let s = formatTick tf v + s' = if null dl then s else case head dl of + NoText -> error "NoText as a datalabel" + BareText bt -> bt + SizeText _ _ st -> st + FontText _ ft -> ft + lt <- pango $ P.layoutText pc s' + setTextOptions (scaleFontSize tickLabelScale to) lt + (_,twh) <- textSize lt Centre Middle 0 0 + return twh + shiftForTicks'' p (tw,th) ax sd + where shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Lower) = do + bbRaiseBottom (th+2*textPad) + return $ Padding l r (b+th+2*textPad) t + shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Lower) = do + bbShiftLeft (tw+2*textPad) + return $ Padding (l+tw+2*textPad) r b t + shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Upper) = do + bbLowerTop (th+2*textPad) + return $ Padding l r b (t+th+2*textPad) + shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Upper) = do + bbShiftRight (tw+2*textPad) + return $ Padding l (r+tw+2*textPad) b t + shiftForTicks'' p' (_,_) _ (Value _) = return p' + {- shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) XAxis (Side Lower) _ _ = do bbRaiseBottom minorTickLength @@ -214,43 +244,20 @@ bbShiftRight minorTickLength return $ Padding l (r+minorTickLength) b t -} -shiftForTicks' p (Ticks _ _) (Ticks _ _) ax sd tf v = do - to <- asks (_textoptions . _renderoptions) - pc <- asks _pangocontext - (tw,th) <- cairo $ do - let s = formatTick tf v - lt <- pango $ P.layoutText pc s - setTextOptions (scaleFontSize tickLabelScale to) lt - (_,twh) <- textSize lt Centre Middle 0 0 - return twh - shiftForTicks'' p (tw,th) ax sd - where shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Lower) = do - bbRaiseBottom (th+2*textPad) - return $ Padding l r (b+th+2*textPad) t - shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Lower) = do - bbShiftLeft (tw+2*textPad) - return $ Padding (l+tw+2*textPad) r b t - shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Upper) = do - bbLowerTop (th+2*textPad) - return $ Padding l r b (t+th+2*textPad) - shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Upper) = do - bbShiftRight (tw+2*textPad) - return $ Padding l (r+tw+2*textPad) b t - shiftForTicks'' p' (_,_) _ (Value _) = return p' renderAxis :: Ranges -> AxisData -> Render () -renderAxis _ (Axis _ _ NoLine _ _ _ _) = return () +renderAxis _ (Axis _ _ NoLine _ _ _ _ _) = return () renderAxis r (Axis ax sd (ColourLine c) - min maj tf l) = do - lo <- asks (_lineoptions . _renderoptions) - renderAxis r (Axis ax sd (TypeLine lo c) min maj tf l) + min maj tf dl l) = do + lo <- asks (_lineoptions . _renderoptions) + renderAxis r (Axis ax sd (TypeLine lo c) min maj tf dl l) renderAxis r (Axis ax sd lt - min maj tf _) = do - cairo $ setLineStyle lt - renderAxisTicks r ax sd min maj tf - renderAxisLine r ax sd - return () + min maj tf dl _) = do + cairo $ setLineStyle lt + renderAxisTicks r ax sd min maj tf dl + renderAxisLine r ax sd + return () lowerRange :: Either Range (Range,Range) -> Range lowerRange (Left r@(Range _ _ _)) = r @@ -258,63 +265,64 @@ renderAxisLine :: Ranges -> AxisType -> AxisPosn -> Render () renderAxisLine (Ranges _ yr) XAxis (Value v) = do - let (Range _ min max) = lowerRange yr - (BoundingBox x y w h) <- get - cairo $ do - lw' <- C.getLineWidth - let lw = lw'/2 - moveTo (x-lw) (y+h*((v-min)/(max-min))) - lineTo (x+w+lw) (y+h*((v-min)/(max-min))) - C.stroke + let (Range _ min max) = lowerRange yr + (BoundingBox x y w h) <- get + cairo $ do + lw' <- C.getLineWidth + let lw = lw'/2 + moveTo (x-lw) (y+h*((max-v)/(max-min))) + lineTo (x+w+lw) (y+h*((max-v)/(max-min))) + C.stroke renderAxisLine (Ranges xr _) YAxis (Value v) = do - let (Range _ min max) = lowerRange xr - (BoundingBox x y w h) <- get - cairo $ do - lw' <- C.getLineWidth - let lw = lw'/2 - moveTo (x+w*((v-min)/(max-min))) (y-lw) - lineTo (x+w*((v-min)/(max-min))) (y+h+lw) - C.stroke + let (Range _ min max) = lowerRange xr + (BoundingBox x y w h) <- get + cairo $ do + lw' <- C.getLineWidth + let lw = lw'/2 + moveTo (x+w*((v-min)/(max-min))) (y-lw) + lineTo (x+w*((v-min)/(max-min))) (y+h+lw) + C.stroke renderAxisLine _ XAxis (Side Lower) = do - (BoundingBox x y w h) <- get - cairo $ do - lw' <- C.getLineWidth - let lw = lw'/2 - moveTo (x-lw) (y+h) - lineTo (x+w+lw) (y+h) - C.stroke + (BoundingBox x y w h) <- get + cairo $ do + lw' <- C.getLineWidth + let lw = lw'/2 + moveTo (x-lw) (y+h) + lineTo (x+w+lw) (y+h) + C.stroke renderAxisLine _ XAxis (Side Upper) = do - (BoundingBox x y w _) <- get - cairo $ do - lw' <- C.getLineWidth - let lw = lw'/2 - moveTo (x-lw) (y) - lineTo (x+w+lw) (y) - C.stroke + (BoundingBox x y w _) <- get + cairo $ do + lw' <- C.getLineWidth + let lw = lw'/2 + moveTo (x-lw) (y) + lineTo (x+w+lw) (y) + C.stroke renderAxisLine _ YAxis (Side Lower) = do - (BoundingBox x y _ h) <- get - cairo $ do - lw' <- C.getLineWidth - let lw = lw'/2 - moveTo (x) (y-lw) - lineTo (x) (y+h+lw) - C.stroke + (BoundingBox x y _ h) <- get + cairo $ do + lw' <- C.getLineWidth + let lw = lw'/2 + moveTo (x) (y-lw) + lineTo (x) (y+h+lw) + C.stroke renderAxisLine _ YAxis (Side Upper) = do - (BoundingBox x y w h) <- get - cairo $ do - lw' <- C.getLineWidth - let lw = lw'/2 - moveTo (x+w) (y-lw) - lineTo (x+w) (y+h+lw) - C.stroke + (BoundingBox x y w h) <- get + cairo $ do + lw' <- C.getLineWidth + let lw = lw'/2 + moveTo (x+w) (y-lw) + lineTo (x+w) (y+h+lw) + C.stroke tickPosition :: Scale -> Double -> Double -> Int -> [(Double,Double)] -tickPosition sc min max n = let pos = map (\x -> min + (max-min)*(x)/(fromIntegral (n-1))) (take n [(0 :: Double)..]) - val = if sc == Log - then map (\x -> logBase 10 min + (x/(fromIntegral (n-1))) * (logBase 10 max - logBase 10 min)) - (take n [(0 :: Double)..]) - else pos - in zip pos val +tickPosition sc min max n = + let pos = map (\x -> min + (max-min)*(x)/(fromIntegral (n-1))) (take n [(0 :: Double)..]) + val = if sc == Log + then map (\x -> logBase 10 min + (x/(fromIntegral (n-1))) * (logBase 10 max - logBase 10 min)) + (take n [(0 :: Double)..]) + else pos + in zip pos val {- tickPosition min max n = let diff = max - min (sc,sd) = scaleDiff 1.0 diff n @@ -325,9 +333,11 @@ | (round (s*diff)) < n = scaleDiff (10*s) (10*diff) n | otherwise = (s,(round diff) `div` n) -} -renderAxisTicks :: Ranges -> AxisType -> AxisPosn -> Ticks -> Ticks -> TickFormat -> Render () + + +renderAxisTicks :: Ranges -> AxisType -> AxisPosn -> Maybe Ticks -> Maybe Ticks -> TickFormat -> [TextEntry] -> Render () renderAxisTicks (Ranges xrange yrange) ax sd - (Ticks gmin (Left tmin)) (Ticks gmaj (Left tmaj)) tf = do + (Just (Ticks gmin (TickNumber tmin))) (Just (Ticks gmaj (TickNumber tmaj))) tf dl = do (BoundingBox x y w h) <- get to <- asks (_textoptions . _renderoptions) pc <- asks _pangocontext @@ -355,20 +365,23 @@ (Right (Range scl ymin ymax,_)) -> (scl,ymin,ymax) -- convert axis position to non-data coordinates let sd' = case sd of - (Side _) -> sd - (Value v) -> case ax of - XAxis -> let (Range _ b t) = lowerRange yrange - in Value (y+h*(t-v)/(t-b)) - YAxis -> let (Range _ b t) = lowerRange xrange - in Value (x+w*(v-b)/(t-b)) + (Side _) -> sd + (Value v) -> case ax of + XAxis -> let (Range _ b t) = lowerRange yrange + in Value (y+h*(t-v)/(t-b)) + YAxis -> let (Range _ b t) = lowerRange xrange + in Value (x+w*(v-b)/(t-b)) let (pos,val) = unzip (tickPosition sc min max tmaj) + let ln = length pos + let dl' = if null dl then replicate ln Nothing else map Just dl let majpos = let ones = 1.0 : ones - ln = length pos - in zip3 pos (take ln ones) val + in zip4 pos (take ln ones) val dl' (pos',val') = unzip (tickPosition sc min max tmin) - minpos' = zip3 pos' (minorTickLengths tmin tmaj) val' - minpos = filter (not . (\(p,_,_) -> elem p pos)) minpos' - let renderAxisTick' = renderAxisTick pc to x y w h sc min max ax sd' tf + ln' = length pos' + minpos' = zip4 pos' (minorTickLengths tmin tmaj) val' + (replicate ln' Nothing) + minpos = filter (not . (\(p,_,_,_) -> elem p pos)) minpos' + let renderAxisTick' = renderAxisTick pc to x y w h sc min max ax sd' tf mapM_ (renderAxisTick' Minor gmin) minpos mapM_ (renderAxisTick' Major gmaj) majpos return () @@ -382,78 +395,86 @@ renderAxisTick :: P.PangoContext -> TextOptions -> Double -> Double -> Double -> Double -> Scale -> Double -> Double -> AxisType -> AxisPosn -> TickFormat -> Tick -> LineType - -> (Double,Double,Double) -> C.Render () -renderAxisTick pc to x y w h sc min max xa sd tf t gl (p,l,v) = do + -> (Double,Double,Double,Maybe TextEntry) -> C.Render () +renderAxisTick pc to x y w h sc min max xa sd tf t gl (p,l,v,dl) = do let tl' = case t of Minor -> minorTickLength Major -> majorTickLength tl = tl' * l (x1,y1,x2,y2) = case xa of - XAxis -> case sd of - (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min) - in (xt p,y+h,xt p,y+h-tl) - (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min) - in (xt p,y,xt p,y+tl) - (Value v') -> let xt x' = x + (x'-min)*w/(max-min) - in (xt p,v'-tl,xt p,v'+tl) - YAxis -> case sd of - (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min) - in (x,yt p,x+tl,yt p) - (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min) - in (x+w,yt p,x+w-tl,yt p) - (Value v') -> let yt y' = (y + h) - (y'-min)*h/(max-min) - in (v'-tl,yt p,v'+tl,yt p) + XAxis -> case sd of + (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min) + in (xt p,y+h,xt p,y+h-tl) + (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min) + in (xt p,y,xt p,y+tl) + (Value v') -> let xt x' = x + (x'-min)*w/(max-min) + in (xt p,v'-tl,xt p,v'+tl) + YAxis -> case sd of + (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min) + in (x,yt p,x+tl,yt p) + (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min) + in (x+w,yt p,x+w-tl,yt p) + (Value v') -> let yt y' = (y + h) - (y'-min)*h/(max-min) + in (v'-tl,yt p,v'+tl,yt p) moveTo x1 y1 lineTo x2 y2 C.stroke when (gl /= NoLine) (do - let (x3,y3,x4,y4) = case xa of - XAxis -> case sd of - (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min) - in (xt p,y,xt p,y+h) - (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min) - in (xt p,y,xt p,y+h) - (Value _) -> let xt x' = x + (x'-min)*w/(max-min) - in (xt p,y,xt p,y+h) - YAxis -> case sd of - (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min) - in (x,yt p,x+w,yt p) - (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min) - in (x,yt p,x+w,yt p) - (Value _) -> let yt y' = (y + h) - (y'-min)*h/(max-min) - in (x,yt p,x+w,yt p) - C.save - setLineStyle gl - moveTo x3 y3 - lineTo x4 y4 - C.stroke - C.restore) + let (x3,y3,x4,y4) = case xa of + XAxis -> case sd of + (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min) + in (xt p,y,xt p,y+h) + (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min) + in (xt p,y,xt p,y+h) + (Value _) -> let xt x' = x + (x'-min)*w/(max-min) + in (xt p,y,xt p,y+h) + YAxis -> case sd of + (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min) + in (x,yt p,x+w,yt p) + (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min) + in (x,yt p,x+w,yt p) + (Value _) -> let yt y' = (y + h) - (y'-min)*h/(max-min) + in (x,yt p,x+w,yt p) + C.save + setLineStyle gl + moveTo x3 y3 + lineTo x4 y4 + C.stroke + C.restore) let majlab = case sd of - (Side _) -> True - (Value _) -> False + (Side _) -> True + (Value _) -> False when (t == Major && majlab) $ do let s = if sc == Log then formatTick "10e%.1g" v else formatTick tf v - lo <- pango $ P.layoutText pc s + let s' = case dl of + Nothing -> BareText s + Just d -> d + let s'' = case s' of + NoText -> error "NoText for data label" + BareText bt -> bt + SizeText _ _ st -> st + FontText _ ft -> ft + lo <- pango $ P.layoutText pc s'' setTextOptions (scaleFontSize tickLabelScale to) lo case xa of - XAxis -> do - case sd of - (Side Lower) -> do - ((x',y'),_) <- textSize lo Centre TTop x1 (y1+2*textPad) - showText lo x' y' - (Side Upper) -> do - ((x',y'),_) <- textSize lo Centre TBottom x1 (y1-2*textPad) - showText lo x' y' - (Value _) -> error "renderAxisTicks: unreachable code (when majlab)" - YAxis -> do - case sd of - (Side Lower) -> do - ((x',y'),_) <- textSize lo TLeft Middle (x1-2*textPad) y1 - showText lo x' y' - (Side Upper) -> do - ((x',y'),_) <- textSize lo TRight Middle (x1+2*textPad) y1 - showText lo x' y' - (Value _) -> error "renderAxisTicks: unreachable code (when majlab)" + XAxis -> do + case sd of + (Side Lower) -> do + ((x',y'),_) <- textSize lo Centre TTop x1 (y1+2*textPad) + showText lo x' y' + (Side Upper) -> do + ((x',y'),_) <- textSize lo Centre TBottom x1 (y1-2*textPad) + showText lo x' y' + (Value _) -> error "renderAxisTicks: unreachable code (when majlab)" + YAxis -> do + case sd of + (Side Lower) -> do + ((x',y'),_) <- textSize lo TLeft Middle (x1-2*textPad) y1 + showText lo x' y' + (Side Upper) -> do + ((x',y'),_) <- textSize lo TRight Middle (x1+2*textPad) y1 + showText lo x' y' + (Value _) -> error "renderAxisTicks: unreachable code (when majlab)" return () ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UnicodeSyntax #-} ----------------------------------------------------------------------------- @@ -167,6 +168,8 @@ logSeries Log a = logBase 10 $ mapVector zeroToOne a logSeries _ a = a +midpoints :: (Num (Vector t), Container Vector t) + => (t1, Vector t) -> (t1, Vector t) midpoints(mi,v) = let v' = subVector 1 (dim v - 1) v w' = subVector 0 (dim v - 1) v in (mi,(v'+w')/2.0) @@ -231,8 +234,10 @@ case dat of Left (Left (t',y')) -> do renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y' - Left (Right (Left _)) -> do - error "Data.hs renderSeries: cannot have single error value with points type" + Left (Right (Left ((t',y'),(_,e')))) -> do + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y' + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' (y'-e') + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' (y'+e') Left (Right (Right ((t',y'),(_,l),(_,h)))) -> do renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y' renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' l @@ -245,7 +250,11 @@ Left (Left (t',y')) -> do renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y' renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y' - Left (Right (Left _)) -> do + Left (Right (Left ((t',y'),(_,e')))) -> do + renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y' + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y' + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' (y'-e') + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' (y'+e') error "Data.hs renderSeries: cannot have single error value with line-points type" Left (Right (Right ((t',y'),(_,l),(_,h)))) -> do renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y' @@ -361,9 +370,9 @@ Nothing -> C.moveTo ((t @> xmin_ix)*xscale) ((y @> xmin_ix)*yscale) Just s' -> s' _ <- runMaybeT $ do - mapVectorWithIndexM_ (\i y' -> do - when (i >= xmin_ix && i `mod` diff == 0) - (renderSample i xmax_ix t (f xscale yscale) y') + mapVectorWithIndexM_ (\j y' -> do + when (j >= xmin_ix && j `mod` diff == 0) + (renderSample j xmax_ix t (f xscale yscale) y') return ()) y (e xscale yscale) @@ -390,9 +399,9 @@ Nothing -> C.moveTo ((t @> xmin_ix)*xscale) (((fst $ y) @> xmin_ix)*yscale) Just s' -> s' - _ <- runMaybeT $ mapVectorWithIndexM_ (\i t' -> do - when (i >= xmin_ix && i `mod` diff == 0) - (renderMinMaxSample i xmax_ix t' (f xscale yscale) (e xscale yscale) y) + _ <- runMaybeT $ mapVectorWithIndexM_ (\j t' -> do + when (j >= xmin_ix && j `mod` diff == 0) + (renderMinMaxSample j xmax_ix t' (f xscale yscale) (e xscale yscale) y) return ()) t return () diff --git a/lib/Graphics/Rendering/Plot/Types.hs b/lib/Graphics/Rendering/Plot/Types.hs --- a/lib/Graphics/Rendering/Plot/Types.hs +++ b/lib/Graphics/Rendering/Plot/Types.hs @@ -182,26 +182,32 @@ data Tick = Minor | Major deriving(Eq) type GridLines = Bool -type TickValues = Either Int (Vector Double) -- ^ Either (number of ticks) (tick values) + +data TickValues = TickNumber Int + | TickValues (Vector Double) + data Ticks = Ticks LineType TickValues -setTickGridlines :: LineType -> Ticks -> Ticks -setTickGridlines gl (Ticks _ tv) = Ticks gl tv +setTickGridlines :: LineType -> Maybe Ticks -> Maybe Ticks +setTickGridlines gl (Just (Ticks _ tv)) = Just $ Ticks gl tv +setTickGridlines _ Nothing = Nothing -setTickValues :: TickValues -> Ticks -> Ticks -setTickValues tv (Ticks gl _) = Ticks gl tv +setTickValues :: TickValues -> Maybe Ticks -> Maybe Ticks +setTickValues tv (Just (Ticks gl _)) = Just $ Ticks gl tv +setTickValues tv Nothing = Just $ Ticks NoLine tv type TickFormat = String data AxisData = Axis { - _axis_type :: AxisType - , _position :: AxisPosn - , _line_type :: LineType - , _minor_ticks :: Ticks - , _major_ticks :: Ticks - , _tick_format :: TickFormat - , _label :: TextEntry - } + _axis_type :: AxisType + , _position :: AxisPosn + , _line_type :: LineType + , _minor_ticks :: Maybe Ticks + , _major_ticks :: Maybe Ticks + , _tick_format :: TickFormat + , _data_labels :: [TextEntry] + , _label :: TextEntry + } -- want line styles, so that, e.g., axes in centre of chart are grey or dashed etc. ----------------------------------------------------------------------------- @@ -223,11 +229,11 @@ -- need to have same number of entries as data series data LegendData = Legend { - _bounded :: Bool -- is there a box around the legend? - , _location :: LegendLocation - , _orient :: LegendOrientation - , _leg_fmt :: TextOptions - } + _bounded :: Bool -- is there a box around the legend? + , _location :: LegendLocation + , _orient :: LegendOrientation + , _leg_fmt :: TextOptions + } -- do we want a toggle for legends so the labels don't get destroyed? ----------------------------------------------------------------------------- @@ -246,11 +252,11 @@ ----------------------------------------------------------------------------- data Options = Options { - _lineoptions :: LineOptions - , _pointoptions :: PointOptions - , _baroptions :: BarOptions - , _textoptions :: TextOptions - } + _lineoptions :: LineOptions + , _pointoptions :: PointOptions + , _baroptions :: BarOptions + , _textoptions :: TextOptions + } ----------------------------------------------------------------------------- @@ -279,6 +285,8 @@ getOrdData (MinMax (o,_) _) = o getMinMaxData :: OrdSeries -> Either MinMaxSeries (MinMaxSeries,(ErrorSeries,ErrorSeries)) +getMinMaxData (Plain _) = error "Unreachable code, not MinMax" +getMinMaxData (Error _ _) = error "Unreachable code, not MinMax" getMinMaxData (MinMax o Nothing) = Left o getMinMaxData (MinMax o (Just e)) = Right (o,e) @@ -386,9 +394,9 @@ ----------------------------------------------------------------------------- data SupplyData = SupplyData { - _colours :: [Color] - , _glyphs :: [Glyph] - } + _colours :: [Color] + , _glyphs :: [Glyph] + } instance Supply SupplyData Color where nextSupply (SupplyData [] _ ) = error "Empty supply" @@ -401,15 +409,15 @@ -- | a plot data PlotData = Plot { - _border :: Border - , _plot_pads :: Padding - , _heading :: TextEntry - , _ranges :: Ranges - , _axes :: [AxisData] - , _data :: DataSeries - , _legend :: Maybe LegendData - , _annote :: Annotations - } + _border :: Border + , _plot_pads :: Padding + , _heading :: TextEntry + , _ranges :: Ranges + , _axes :: [AxisData] + , _data :: DataSeries + , _legend :: Maybe LegendData + , _annote :: Annotations + } ----------------------------------------------------------------------------- @@ -456,19 +464,19 @@ -- | a chart has a title and contains one or more plots data FigureData = Figure { - _fig_pads :: Padding - , _title :: TextEntry - , _subtitle :: TextEntry - , _plots :: Plots - } + _fig_pads :: Padding + , _title :: TextEntry + , _subtitle :: TextEntry + , _plots :: Plots + } ----------------------------------------------------------------------------- data FigureState = FigureState { - _defaults :: Options - , _supplies :: SupplyData - , _figure :: FigureData - } + _defaults :: Options + , _supplies :: SupplyData + , _figure :: FigureData + } newtype Figure a = FC { runFigure :: State FigureState a } deriving(Monad, MonadState FigureState) diff --git a/plot.cabal b/plot.cabal --- a/plot.cabal +++ b/plot.cabal @@ -1,5 +1,5 @@ Name: plot -Version: 0.1.4.2 +Version: 0.1.5 License: BSD3 License-file: LICENSE Copyright: (c) A.V.H. McPhail 2010, 2012 @@ -52,7 +52,7 @@ Cabal-version: >= 1.8 Build-type: Simple -Extra-source-files: README, CHANGES, LICENSE, +Extra-source-files: README, CHANGES, LICENSE, THANKS examples/perturbed-sine.hs, examples/perturbed-sine.png