diff --git a/app/examples.hs b/app/examples.hs
--- a/app/examples.hs
+++ b/app/examples.hs
@@ -8,21 +8,21 @@
import Chart
import Chart.Examples
import Control.Lens
+import Lucid
import NumHask.Prelude hiding (replace)
import Web.Rep
-import Lucid
chartServer :: SharedRep IO (Text, Text) -> IO ()
chartServer srep = sharedServer srep defaultSocketConfig (chartStyler True) defaultInputCode chartOutputCode
-chartOutputCode :: Either Text (Text,Text) -> IO [Code]
-chartOutputCode ea = do
- pure $ case ea of
- Left err -> [Append "debug" ("hashmap error: " <> err)]
- Right (chart',debug') ->
- [ Replace "output" chart',
- Replace "debug" debug'
- ]
+chartOutputCode :: Either Text (Text, Text) -> IO [Code]
+chartOutputCode ea =
+ pure $ case ea of
+ Left err -> [Append "debug" ("hashmap error: " <> err)]
+ Right (chart', debug') ->
+ [ Replace "output" chart',
+ Replace "debug" debug'
+ ]
chartStyler :: Bool -> Page
chartStyler doDebug =
@@ -46,29 +46,32 @@
-- main example
main :: IO ()
main =
- chartServer
- ( repChoice
- 5
- [ ("mempty", repEx memptyExample),
- ("unit", repEx unitExample),
- ("hud", repEx hudExample),
- ("rect", repEx rectExample),
- ("line", repEx lineExample),
- ("wave", repEx mainExample),
- ("text", repEx textExample),
- ("glyphs", repEx glyphExample),
- ("bar", repBarChart defaultSvgOptions barDataExample defaultBarOptions),
- ("pixel", repPixelChart
- (defaultSvgOptions,
- defaultPixelOptions &
- #poGrain .~ Point 20 20 &
- #poRange .~ Rect 1 2 1 2,
- defaultHudOptions,
- defaultPixelLegendOptions "pixel test",
- f1)),
- ("bound text bug", repEx (makeExample defaultHudOptions boundTextBug)),
- ("compound chart", repEx (makeExample defaultHudOptions (lglyph <> glines))),
- ("label", repEx (makeExample defaultHudOptions label)),
- ("legend test", repNoData defaultSvgOptions BlankA legendTest)
- ]
- )
+ chartServer
+ ( repChoice
+ 5
+ [ ("mempty", repEx memptyExample),
+ ("unit", repEx unitExample),
+ ("hud", repEx hudExample),
+ ("rect", repEx rectExample),
+ ("line", repEx lineExample),
+ ("wave", repEx mainExample),
+ ("text", repEx textExample),
+ ("glyphs", repEx glyphExample),
+ ("bar", repBarChart defaultSvgOptions barDataExample defaultBarOptions),
+ ( "pixel",
+ repPixelChart
+ ( defaultSvgOptions,
+ defaultPixelOptions
+ & #poGrain .~ Point 20 20
+ & #poRange .~ Rect 1 2 1 2,
+ defaultHudOptions,
+ defaultPixelLegendOptions "pixel test",
+ f1
+ )
+ ),
+ ("bound text bug", repEx (makeExample defaultHudOptions boundTextBug)),
+ ("compound chart", repEx (makeExample defaultHudOptions (lglyph <> glines))),
+ ("label", repEx (makeExample defaultHudOptions label)),
+ ("legend test", repNoData defaultSvgOptions BlankA legendTest)
+ ]
+ )
diff --git a/app/venn.hs b/app/venn.hs
--- a/app/venn.hs
+++ b/app/venn.hs
@@ -17,9 +17,9 @@
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
-import NumHask.Prelude
import Lucid
import Lucid.Base
+import NumHask.Prelude
xs :: Map.Map Text (Point Double)
xs =
@@ -187,20 +187,27 @@
renderToSvgt :: CssOptions -> Point Double -> Rect Double -> [Chart Double] -> [(TextStyle, Text)] -> Html ()
renderToSvgt csso (Point w' h') (Rect x z y w) cs tts =
with
- (svg2_ (bool id (cssCrisp <>) (csso == UseCssCrisp) $
- chartDefs cs <>
- mconcat (zipWith svgt cs tts)))
- [width_ (show w'),
- height_ (show h'),
- makeAttribute "viewBox" (show x <> " " <> show (- w) <> " " <> show (z - x) <> " " <> show (w - y))]
+ ( svg2_
+ ( bool id (cssCrisp <>) (csso == UseCssCrisp) $
+ chartDefs cs
+ <> mconcat (zipWith svgt cs tts)
+ )
+ )
+ [ width_ (show w'),
+ height_ (show h'),
+ makeAttribute "viewBox" (show x <> " " <> show (- w) <> " " <> show (z - x) <> " " <> show (w - y))
+ ]
writeVennWords :: IO ()
writeVennWords =
- writeFile "other/venn2.svg" $ Lazy.toStrict $ renderText $
- renderToSvgt NoCssOptions (Point 300 300) (Rect (-2) 2 (-2) 2)
- (phrases <> venns <> [Chart BlankA [SpotRect (Rect (-2.0) 2.0 (-2.0) 2.0)]]) $
- (defaultTextStyle & set #color colorText,) <$>
- (replicate 7 "" <> (phraseText <$> mainPhrases) <> [""])
+ writeFile "other/venn2.svg" $ Lazy.toStrict $ renderText
+ $ renderToSvgt
+ NoCssOptions
+ (Point 300 300)
+ (Rect (-2) 2 (-2) 2)
+ (phrases <> venns <> [Chart BlankA [SpotRect (Rect (-2.0) 2.0 (-2.0) 2.0)]])
+ $ (defaultTextStyle & set #color colorText,)
+ <$> (replicate 7 "" <> (phraseText <$> mainPhrases) <> [""])
writeVenn :: [Colour] -> IO ()
writeVenn cs = writeChartsWith "other/venn.svg" (defaultSvgOptions & set #scaleCharts' NoScaleCharts & set #svgAspect ChartAspect & set #svgHeight 100) ([phraseChart (Phrase "λ" (Point 0 (-0.2)) 0.8 0 (Colour 0.1 0 0.2 1) "chart-svg" 1)] <> zipWith (\p c -> Chart (GlyphA $ seg p c) [SpotPoint (Point 0.0 0.0)]) [outerseg1, outerseg2, outerseg3, midseg1, midseg2, midseg3] cs <> [Chart BlankA [SpotRect (Rect (-1.5) 1.5 (-1.5) 1.5)]])
diff --git a/chart-svg.cabal b/chart-svg.cabal
--- a/chart-svg.cabal
+++ b/chart-svg.cabal
@@ -1,6 +1,6 @@
cabal-version: 2.4
name: chart-svg
-version: 0.1.0
+version: 0.1.1
synopsis: Charts in SVG
description: Chart library targetting SVG.
category: project
@@ -13,7 +13,6 @@
license-file: LICENSE
build-type: Simple
extra-doc-files:
- readme.md,
other/*.svg
source-repository head
diff --git a/readme.md b/readme.md
deleted file mode 100644
--- a/readme.md
+++ /dev/null
@@ -1,52 +0,0 @@
-chart-svg
-=========
-
-[](https://travis-ci.org/tonyday567/chart-svg)
-[](https://hackage.haskell.org/package/chart-svg)
-[](http://stackage.org/lts/package/chart-svg)
-[](http://stackage.org/nightly/package/chart-svg)
-
-A chart library targetting SVG.
-
-
-
-
-
-Chart Types
-===
-
-rect
-
-
-
-line
-
-
-
-text
-
-
-
-glyph
-
-
-
-bar
-
-
-
-pixel
-
-
-
-legend
-
-
-
-recipe
-------
-
-```
-stack exec examples --file-watch
-```
diff --git a/src/Chart.hs b/src/Chart.hs
--- a/src/Chart.hs
+++ b/src/Chart.hs
@@ -68,7 +68,6 @@
defaultAdjustments,
LegendOptions (..),
defaultLegendOptions,
-
-- $color
Colour,
pattern Colour,
@@ -82,15 +81,13 @@
toHex,
fromHex,
unsafeFromHex,
-
grayscale,
colorText,
transparent,
black,
white,
-
-- $formats
- FormatN(..),
+ FormatN (..),
defaultFormatN,
fromFormatN,
toFormatN,
@@ -100,7 +97,6 @@
dollar,
formatN,
formatNs,
-
-- $core
dataBox,
toAspect,
@@ -108,7 +104,6 @@
defRect,
defRectS,
moveChart,
-
-- $hud
runHudWith,
runHud,
@@ -126,7 +121,6 @@
legendEntry,
legendChart,
legendFromChart,
-
-- $svg
svg,
svgt,
@@ -144,7 +138,6 @@
stack,
addChartBox,
addChartBoxes,
-
module Chart.Page,
module Chart.Render,
module Chart.Bar,
@@ -160,80 +153,75 @@
import Chart.Types
import NumHask.Space
-{- $setup
-
->>> :set -XOverloadedLabels
->>> :set -XNoImplicitPrelude
->>> -- import NumHask.Prelude
->>> import Control.Lens
-
--}
-
-
-{- $overview
-
-A chart consists of related conceptual layers:
-
-1. the data to be represented
-2. the manifestation of the data on the screen
-3. visual aids to help interpret the data, such as axes, gridlines and titles.
-
->>> :t Chart
-Chart :: Annotation -> [Spot a] -> Chart a
-
-A 'Chart' in this library specifically consists of
-
-- a list of values, either points or rectangles (unified as a 'Spot')
-
-- an 'Annotation', which describes the way that the data should be represented on a 2-dimensional plane.
-
-What exactly is annotation and what is data is highly variant within charting practice. This construction treats position on a plane differently from other quantitative manifestations such as color and size. The chief advantage of priveleging position is that scaling and integrating data with other chart elements becomes much easier. The disadvantage is that, to use quantitative tools such as size, data needs to be consciously separated into that which is position orientated, and that which is defined as 'Annotation'.
-
-
-Here's some data:
-
->>> :{
- let ls = fmap (SpotPoint . uncurry Point) <$>
- [ [(0.0, 1.0), (1.0, 1.0), (2.0, 5.0 :: Double)],
- [(0.0, 0.0), (3.0, 3.0)],
- [(0.5, 4.0), (0.5, 0)] ]
- :}
-
->>> :t ls
-ls :: [[Spot Double]]
-
-and an Annotation to describe representation of this data.
-
->>> :{
- let anns = LineA <$>
- [ defaultLineStyle & #color .~ (palette1 !! 0) & #width .~ 0.015,
- defaultLineStyle & #color .~ (palette1 !! 1) & #width .~ 0.03,
- defaultLineStyle & #color .~ (palette1 !! 5) & #width .~ 0.01
- ]
- :}
-
-and this is enough to put together a Chart.
-
->>> let lines = zipWith Chart anns ls
->>> :t lines
-lines :: [Chart Double]
-
-Most charts will, in reality, be a list of charts, and much of the library API is designed for this.
-
-> writeCharts "other/lines.svg" lines
-
-
-
-Physical, on-the-page representations of data is separate to need to be considered separately to the domain of the data itself but their concerns bleed into each other. An axis on a chart needs to know the range of the data to render a tick value.
-
-> writeHudOptionsChart "other/linehud.svg" defaultSvgOptions defaultHudOptions [] lines
-
-
-
-chart-svg takes inspiration from gaming heads-up display aesthetics. Chart decorations such as titles and axes are tools to interpret the landscape of data being viewed, should be readily transparent, have sane defaults but be fully configurable.
-
-The library considers a hud to be a recipe for the creation of a 'Chart' list, in the domain of the viewbox of an svg file or similar conception.
-
-Being charts all the way down creates a direct mapping between a chart and its representation. The best way to understand this would be to run the example app, which serves a websocket receiving chart options and updating a chart.
+-- $setup
+--
+-- >>> :set -XOverloadedLabels
+-- >>> :set -XNoImplicitPrelude
+-- >>> -- import NumHask.Prelude
+-- >>> import Control.Lens
--}
+-- $overview
+--
+-- A chart consists of related conceptual layers:
+--
+-- 1. the data to be represented
+-- 2. the manifestation of the data on the screen
+-- 3. visual aids to help interpret the data, such as axes, gridlines and titles.
+--
+-- >>> :t Chart
+-- Chart :: Annotation -> [Spot a] -> Chart a
+--
+-- A 'Chart' in this library specifically consists of
+--
+-- - a list of values, either points or rectangles (unified as a 'Spot')
+--
+-- - an 'Annotation', which describes the way that the data should be represented on a 2-dimensional plane.
+--
+-- What exactly is annotation and what is data is highly variant within charting practice. This construction treats position on a plane differently from other quantitative manifestations such as color and size. The chief advantage of priveleging position is that scaling and integrating data with other chart elements becomes much easier. The disadvantage is that, to use quantitative tools such as size, data needs to be consciously separated into that which is position orientated, and that which is defined as 'Annotation'.
+--
+--
+-- Here's some data:
+--
+-- >>> :{
+-- let ls = fmap (SpotPoint . uncurry Point) <$>
+-- [ [(0.0, 1.0), (1.0, 1.0), (2.0, 5.0 :: Double)],
+-- [(0.0, 0.0), (3.0, 3.0)],
+-- [(0.5, 4.0), (0.5, 0)] ]
+-- :}
+--
+-- >>> :t ls
+-- ls :: [[Spot Double]]
+--
+-- and an Annotation to describe representation of this data.
+--
+-- >>> :{
+-- let anns = LineA <$>
+-- [ defaultLineStyle & #color .~ (palette1 !! 0) & #width .~ 0.015,
+-- defaultLineStyle & #color .~ (palette1 !! 1) & #width .~ 0.03,
+-- defaultLineStyle & #color .~ (palette1 !! 5) & #width .~ 0.01
+-- ]
+-- :}
+--
+-- and this is enough to put together a Chart.
+--
+-- >>> let lines = zipWith Chart anns ls
+-- >>> :t lines
+-- lines :: [Chart Double]
+--
+-- Most charts will, in reality, be a list of charts, and much of the library API is designed for this.
+--
+-- > writeCharts "other/lines.svg" lines
+--
+-- 
+--
+-- Physical, on-the-page representations of data is separate to need to be considered separately to the domain of the data itself but their concerns bleed into each other. An axis on a chart needs to know the range of the data to render a tick value.
+--
+-- > writeHudOptionsChart "other/linehud.svg" defaultSvgOptions defaultHudOptions [] lines
+--
+-- 
+--
+-- chart-svg takes inspiration from gaming heads-up display aesthetics. Chart decorations such as titles and axes are tools to interpret the landscape of data being viewed, should be readily transparent, have sane defaults but be fully configurable.
+--
+-- The library considers a hud to be a recipe for the creation of a 'Chart' list, in the domain of the viewbox of an svg file or similar conception.
+--
+-- Being charts all the way down creates a direct mapping between a chart and its representation. The best way to understand this would be to run the example app, which serves a websocket receiving chart options and updating a chart.
diff --git a/src/Chart/Bar.hs b/src/Chart/Bar.hs
--- a/src/Chart/Bar.hs
+++ b/src/Chart/Bar.hs
@@ -17,7 +17,6 @@
)
where
-
import Chart.Types
import Control.Lens
import Data.Generics.Labels ()
@@ -26,19 +25,16 @@
import NumHask.Space
import qualified Prelude as P
-{- $setup
-
->>> :set -XOverloadedLabels
->>> :set -XNoImplicitPrelude
->>> -- import NumHask.Prelude
->>> import Control.Lens
-
--}
+-- $setup
+--
+-- >>> :set -XOverloadedLabels
+-- >>> :set -XNoImplicitPrelude
+-- >>> -- import NumHask.Prelude
+-- >>> import Control.Lens
-- | the usual bar chart eye-candy
--
-- 
---
data BarOptions
= BarOptions
{ barRectStyles :: [RectStyle],
@@ -92,16 +88,13 @@
gs = (\x -> RectStyle 0.002 x x) <$> palette1
ts = (\x -> defaultTextStyle & #color .~ x & #size .~ 0.04) <$> palette1
-{- | imagine a dataframe you get in other languages:
-
-- definietly some [[Double]]
-
-- maybe some row names
-
-- maybe some column names
-
--}
-
+-- | imagine a dataframe you get in other languages:
+--
+-- - definietly some [[Double]]
+--
+-- - maybe some row names
+--
+-- - maybe some column names
data BarData
= BarData
{ barData :: [[Double]],
@@ -169,14 +162,12 @@
--
-- >>> bars defaultBarOptions (BarData [[1,2],[2,3]] Nothing Nothing)
-- [Chart {annotation = RectA (RectStyle {borderSize = 2.0e-3, borderColor = RGBA 0.65 0.81 0.89 1.00, color = RGBA 0.65 0.81 0.89 1.00}), spots = [SpotRect Rect 5.0e-2 0.45 0.0 1.0,SpotRect Rect 1.05 1.4500000000000002 0.0 2.0]},Chart {annotation = RectA (RectStyle {borderSize = 2.0e-3, borderColor = RGBA 0.12 0.47 0.71 1.00, color = RGBA 0.12 0.47 0.71 1.00}), spots = [SpotRect Rect 0.45 0.8500000000000001 0.0 2.0,SpotRect Rect 1.4500000000000002 1.85 0.0 3.0]},Chart {annotation = BlankA, spots = [SpotRect Rect -5.0e-2 1.9500000000000002 0.0 3.0]}]
---
bars :: BarOptions -> BarData -> [Chart Double]
bars bo bd =
zipWith (\o d -> Chart (RectA o) d) (bo ^. #barRectStyles) (fmap SpotRect <$> barRects bo (bd ^. #barData)) <> [Chart BlankA [SpotRect (Rect (x - (bo ^. #outerGap)) (z + (bo ^. #outerGap)) y w)]]
where
(Rect x z y w) = fromMaybe unitRect $ foldRect $ catMaybes $ foldRect <$> barRects bo (bd ^. #barData)
-
maxRows :: [[Double]] -> Int
maxRows [] = 0
maxRows xs = maximum $ length <$> xs
@@ -211,7 +202,6 @@
-- | A bar chart with hud trimmings.
--
-- By convention only, the first axis (if any) is the bar axis.
---
barChart :: BarOptions -> BarData -> (HudOptions, [Chart Double])
barChart bo bd =
( bo ^. #barHudOptions & #hudLegend %~ fmap (second (const (barLegend bd bo))) & #hudAxes %~ tickFirstAxis bd . flipAllAxes (barOrientation bo),
@@ -257,4 +247,3 @@
barTextCharts :: BarOptions -> BarData -> [Chart Double]
barTextCharts bo bd =
zipWith (\o d -> Chart (TextA o (fst <$> d)) (SpotPoint . snd <$> d)) (bo ^. #barTextStyles) (barTexts bo (bd ^. #barData))
-
diff --git a/src/Chart/Examples.hs b/src/Chart/Examples.hs
--- a/src/Chart/Examples.hs
+++ b/src/Chart/Examples.hs
@@ -64,9 +64,10 @@
]
ropts :: [RectStyle]
-ropts = [ blob (fromRGB (palette !! 0) 0.4),
- blob (fromRGB (palette !! 5) 0.4)
- ]
+ropts =
+ [ blob (fromRGB (palette !! 0) 0.4),
+ blob (fromRGB (palette !! 5) 0.4)
+ ]
-- | line example
lineExample :: Ex
@@ -324,28 +325,29 @@
writeAllExamples :: IO ()
writeAllExamples = do
-
-- haddocks
- let ls' = fmap (SpotPoint . uncurry Point) <$>
- [ [(0.0, 1.0), (1.0, 1.0), (2.0, 5.0 :: Double)],
- [(0.0, 0.0), (3.0, 3.0)],
- [(0.5, 4.0), (0.5, 0)] ]
- let anns = LineA <$>
- [ defaultLineStyle & #color .~ (palette1 !! 0) & #width .~ 0.015,
- defaultLineStyle & #color .~ (palette1 !! 1) & #width .~ 0.03,
- defaultLineStyle & #color .~ (palette1 !! 5) & #width .~ 0.01
- ]
+ let ls' =
+ fmap (SpotPoint . uncurry Point)
+ <$> [ [(0.0, 1.0), (1.0, 1.0), (2.0, 5.0 :: Double)],
+ [(0.0, 0.0), (3.0, 3.0)],
+ [(0.5, 4.0), (0.5, 0)]
+ ]
+ let anns =
+ LineA
+ <$> [ defaultLineStyle & #color .~ (palette1 !! 0) & #width .~ 0.015,
+ defaultLineStyle & #color .~ (palette1 !! 1) & #width .~ 0.03,
+ defaultLineStyle & #color .~ (palette1 !! 5) & #width .~ 0.01
+ ]
let lines' = zipWith Chart anns ls'
writeCharts "other/lines.svg" lines'
writeHudOptionsChart "other/linehud.svg" defaultSvgOptions defaultHudOptions [] lines'
- writeCharts "other/unit.svg" [Chart (RectA defaultRectStyle) [SpotRect (unitRect::Rect Double)]]
+ writeCharts "other/unit.svg" [Chart (RectA defaultRectStyle) [SpotRect (unitRect :: Rect Double)]]
let t = zipWith (\x y -> Chart (TextA (defaultTextStyle & (#size .~ (0.05 :: Double))) [x]) [SpotPoint y]) (fmap Text.singleton ['a' .. 'y']) [Point (sin (x * 0.1)) x | x <- [0 .. 25]]
writeCharts "other/text.svg" t
writeCharts "other/glyph.svg" glyphs
writeHudOptionsChart "other/pixel.svg" defaultSvgOptions defaultHudOptions (snd pixelEx) (fst pixelEx)
writeChartsWith "other/svgoptions.svg" (defaultSvgOptions & #svgAspect .~ ManualAspect 0.7) lines'
writeHudOptionsChart "other/hud.svg" defaultSvgOptions defaultHudOptions [] []
-
-- basics
writeCharts "other/mempty.svg" []
writeChartExample "other/bar.svg" barExample
diff --git a/src/Chart/Page.hs b/src/Chart/Page.hs
--- a/src/Chart/Page.hs
+++ b/src/Chart/Page.hs
@@ -600,7 +600,6 @@
TickRound _ _ e -> e == TickExtend
_ -> True
-
repTick :: (Monad m) => Tick -> SharedRep m Tick
repTick cfg = bimap hmap Tick ts <<*>> gt <<*>> tt <<*>> lt
where
@@ -893,7 +892,7 @@
((\(a, _, _) -> a) debug)
<> bool
mempty
- ( mconcat $
+ ( mconcat
[ "chart svg
",
"<![CDATA[",
renderHudOptionsChart css hc [] cs,
diff --git a/src/Chart/Types.hs b/src/Chart/Types.hs
--- a/src/Chart/Types.hs
+++ b/src/Chart/Types.hs
@@ -1,9 +1,3 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
@@ -17,11 +11,11 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RebindableSyntax #-}
{-# OPTIONS_GHC -Wall #-}
-{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
module Chart.Types
( Chart (..),
@@ -89,7 +83,6 @@
defaultAdjustments,
LegendOptions (..),
defaultLegendOptions,
-
-- $color
Colour,
pattern Colour,
@@ -103,7 +96,6 @@
toHex,
fromHex,
unsafeFromHex,
-
grayscale,
colorText,
transparent,
@@ -112,9 +104,8 @@
-- * re-exports
module Graphics.Color.Model,
-
-- $formats
- FormatN(..),
+ FormatN (..),
defaultFormatN,
fromFormatN,
toFormatN,
@@ -125,7 +116,6 @@
formatN,
precision,
formatNs,
-
-- $core
projectTo,
projectSpots,
@@ -136,7 +126,6 @@
defRect,
defRectS,
moveChart,
-
-- $hud
runHudWith,
runHud,
@@ -153,7 +142,6 @@
legendEntry,
legendChart,
legendFromChart,
-
-- $svg
svg,
svgt,
@@ -171,49 +159,40 @@
stack,
addChartBox,
addChartBoxes,
-
- )
+ )
where
+import qualified Control.Foldl as L
import Control.Lens
import qualified Data.Attoparsec.Text as A
import Data.Generics.Labels ()
-import Data.List ((!!))
-import Graphics.Color.Model
-import NumHask.Prelude
-import NumHask.Space hiding (Element)
-import qualified Prelude as P
-import qualified Data.Text as Text
-import Data.List (nub)
+import Data.List ((!!), nub)
import Data.Scientific
+import qualified Data.Text as Text
import Data.Time
-import qualified Control.Foldl as L
-import Data.Generics.Labels ()
+import Graphics.Color.Model
import qualified Lucid
-import Lucid (with, term, width_, height_, id_, class_, toHtmlRaw)
-import NumHask.Space as NH hiding (Element)
-import Text.HTML.TagSoup hiding (Attribute)
+import Lucid (class_, height_, id_, term, toHtmlRaw, width_, with)
import Lucid.Base (makeXmlElementNoEnd)
import qualified Lucid.Base as Lucid
-
-
-{- $setup
-
->>> :set -XOverloadedLabels
->>> :set -XNoImplicitPrelude
->>> -- import NumHask.Prelude
->>> import Control.Lens
->>> import Chart.Render
-
--}
+import NumHask.Prelude
+import NumHask.Space as NH hiding (Element)
+import Text.HTML.TagSoup hiding (Attribute)
+import qualified Prelude as P
+-- $setup
+--
+-- >>> :set -XOverloadedLabels
+-- >>> :set -XNoImplicitPrelude
+-- >>> -- import NumHask.Prelude
+-- >>> import Control.Lens
+-- >>> import Chart.Render
-- * Chart
-- | A `Chart` consists of
-- - a list of spots on the xy-plane, and
-- - specific style of representation for each spot.
---
data Chart a
= Chart
{ annotation :: Annotation,
@@ -250,7 +229,6 @@
-- >writeCharts "other/unit.svg" [Chart (RectA defaultRectStyle) [SpotRect (unitRect::Rect Double)]]
--
-- 
---
data RectStyle
= RectStyle
{ borderSize :: Double,
@@ -267,7 +245,6 @@
--
-- >>> blob black
-- RectStyle {borderSize = 0.0, borderColor = RGBA 0.00 0.00 0.00 0.00, color = RGBA 0.00 0.00 0.00 1.00}
---
blob :: Colour -> RectStyle
blob = RectStyle 0 transparent
@@ -275,7 +252,6 @@
--
-- >>> clear
-- RectStyle {borderSize = 0.0, borderColor = RGBA 0.00 0.00 0.00 0.00, color = RGBA 0.00 0.00 0.00 0.00}
---
clear :: RectStyle
clear = RectStyle 0 transparent transparent
@@ -283,22 +259,19 @@
--
-- >>> border 0.01 transparent
-- RectStyle {borderSize = 1.0e-2, borderColor = RGBA 0.00 0.00 0.00 0.00, color = RGBA 0.00 0.00 0.00 0.00}
---
border :: Double -> Colour -> RectStyle
border s c = RectStyle s c transparent
-{- | Text styling
-
->>> defaultTextStyle
-TextStyle {size = 8.0e-2, color = RGBA 0.20 0.20 0.20 1.00, anchor = AnchorMiddle, hsize = 0.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing, translate = Nothing, hasMathjax = False}
-
->>> let t = zipWith (\x y -> Chart (TextA (defaultTextStyle & (#size .~ (0.05 :: Double))) [x]) [SpotPoint y]) (fmap Text.singleton ['a' .. 'y']) [Point (sin (x * 0.1)) x | x <- [0 .. 25]]
-
-> writeCharts "other/text.svg" t
-
-
-
--}
+-- | Text styling
+--
+-- >>> defaultTextStyle
+-- TextStyle {size = 8.0e-2, color = RGBA 0.20 0.20 0.20 1.00, anchor = AnchorMiddle, hsize = 0.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing, translate = Nothing, hasMathjax = False}
+--
+-- >>> let t = zipWith (\x y -> Chart (TextA (defaultTextStyle & (#size .~ (0.05 :: Double))) [x]) [SpotPoint y]) (fmap Text.singleton ['a' .. 'y']) [Point (sin (x * 0.1)) x | x <- [0 .. 25]]
+--
+-- > writeCharts "other/text.svg" t
+--
+-- 
data TextStyle
= TextStyle
{ size :: Double,
@@ -340,7 +313,6 @@
-- GlyphStyle {size = 3.0e-2, color = RGBA 0.65 0.81 0.89 0.30, borderColor = RGBA 0.12 0.47 0.71 0.80, borderSize = 3.0e-3, shape = SquareGlyph, rotation = Nothing, translate = Nothing}
--
-- 
---
data GlyphStyle
= GlyphStyle
{ -- | glyph radius
@@ -400,7 +372,6 @@
--
-- >>> defaultLineStyle
-- LineStyle {width = 1.2e-2, color = RGBA 0.65 0.81 0.89 0.30}
---
data LineStyle
= LineStyle
{ width :: Double,
@@ -418,7 +389,6 @@
-- PixelStyle {pixelColorMin = RGBA 0.65 0.81 0.89 1.00, pixelColorMax = RGBA 0.12 0.47 0.71 1.00, pixelGradient = 1.5707963267948966, pixelRectStyle = RectStyle {borderSize = 0.0, borderColor = RGBA 0.00 0.00 0.00 0.00, color = RGBA 0.00 0.00 0.00 1.00}, pixelTextureId = "pixel"}
--
-- 
---
data PixelStyle
= PixelStyle
{ pixelColorMin :: Colour,
@@ -523,7 +493,6 @@
-- > writeChartsWith "other/svgoptions.svg" (defaultSvgOptions & #svgAspect .~ ManualAspect 0.7) lines
--
-- 
---
data SvgOptions
= SvgOptions
{ svgHeight :: Double,
@@ -627,7 +596,6 @@
PlaceAbsolute _ -> "Absolute"
-- | axis options
---
data AxisOptions
= AxisOptions
{ abar :: Maybe Bar,
@@ -645,7 +613,6 @@
--
-- >>> defaultBar
-- Bar {rstyle = RectStyle {borderSize = 0.0, borderColor = RGBA 0.50 0.50 0.50 1.00, color = RGBA 0.50 0.50 0.50 1.00}, wid = 5.0e-3, buff = 1.0e-2}
---
data Bar
= Bar
{ rstyle :: RectStyle,
@@ -686,7 +653,6 @@
--
-- >>> defaultTick
-- Tick {tstyle = TickRound (FormatComma 0) 8 TickExtend, gtick = Just (GlyphStyle {size = 3.0e-2, color = RGBA 0.50 0.50 0.50 1.00, borderColor = RGBA 0.50 0.50 0.50 1.00, borderSize = 5.0e-3, shape = VLineGlyph 5.0e-3, rotation = Nothing, translate = Nothing},1.25e-2), ttick = Just (TextStyle {size = 5.0e-2, color = RGBA 0.50 0.50 0.50 1.00, anchor = AnchorMiddle, hsize = 0.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing, translate = Nothing, hasMathjax = False},1.5e-2), ltick = Just (LineStyle {width = 5.0e-3, color = RGBA 0.50 0.50 0.50 0.05},0.0)}
---
data Tick
= Tick
{ tstyle :: TickStyle,
@@ -759,7 +725,6 @@
--
-- >>> defaultAdjustments
-- Adjustments {maxXRatio = 8.0e-2, maxYRatio = 6.0e-2, angledRatio = 0.12, allowDiagonal = True}
---
data Adjustments
= Adjustments
{ maxXRatio :: Double,
@@ -781,7 +746,6 @@
-- LegendOptions {lsize = 0.1, vgap = 0.2, hgap = 0.1, ltext = TextStyle {size = 8.0e-2, color = RGBA 0.20 0.20 0.20 1.00, anchor = AnchorMiddle, hsize = 0.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing, translate = Nothing, hasMathjax = False}, lmax = 10, innerPad = 0.1, outerPad = 0.1, legendFrame = Just (RectStyle {borderSize = 2.0e-2, borderColor = RGBA 0.50 0.50 0.50 1.00, color = RGBA 1.00 1.00 1.00 1.00}), lplace = PlaceBottom, lscale = 0.2}
--
-- 
---
data LegendOptions
= LegendOptions
{ lsize :: Double,
@@ -815,20 +779,25 @@
0.2
-- | snatching Colour as the library color representation.
-newtype Colour = Colour' { color' :: Color (Alpha RGB) Double } deriving (Eq, Generic)
+newtype Colour = Colour' {color' :: Color (Alpha RGB) Double} deriving (Eq, Generic)
-- | Constructor.
pattern Colour :: Double -> Double -> Double -> Double -> Colour
pattern Colour r g b a = Colour' (ColorRGBA r g b a)
+
{-# COMPLETE Colour #-}
instance Show Colour where
show (Colour r g b a) =
- Text.unpack $ "RGBA " <>
- fixed 2 r <> " " <>
- fixed 2 g <> " " <>
- fixed 2 b <> " " <>
- fixed 2 a
+ Text.unpack $
+ "RGBA "
+ <> fixed 2 r
+ <> " "
+ <> fixed 2 g
+ <> " "
+ <> fixed 2 b
+ <> " "
+ <> fixed 2 a
-- | get opacity
opac :: Colour -> Double
@@ -858,13 +827,13 @@
-- |
parseHex :: A.Parser (Color RGB Double)
parseHex =
- (fmap toDouble
- . ( \((r, g), b) ->
+ fmap toDouble
+ . ( \((r, g), b) ->
ColorRGB (fromIntegral r) (fromIntegral g) (fromIntegral b) :: Color RGB Word8
)
- . (\(f, b) -> (f `divMod` (256 :: Int), b))
- . (`divMod` 256)
- <$> (A.string "#" *> A.hexadecimal))
+ . (\(f, b) -> (f `divMod` (256 :: Int), b))
+ . (`divMod` 256)
+ <$> (A.string "#" *> A.hexadecimal)
-- |
fromHex :: Text -> Either Text (Color RGB Double)
@@ -902,15 +871,15 @@
-- |
i2d :: Int -> Char
-i2d i = (chr (ord '0' + i))
+i2d i = chr (ord '0' + i)
-- | some RGB colors to work with
palette :: [Color RGB Double]
-palette = unsafeFromHex <$> ["#a6cee3","#1f78b4","#b2df8a","#33a02c","#fb9a99","#e31a1c","#fdbf6f","#ff7f00","#cab2d6","#6a3d9a","#ffff99","#b15928"]
+palette = unsafeFromHex <$> ["#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99", "#e31a1c", "#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a", "#ffff99", "#b15928"]
-- | some RGBA colors
palette1 :: [Colour]
-palette1 = (\c -> fromRGB c 1) <$> palette
+palette1 = (\c -> fromRGB c 1) <$> palette
-- | gray with 1 opacity
grayscale :: Double -> Color RGB Double
@@ -936,7 +905,6 @@
--
-- >>> defaultFormatN
-- FormatComma 2
---
data FormatN
= FormatFixed Int
| FormatComma Int
@@ -1078,8 +1046,13 @@
ss = annotation <$> cs
cs' = zipWith Chart ss xss
projectTo2 vb xss =
- fmap (maybe id (projectOn vb)
- (fold $ foldRect . fmap toRect <$> xss)) <$> xss
+ fmap
+ ( maybe
+ id
+ (projectOn vb)
+ (fold $ foldRect . fmap toRect <$> xss)
+ )
+ <$> xss
projectSpotsWith :: (Ord a, Fractional a) => Rect a -> Rect a -> [Chart a] -> [Chart a]
projectSpotsWith new old cs = cs'
@@ -1092,7 +1065,7 @@
toAspect (Rect x z y w) = (z - x) / (w - y)
-- |
-dataBox :: (Ord a) =>[Chart a] -> Maybe (Rect a)
+dataBox :: (Ord a) => [Chart a] -> Maybe (Rect a)
dataBox cs = foldRect . mconcat $ fmap toRect <$> (spots <$> cs)
scaleAnn :: Double -> Annotation -> Annotation
@@ -1118,7 +1091,6 @@
{-# COMPLETE SR' #-}
-
-- | combine huds and charts to form a new Chart using the supplied
-- initial canvas and data dimensions.
-- Note that chart data is transformed by this computation.
@@ -1175,7 +1147,7 @@
_ -> Rect a0 a1 y w
freezeTicks _ _ ts = (ts, Nothing)
--- |
+-- |
flipAxis :: AxisOptions -> AxisOptions
flipAxis ac = case ac ^. #place of
PlaceBottom -> ac & #place .~ PlaceLeft
@@ -1993,7 +1965,6 @@
--
-- >>> padChart 0.1 [Chart (RectA defaultRectStyle) [SpotRect unitRect]]
-- [Chart {annotation = RectA (RectStyle {borderSize = 1.0e-2, borderColor = RGBA 0.12 0.47 0.71 0.80, color = RGBA 0.12 0.47 0.71 0.30}), spots = [SpotRect Rect -0.5 0.5 -0.5 0.5]},Chart {annotation = BlankA, spots = [SpotRect Rect -0.605 0.605 -0.605 0.605]}]
---
padChart :: Double -> [Chart Double] -> [Chart Double]
padChart p cs = cs <> [Chart BlankA (maybeToList (SpotRect . padRect p <$> styleBoxes cs))]
@@ -2001,7 +1972,6 @@
--
-- >>> frameChart defaultRectStyle 0.1 blank
-- [Chart {annotation = RectA (RectStyle {borderSize = 1.0e-2, borderColor = RGBA 0.12 0.47 0.71 0.80, color = RGBA 0.12 0.47 0.71 0.30}), spots = []},Chart {annotation = BlankA, spots = []}]
---
frameChart :: RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart rs p cs = [Chart (RectA rs) (maybeToList (SpotRect . padRect p <$> styleBoxes cs))] <> cs
]]>