chart-svg-0.6.0.0: Charting library targetting SVGs.
Safe HaskellSafe-Inferred
LanguageGHC2021

Chart.Primitive

Description

Base Chart and ChartTree types and support

Synopsis

Charts

data Chart Source #

A product type consisting of a Style, which is the stylistic manifestation of chart data, and ChartData representing where data is located on the chart canvas (an xy-plane).

A simple example is:

>>> let r = Chart defaultRectStyle (RectData [one])
>>> r
Chart {chartStyle = Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData [Rect (-0.5) 0.5 (-0.5) 0.5]}

Using the defaults, this chart is rendered as:

writeChartOptions "other/unit.hs" $ mempty & #hudOptions .~ defaultHudOptions & #chartTree .~ unnamed [r]

Constructors

Chart 

Instances

Instances details
Generic Chart Source # 
Instance details

Defined in Chart.Primitive

Associated Types

type Rep Chart :: Type -> Type #

Methods

from :: Chart -> Rep Chart x #

to :: Rep Chart x -> Chart #

Show Chart Source # 
Instance details

Defined in Chart.Primitive

Methods

showsPrec :: Int -> Chart -> ShowS #

show :: Chart -> String #

showList :: [Chart] -> ShowS #

Eq Chart Source # 
Instance details

Defined in Chart.Primitive

Methods

(==) :: Chart -> Chart -> Bool #

(/=) :: Chart -> Chart -> Bool #

type Rep Chart Source # 
Instance details

Defined in Chart.Primitive

type Rep Chart = D1 ('MetaData "Chart" "Chart.Primitive" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "Chart" 'PrefixI 'True) (S1 ('MetaSel ('Just "chartStyle") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Style) :*: S1 ('MetaSel ('Just "chartData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ChartData)))

data ChartData Source #

Data of a Chart

A sum type representing the data behind six different types of chart:

  • RectData: a list of rectangles in the XY-domain. For example, a Rect 0 1 0 1 is the set of points on the XY Plane bounded by (0,0), (0,1), (1,0) & (1,1). Much of the library is built on Rect Doubles.
  • LineData: a list of (list of points) which represent connected straight lines. [Point 0 0, Point 1 1, Point 2 2, Point 3 3] is an example; three lines connected up to form a line from (0,0) to (3,3).
  • GlyphData: a list of points to draw a GlyphShape.
  • TextData: A list of Text,Point tuples representing text centered at a Point in XY space.
  • ChartData: specification of curvilinear paths using the SVG standards.
  • BlankData: a rectangular space that has no visual representation.

Constructors

RectData [Rect Double]

List of rectangles

LineData [[Point Double]]

List of (List of Points)

GlyphData [Point Double]

List of Points (to place the GlyphShape)

TextData [(Text, Point Double)]

List of text and point to place it.

PathData [PathData Double]

List of paths

BlankData [Rect Double]

List of rectangles with no Style representation

Instances

Instances details
Generic ChartData Source # 
Instance details

Defined in Chart.Primitive

Associated Types

type Rep ChartData :: Type -> Type #

Show ChartData Source # 
Instance details

Defined in Chart.Primitive

Eq ChartData Source # 
Instance details

Defined in Chart.Primitive

type Rep ChartData Source # 
Instance details

Defined in Chart.Primitive

rectData' :: Lens' ChartData (Maybe [Rect Double]) Source #

RectData partial lens

lineData' :: Lens' ChartData (Maybe [[Point Double]]) Source #

LineData partial lens

glyphData' :: Lens' ChartData (Maybe [Point Double]) Source #

GlyphData partial lens

textData' :: Lens' ChartData (Maybe [(Text, Point Double)]) Source #

TextData partial lens

pathData' :: Lens' ChartData (Maybe [PathData Double]) Source #

PathData partial lens

blankData' :: Lens' ChartData (Maybe [Rect Double]) Source #

BlankData partial lens

pattern RectChart :: Style -> [Rect Double] -> Chart Source #

pattern of a Chart with RectData

pattern LineChart :: Style -> [[Point Double]] -> Chart Source #

pattern of a Chart with LineData

pattern GlyphChart :: Style -> [Point Double] -> Chart Source #

pattern of a Chart with GlyphData

pattern TextChart :: Style -> [(Text, Point Double)] -> Chart Source #

pattern of a Chart with TextData

pattern PathChart :: Style -> [PathData Double] -> Chart Source #

pattern of a Chart with PathData

pattern BlankChart :: Style -> [Rect Double] -> Chart Source #

pattern of a Chart with BlankData

pattern LineChart1 :: Style -> [Point Double] -> Chart Source #

pattern of a Chart with a singleton LineData

blankChart1 :: Rect Double -> Chart Source #

Create a blank Chart with a single Rect

newtype ChartTree Source #

A group of charts represented by a Tree of chart lists with labelled branches. The labelling is particularly useful downstream, when groupings become grouped SVG elements with classes or ids.

Constructors

ChartTree 

Fields

Instances

Instances details
Monoid ChartTree Source # 
Instance details

Defined in Chart.Primitive

Semigroup ChartTree Source # 
Instance details

Defined in Chart.Primitive

Generic ChartTree Source # 
Instance details

Defined in Chart.Primitive

Associated Types

type Rep ChartTree :: Type -> Type #

Show ChartTree Source # 
Instance details

Defined in Chart.Primitive

Eq ChartTree Source # 
Instance details

Defined in Chart.Primitive

type Rep ChartTree Source # 
Instance details

Defined in Chart.Primitive

type Rep ChartTree = D1 ('MetaData "ChartTree" "Chart.Primitive" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'True) (C1 ('MetaCons "ChartTree" 'PrefixI 'True) (S1 ('MetaSel ('Just "tree") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Tree (Maybe Text, [Chart])))))

tree' :: Iso' ChartTree (Tree (Maybe Text, [Chart])) Source #

Lens between ChartTree and the underlying Tree representation

chart' :: Traversal' ChartTree Chart Source #

A traversal of each chart in a tree.

charts' :: Traversal' ChartTree [Chart] Source #

A traversal of each chart list in a tree.

named :: Text -> [Chart] -> ChartTree Source #

Convert a chart list to a tree, adding a specific text label.

unnamed :: [Chart] -> ChartTree Source #

Convert a chart list to a tree, with no text label.

renamed :: Text -> ChartTree -> ChartTree Source #

Rename a ChartTree, removing descendent names

rename :: Maybe Text -> ChartTree -> ChartTree Source #

Rename a top-level label in a tree.

blank :: Rect Double -> ChartTree Source #

A tree with no charts and no label.

group :: Maybe Text -> [ChartTree] -> ChartTree Source #

Group a list of trees into a new tree.

filterChartTree :: (Chart -> Bool) -> ChartTree -> ChartTree Source #

Apply a filter to a ChartTree

data Orientation Source #

Verticle or Horizontal

Constructors

Vert 
Hori 

Instances

Instances details
Generic Orientation Source # 
Instance details

Defined in Chart.Primitive

Associated Types

type Rep Orientation :: Type -> Type #

Show Orientation Source # 
Instance details

Defined in Chart.Primitive

Eq Orientation Source # 
Instance details

Defined in Chart.Primitive

type Rep Orientation Source # 
Instance details

Defined in Chart.Primitive

type Rep Orientation = D1 ('MetaData "Orientation" "Chart.Primitive" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "Vert" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Hori" 'PrefixI 'False) (U1 :: Type -> Type))

data Stacked Source #

Whether to stack chart data

Constructors

Stacked 
NonStacked 

Instances

Instances details
Generic Stacked Source # 
Instance details

Defined in Chart.Primitive

Associated Types

type Rep Stacked :: Type -> Type #

Methods

from :: Stacked -> Rep Stacked x #

to :: Rep Stacked x -> Stacked #

Show Stacked Source # 
Instance details

Defined in Chart.Primitive

Eq Stacked Source # 
Instance details

Defined in Chart.Primitive

Methods

(==) :: Stacked -> Stacked -> Bool #

(/=) :: Stacked -> Stacked -> Bool #

type Rep Stacked Source # 
Instance details

Defined in Chart.Primitive

type Rep Stacked = D1 ('MetaData "Stacked" "Chart.Primitive" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "Stacked" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NonStacked" 'PrefixI 'False) (U1 :: Type -> Type))

data ChartAspect Source #

The basis for the x-y ratio of a chart

Default style features tend towards assuming that the usual height of the overall svg image is around 1, and ChartAspect is based on this assumption, so that a ChartAspect of FixedAspect 1.5, say, means a height of 1 and a width of 1.5.

Constructors

FixedAspect Double

Rescale charts to a fixed x-y ratio, inclusive of hud and style features

CanvasAspect Double

Rescale charts to an overall height of 1, preserving the x-y ratio of the data canvas.

ChartAspect

Rescale charts to a height of 1, preserving the existing x-y ratio of the underlying charts, inclusive of hud and style.

UnscaledAspect

Do not rescale charts. The style values should make sense in relation to the data ranges.

Instances

Instances details
Generic ChartAspect Source # 
Instance details

Defined in Chart.Primitive

Associated Types

type Rep ChartAspect :: Type -> Type #

Show ChartAspect Source # 
Instance details

Defined in Chart.Primitive

Eq ChartAspect Source # 
Instance details

Defined in Chart.Primitive

type Rep ChartAspect Source # 
Instance details

Defined in Chart.Primitive

type Rep ChartAspect = D1 ('MetaData "ChartAspect" "Chart.Primitive" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) ((C1 ('MetaCons "FixedAspect" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)) :+: C1 ('MetaCons "CanvasAspect" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double))) :+: (C1 ('MetaCons "ChartAspect" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "UnscaledAspect" 'PrefixI 'False) (U1 :: Type -> Type)))

Boxes

Library functionality (rescaling, combining charts, working out axes and generally putting charts together) is driven by a box model. A box is a rectangular space that bounds chart elements.

box :: ChartData -> Maybe (Rect Double) Source #

The Rect which encloses the data elements of the chart. Bounding box is a synonym.

>>> box (chartData r)
Just Rect (-0.5) 0.5 (-0.5) 0.5

sbox :: Chart -> Maybe (Rect Double) Source #

The bounding box for a chart including both data and style elements.

>>> sbox r
Just Rect (-0.505) 0.505 (-0.505) 0.505

In the above example, the border of the rectangle adds an extra 0.1 to the height and width of the bounding box enclosing the chart.

projectWith :: Rect Double -> Rect Double -> Chart -> Chart Source #

projects a Chart to a new space from an old rectangular space, preserving linear metric structure.

>>> projectWith (fmap (2*) one) one r
Chart {chartStyle = Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData [Rect (-1.0) 1.0 (-1.0) 1.0]}

projectChartDataWith :: Rect Double -> Rect Double -> ChartData -> ChartData Source #

Projects ChartData from an old space to a new space.

moveChart :: Point Double -> Chart -> Chart Source #

Move a chart.

scaleChart :: Double -> Chart -> Chart Source #

Scale a chart (effecting both the chart data and the style, if #style % #scaleP is a scaling value).

colourStyle :: (Colour -> Colour) -> Style -> Style Source #

Modify chart colors, applying to both border and main colors.

projectChartTree :: Rect Double -> ChartTree -> ChartTree Source #

Project a chart tree to a new bounding box, guarding against singleton bounds.

boxes :: [Chart] -> Maybe (Rect Double) Source #

Compute the bounding box of a list of charts, not including style allowances.

box' :: Lens' ChartTree (Maybe (Rect Double)) Source #

Lens between a ChartTree and its bounding box.

styleBoxes :: [Chart] -> Maybe (Rect Double) Source #

Compute the bounding box of the data and style elements contained in a list of charts.

styleBox' :: Lens' ChartTree (Maybe (Rect Double)) Source #

Lens between a style bounding box and a ChartTree tree.

Note that a round trip may be only approximately isomorphic ie

forall c r. \c -> view styleBox' . set styleBox' r c ~= r

safeBox' :: Getter ChartTree (Rect Double) Source #

Getter of a ChartTree bounding box, excluding style, with singleton dimension guards, defaulting to one:

safeStyleBox' :: Getter ChartTree (Rect Double) Source #

Getter of a ChartTree bounding box, including style, with singleton dimension guards, defaulting to one:

Combinators

vert :: Double -> [ChartTree] -> ChartTree Source #

Vertically stack a list of trees (proceeding upwards), aligning them to the left

hori :: Double -> [ChartTree] -> ChartTree Source #

Horizontally stack a list of trees (proceeding to the right) with a gap between

stack :: Int -> Double -> [ChartTree] -> ChartTree Source #

Stack a list of tree charts horizontally, then vertically (proceeding downwards which is opposite to the usual coordinate reference system but intuitively the way people read charts)

frameChart :: Style -> Double -> ChartTree -> ChartTree Source #

Create a frame over some charts with (additive) padding.

>>> frameChart defaultRectStyle 0.1 (unnamed [BlankChart defaultStyle []])
ChartTree {tree = Node {rootLabel = (Just "frame",[Chart {chartStyle = Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData []}]), subForest = []}}

isEmptyChart :: ChartData -> Bool Source #

Whether a chart is empty of data to be represented.

padChart :: Double -> ChartTree -> ChartTree Source #

Additive padding, framing or buffering for a chart list.

rectangularize :: Style -> ChartTree -> ChartTree Source #

Make a new chart tree out of the bounding boxes of a chart tree.

This includes any extra space for style elements.

glyphize :: Style -> ChartTree -> ChartTree Source #

Make a new chart tree out of the data points of a chart tree, using the supplied style (for glyphs).