Chart 1.8.3 → 1.9

raw patch · 4 files changed

+94/−56 lines, 4 filesdep +semigroupsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Chart.cabal +4/−1
• Graphics/Rendering/Chart/Geometry.hs +15/−11
• Graphics/Rendering/Chart/Plot/Annotation.hs +26/−3
• Graphics/Rendering/Chart/Renderable.hs +49/−41

@@ -1,5 +1,5 @@ Name: Chart-Version: 1.8.3+Version: 1.9 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2014@@ -27,6 +27,9 @@                , mtl >= 2.0 && < 2.3                , operational >= 0.2.2 && < 0.3                , vector >=0.9 && <0.13++  if !impl(ghc >= 8.0)+    build-depends: semigroups >= 0.18.4 && <0.19     Ghc-options: -Wall -fno-warn-orphans

@@ -53,7 +53,8 @@  import qualified Prelude import Prelude hiding ((^))-import Data.Monoid+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup(..))  -- The homomorphic version to avoid casts inside the code. (^) :: Num a => a -> Integer -> a@@ -196,14 +197,17 @@ -- | Paths are monoids. After a path is closed you can not append --   anything to it anymore. The empty path is open. --   Use 'close' to close a path.-instance Monoid Path where-  mappend p1 p2 = case p1 of-    MoveTo p path -> MoveTo p $ mappend path p2-    LineTo p path -> LineTo p $ mappend path p2-    Arc    p r a1 a2 path -> Arc p r a1 a2 $ mappend path p2-    ArcNeg p r a1 a2 path -> ArcNeg p r a1 a2 $ mappend path p2+instance Semigroup Path where+  p1 <> p2 = case p1 of+    MoveTo p path -> MoveTo p $ path <> p2+    LineTo p path -> LineTo p $ path <> p2+    Arc    p r a1 a2 path -> Arc p r a1 a2 $ path <> p2+    ArcNeg p r a1 a2 path -> ArcNeg p r a1 a2 $ path <> p2     End   -> p2     Close -> Close++instance Monoid Path where+  mappend = (<>)   mempty = End  -- | Move the paths pointer to the given location.@@ -265,10 +269,10 @@ foldPath moveTo_ lineTo_ arc_ arcNeg_ close_ path =   let restF = foldPath moveTo_ lineTo_ arc_ arcNeg_ close_   in case path of-    MoveTo p rest -> moveTo_ p <> restF rest-    LineTo p rest -> lineTo_ p <> restF rest-    Arc    p r a1 a2 rest -> arc_    p r a1 a2 <> restF rest-    ArcNeg p r a1 a2 rest -> arcNeg_ p r a1 a2 <> restF rest+    MoveTo p rest -> moveTo_ p `mappend` restF rest+    LineTo p rest -> lineTo_ p `mappend` restF rest+    Arc    p r a1 a2 rest -> arc_    p r a1 a2 `mappend` restF rest+    ArcNeg p r a1 a2 rest -> arcNeg_ p r a1 a2 `mappend` restF rest     End   -> mempty     Close -> close_ 

@@ -15,12 +15,14 @@     plot_annotation_vanchor,     plot_annotation_angle,     plot_annotation_style,+    plot_annotation_background,     plot_annotation_values ) where  import Control.Lens import Graphics.Rendering.Chart.Geometry import Graphics.Rendering.Chart.Drawing+import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Default.Class @@ -34,6 +36,10 @@       _plot_annotation_angle   :: Double,       -- ^ Angle, in degrees, to rotate the annotation about the anchor point.       _plot_annotation_style   :: FontStyle,+      _plot_annotation_background :: Rectangle,+      -- ^ Rectangle which style determines the background of the annotation+      -- text and which '_rect_minsize' determines the additional width and+      -- height of the background area       _plot_annotation_values  :: [(x,y,String)] } @@ -49,15 +55,31 @@   renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> BackendProgram ()-renderAnnotation p pMap = withFontStyle style $+renderAnnotation p pMap = withFontStyle style $ do+                            mapM_ drawRect values                             mapM_ drawOne values     where hta = _plot_annotation_hanchor p           vta = _plot_annotation_vanchor p           values = _plot_annotation_values p           angle =  _plot_annotation_angle p           style =  _plot_annotation_style p-          drawOne (x,y,s) = drawTextsR hta vta angle point s-              where point = pMap (LValue x, LValue y)+          rectangle = _plot_annotation_background p+          (x1,y1) = _rect_minsize rectangle+          drawRect (x,y,s) = do+              ts <- textSize s+              let (x2,y2) = (textSizeWidth ts, textSizeHeight ts)+                  Point x3 y3 = point x y+                  -- position of top-left vertex of the rectangle+                  xvp HTA_Left = x3 - x1 / 2+                  xvp HTA_Centre = x3 - (x1 + x2) / 2+                  xvp HTA_Right = x3 - x2 - x1 / 2+                  yvp VTA_Top = y3 - y1 / 2+                  yvp VTA_Centre = y3 - (y1 + y2) / 2+                  yvp VTA_Bottom = y3 - y2 - y1 / 2+                  yvp VTA_BaseLine = y3 - y1 / 2 - textSizeAscent ts+              drawRectangle (Point (xvp hta) (yvp vta)) rectangle{ _rect_minsize = (x1+x2,y1+y2) }+          drawOne (x,y,s) = drawTextsR hta vta angle (point x y) s+          point x y = pMap (LValue x, LValue y)  instance Default (PlotAnnotation x y) where   def = PlotAnnotation @@ -65,6 +87,7 @@     , _plot_annotation_vanchor = VTA_Centre     , _plot_annotation_angle   = 0     , _plot_annotation_style   = def+    , _plot_annotation_background = def     , _plot_annotation_values  = []     } 

@@ -19,6 +19,7 @@     RectCornerStyle(..),          rectangleToRenderable,+    drawRectangle,      fillBackground,     addMargins,@@ -218,47 +219,54 @@ rectangleToRenderable :: Rectangle -> Renderable a rectangleToRenderable rectangle = Renderable mf rf   where-    mf    = return (_rect_minsize rectangle)-    rf sz = do-      maybeM () (fill sz) (_rect_fillStyle rectangle)-      maybeM () (stroke sz) (_rect_lineStyle rectangle)-      return nullPickFn--    fill sz fs = -        withFillStyle fs $ -          fillPath $ strokeRectangleP sz (_rect_cornerStyle rectangle)--    stroke sz ls = -        withLineStyle ls $ -          strokePath $ strokeRectangleP sz (_rect_cornerStyle rectangle)--    strokeRectangleP (x2,y2) RCornerSquare =-      let (x1,y1) = (0,0) in moveTo' x1 y1-                          <> lineTo' x1 y2-                          <> lineTo' x2 y2-                          <> lineTo' x2 y1-                          <> lineTo' x1 y1-                          <> lineTo' x1 y2-                                -    strokeRectangleP (x2,y2) (RCornerBevel s) =-      let (x1,y1) = (0,0) in moveTo' x1 (y1+s)-                          <> lineTo' x1 (y2-s)-                          <> lineTo' (x1+s) y2-                          <> lineTo' (x2-s) y2-                          <> lineTo' x2 (y2-s)-                          <> lineTo' x2 (y1+s)-                          <> lineTo' (x2-s) y1-                          <> lineTo' (x1+s) y1-                          <> lineTo' x1 (y1+s)-                          <> lineTo' x1 (y2-s)+    mf = return (_rect_minsize rectangle)+    rf = \rectSize -> drawRectangle (Point 0 0)+                                    rectangle{ _rect_minsize = rectSize } -    strokeRectangleP (x2,y2) (RCornerRounded s) =-      let (x1,y1) = (0,0) in arcNeg (Point (x1+s) (y2-s)) s (pi2*2) pi2 -                          <> arcNeg (Point (x2-s) (y2-s)) s pi2 0-                          <> arcNeg (Point (x2-s) (y1+s)) s 0 (pi2*3)-                          <> arcNeg (Point (x1+s) (y1+s)) s (pi2*3) (pi2*2)-                          <> lineTo' x1 (y2-s)-    -    pi2 = pi / 2+-- | Draw the specified rectangle such that its top-left vertex is placed at+--   the given position+drawRectangle :: Point -> Rectangle -> BackendProgram (PickFn a)+drawRectangle point rectangle = do+  maybeM () (fill point size) (_rect_fillStyle rectangle)+  maybeM () (stroke point size) (_rect_lineStyle rectangle)+  return nullPickFn+    where+      size = _rect_minsize rectangle+ +      fill p sz fs = +          withFillStyle fs $ +            fillPath $ strokeRectangleP p sz (_rect_cornerStyle rectangle)+ +      stroke p sz ls = +          withLineStyle ls $ +            strokePath $ strokeRectangleP p sz (_rect_cornerStyle rectangle)+ +      strokeRectangleP (Point x1 y1) (x2,y2) RCornerSquare =+          let (x3,y3) = (x1+x2,y1+y2) in moveTo' x1 y1+                                      <> lineTo' x1 y3+                                      <> lineTo' x3 y3+                                      <> lineTo' x3 y1+                                      <> lineTo' x1 y1+                                  +      strokeRectangleP (Point x1 y1) (x2,y2) (RCornerBevel s) =+          let (x3,y3) = (x1+x2,y1+y2) in moveTo' x1 (y1+s)+                                      <> lineTo' x1 (y3-s)+                                      <> lineTo' (x1+s) y3+                                      <> lineTo' (x3-s) y3+                                      <> lineTo' x3 (y3-s)+                                      <> lineTo' x3 (y1+s)+                                      <> lineTo' (x3-s) y1+                                      <> lineTo' (x1+s) y1+                                      <> lineTo' x1 (y1+s)+ +      strokeRectangleP (Point x1 y1) (x2,y2) (RCornerRounded s) =+          let (x3,y3) = (x1+x2,y1+y2) in+            arcNeg (Point (x1+s) (y3-s)) s (pi2*2) pi2+            <> arcNeg (Point (x3-s) (y3-s)) s pi2 0+            <> arcNeg (Point (x3-s) (y1+s)) s 0 (pi2*3)+            <> arcNeg (Point (x1+s) (y1+s)) s (pi2*3) (pi2*2)+            <> lineTo' x1 (y3-s)+      +      pi2 = pi / 2  $( makeLenses ''Rectangle )