chart-svg 0.4.0 → 0.4.1.0
raw patch · 16 files changed
+170/−140 lines, 16 filesdep ~bytestringdep ~flatparsedep ~numhaskPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: bytestring, flatparse, numhask, numhask-array, numhask-space
API changes (from Hackage documentation)
- Chart.Data: angle :: Direction coord dir => coord -> dir
- Chart.Data: basis :: Norm a b => a -> a
- Chart.Data: class (Additive coord, Multiplicative coord, Additive dir, Multiplicative dir) => Direction coord dir | coord -> dir
- Chart.Data: class (Additive a, Multiplicative b, Additive b) => Norm a b | a -> b
- Chart.Data: class (Additive a, Multiplicative a) => Signed a
- Chart.Data: norm :: Norm a b => a -> b
- Chart.Data: ray :: Direction coord dir => dir -> coord
- Chart.Data: sign :: Signed a => a -> a
- Chart.Surface: surfacefl :: (Point Double -> Double) -> SurfaceOptions -> SurfaceLegendOptions -> ([Chart], [Hud])
+ Chart.Data: magnitude :: Basis a => a -> Mag a
+ Chart.Surface: surfaceLegendChart :: Range Double -> SurfaceLegendOptions -> ChartTree
- Chart.Data: abs :: Signed a => a -> a
+ Chart.Data: abs :: Absolute a => a -> a
- Data.Path: CubicPolar :: Point a -> Point a -> Polar a a -> Polar a a -> CubicPolar a
+ Data.Path: CubicPolar :: Point a -> Point a -> Polar a -> Polar a -> CubicPolar a
- Data.Path: QuadPolar :: Point a -> Point a -> Polar a a -> QuadPolar a
+ Data.Path: QuadPolar :: Point a -> Point a -> Polar a -> QuadPolar a
- Data.Path: [cpolControl1] :: CubicPolar a -> Polar a a
+ Data.Path: [cpolControl1] :: CubicPolar a -> Polar a
- Data.Path: [cpolControl2] :: CubicPolar a -> Polar a a
+ Data.Path: [cpolControl2] :: CubicPolar a -> Polar a
- Data.Path: [qpolControl] :: QuadPolar a -> Polar a a
+ Data.Path: [qpolControl] :: QuadPolar a -> Polar a
- Data.Path: arcPosition :: (Ord a, Signed a, TrigField a) => ArcCentroid a -> ArcPosition a
+ Data.Path: arcPosition :: (Ord a, Absolute a, TrigField a) => ArcCentroid a -> ArcPosition a
- Data.Path: ellipse :: (Direction b a, Affinity b a, TrigField a) => b -> b -> a -> a -> b
+ Data.Path: ellipse :: (Direction b, Dir b ~ a, Affinity b a, TrigField a) => b -> b -> a -> a -> b
Files
- chart-svg.cabal +84/−26
- src/Chart.hs +0/−1
- src/Chart/Bar.hs +0/−2
- src/Chart/Data.hs +4/−7
- src/Chart/Examples.hs +8/−6
- src/Chart/FlatParse.hs +0/−6
- src/Chart/Hud.hs +5/−8
- src/Chart/Markup.hs +1/−4
- src/Chart/Markup/Parser.hs +1/−3
- src/Chart/Primitive.hs +1/−5
- src/Chart/Style.hs +2/−4
- src/Chart/Surface.hs +4/−14
- src/Data/Colour.hs +10/−15
- src/Data/Path.hs +47/−30
- src/Data/Path/Parser.hs +1/−7
- test/test.hs +2/−2
chart-svg.cabal view
@@ -1,12 +1,12 @@-cabal-version: 2.4+cabal-version: 3.0 name: chart-svg-version: 0.4.0+version: 0.4.1.0 synopsis: Charting library targetting SVGs. description: This package provides a charting library targetting SVG as the rendered output.- .+ == Usage- .+ >>> :set -XOverloadedLabels >>> :set -XOverloadedStrings >>> import Chart@@ -16,9 +16,9 @@ >>> let cs = zipWith (\s x -> LineChart s [x]) styles lines >>> let lineExample = mempty & #charts .~ named "line" cs & #hudOptions .~ defaultHudOptions :: ChartOptions >>> writeChartOptions "other/usage.svg" lineExample- .+ - .+ See "Chart" for a broad overview of concepts, and "Chart.Examples" for practical examples. category: charts@@ -31,14 +31,81 @@ license-file: LICENSE build-type: Simple extra-doc-files: other/*.svg-tested-with:- GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.2.5 || ==9.4.4+tested-with: GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2 source-repository head type: git location: https://github.com/tonyday567/chart-svg +common ghc2021-stanza+ if impl(ghc >=9.2)+ default-language:+ GHC2021+ if impl(ghc <9.2)+ default-language:+ Haskell2010+ default-extensions:+ BangPatterns+ BinaryLiterals+ ConstrainedClassMethods+ ConstraintKinds+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DoAndIfThenElse+ EmptyCase+ EmptyDataDecls+ EmptyDataDeriving+ ExistentialQuantification+ ExplicitForAll+ FlexibleContexts+ FlexibleInstances+ ForeignFunctionInterface+ GADTSyntax+ GeneralisedNewtypeDeriving+ HexFloatLiterals+ ImplicitPrelude+ InstanceSigs+ KindSignatures+ MonomorphismRestriction+ MultiParamTypeClasses+ NamedFieldPuns+ NamedWildCards+ NumericUnderscores+ PatternGuards+ PolyKinds+ PostfixOperators+ RankNTypes+ RelaxedPolyRec+ ScopedTypeVariables+ StandaloneDeriving+ StarIsType+ TraditionalRecordSyntax+ TupleSections+ TypeApplications+ TypeOperators+ TypeSynonymInstances+ if impl(ghc <9.2) && impl(ghc >=8.10)+ default-extensions:+ ImportQualifiedPost+ StandaloneKindSignatures++common ghc-options-stanza+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -Widentities+ -Wpartial-fields+ library+ import: ghc2021-stanza+ import: ghc-options-stanza exposed-modules: Chart Chart.Bar@@ -61,16 +128,16 @@ adjunctions ^>=4.4, attoparsec >=0.13.2 && <0.15, base >=4.7 && <5,- bytestring ^>=0.11.3,+ bytestring >=0.11.3 && <0.13, containers ^>=0.6, cubicbezier ^>=0.6,- flatparse >= 0.4 && <0.5,+ flatparse >=0.4 && <0.6, foldl ^>=1.4, formatn >=0.3 && < 0.4, mtl >=2.2.2 && <2.4,- numhask ^>=0.10,- numhask-array ^>=0.10,- numhask-space ^>=0.10,+ numhask ^>=0.11,+ numhask-array ^>=0.11,+ numhask-space ^>=0.11, optics-core ^>=0.4, random ^>=1.2.1, string-interpolate ^>=0.3,@@ -78,27 +145,18 @@ time >=1.9 && <2, tree-diff >=0.3 && <0.4, - default-language: Haskell2010- default-extensions: StrictData- ghc-options:- -Wall -Wcompat -Wincomplete-record-updates- -Wincomplete-uni-patterns -Wredundant-constraints- test-suite test+ import: ghc2021-stanza+ import: ghc-options-stanza type: exitcode-stdio-1.0 main-is: test.hs- default-language: Haskell2010 hs-source-dirs: test build-depends: base >=4.7 && <5,- bytestring ^>=0.11.3,+ bytestring >=0.11.3 && <0.13, chart-svg,- flatparse >= 0.4.0 && <0.5,+ flatparse >=0.4 && <0.6, tasty >=1.2 && <1.5, tasty-golden ^>=2.3.1.1, tree-diff >=0.3 && <0.4,-- ghc-options:- -Wall -Wcompat -Wincomplete-record-updates- -Wincomplete-uni-patterns -Wredundant-constraints
src/Chart.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_HADDOCK prune #-} -- | A haskell Charting library targetting SVG.
src/Chart/Bar.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-} -- | Bar charts module Chart.Bar
src/Chart/Data.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE RebindableSyntax #-}-{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_HADDOCK prune #-} -- | Data primitives and utilities ----- Whilst the library makes use of <https://hackage.haskell.org/package/numhask numhask>, it does not re-export, to avoid clashes with Prelude, with the exception of 'zero', 'one', 'angle', 'norm' & 'abs'.+-- Whilst the library makes use of <https://hackage.haskell.org/package/numhask numhask>, it does not re-export, to avoid clashes with Prelude, with the exception of 'zero', 'one', 'angle' & 'abs'. -- -- 'Rect' and 'Point', from <https://hackage.haskell.org/package/numhask-space numhask-space>, make up the base elements of many chart primitives, and all of numhask-space is re-exported. module Chart.Data@@ -18,14 +17,12 @@ -- * NumHask Exports - --- -- | Note that (+) and (*) from numhask are not actually re-exported. Multiplicative (one), Additive (zero),- Direction (..),- Norm (..),- Signed (..),+ abs,+ angle,+ magnitude, -- * Re-exports module NumHask.Space,
src/Chart/Examples.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -Wall #-} -- | Examples of chart construction. module Chart.Examples@@ -49,9 +47,10 @@ import Data.Bool import Data.ByteString (ByteString) import Data.Function+import Data.Maybe import Data.String.Interpolate import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Time import Optics.Core import Prelude hiding (abs)@@ -515,16 +514,19 @@ & #charts .~ named "surface" cs & #markupOptions .~ (defaultMarkupOptions & #cssOptions % #shapeRendering .~ UseCssCrisp) where+ -- FIXME: surface legends are broken as.+ -- & #hudOptions % #legends .~ [(30,defaultLegendOptions & #content .~ [("", foldOf charts' $ surfaceLegendChart rangef (defaultSurfaceLegendOptions dark "text"))])]+ grain = Point 100 100 r = one f = fst . bimap ((-1.0) *) (fmap ((-1.0) *)) . rosenbrock 1 10 evenColors = trimColour . over lightness' (const 0.55) . palette1 <$> [0 .. 5]+ (cs, _) = surfacef f so so = defaultSurfaceOptions & #soGrain .~ grain & #soRange .~ r & #soStyle % #surfaceColors .~ evenColors- (cs, _) = surfacef f so -- | arrow example --@@ -566,9 +568,9 @@ gchart s r' p = GlyphChart (gs s r') [p] tail' :: Point Double -> Double- tail' = max 0.05 . min 0.02 . (* 0.01) . (/ avmag) . norm+ tail' = max 0.05 . min 0.02 . (* 0.01) . (/ avmag) . magnitude - avmag = sum (norm . f <$> ps) / fromIntegral (length ps)+ avmag = sum (magnitude . f <$> ps) / fromIntegral (length ps) -- | function for testing --
src/Chart/FlatParse.hs view
@@ -1,17 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} -- | Lower-level flatparse parsers
src/Chart/Hud.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -Wall #-} -- | A hud stands for <https://en.wikipedia.org/wiki/Head-up_display head-up display>, and is a collective noun used to name chart elements that assist in data interpretation or otherwise annotate and decorate data. --@@ -84,14 +81,14 @@ import Data.Colour import Data.Foldable hiding (sum) import Data.FormatN-import qualified Data.List as List+import Data.List qualified as List import Data.Maybe import Data.Path import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Tuple import GHC.Generics hiding (to)-import qualified NumHask.Prelude as NH+import NumHask.Prelude qualified as NH import Optics.Core import Prelude @@ -422,7 +419,7 @@ bool (space1 ticks0) Nothing (e == NoTickExtend) ) where- ticks0 = gridSensible OuterPos (e == NoTickExtend) r (fromIntegral n :: Integer)+ ticks0 = gridSensible OuterPos (e == NoTickExtend) r n TickExact f n -> (zip ticks0 (formatNs f ticks0), Nothing) where ticks0 = grid OuterPos r n@@ -882,7 +879,7 @@ TickNone -> [] TickRound f n e -> zip (project r d <$> ticks0) (formatNs f ticks0) where- ticks0 = gridSensible OuterPos (e == NoTickExtend) r (fromIntegral n :: Integer)+ ticks0 = gridSensible OuterPos (e == NoTickExtend) r n TickExact f n -> zip (project r d <$> ticks0) (formatNs f ticks0) where ticks0 = grid OuterPos r n
src/Chart/Markup.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TupleSections #-} -- | An intermediary representation not unlike SVG or XML but only forming a subset of these standards. module Chart.Markup@@ -44,7 +42,7 @@ import Data.Colour import Data.FormatN import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe import Data.Path import Data.Path.Parser@@ -477,7 +475,6 @@ -- > fillSwitch (color1, color2) "dark" "stuff" -- -- ... will default to color1 for elements of the "stuff" class, but switch to color2 if "dark" mode is preferred by the user.--- fillSwitch :: (Colour, Colour) -> ByteString -> ByteString -> ByteString fillSwitch (colorNormal, colorPrefer) prefer item = [i|
src/Chart/Markup/Parser.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-} -- | Much of the parsing logic is based on the XML productions found in https://www.w3.org/TR/xml/#NT-content --@@ -51,7 +49,7 @@ import Data.ByteString (ByteString) import Data.String.Interpolate import FlatParse.Basic hiding (cut)-import qualified FlatParse.Basic.Text as T+import FlatParse.Basic.Text qualified as T import GHC.Generics import Prelude
src/Chart/Primitive.hs view
@@ -1,10 +1,6 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-} -- | Base 'Chart' and 'ChartTree' types and support module Chart.Primitive@@ -65,7 +61,7 @@ import Data.Text (Text) import Data.Tree import GHC.Generics-import qualified NumHask.Prelude as NH+import NumHask.Prelude qualified as NH import Optics.Core import Prelude
src/Chart/Style.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-} -- | Stylistic or syntactical options for chart elements. module Chart.Style@@ -50,13 +48,13 @@ import Chart.Data import Data.ByteString (ByteString) import Data.Colour-import qualified Data.List as List+import Data.List qualified as List import Data.Maybe import Data.Path import Data.Path.Parser import Data.String import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import GHC.Generics import Optics.Core import Prelude
src/Chart/Surface.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wall #-} -- | Surface chart combinators. --@@ -15,9 +13,9 @@ mkSurfaceData, surfaces, surfacef,- surfacefl, SurfaceLegendOptions (..), defaultSurfaceLegendOptions,+ surfaceLegendChart, surfaceAxisOptions, ) where@@ -96,12 +94,13 @@ Grid (Rect Double) -> [Colour] -> ([SurfaceData], Range Double)-mkSurfaceData f r g cs = (zipWith SurfaceData rects (flip mixes cs <$> proj), unsafeSpace1 vs)+mkSurfaceData f r g cs = (zipWith SurfaceData rects (flip mixes cs <$> proj), rx) where ps = gridF f r g rects = fst <$> ps vs = snd <$> ps- proj = project (unsafeSpace1 vs :: Range Double) (Range 0 1) <$> vs+ rx = unsafeSpace1 vs :: Range Double+ proj = project rx (Range 0 1) <$> vs -- | Create a surface chart from a function. surfacef :: (Point Double -> Double) -> SurfaceOptions -> ([Chart], Range Double)@@ -112,15 +111,6 @@ (cfg ^. #soRange) (cfg ^. #soGrain) (toList $ cfg ^. #soStyle % #surfaceColors)---- | Create a surface chart and accompanying legend from a function.-surfacefl :: (Point Double -> Double) -> SurfaceOptions -> SurfaceLegendOptions -> ([Chart], [Hud])-surfacefl f po slo =- ( cs,- [Hud 10 (legendHud (slo ^. #sloLegendOptions) (surfaceLegendChart dr slo))]- )- where- (cs, dr) = surfacef f po -- | Legend specialization for a surface chart. data SurfaceLegendOptions = SurfaceLegendOptions
src/Data/Colour.hs view
@@ -1,14 +1,9 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wall #-} -- | Colour representations and combinations. module Data.Colour@@ -76,7 +71,7 @@ where import Chart.Data-import qualified Data.Attoparsec.Text as A+import Data.Attoparsec.Text qualified as A import Data.Bifunctor import Data.Bool (bool) import Data.ByteString (ByteString)@@ -84,14 +79,14 @@ import Data.Either import Data.FormatN import Data.Functor.Rep-import qualified Data.List as List+import Data.List qualified as List import Data.String.Interpolate import Data.Text (Text, pack)-import qualified Data.Text as Text+import Data.Text qualified as Text import GHC.Exts import GHC.Generics hiding (prec) import Graphics.Color.Model as M hiding (LCH)-import qualified Graphics.Color.Space as S+import Graphics.Color.Space qualified as S import NumHask.Algebra.Metric import NumHask.Array.Fixed import Optics.Core@@ -438,12 +433,12 @@ -- * lab to lch --- | Lens between generic XY color representations and CH ones, which are polar version of the XY.+-- | Lens between generic XY color representations and CH ones, which are polar versions of the XY. xy2ch' :: Iso' (Double, Double) (Double, Double) xy2ch' = iso- (\(x, y) -> (norm (Point x y), 180 / pi * mod_ (angle (Point x y)) (2 * pi)))- (\(c, h) -> let (Point x y) = coord (Polar c (pi / 180 * h)) in (x, y))+ (\(x, y) -> (magnitude (Point x y), 180 / pi * mod_ (angle (Point x y)) (2 * pi)))+ (\(c, h) -> let (Point x y) = fmap (c *) (ray (pi / 180 * h)) in (x, y)) mod_ :: Double -> Double -> Double mod_ x d = x - fromIntegral (floor (x / d) :: Integer) * d@@ -656,9 +651,9 @@ showSwatches :: Text -> Text -> [(Text, Colour)] -> Text showSwatches pref suff hs = [i|<div>-#{pref}-#{divs}-#{suff}+ #{pref}+ #{divs}+ #{suff} </div> |] where
src/Data/Path.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RebindableSyntax #-}-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# LANGUAGE TypeFamilies #-} -- | SVG path manipulation module Data.Path@@ -46,10 +44,10 @@ where import Chart.Data-import qualified Control.Foldl as L+import Control.Foldl qualified as L import Control.Monad.State.Lazy import GHC.Generics-import qualified Geom2D.CubicBezier as B+import Geom2D.CubicBezier qualified as B import NumHask.Prelude -- $setup@@ -199,7 +197,7 @@ arcCentroid :: (Ord a, FromInteger a, TrigField a, ExpField a) => ArcPosition a -> ArcCentroid a arcCentroid (ArcPosition p1@(Point x1 y1) p2@(Point x2 y2) (ArcInfo rad phi' large' clockwise')) = ArcCentroid c (Point rx ry) phi' ang1 angd where- (Point x1' y1') = rotateP (-phi') ((p1 - p2) /. two)+ (Point x1' y1') = rotateP (-phi') ((p1 - p2) |/ two) (Point rx' ry') = rad l = x1' ** 2 / rx' ** 2 + y1' ** 2 / ry' ** 2 (rx, ry) = bool (rx', ry') (rx' * sqrt l, ry' * sqrt l) (l > 1)@@ -232,7 +230,7 @@ -- - angle diff is pi and large is True -- -- - radii are less than they should be and thus get scaled up.-arcPosition :: (Ord a, Signed a, TrigField a) => ArcCentroid a -> ArcPosition a+arcPosition :: (Ord a, Absolute a, TrigField a) => ArcCentroid a -> ArcPosition a arcPosition (ArcCentroid c r phi' ang1 angd) = ArcPosition p1 p2 (ArcInfo r phi' large' clockwise') where@@ -255,7 +253,7 @@ -- > c + (rotate phi |. (r * ray theta)) -- -- See also: [wolfram](https://mathworld.wolfram.com/Ellipse.html)-ellipse :: (Direction b a, Affinity b a, TrigField a) => b -> b -> a -> a -> b+ellipse :: (Direction b, Dir b ~ a, Affinity b a, TrigField a) => b -> b -> a -> a -> b ellipse c r phi' theta = c + (rotate phi' |. (r * ray theta)) -- | compute the bounding box for an arcBox@@ -314,18 +312,18 @@ -- | ending point qpolEnd :: Point a, -- | control point in terms of distance from and angle to the qp0 - qp2 line- qpolControl :: Polar a a+ qpolControl :: Polar a } deriving (Eq, Show, Generic) -- | Convert from a positional to a polar representation of a cubic bezier. -- -- >>> quadPolar (QuadPosition (Point 0 0) (Point 1 1) (Point 2 (-1)))--- QuadPolar {qpolStart = Point 0.0 0.0, qpolEnd = Point 1.0 1.0, qpolControl = Polar {magnitude = 2.1213203435596424, direction = -0.7853981633974483}}+-- QuadPolar {qpolStart = Point 0.0 0.0, qpolEnd = Point 1.0 1.0, qpolControl = Polar {radial = 2.1213203435596424, azimuth = -0.7853981633974483}} quadPolar :: (Eq a, TrigField a, ExpField a) => QuadPosition a -> QuadPolar a quadPolar (QuadPosition start' end control) = QuadPolar start' end control' where- mp = (start' + end) /. two+ mp = (start' + end) |/ two control' = polar (control - mp) -- | Convert from a polar to a positional representation of a quadratic bezier.@@ -338,7 +336,7 @@ quadPosition :: (TrigField a) => QuadPolar a -> QuadPosition a quadPosition (QuadPolar start' end control) = QuadPosition start' end control' where- control' = coord control + (start' + end) /. two+ control' = coord control + (start' + end) |/ two -- | The quadratic bezier equation --@@ -346,9 +344,16 @@ -- Point 0.9999999933333332 -0.33333333333333326 quadBezier :: (FromInteger a, ExpField a) => QuadPosition a -> a -> Point a quadBezier (QuadPosition start' end control) theta =- (1 - theta) ^ 2 .* start'- + 2 * (1 - theta) * theta .* control- + theta ^ 2 .* end+ (1 - theta)+ ^ 2+ *| start'+ + 2+ * (1 - theta)+ * theta+ *| control+ + theta+ ^ 2+ *| end -- | QuadPosition turning points. --@@ -357,7 +362,7 @@ quadDerivs :: QuadPosition Double -> [Double] quadDerivs (QuadPosition start' end control) = [x', y'] where- (Point detx dety) = start' - 2 .* control + end+ (Point detx dety) = start' - 2 *| control + end x' = bool ((_x start' - _x control) / detx) (2 * (_x control - _x start')) (detx == 0) y' = bool ((_y start' - _y control) / dety) (2 * (_y control - _y start')) (dety == 0) @@ -393,9 +398,9 @@ -- | ending point cpolEnd :: Point a, -- | control point in terms of distance from and angle to the start end line- cpolControl1 :: Polar a a,+ cpolControl1 :: Polar a, -- | control point in terms of distance from and angle to the start end line- cpolControl2 :: Polar a a+ cpolControl2 :: Polar a } deriving (Eq, Show, Generic) @@ -405,13 +410,13 @@ -- > cubicPolar . cubicPosition == id -- -- >>> cubicPolar (CubicPosition (Point 0 0) (Point 1 1) (Point 1 (-1)) (Point 0 2))--- CubicPolar {cpolStart = Point 0.0 0.0, cpolEnd = Point 1.0 1.0, cpolControl1 = Polar {magnitude = 1.1180339887498947, direction = -1.2490457723982544}, cpolControl2 = Polar {magnitude = 1.1180339887498947, direction = 1.8925468811915387}}+-- CubicPolar {cpolStart = Point 0.0 0.0, cpolEnd = Point 1.0 1.0, cpolControl1 = Polar {radial = 1.1180339887498947, azimuth = -1.2490457723982544}, cpolControl2 = Polar {radial = 1.1180339887498947, azimuth = 1.8925468811915387}} cubicPolar :: (Eq a, ExpField a, TrigField a) => CubicPosition a -> CubicPolar a cubicPolar (CubicPosition start' end control1 control2) = CubicPolar start' end control1' control2' where- mp = (start' + end) /. two- control1' = polar $ (control1 - mp) /. norm (end - start')- control2' = polar $ (control2 - mp) /. norm (end - start')+ mp = (start' + end) |/ two+ control1' = polar $ (control1 - mp) |/ magnitude (end - start')+ control2' = polar $ (control2 - mp) |/ magnitude (end - start') -- | Convert from a polar to a positional representation of a cubic bezier. --@@ -423,8 +428,8 @@ cubicPosition :: (Eq a, TrigField a, ExpField a) => CubicPolar a -> CubicPosition a cubicPosition (CubicPolar start' end control1 control2) = CubicPosition start' end control1' control2' where- control1' = norm (end - start') .* coord control1 + (start' + end) /. two- control2' = norm (end - start') .* coord control2 + (start' + end) /. two+ control1' = magnitude (end - start') *| coord control1 + (start' + end) |/ two+ control2' = magnitude (end - start') *| coord control2 + (start' + end) |/ two -- | The cubic bezier equation --@@ -432,10 +437,22 @@ -- Point 0.6767766952966369 1.2071067811865475 cubicBezier :: (FromInteger a, TrigField a) => CubicPosition a -> a -> Point a cubicBezier (CubicPosition start' end control1 control2) theta =- (1 - theta) ^ 3 .* start'- + 3 * (1 - theta) ^ 2 * theta .* control1- + 3 * (1 - theta) * theta ^ 2 .* control2- + theta ^ 3 .* end+ (1 - theta)+ ^ 3+ *| start'+ + 3+ * (1 - theta)+ ^ 2+ * theta+ *| control1+ + 3+ * (1 - theta)+ * theta+ ^ 2+ *| control2+ + theta+ ^ 3+ *| end -- | Turning point positions for a CubicPosition (0,1 or 2) --@@ -504,6 +521,6 @@ projectArcPosition new old (ArcPosition _ _ (ArcInfo (Point rx ry) phi' l cl)) = ArcInfo (Point rx'' ry'') phi' l cl where rx' = rotateP phi' (Point rx zero)- rx'' = norm $ rx' * width new / width old+ rx'' = magnitude $ rx' * width new / width old ry' = rotateP phi' (Point zero ry)- ry'' = norm $ ry' * width new / width old+ ry'' = magnitude $ ry' * width new / width old
src/Data/Path/Parser.hs view
@@ -1,12 +1,7 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RebindableSyntax #-}-{-# HLINT ignore "Use unwords" #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -Wall #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -- | SVG path manipulation module Data.Path.Parser@@ -35,7 +30,7 @@ import FlatParse.Basic import GHC.Generics import GHC.OverloadedLabels-import NumHask.Prelude+import NumHask.Prelude hiding (optional, (<|>)) import Optics.Core hiding ((<|)) -- $parsing@@ -239,7 +234,6 @@ <> pp' control <> " " <> pp' p--- FIXME: check why y doesn't need swapping into SVG coord system toPathAbsolute (ArcP (ArcInfo (Point x y) phi' l sw) x2) = "A " <> pv' x
test/test.hs view
@@ -7,11 +7,11 @@ import Chart.Examples import Chart.Markup import Chart.Markup.Parser-import qualified Data.ByteString as BS+import Data.ByteString qualified as BS import Data.Foldable import Data.Maybe import Data.TreeDiff-import qualified Data.TreeDiff.OMap as O+import Data.TreeDiff.OMap qualified as O import FlatParse.Basic import GHC.Exts import Test.Tasty (TestTree, defaultMain, testGroup)