Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Chart.Primitive
Synopsis
- data Chart = Chart {}
- data ChartData
- rectData' :: Lens' ChartData (Maybe [Rect Double])
- lineData' :: Lens' ChartData (Maybe [[Point Double]])
- glyphData' :: Lens' ChartData (Maybe [Point Double])
- textData' :: Lens' ChartData (Maybe [(Text, Point Double)])
- pathData' :: Lens' ChartData (Maybe [PathData Double])
- blankData' :: Lens' ChartData (Maybe [Rect Double])
- pattern RectChart :: Style -> [Rect Double] -> Chart
- pattern LineChart :: Style -> [[Point Double]] -> Chart
- pattern GlyphChart :: Style -> [Point Double] -> Chart
- pattern TextChart :: Style -> [(Text, Point Double)] -> Chart
- pattern PathChart :: Style -> [PathData Double] -> Chart
- pattern BlankChart :: Style -> [Rect Double] -> Chart
- pattern LineChart1 :: Style -> [Point Double] -> Chart
- blankChart1 :: Rect Double -> Chart
- newtype ChartTree = ChartTree {}
- tree' :: Iso' ChartTree (Tree (Maybe Text, [Chart]))
- chart' :: Traversal' ChartTree Chart
- charts' :: Traversal' ChartTree [Chart]
- named :: Text -> [Chart] -> ChartTree
- unnamed :: [Chart] -> ChartTree
- renamed :: Text -> ChartTree -> ChartTree
- rename :: Maybe Text -> ChartTree -> ChartTree
- blank :: Rect Double -> ChartTree
- group :: Maybe Text -> [ChartTree] -> ChartTree
- filterChartTree :: (Chart -> Bool) -> ChartTree -> ChartTree
- data Orientation
- data Stacked
- data ChartAspect
- box :: ChartData -> Maybe (Rect Double)
- sbox :: Chart -> Maybe (Rect Double)
- projectWith :: Rect Double -> Rect Double -> Chart -> Chart
- projectChartDataWith :: Rect Double -> Rect Double -> ChartData -> ChartData
- moveChartData :: Point Double -> ChartData -> ChartData
- moveChart :: Point Double -> Chart -> Chart
- scaleChart :: Double -> Chart -> Chart
- scaleChartData :: Double -> ChartData -> ChartData
- colourStyle :: (Colour -> Colour) -> Style -> Style
- projectChartTree :: Rect Double -> ChartTree -> ChartTree
- boxes :: [Chart] -> Maybe (Rect Double)
- box' :: Lens' ChartTree (Maybe (Rect Double))
- styleBoxes :: [Chart] -> Maybe (Rect Double)
- styleBox' :: Lens' ChartTree (Maybe (Rect Double))
- safeBox' :: Getter ChartTree (Rect Double)
- safeStyleBox' :: Getter ChartTree (Rect Double)
- vert :: Align -> Double -> [ChartTree] -> ChartTree
- hori :: Align -> Double -> [ChartTree] -> ChartTree
- stack :: Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
- besideChart :: Place -> Double -> Double -> Rect Double -> ChartTree -> ChartTree
- frameChart :: Style -> Double -> ChartTree -> ChartTree
- isEmptyChart :: ChartData -> Bool
- padChart :: Double -> ChartTree -> ChartTree
- rectangularize :: Style -> ChartTree -> ChartTree
- glyphize :: Style -> ChartTree -> ChartTree
- data Align
- data Place
- flipPlace :: Place -> Place
- beside :: Place -> Double -> Double -> Rect Double -> Rect Double -> Point Double
Charts
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:
>>>
Chart defaultRectStyle (RectData [one])
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, textAnchor = 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 | |
Fields
|
Instances
Generic Chart Source # | |
Show Chart Source # | |
Eq Chart Source # | |
type Rep Chart Source # | |
Defined in Chart.Primitive type Rep Chart = D1 ('MetaData "Chart" "Chart.Primitive" "chart-svg-0.8.0.3-2UxaUyRiTV89j821IfAzNv" '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 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
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 onRect
0 1 0 1Rect
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 aGlyphShape
.TextData
: A list of Text,Point tuples representing text centered at aPoint
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 |
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 |
Instances
pattern TextChart :: Style -> [(Text, Point Double)] -> Chart Source #
pattern of a Chart with TextData
pattern LineChart1 :: Style -> [Point Double] -> Chart Source #
pattern of a Chart with a singleton LineData
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.
tree' :: Iso' ChartTree (Tree (Maybe Text, [Chart])) Source #
Lens between ChartTree and the underlying Tree representation
named :: Text -> [Chart] -> ChartTree Source #
Convert a chart list to a tree, adding a specific text label.
data Orientation Source #
Verticle or Horizontal
Instances
Generic Orientation Source # | |
Defined in Chart.Primitive Associated Types type Rep Orientation :: Type -> Type # | |
Show Orientation Source # | |
Defined in Chart.Primitive Methods showsPrec :: Int -> Orientation -> ShowS # show :: Orientation -> String # showList :: [Orientation] -> ShowS # | |
Eq Orientation Source # | |
Defined in Chart.Primitive | |
type Rep Orientation Source # | |
Whether to stack chart data
Constructors
Stacked | |
NonStacked |
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
Generic ChartAspect Source # | |
Defined in Chart.Primitive Associated Types type Rep ChartAspect :: Type -> Type # | |
Show ChartAspect Source # | |
Defined in Chart.Primitive Methods showsPrec :: Int -> ChartAspect -> ShowS # show :: ChartAspect -> String # showList :: [ChartAspect] -> ShowS # | |
Eq ChartAspect Source # | |
Defined in Chart.Primitive | |
type Rep ChartAspect Source # | |
Defined in Chart.Primitive type Rep ChartAspect = D1 ('MetaData "ChartAspect" "Chart.Primitive" "chart-svg-0.8.0.3-2UxaUyRiTV89j821IfAzNv" '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, textAnchor = 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.
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 :: Align -> Double -> [ChartTree] -> ChartTree Source #
Vertically stack a list of trees (proceeding upwards), at the supplied Align and with the supplied gap intercalated.
hori :: Align -> Double -> [ChartTree] -> ChartTree Source #
Horizontally stack a list of trees (proceeding to the right), at the supplied Align and with the supplied gap intercalated.
stack :: Int -> Align -> Align -> 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)
besideChart :: Place -> Double -> Double -> Rect Double -> ChartTree -> ChartTree Source #
Place a ChartTree beside a Rect
.
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, textAnchor = 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).
Relative position
Aligning stacked things.
Constructors
NoAlign | |
AlignRight | |
AlignLeft | |
AlignMid |
Instances
Generic Align Source # | |
Show Align Source # | |
Eq Align Source # | |
type Rep Align Source # | |
Defined in Chart.Style type Rep Align = D1 ('MetaData "Align" "Chart.Style" "chart-svg-0.8.0.3-2UxaUyRiTV89j821IfAzNv" 'False) ((C1 ('MetaCons "NoAlign" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "AlignRight" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "AlignLeft" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "AlignMid" 'PrefixI 'False) (U1 :: Type -> Type))) |
Rectangular placement
Constructors
PlaceLeft | |
PlaceRight | |
PlaceTop | |
PlaceBottom | |
PlaceAbsolute (Point Double) |
Instances
Generic Place Source # | |
Show Place Source # | |
Eq Place Source # | |
type Rep Place Source # | |
Defined in Chart.Primitive type Rep Place = D1 ('MetaData "Place" "Chart.Primitive" "chart-svg-0.8.0.3-2UxaUyRiTV89j821IfAzNv" 'False) ((C1 ('MetaCons "PlaceLeft" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PlaceRight" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PlaceTop" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "PlaceBottom" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PlaceAbsolute" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Point Double)))))) |
flipPlace :: Place -> Place Source #
Flip Place to the opposite side, or negate if PlaceAbsolute
.
>>>
flipPlace PlaceLeft
PlaceRight
beside :: Place -> Double -> Double -> Rect Double -> Rect Double -> Point Double Source #
Point that moves a Rect
in relation to another Rect
above and centered >>> beside PlaceTop 0 0.01 one half Point 0.0 0.76
above and right-aligned >>> beside PlaceTop 0.5 0.01 one half Point 0.25 0.76
left and with tops inline >>> beside PlaceLeft (-0.5) 0 one half Point (-0.75) 0.25
left and with bottoms aligned >>> beside PlaceLeft 0.5 0 one half Point (-0.75) (-0.25)