plot 0.2.3.11 → 0.2.3.12
raw patch · 10 files changed
+248/−207 lines, 10 filesdep ~arraydep ~hmatrixdep ~mtl
Dependency ranges changed: array, hmatrix, mtl
Files
- CHANGES +4/−0
- lib/Control/Monad/Supply.hs +17/−6
- lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs +12/−9
- lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs +44/−40
- lib/Graphics/Rendering/Plot/Render/Plot.hs +7/−4
- lib/Graphics/Rendering/Plot/Render/Plot/Annotation.hs +8/−3
- lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs +55/−50
- lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +52/−49
- lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs +44/−40
- plot.cabal +5/−6
CHANGES view
@@ -145,3 +145,7 @@ 0.2.3.11: * enabled compilation on ghc 8.8.3, fixing Monad fail. (by hasufell)++0.2.3.12:+ * updated to be compatible with ghc 9.8+
lib/Control/Monad/Supply.hs view
@@ -37,7 +37,9 @@ import Control.Monad.Fail ( MonadFail, fail ) import Prelude hiding ( fail ) #endif-+#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif ----------------------------------------------------------------------------- class Supply a b where@@ -50,16 +52,26 @@ -} ----------------------------------------------------------------------------- +repM :: Monad m => Int -> m a -> m [a]+repM 0 m = return []+repM 1 m = do+ a <- m+ return [a]+repM n m = do+ a <- m+ as <- replicateM (n-1) m+ return (a:as)+ class Monad m => MonadSupply s m | m -> s where supply :: Supply s a => m a supplyN :: (MonadSupply s m, Supply s a) => Int -> m [a]-supplyN n = replicateM n supply+supplyN n = repM n supply ----------------------------------------------------------------------------- newtype SupplyT s m a = SupplyT { runSupplyT :: s -> m (a, s) }- + evalSupplyT :: Monad m => SupplyT s m a -> s -> m a evalSupplyT st s = do ~(a,_) <- runSupplyT st s@@ -84,14 +96,14 @@ (<*>) = ap instance Monad m => Monad (SupplyT s m) where- return a = SupplyT $ \s -> return (a, s) + return a = SupplyT $ \s -> return (a, s) m >>= f = SupplyT $ \s -> do ~(a,s') <- runSupplyT m s runSupplyT (f a) s' instance (MonadFail m, Monad m) => MonadFail (SupplyT s m) where fail str = SupplyT $ \_ -> fail str- + instance MonadTrans (SupplyT s) where lift m = SupplyT $ \s -> do a <- m@@ -125,4 +137,3 @@ return ((a,s'),f) ------------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Figure.Plot.Axis@@ -33,6 +34,9 @@ import Control.Monad.State import Control.Monad.Reader+#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif import Graphics.Rendering.Plot.Types import Graphics.Rendering.Plot.Defaults@@ -87,20 +91,20 @@ -- | format the axis ticks setTicks :: Tick -> TickValues -> Axis ()-setTicks Minor (TickNumber 0) = modify $ \s -> +setTicks Minor (TickNumber 0) = modify $ \s -> changeMinorTicks (const Nothing) s-setTicks Minor ts = modify $ \s -> +setTicks Minor ts = modify $ \s -> changeMinorTicks (setTickValues ts) s-setTicks Major (TickNumber 0) = modify $ \s -> +setTicks Major (TickNumber 0) = modify $ \s -> changeMajorTicks (const Nothing) s-setTicks Major ts = modify $ \s -> +setTicks Major ts = modify $ \s -> changeMajorTicks (setTickValues ts) s -- | should gridlines be displayed? setGridlines :: Tick -> GridLines -> Axis ()-setGridlines Minor gl = modify $ \s -> +setGridlines Minor gl = modify $ \s -> changeMinorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s-setGridlines Major gl = modify $ \s -> +setGridlines Major gl = modify $ \s -> changeMajorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s -- | set the tick label format@@ -109,7 +113,7 @@ -- | a list of data labels setTickLabels :: [String] -> Axis ()-setTickLabels dl = modify $ \s -> +setTickLabels dl = modify $ \s -> changeTickLabels (const (map BareText dl)) s -- | format the tick labels@@ -124,7 +128,7 @@ withAxisLabel m = do ax <- get to <- asks _textoptions- put $ ax { _label = execText m to (_label ax) } + put $ ax { _label = execText m to (_label ax) } ----------------------------------------------------------------------------- @@ -137,4 +141,3 @@ put $ ax { _tick_labels = map (execText m to) (_tick_labels ax) } ------------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Figure.Plot.Data@@ -57,6 +58,10 @@ import Graphics.Rendering.Plot.Figure.Point import Graphics.Rendering.Plot.Figure.Bar +#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif+ ----------------------------------------------------------------------------- dataSeriesNum :: DataSeries -> Int@@ -218,9 +223,9 @@ lt <- toLine c return $ DecStep lt setSeriesType'' Step (DecLinPt lt _) = return $ DecStep lt- setSeriesType'' Step (DecImpulse lt) = return $ DecStep lt + setSeriesType'' Step (DecImpulse lt) = return $ DecStep lt setSeriesType'' Step d@(DecStep _) = return d- setSeriesType'' Step (DecArea lt) = return $ DecStep lt + setSeriesType'' Step (DecArea lt) = return $ DecStep lt setSeriesType'' Step (DecBar bt) = do let c = getBarColour bt lt <- toLine c@@ -243,8 +248,8 @@ lt <- toLine c return $ DecArea lt setSeriesType'' Area (DecLinPt lt _) = return $ DecArea lt- setSeriesType'' Area (DecImpulse lt) = return $ DecArea lt - setSeriesType'' Area (DecStep lt) = return $ DecArea lt + setSeriesType'' Area (DecImpulse lt) = return $ DecArea lt+ setSeriesType'' Area (DecStep lt) = return $ DecArea lt setSeriesType'' Area d@(DecArea _) = return d setSeriesType'' Area (DecBar bt) = do let c = getBarColour bt@@ -383,23 +388,23 @@ setSeriesType' :: Int -> SeriesType -> DataSeries -> Data DataSeries setSeriesType' i t (DS_Y a) = do s' <- setSeriesType'' t $ a A.! i- return $ DS_Y $ a A.// [(i,s')] + return $ DS_Y $ a A.// [(i,s')] setSeriesType' i t (DS_1toN x a) = do s' <- setSeriesType'' t $ a A.! i- return $ DS_1toN x $ a A.// [(i,s')] + return $ DS_1toN x $ a A.// [(i,s')] setSeriesType' i t (DS_1to1 a) = do let (x,s) = a A.! i s' <- setSeriesType'' t s- return $ DS_1to1 $ a A.// [(i,(x,s'))] + return $ DS_1to1 $ a A.// [(i,(x,s'))] setSeriesType' _ _ d@(DS_Surf _) = return d- + -- | set the series type of a given data series setSeriesType :: SeriesType -> Int -> Data () setSeriesType t i = do ds <- get ds' <- setSeriesType' i t ds put ds'- + -- | set the series type of all data series setAllSeriesTypes :: SeriesType -> Data () setAllSeriesTypes t = do@@ -464,19 +469,19 @@ modifyFormat _ d@(DecSeries _ (DecArea _)) = return d modifyFormat _ d@(DecSeries _ (DecPoint _)) = return d modifyFormat _ d@(DecSeries _ (DecLinPt _ _)) = return d- modifyFormat b (DecSeries o (DecBar bt)) = do + modifyFormat b (DecSeries o (DecBar bt)) = do bo <- asks _baroptions let bt' = execBar b bo bt return $ DecSeries o (DecBar bt')- modifyFormat b (DecSeries o (DecHist bt)) = do + modifyFormat b (DecSeries o (DecHist bt)) = do bo <- asks _baroptions let bt' = execBar b bo bt return $ DecSeries o (DecHist bt')- modifyFormat b (DecSeries o (DecCand bt)) = do + modifyFormat b (DecSeries o (DecCand bt)) = do bo <- asks _baroptions let bt' = execBar b bo bt return $ DecSeries o (DecCand bt')- modifyFormat b (DecSeries o (DecWhisk bt)) = do + modifyFormat b (DecSeries o (DecWhisk bt)) = do bo <- asks _baroptions let bt' = execBar b bo bt return $ DecSeries o (DecWhisk bt')@@ -511,7 +516,7 @@ ds <- get let ln = dataSeriesNum ds mapM_ (\i -> withSeriesFormat i (f i)) [1..ln]- + ----------------------------------------------------------------------------- class Abscissa a where@@ -594,7 +599,7 @@ step o f = do f' <- toLine f setSeriesType'' Step (format o f')- + area :: (Ordinate a, LineFormat b) => a -> b -> FormattedSeries area o f = do f' <- toLine f@@ -629,7 +634,7 @@ return $ toDecoration lt getType Point = do g <- supply- pt <- toPoint (g :: Glyph) + pt <- toPoint (g :: Glyph) return $ toDecoration pt getType LinePoint = do c <- supply@@ -676,9 +681,9 @@ instance Dataset Surface where toDataSeries m = return $ DS_Surf m- -instance (Ordinate a) => Dataset (SeriesType,[a]) where ++instance (Ordinate a) => Dataset (SeriesType,[a]) where toDataSeries (Line,os) = do let ln = length os cs <- supplyN ln@@ -745,14 +750,14 @@ let ln = length os cs <- supplyN ln ls <- mapM toLine (cs :: [Color])- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ls toDataSeries (Point,t,os) = do let ln = length os cs <- supplyN ln gs <- supplyN ln ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color]))- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ps toDataSeries (LinePoint,t,os) = do let ln = length os@@ -761,55 +766,55 @@ ls <- mapM toLine cs ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color])) let ds = toDecorations (zip ls ps)- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds toDataSeries (Impulse,t,os) = do let ln = length os cs <- supplyN ln ls <- mapM toLine (cs :: [Color]) ds <- mapM (setSeriesType'' Impulse) $ toDecorations ls- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds toDataSeries (Step,t,os) = do let ln = length os cs <- supplyN ln ls <- mapM toLine (cs :: [Color]) ds <- mapM (setSeriesType'' Step) $ toDecorations ls- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds toDataSeries (Area,t,os) = do let ln = length os cs <- supplyN ln ls <- mapM toLine (cs :: [Color]) ds <- mapM (setSeriesType'' Area) $ toDecorations ls- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds toDataSeries (Bar,t,os) = do let ln = length os cs <- supplyN ln bs <- mapM toBar (cs :: [Color])- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os bs toDataSeries (Hist,t,os) = do let ln = length os cs <- supplyN ln bs <- mapM toBar (cs :: [Color]) ds <- mapM (setSeriesType'' Hist) $ toDecorations bs- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds toDataSeries (Candle,t,os) = do let ln = length os cs <- supplyN ln bs <- mapM toBar (cs :: [Color]) ds <- mapM (setSeriesType'' Candle) $ toDecorations bs- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds toDataSeries (Whisker,t,os) = do let ln = length os cs <- supplyN ln bs <- mapM toBar (cs :: [Color]) ds <- mapM (setSeriesType'' Whisker) $ toDecorations bs- return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds instance (Abscissa a, Ordinate b) => Dataset [(SeriesType,a,b)] where@@ -822,57 +827,57 @@ toDataSeries' :: Ordinate b => (SeriesType,b) -> Data DecoratedSeries toDataSeries' (Line,o) = do- c <- supply + c <- supply l <- toLine (c :: Color) return $ format o l toDataSeries' (Point,o) = do- c <- supply + c <- supply g <- supply p <- toPoint ((g :: Glyph),(c :: Color)) return $ format o p toDataSeries' (LinePoint,o) = do- c <- supply + c <- supply g <- supply l <- toLine (c :: Color) p <- toPoint ((g :: Glyph),(c :: Color)) let d = toDecoration (l,p) return $ format o d toDataSeries' (Impulse,o) = do- c <- supply + c <- supply l <- toLine (c :: Color) d <- setSeriesType'' Impulse $ toDecoration l return $ format o d toDataSeries' (Step,o) = do- c <- supply + c <- supply l <- toLine (c :: Color) d <- setSeriesType'' Step $ toDecoration l return $ format o d toDataSeries' (Area,o) = do- c <- supply + c <- supply l <- toLine (c :: Color) d <- setSeriesType'' Area $ toDecoration l return $ format o d toDataSeries' (Bar,o) = do- c <- supply + c <- supply b <- toBar (c :: Color) return $ format o b toDataSeries' (Hist,o) = do- c <- supply + c <- supply b <- toBar (c :: Color) d <- setSeriesType'' Hist $ toDecoration b return $ format o d toDataSeries' (Candle,o) = do- c <- supply + c <- supply b <- toBar (c :: Color) d <- setSeriesType'' Candle $ toDecoration b return $ format o d toDataSeries' (Whisker,o) = do- c <- supply + c <- supply b <- toBar (c :: Color) d <- setSeriesType'' Whisker $ toDecoration b return $ format o d -instance Dataset [FormattedSeries] where +instance Dataset [FormattedSeries] where toDataSeries ds = do let ln = length ds ds' <- sequence ds@@ -911,4 +916,3 @@ isMonotoneIncreasing v = maybe False (\_ -> True) $ evalState (runMaybeT $ (mapVectorM_ monoStep (subVector 1 (size v -1) v))) (v `atIndex` 0) ------------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render/Plot.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Render.Plot@@ -60,6 +61,10 @@ --import Prelude hiding(min,max) --import qualified Prelude(max) +#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif+ ----------------------------------------------------------------------------- bbPlot :: Int -> Int -> (Int,Int) -> Render ()@@ -109,7 +114,7 @@ cairo C.save axes cairo C.restore- + renderBorder :: Border -> Render () renderBorder False = return () renderBorder True = do@@ -118,7 +123,5 @@ C.setLineWidth 0.5 C.rectangle (x+0.5) (y+0.5) w h C.stroke- ------------------------------------------------------------------------------ -+-----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render/Plot/Annotation.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Render.Plot.Annotation@@ -37,6 +38,10 @@ --import Prelude hiding(min,max) --import qualified Prelude(max) +#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif+ ----------------------------------------------------------------------------- renderAnnotations :: Ranges -> Annotations -> Render ()@@ -44,13 +49,13 @@ (BoundingBox x y w h) <- get let (xsc,xmin',xmax') = getRanges XAxis Lower r let (xmin,xmax) = if xsc == Log then (logBase 10 xmin',logBase 10 xmax') else (xmin',xmax')- let xscale = w/(xmax-xmin) + let xscale = w/(xmax-xmin) cairo $ C.save let (yscl,yminl',ymaxl') = getRanges YAxis Lower r let (yminl,ymaxl) = if yscl == Log then (logBase 10 yminl',logBase 10 ymaxl') else (yminl',ymaxl')- let yscalel = h/(ymaxl-yminl) + let yscalel = h/(ymaxl-yminl) -- transform to data coordinates- cairo $ do + cairo $ do C.translate x (y+h) --C.scale xscale yscalel C.translate (-xmin*xscale) (yminl*yscalel)
lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Render.Plot.Axis@@ -25,7 +26,7 @@ import Data.Either -import Data.List +import Data.List import Numeric.LinearAlgebra.Data hiding (Range) @@ -48,6 +49,10 @@ import Prelude hiding(min,max) import qualified Prelude(max) +#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif+ ----------------------------------------------------------------------------- moveTo :: Double -> Double -> C.Render ()@@ -135,7 +140,7 @@ YAxis -> do (_,((w',h'))) <- textSizeVertical lo Centre Middle 0 0 return (h',w')- shiftForAxisLabel' p ax sd w h + 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@@ -177,38 +182,38 @@ shiftForTicks :: Ranges -> Padding -> AxisData -> Render Padding shiftForTicks (Ranges (Left (Range _ xmin xmax)) _)- p (Axis XAxis (Side Lower) _ min maj tf dl _) - = shiftForTicks' p min maj XAxis (Side Lower) tf dl + 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 dl _) - = shiftForTicks' p min maj XAxis (Side Upper) tf dl + 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 dl _) - = shiftForTicks' p min maj XAxis (Side Lower) tf dl + 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 dl _) - = shiftForTicks' p min maj XAxis (Side Upper) tf dl + 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 dl _) - = shiftForTicks' p min maj YAxis (Side Lower) tf dl + 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 dl _) - = shiftForTicks' p min maj YAxis (Side Upper) tf dl + 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 dl _) - = shiftForTicks' p min maj YAxis (Side Lower) tf dl + 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 dl _) - = shiftForTicks' p min maj YAxis (Side Upper) tf dl + 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 _) _ _ _ _ _ _) +shiftForTicks _ p (Axis _ (Value _) _ _ _ _ _ _) = return p shiftForTicks' :: Padding -> Maybe Ticks -> Maybe Ticks -> AxisType -> AxisPosn -> TickFormat -> [TextEntry] -> Double -> Render Padding@@ -222,7 +227,7 @@ s' = if null dl then s else case head dl of NoText -> error "NoText as a datalabel" BareText bt -> bt- SizeText _ _ st -> st + SizeText _ _ st -> st FontText _ ft -> ft lt <- pango $ P.layoutText pc s' setTextOptions (scaleFontSize tickLabelScale to) lt@@ -259,9 +264,9 @@ -} renderAxis :: Ranges -> AxisData -> Render ()-renderAxis _ (Axis _ _ NoLine _ _ _ _ _) = return () -renderAxis r (Axis ax sd - (ColourLine c) +renderAxis _ (Axis _ _ NoLine _ _ _ _ _) = return ()+renderAxis r (Axis ax sd+ (ColourLine c) min maj tf dl l) = do lo <- asks (_lineoptions . _renderoptions) renderAxis r (Axis ax sd (TypeLine lo c) min maj tf dl l)@@ -278,7 +283,7 @@ renderAxisLine :: Ranges -> AxisType -> AxisPosn -> Render () renderAxisLine (Ranges _ yr) XAxis (Value v) = do- let (Range _ min max) = lowerRange yr + let (Range _ min max) = lowerRange yr (BoundingBox x y w h) <- get cairo $ do lw' <- C.getLineWidth@@ -287,7 +292,7 @@ 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 + let (Range _ min max) = lowerRange xr (BoundingBox x y w h) <- get cairo $ do lw' <- C.getLineWidth@@ -329,7 +334,7 @@ C.stroke tickPosition :: Tick -> Scale -> Double -> Double -> Either Int [Double] -> [(Double,Double)]-tickPosition _ sc min max nv = +tickPosition _ sc min max nv = let ticks = either (\n -> take n [(0::Double)..]) id nv l = fromIntegral $ length ticks - 1 pos = case nv of@@ -367,7 +372,7 @@ (Right (_,Range scl xmin xmax)) -> (scl,xmin,xmax) (Value _) -> case xrange of (Left (Range scl xmin xmax)) -> (scl,xmin,xmax)- (Right (Range scl xmin xmax,_)) -> (scl,xmin,xmax) + (Right (Range scl xmin xmax,_)) -> (scl,xmin,xmax) YAxis -> case sd of (Side Lower) -> case yrange of (Left (Range scl ymin ymax)) -> (scl,ymin,ymax)@@ -382,31 +387,31 @@ let sd' = case sd of (Side _) -> sd (Value v) -> case ax of- XAxis -> let (Range _ b t) = + XAxis -> let (Range _ b t) = lowerRange yrange in Value (y+h*(t-v)/(t-b))- YAxis -> let (Range _ b t) = + YAxis -> let (Range _ b t) = lowerRange xrange in Value (x+w*(v-b)/(t-b))- let renderAxisTick' = renderAxisTick pc to x y w h - sc min max ax sd' tf + let renderAxisTick' = renderAxisTick pc to x y w h+ sc min max ax sd' tf (majpos',gmaj',tjpos,tmaj') <- case tmj of (Just (Ticks gmaj (TickNumber tmaj))) -> do- let (pos,val) = unzip (tickPosition Major sc min max - (Left tmaj)) + let (pos,val) = unzip (tickPosition Major sc min max+ (Left tmaj)) let ln = length pos- let dl' = if null dl - then replicate ln Nothing + let dl' = if null dl+ then replicate ln Nothing else map Just dl let majpos = let ones = 1.0 : ones in zip4 pos (take ln ones) val dl' return $ (Just majpos,Just gmaj,Just pos,Just tmaj) (Just (Ticks gmaj (TickValues tmaj))) -> do- let (pos,val) = unzip (tickPosition Major sc min max + let (pos,val) = unzip (tickPosition Major sc min max (Right $ toList tmaj)) ln = length pos- let dl' = if null dl - then replicate ln Nothing + let dl' = if null dl+ then replicate ln Nothing else map Just dl let majpos = let ones = 1.0 : ones in zip4 pos (take ln ones) val dl'@@ -414,31 +419,31 @@ Nothing -> return (Nothing,Nothing,Nothing,Nothing) (minpos',gmin') <- case tmn of (Just (Ticks gmin (TickNumber tmin))) -> do- let (pos',val') = unzip (tickPosition Minor sc min max + let (pos',val') = unzip (tickPosition Minor sc min max (Left tmin)) ln' = length pos'- minpos' = zip4 pos' (minorTickLengths tmin - (maybe 0 id tmaj')) val' + minpos' = zip4 pos' (minorTickLengths tmin+ (maybe 0 id tmaj')) val' (replicate ln' Nothing)- minpos = filter (not . (\(p,_,_,_) -> + minpos = filter (not . (\(p,_,_,_) -> elem p (maybe [] id tjpos))) minpos' return $ (Just minpos,Just gmin) (Just (Ticks gmin (TickValues tmin))) -> do- let (pos,val) = unzip (tickPosition Minor sc min max + let (pos,val) = unzip (tickPosition Minor sc min max (Right $ toList tmin)) ln = length pos minpos' = let halves = 0.7 : halves in zip4 pos halves pos (replicate ln Nothing)- minpos = filter (not . (\(p,_,_,_) -> + minpos = filter (not . (\(p,_,_,_) -> elem p (maybe [] id tjpos))) minpos' return $ (Just minpos,Just gmin) Nothing -> return (Nothing,Nothing) case majpos' of- (Just m) -> mapM_ (renderAxisTick' Major + (Just m) -> mapM_ (renderAxisTick' Major (maybe NoLine id gmaj')) m Nothing -> return () case minpos' of- (Just m) -> mapM_ (renderAxisTick' Minor + (Just m) -> mapM_ (renderAxisTick' Minor (maybe NoLine id gmin')) m Nothing -> return () return ()@@ -449,7 +454,7 @@ in map ((/ 2) . (+ 1) . (* 2) . (/ (fromIntegral num)) . fromIntegral . (\x -> if x > (num `div` 2) then num - x else x) . (`mod` num)) (take (min+1) [0..]) --map ((/) 2 . (+) 1 . (/) (fromIntegral tmaj) . fromIntegral . (mod tmaj)) (take (tmin+1) [0..]) -renderAxisTick :: P.PangoContext -> TextOptions +renderAxisTick :: P.PangoContext -> TextOptions -> Double -> Double -> Double -> Double -> Scale -> Double -> Double -> AxisType -> AxisPosn -> TickFormat -> Tick -> LineType -> (Double,Double,Double,Maybe TextEntry) -> C.Render ()@@ -493,12 +498,12 @@ (Value _) -> let yt y' = (y + h) - (y'-min)*h/(max-min) in (x,yt p,x+w,yt p) C.save- setLineStyle gl + setLineStyle gl moveTo x3 y3 lineTo x4 y4 C.stroke C.restore)- let majlab = case sd of + let majlab = case sd of (Side _) -> True (Value _) -> False when (t == Major && majlab) $ do@@ -513,7 +518,7 @@ FontText _ ft -> ft lo <- pango $ P.layoutText pc s'' setTextOptions (scaleFontSize tickLabelScale to) lo- case xa of + case xa of XAxis -> do case sd of (Side Lower) -> do
lib/Graphics/Rendering/Plot/Render/Plot/Data.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- |@@ -26,7 +27,7 @@ import Data.List(partition) --import Prelude.Unicode ---import Foreign.Storable +--import Foreign.Storable --import Foreign.Ptr import Numeric.LinearAlgebra hiding (Upper, Lower)@@ -39,7 +40,7 @@ import Data.Word -import Data.Maybe +import Data.Maybe import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM @@ -58,6 +59,10 @@ import Prelude hiding(min,max,abs) import qualified Prelude +#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif+ ----------------------------------------------------------------------------- findMinIdx, findMaxIdx :: Vector Double -> Double -> Int -> Int -> Int@@ -94,7 +99,7 @@ | otherwise = x renderData :: Ranges -> BarSetting -> SampleData -> DataSeries -> Render ()-renderData _ _ _ (DS_Surf m) = do +renderData _ _ _ (DS_Surf m) = do (BoundingBox x y w h) <- get let r = rows m c = cols m@@ -126,25 +131,25 @@ renderData r bc sd ds = do let aos = case ds of (DS_Y os') -> zip (repeat (AbsFunction id)) (A.elems os')- (DS_1toN abs' os') -> zip (repeat abs') (A.elems os') + (DS_1toN abs' os') -> zip (repeat abs') (A.elems os') (DS_1to1 aos') -> A.elems aos' _ -> error "renderData: DataSeries not handled" let (los,ups) = partition (\(_,DecSeries o _) -> isLower o) aos (BoundingBox x y w h) <- get let (xsc,xmin',xmax') = getRanges XAxis Lower r let (xmin,xmax) = if xsc == Log then (logBase 10 $ zeroToOne xmin',logBase 10 $ zeroToOne xmax') else (xmin',xmax')- let xscale = w/(xmax-xmin) + let xscale = w/(xmax-xmin) cairo $ C.save let (yscl,yminl',ymaxl') = getRanges YAxis Lower r let (yminl,ymaxl) = if yscl == Log then (logBase 10 $ zeroToOne yminl',logBase 10 $ zeroToOne ymaxl') else (yminl',ymaxl')- let yscalel = h/(ymaxl-yminl) + let yscalel = h/(ymaxl-yminl) -- transform to data coordinates- cairo $ do + cairo $ do C.translate x (y+h) --C.scale xscale yscalel C.translate (-xmin*xscale) (yminl*yscalel) flipVertical- los' <- configureBars xsc yscl xmin xmax xscale yscalel bc los + los' <- configureBars xsc yscl xmin xmax xscale yscalel bc los mapM_ (renderSeries xsc yscl xmin xmax xscale yscalel sd) los' cairo $ C.restore when (not $ null ups)@@ -152,14 +157,14 @@ cairo $ C.save let (yscu,yminu',ymaxu') = getRanges YAxis Upper r let (yminu,ymaxu) = if yscu == Log then (logBase 10 $ zeroToOne yminu',logBase 10 $ zeroToOne ymaxu') else (yminu',ymaxu')- let yscaleu = h/(ymaxu-yminu) + let yscaleu = h/(ymaxu-yminu) -- transform to data coordinates- cairo $ do + cairo $ do C.translate x (y+h) --C.scale xscale yscaleu C.translate (-xmin*xscale) (yminu*yscaleu) flipVertical- ups' <- configureBars xsc yscu xmin xmax xscale yscaleu bc ups + ups' <- configureBars xsc yscu xmin xmax xscale yscaleu bc ups mapM_ (renderSeries xsc yscu xmin xmax xscale yscaleu sd) ups' cairo $ C.restore) -- could filter annotations as well@@ -169,7 +174,7 @@ logSeries Log a = logBase 10 $ cmap zeroToOne a logSeries _ a = a -midpoints :: (Fractional t, Num (Vector t), Container Vector t) +midpoints :: (Fractional t, Num (Vector t), Container Vector t) => (t1, Vector t) -> (t1, Vector t) midpoints(mi,v) = let v' = subVector 1 (size v - 1) v w' = subVector 0 (size v - 1) v@@ -179,8 +184,8 @@ logSeriesMinMax Log (v,w) = (logSeries Log v,logSeries Log w) logSeriesMinMax Linear x = x -getBar :: (Integer,(Abscissae,DecoratedSeries)) - -> Maybe (Integer,(Abscissae,DecoratedSeries,BarType)) +getBar :: (Integer,(Abscissae,DecoratedSeries))+ -> Maybe (Integer,(Abscissae,DecoratedSeries,BarType)) getBar (ix,(as,DecSeries os ds)) = let d = decorationGetBarType ds in case d of Just d' -> Just (ix,(as,DecSeries os ds,d'))@@ -201,9 +206,9 @@ shiftAbscissa (j,(AbsFunction f,ds,_)) s = (j,(AbsFunction ((+) s . f),ds)) shiftAbscissa (j,(AbsPoints mi t,ds,_)) s = (j,(AbsPoints mi ((+) (vector [s]) t),ds)) -replaceBars :: [(Integer,(Abscissae,DecoratedSeries))] - -> [(Abscissae,DecoratedSeries)] - -> [(Abscissae,DecoratedSeries)] +replaceBars :: [(Integer,(Abscissae,DecoratedSeries))]+ -> [(Abscissae,DecoratedSeries)]+ -> [(Abscissae,DecoratedSeries)] replaceBars [] as = as replaceBars ((j,ds):dss) as = replaceBars dss $ replace j ds as @@ -225,7 +230,7 @@ mkCandlesFromBars :: (Vector Double,Vector Double) -> (Integer,(Abscissae,DecoratedSeries,BarType)) -> (Integer,(Abscissae,DecoratedSeries))-mkCandlesFromBars (v,w) (j,(a,DecSeries (OrdPoints ax o mb_l) _,bt)) = +mkCandlesFromBars (v,w) (j,(a,DecSeries (OrdPoints ax o mb_l) _,bt)) = (j,(a,DecSeries (OrdPoints ax ordSeries mb_l) (DecCand bt))) where ordSeries = convertBarToCandle (v,w) o@@ -238,8 +243,8 @@ configureBars :: Scale -> Scale -> Double -> Double -> Double -> Double -> BarSetting- -> [(Abscissae,DecoratedSeries)] - -> Render [(Abscissae,DecoratedSeries)] + -> [(Abscissae,DecoratedSeries)]+ -> Render [(Abscissae,DecoratedSeries)] configureBars _ _ _ _ xscale _ bs aos = do let bars = mapMaybe getBar $ zip [0..] aos case bs of@@ -256,7 +261,7 @@ let od = (getOrdData' . (\(_,b,_) -> b) . snd . head) bars let ln = size $ od let zero = konst 0 ln- let pairs = pair $ scanl scanStacked zero bars + let pairs = pair $ scanl scanStacked zero bars let candles = zipWith mkCandlesFromBars pairs bars let aos' = replaceBars candles aos return aos'@@ -265,8 +270,8 @@ pair [x,y] = [(x,y)] pair (x:y:xs) = (x,y) : pair (y:xs) -renderSeries :: Scale -> Scale - -> Double -> Double -> Double -> Double -> SampleData +renderSeries :: Scale -> Scale+ -> Double -> Double -> Double -> Double -> SampleData -> (Abscissae,DecoratedSeries) -> Render () renderSeries xsc ysc xmin xmax xscale yscale sd (abs,(DecSeries o d)) = do dat <- case o of@@ -276,7 +281,7 @@ return $ Left $ Left ((True,t),logSeries ysc $ f t) (OrdPoints _ (Plain o') _) -> do let t = case abs of- AbsFunction f -> + AbsFunction f -> if isHist d then (True,cmap f $ fromList [0.0..(fromIntegral $ size o')]) else (True,cmap f $ fromList [1.0..(fromIntegral $ size o')])@@ -284,7 +289,7 @@ return $ Left $ Left ((fst t,logSeries xsc $ snd t),logSeries ysc $ o') (OrdPoints _ (Error o' (Left e)) _) -> do let t = case abs of- AbsFunction f -> + AbsFunction f -> if isHist d then (True,cmap f $ fromList [0.0..(fromIntegral $ size o')]) else (True,cmap f $ fromList [1.0..(fromIntegral $ size o')])@@ -293,11 +298,11 @@ return $ Left $ Right $ Left ((t',logSeries ysc $ o'),(t',logSeries ysc $ e)) (OrdPoints _ (Error o' (Right (l,h))) _) -> do let t = case abs of- AbsFunction f -> + AbsFunction f -> if isHist d then (True,cmap f $ fromList [0.0..(fromIntegral $ size o')]) else (True,cmap f $ fromList [1.0..(fromIntegral $ size o')])- AbsPoints mi t' -> (mi,t') + AbsPoints mi t' -> (mi,t') let t' = (fst t,logSeries xsc $ snd t) return $ Left $ Right $ Right ((t',logSeries ysc $ o'),(t',logSeries ysc $ l),(t',logSeries ysc $ h)) (OrdPoints _ (MinMax o' Nothing) _) -> do@@ -330,8 +335,8 @@ renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Top) endPointSample t' (y'+e') Left (Right (Right ((t',y'),(_,l),(_,h)))) -> do renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz g) endPointSample t' y'- renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Bot) endPointSample t' l - renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Top) endPointSample t' h + renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Bot) endPointSample t' l+ renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Top) endPointSample t' h _ -> error "Data.hs renderSeries: cannot have MinMax data series with point type" (DecLinPt lt pt) -> do formatLineSeries lt@@ -345,12 +350,12 @@ renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz g) endPointSample t' y' renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Bot) endPointSample t' (y'-e') renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Top) endPointSample t' (y'+e')--- error "Data.hs renderSeries: cannot have single error value with line-points type" +-- 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 sd Nothing renderLineSample endLineSample t' y' renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz g) endPointSample t' y'- renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Bot) endPointSample t' l - renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Top) endPointSample t' h + renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Bot) endPointSample t' l+ renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample pz Top) endPointSample t' h _ -> error "Data.hs renderSeries: cannot have MinMax data series with line-point type" (DecImpulse lt) -> do formatLineSeries lt@@ -376,21 +381,21 @@ _ -> error "Data.hs renderSeries: cannot have error bars with area type" (DecBar bt) -> do (bw,bc,c) <- formatBarSeries bt- (gw,_) <- formatPointSeries defaultPointType + (gw,_) <- formatPointSeries defaultPointType case dat of Left (Left (t',y')) -> do- renderSamples xscale yscale xmin xmax sd Nothing (renderBarSample bw bc c) endBarSample t' y' + renderSamples xscale yscale xmin xmax sd Nothing (renderBarSample bw bc c) endBarSample t' y' Left (Right (Left ((t',y'),(_,e')))) -> do- renderSamples xscale yscale xmin xmax sd Nothing (renderBarSample bw bc c) endBarSample t' y' + renderSamples xscale yscale xmin xmax sd Nothing (renderBarSample bw bc c) endBarSample t' y' renderSamples xscale yscale xmin xmax sd Nothing (renderPointSampleUpDown gw) endPointSample t' e' Left (Right (Right ((t',y'),(_,l'),(_,h')))) -> do- renderSamples xscale yscale xmin xmax sd Nothing (renderBarSample bw bc c) endBarSample t' y' + renderSamples xscale yscale xmin xmax sd Nothing (renderBarSample bw bc c) endBarSample t' y' renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample gw Bot) endPointSample t' l' renderSamples xscale yscale xmin xmax sd Nothing (renderPointSample gw Top) endPointSample t' h' _ -> error "Data.hs renderSeries: cannot have MinMax data series with bar type" (DecHist bt) -> do (bw,bc,c) <- formatBarSeries bt- (gw,_) <- formatPointSeries defaultPointType + (gw,_) <- formatPointSeries defaultPointType case dat of Left (Left (t',y')) -> do let ln = size $ snd $ t'@@ -419,7 +424,7 @@ _ -> error "Data.hs renderSeries: cannot have MinMax data series with histogram type" (DecCand bt) → do (bw,bc,c) <- formatBarSeries bt- case dat of + case dat of Left _ -> error "Candles series requires two data series (MinMax series)" Right (Left (t',y')) -> do renderMinMaxSamples xscale yscale xmin xmax sd Nothing (renderCandleSample bw bc c) endCandleSample t' y'@@ -428,7 +433,7 @@ renderMinMaxSamples xscale yscale xmin xmax sd Nothing (renderCandleSample bw bc c) endCandleSample t' y' (DecWhisk bt) → do (bw,bc,c) <- formatBarSeries bt- case dat of + case dat of Left _ -> error "Candles series requires two data series (MinMax series)" Right (Left (t',y')) -> do renderMinMaxSamples xscale yscale xmin xmax sd Nothing (renderCandleSample bw bc c) endCandleSample t' y'@@ -439,8 +444,8 @@ ----------------------------------------------------------------------------- -renderSamples :: Double -> Double - -> Double -> Double +renderSamples :: Double -> Double+ -> Double -> Double -> SampleData -> Maybe (C.Render ()) -> (Double -> Double -> Double -> Double -> C.Render ()) -> (Double -> Double -> C.Render ())@@ -469,8 +474,8 @@ ----------------------------------------------------------------------------- -renderMinMaxSamples :: Double -> Double - -> Double -> Double +renderMinMaxSamples :: Double -> Double+ -> Double -> Double -> SampleData -> Maybe (C.Render ()) -> (Double -> Double -> Double -> (Double,Double) -> C.Render ()) -> (Double -> Double -> C.Render ())@@ -498,7 +503,7 @@ ----------------------------------------------------------------------------- -renderSample :: Int -> Int -> Vector Double +renderSample :: Int -> Int -> Vector Double -> (Double -> Double -> C.Render ()) -> Double -> MaybeT C.Render () renderSample ix xmax_ix t f y@@ -508,8 +513,8 @@ | otherwise = do lift $ f (t `atIndex` ix) y -renderMinMaxSample :: Int -> Int -> Double - -> (Double -> (Double,Double) -> C.Render ()) -> C.Render () +renderMinMaxSample :: Int -> Int -> Double+ -> (Double -> (Double,Double) -> C.Render ()) -> C.Render () -> (Vector Double,Vector Double) -> MaybeT C.Render () renderMinMaxSample ix xmax_ix t f e (yl,yu) | ix >= xmax_ix = do@@ -582,7 +587,7 @@ C.strokePreserve setColour c C.fill- + endBarSample :: Double -> Double -> C.Render () endBarSample _ _ = return () @@ -636,5 +641,3 @@ endWhiskerSample _ _ = return () -------------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Render.Plot.Legend@@ -41,6 +42,10 @@ --import Prelude hiding(min,max) --import qualified Prelude(max) +#if MIN_VERSION_mtl(2,3,0)+import Control.Monad+#endif+ ----------------------------------------------------------------------------- renderLegend :: Maybe LegendData -> DataSeries -> Render (Padding -> Render ())@@ -53,7 +58,7 @@ (w,h) <- cairo $ do lo <- pango $ P.layoutText pc mx setTextOptions to lo- (_,twh) <- textSize lo Centre Middle 0 0 + (_,twh) <- textSize lo Centre Middle 0 0 return twh -- if outside shift bounding box case o of@@ -65,21 +70,21 @@ Inside -> return $ \_ -> renderLegendInside b l w h to ln ls renderLegendOutside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render (Padding -> Render ())-renderLegendOutside b l w h to ln ls +renderLegendOutside b l w h to ln ls | l == North = do let h' = textPad + h + textPad bbLowerTop $ h' + 4*textPad return $ \(Padding _ _ _ t) -> do x' <- bbCentreWidth y' <- bbTopHeight- let w' = (fromIntegral ln)*(textPad + legendSampleWidth + let w' = (fromIntegral ln)*(textPad + legendSampleWidth + legendSampleWidth + textPad + w) + 5*textPad let x = x'- (w'/2) y = y'- h' - t when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+3*textPad) (y+textPad) - (textPad + legendSampleWidth + legendSampleWidth + textPad - + w + textPad) 0 0 h to ls + renderLegendEntries (x+3*textPad) (y+textPad)+ (textPad + legendSampleWidth + legendSampleWidth + textPad+ + w + textPad) 0 0 h to ls return () | l == NorthEast = do let h' = textPad + h + textPad@@ -87,17 +92,17 @@ return $ \(Padding _ _ _ t) -> do x' <- bbRightWidth y' <- bbTopHeight- let w' = (fromIntegral ln)*(textPad + legendSampleWidth + let w' = (fromIntegral ln)*(textPad + legendSampleWidth + legendSampleWidth + textPad + w) + 5*textPad let x = x'- w' y = y'- h' - t when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+3*textPad) (y+textPad) - (textPad + legendSampleWidth + legendSampleWidth + textPad - + w + textPad) 0 0 h to ls + renderLegendEntries (x+3*textPad) (y+textPad)+ (textPad + legendSampleWidth + legendSampleWidth + textPad+ + w + textPad) 0 0 h to ls return () | l == East = do- let w' = textPad + legendSampleWidth + legendSampleWidth + let w' = textPad + legendSampleWidth + legendSampleWidth + textPad + w + textPad bbShiftRight $ w' + 4*textPad return $ \(Padding _ r _ _) -> do@@ -107,8 +112,8 @@ let x = x' + 4*textPad + r y = y'-(h'/2) when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) - 0 h to ls + renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad)+ 0 h to ls return () | l == SouthEast = do let h' = textPad + h + textPad@@ -116,14 +121,14 @@ return $ \(Padding _ _ b' _) -> do x' <- bbRightWidth y' <- bbBottomHeight- let w' = (fromIntegral ln)*(textPad + legendSampleWidth + let w' = (fromIntegral ln)*(textPad + legendSampleWidth + legendSampleWidth + textPad + w) + 5*textPad let x = x'- w' y = y' + b' +textPad when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+3*textPad) (y+textPad) - (textPad + legendSampleWidth + legendSampleWidth + textPad - + w + textPad) 0 0 h to ls + renderLegendEntries (x+3*textPad) (y+textPad)+ (textPad + legendSampleWidth + legendSampleWidth + textPad+ + w + textPad) 0 0 h to ls return () | l == South = do let h' = textPad + h + textPad@@ -131,14 +136,14 @@ return $ \(Padding _ _ b' _) -> do x' <- bbCentreWidth y' <- bbBottomHeight- let w' = (fromIntegral ln)*(textPad + legendSampleWidth + let w' = (fromIntegral ln)*(textPad + legendSampleWidth + legendSampleWidth + textPad + w) + 5*textPad let x = x' - (w'/2) y = y' + b' +textPad when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+3*textPad) (y+textPad) - (textPad + legendSampleWidth + legendSampleWidth + textPad - + w + textPad) 0 0 h to ls + renderLegendEntries (x+3*textPad) (y+textPad)+ (textPad + legendSampleWidth + legendSampleWidth + textPad+ + w + textPad) 0 0 h to ls return () | l == SouthWest = do let h' = textPad + h + textPad@@ -146,17 +151,17 @@ return $ \(Padding _ _ b' _) -> do x' <- bbLeftWidth y' <- bbBottomHeight- let w' = (fromIntegral ln)*(textPad + legendSampleWidth + let w' = (fromIntegral ln)*(textPad + legendSampleWidth + legendSampleWidth + textPad + w) + 5*textPad let x = x' y = y' + b' +textPad when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+3*textPad) (y+textPad) - (textPad + legendSampleWidth + legendSampleWidth + textPad - + w + textPad) 0 0 h to ls + renderLegendEntries (x+3*textPad) (y+textPad)+ (textPad + legendSampleWidth + legendSampleWidth + textPad+ + w + textPad) 0 0 h to ls return () | l == West = do- let w' = textPad + legendSampleWidth + legendSampleWidth + textPad + let w' = textPad + legendSampleWidth + legendSampleWidth + textPad + w + textPad bbShiftLeft $ w' + 4*textPad return $ \(Padding l' _ _ _) -> do@@ -166,8 +171,8 @@ let x = x' - w' - 4*textPad - l' y = y'-(h'/2) when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) - 0 h to ls + renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad)+ 0 h to ls return () | l == NorthWest = do let h' = textPad + h + textPad@@ -175,14 +180,14 @@ return $ \(Padding _ _ _ t) -> do x' <- bbLeftWidth y' <- bbTopHeight- let w' = (fromIntegral ln)*(textPad + legendSampleWidth + let w' = (fromIntegral ln)*(textPad + legendSampleWidth + legendSampleWidth + textPad + w) + 5*textPad let x = x' y = y'- h' - t when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')- renderLegendEntries (x+3*textPad) (y+textPad) - (textPad + legendSampleWidth + legendSampleWidth + textPad - + w + textPad) 0 0 h to ls + renderLegendEntries (x+3*textPad) (y+textPad)+ (textPad + legendSampleWidth + legendSampleWidth + textPad+ + w + textPad) 0 0 h to ls return () renderLegendOutside _ _ _ _ _ _ _ = return (\_ -> return ()) @@ -195,7 +200,7 @@ renderLegendInside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render () renderLegendInside b l w h to ln ls = do- let w' = (textPad + legendSampleWidth + legendSampleWidth + textPad + let w' = (textPad + legendSampleWidth + legendSampleWidth + textPad + w + textPad) h' = h+textPad h'' = (fromIntegral ln)*h'+textPad@@ -211,7 +216,7 @@ East -> do x' <- bbRightWidth y' <- bbCentreHeight- let y'' = y' - h''/2 + let y'' = y' - h''/2 return (x'-w'-3*textPad,y''-textPad) SouthEast -> do x' <- bbRightWidth@@ -231,7 +236,7 @@ West -> do x' <- bbLeftWidth y' <- bbCentreHeight- let y'' = y' - h''/2 + let y'' = y' - h''/2 return (x'+textPad,y''-textPad) NorthWest -> do x' <- bbLeftWidth@@ -244,10 +249,10 @@ C.rectangle (x+0.5) (y+0.5) w' h'' C.fill C.stroke- renderLegendEntries (x+3*textPad) (y+textPad) 0 h' w' - (h'-textPad) to ls + renderLegendEntries (x+3*textPad) (y+textPad) 0 h' w'+ (h'-textPad) to ls -renderLegendEntries :: Double -> Double -> Double -> Double -> Double -> Double +renderLegendEntries :: Double -> Double -> Double -> Double -> Double -> Double -> TextOptions -> [(SeriesLabel,Decoration)] -> Render () renderLegendEntries x y wa ha w h to ls = do@@ -280,7 +285,7 @@ Nothing -> return () Just p' -> do cairo $ do- C.save + C.save C.moveTo (x+w/2) (y+h/2) g <- setPointStyle p' renderGlyph 1 g@@ -301,4 +306,3 @@ getLabels (DS_Surf _) = (0,[]) ------------------------------------------------------------------------------
plot.cabal view
@@ -1,8 +1,8 @@ Name: plot-Version: 0.2.3.11+Version: 0.2.3.12 License: BSD3 License-file: LICENSE-Copyright: (c) A.V.H. McPhail 2010, 2012-2017, 2019+Copyright: (c) A.V.H. McPhail 2010, 2012-2017, 2019, 2024 Author: Vivian McPhail Maintainer: haskell.vivian.mcphail <at> gmail <dot> com Stability: experimental@@ -51,11 +51,11 @@ default-language: Haskell2010 Build-Depends: base >= 4.9.0.0 && < 5,- mtl > 2, array,+ mtl > 2 && < 3, array > 0.5 && < 0.6, transformers > 0.5 && < 0.7, pango >= 0.13 && < 0.14, cairo >= 0.13 && < 0.14, colour >= 2.2.1 && < 2.4,- hmatrix >= 0.17+ hmatrix >= 0.17 && < 0.21 default-extensions: MultiParamTypeClasses GeneralizedNewtypeDeriving@@ -93,9 +93,8 @@ Control.Monad.Supply ghc-options: -Wall -fno-warn-unused-binds- -O2 - ghc-prof-options: -auto+ ghc-prof-options: source-repository head type: git