Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
A hud stands for head-up display, and is a collective noun used to name chart elements that assist in data interpretation or otherwise annotate and decorate data.
This includes axes, titles, borders, frames, background canvaii, tick marks and tick value labels.
Synopsis
- data Hud = Hud {}
- newtype Priority = Priority {}
- defaultPriority :: Priority
- type HudBox = Rect Double
- type CanvasBox = Rect Double
- type DataBox = Rect Double
- data HudChart = HudChart {}
- canvasBox' :: Lens' HudChart (Maybe CanvasBox)
- canvasStyleBox' :: Getter HudChart (Maybe CanvasBox)
- hudBox' :: Lens' HudChart (Maybe HudBox)
- hudStyleBox' :: Getter HudChart (Maybe HudBox)
- runHudWith :: CanvasBox -> DataBox -> [Hud] -> ChartTree -> ChartTree
- runHud :: CanvasBox -> [Hud] -> ChartTree -> ChartTree
- data HudOptions = HudOptions {
- chartAspect :: ChartAspect
- axes :: [(Priority, AxisOptions)]
- frames :: [(Priority, FrameOptions)]
- legends :: [(Priority, LegendOptions)]
- titles :: [(Priority, Title)]
- defaultHudOptions :: HudOptions
- addHud :: HudOptions -> ChartTree -> ChartTree
- initialCanvas :: ChartAspect -> ChartTree -> Rect Double
- colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions
- toHuds :: HudOptions -> DataBox -> ([Hud], DataBox)
- closes :: Traversable f => f (State HudChart ChartTree) -> State HudChart ()
- fromEffect :: Priority -> State HudChart () -> Hud
- applyChartAspect :: ChartAspect -> State HudChart ()
- getHudBox :: ChartAspect -> HudChart -> Maybe HudBox
- data AxisOptions = AxisOptions {}
- defaultAxisOptions :: AxisOptions
- flipAxis :: AxisOptions -> AxisOptions
- data FrameOptions = FrameOptions {}
- defaultFrameOptions :: FrameOptions
- data Place
- placeText :: Place -> Text
- data AxisBar = AxisBar {}
- defaultAxisBar :: AxisBar
- data Title = Title {}
- defaultTitle :: Text -> Title
- data Ticks = Ticks {}
- defaultGlyphTick :: GlyphStyle
- defaultTextTick :: TextStyle
- defaultLineTick :: LineStyle
- defaultTicks :: Ticks
- data TickStyle
- = TickNone
- | TickLabels [Text]
- | TickRound FormatN Int TickExtend
- | TickExact FormatN Int
- | TickPlaced [(Double, Text)]
- defaultTickStyle :: TickStyle
- tickStyleText :: TickStyle -> Text
- data TickExtend
- adjustTicks :: Adjustments -> HudBox -> DataBox -> Place -> Ticks -> Ticks
- data Adjustments = Adjustments {
- maxXRatio :: Double
- maxYRatio :: Double
- angledRatio :: Double
- allowDiagonal :: Bool
- defaultAdjustments :: Adjustments
- data LegendOptions = LegendOptions {}
- defaultLegendOptions :: LegendOptions
- frameHud :: FrameOptions -> State HudChart ChartTree
- legend :: LegendOptions -> State HudChart ChartTree
- legendHud :: LegendOptions -> ChartTree -> State HudChart ChartTree
- legendFrame :: LegendOptions -> ChartTree -> ChartTree
Hud
Heads-up display additions to charts
A Hud is composed of:
- A priority for the hud element in the chart folding process.
- A chart tree with a state dependency on the chart being created.
Instances
Generic Hud Source # | |
type Rep Hud Source # | |
Defined in Chart.Hud type Rep Hud = D1 ('MetaData "Hud" "Chart.Hud" "chart-svg-0.4.1.1-IWqM7MKR0pA4JJOsSfAD0k" 'False) (C1 ('MetaCons "Hud" 'PrefixI 'True) (S1 ('MetaSel ('Just "priority") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Priority) :*: S1 ('MetaSel ('Just "hud") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (State HudChart ChartTree)))) |
The priority of a Hud element or transformation, lower value means higher priority.
Lower priority (higher values) huds will tend to be placed on the outside of a chart.
Hud elements are rendered in order from high to low priority and the positioning of hud elements can depend on the positioning of elements that have already been included. Equal priority values will be placed in the same process step.
The first example below, based in lineExample
but with the legend placed on the right and coloured frames to help accentuate effects, includes (in order of priority):
- an inner frame, representing the core data area of the chart (Priority 1)
- the axes (defaultPriority (5))
- the titles (Priority 12)
- the legend (Priority 50)
- an outer frame which is transparent and used to pad out the chart (Priority 100).
priorityv1Example = lineExample & (#hudOptions % #frames) .~ [(1, FrameOptions (Just defaultRectStyle) 0), (100, FrameOptions (Just (defaultRectStyle & #color .~ (palette1 4 & opac' .~ 0.05) & #borderColor .~ palette1 4)) 0.1)] & #hudOptions % #legends %~ fmap (first (const (Priority 50))) & #hudOptions % #legends %~ fmap (second (set #place PlaceRight))
The second variation below drops the title priorities to below the legend:
priorityv2Example = priorityv1Example & #hudOptions % #titles %~ fmap (first (const (Priority 51)))
defaultPriority :: Priority Source #
An arbitrary 5.0
>>>
defaultPriority
Priority {priority = 5.0}
type HudBox = Rect Double Source #
A type for Rect to represent the entire bounding box of a chart, including the Hud
type CanvasBox = Rect Double Source #
A type for Rect to represent the bounding box of the canvas portion of a chart, excluding Hud elements
type DataBox = Rect Double Source #
A type for Rect to represent the bounding box of the data elements a chart, which can be a different metric to Canvas and Hud Rects
Type to track the split of Chart elements into Hud and Canvas
- charts: charts that form the canvas or data elements of the chart; the rectangular dimension which is considered to be the data representation space.
- hud: charts that form the Hud.
- dataBox: The bounding box of the underlying data domain.
This is done to support functionality where we can choose whether to normalise the chart aspect based on the entire chart (FixedAspect) or on just the data visualisation space (CanvasAspect).
Instances
Generic HudChart Source # | |
Show HudChart Source # | |
Eq HudChart Source # | |
type Rep HudChart Source # | |
Defined in Chart.Hud type Rep HudChart = D1 ('MetaData "HudChart" "Chart.Hud" "chart-svg-0.4.1.1-IWqM7MKR0pA4JJOsSfAD0k" 'False) (C1 ('MetaCons "HudChart" 'PrefixI 'True) (S1 ('MetaSel ('Just "chart") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ChartTree) :*: (S1 ('MetaSel ('Just "hud") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ChartTree) :*: S1 ('MetaSel ('Just "dataBox") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DataBox)))) |
canvasBox' :: Lens' HudChart (Maybe CanvasBox) Source #
A lens between a HudChart and the bounding box of the canvas
canvasStyleBox' :: Getter HudChart (Maybe CanvasBox) Source #
A lens between a HudChart and the bounding box of the canvas, including style extensions.
hudBox' :: Lens' HudChart (Maybe HudBox) Source #
lens between a HudChart and its hud bounding box, not including style.
hudStyleBox' :: Getter HudChart (Maybe HudBox) Source #
a lens between a HudChart and the bounding box of the hud.
Hud Processing
:: CanvasBox | initial canvas |
-> DataBox | initial data space |
-> [Hud] | huds to add |
-> ChartTree | underlying chart |
-> ChartTree | integrated chart tree |
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 (a linear type might be useful here).
:: CanvasBox | initial canvas dimension |
-> [Hud] | huds |
-> ChartTree | underlying charts |
-> ChartTree | integrated chart list |
Combine huds and charts to form a new ChartTree with a supplied initial canvas dimension.
Note that the original chart data are transformed and irrevocably forgotten by this computation.
HudOptions
data HudOptions Source #
Typical, configurable hud elements. Anything else can be hand-coded as a Hud
.
HudOptions | |
|
Instances
defaultHudOptions :: HudOptions Source #
The official hud options.
- A fixed chart aspect (width:height) of 1.5
- An x axis at the bottom and y axis at the left.
- The default tick style for each axis of an axis bar, tick glyphs (or marks), automated tick labels, and tick (or grid) lines.
- A high
Priority
(and thus inner), low-opacity frame, representing the data area of the chart. - A low priority (outer), transparent frame, providing some padding around the chart.
initialCanvas :: ChartAspect -> ChartTree -> Rect Double Source #
The initial canvas before applying Huds
>>>
initialCanvas (FixedAspect 1.5) (unnamed [RectChart defaultRectStyle [one]])
Rect -0.75 0.75 -0.5 0.5
colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions Source #
alter a colour with a function
toHuds :: HudOptions -> DataBox -> ([Hud], DataBox) Source #
Make Huds and potential data box extension; from a HudOption and an initial data box.
Hud Effects
closes :: Traversable f => f (State HudChart ChartTree) -> State HudChart () Source #
Absorb a series of state-dependent tress into state.
applyChartAspect :: ChartAspect -> State HudChart () Source #
Apply a ChartAspect
getHudBox :: ChartAspect -> HudChart -> Maybe HudBox Source #
Supply the bounding box of the HudChart given a ChartAspect.
Hud primitives
data AxisOptions Source #
axis options
Instances
defaultAxisOptions :: AxisOptions Source #
The official axis
flipAxis :: AxisOptions -> AxisOptions Source #
flip an axis from being an X dimension to a Y one or vice-versa.
data FrameOptions Source #
Options for hud frames
>>>
defaultFrameOptions
FrameOptions {frame = Just (RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 1.00 1.00 1.00 0.02}), buffer = 0.0}
Instances
Generic FrameOptions Source # | |
Defined in Chart.Hud type Rep FrameOptions :: Type -> Type # from :: FrameOptions -> Rep FrameOptions x # to :: Rep FrameOptions x -> FrameOptions # | |
Show FrameOptions Source # | |
Defined in Chart.Hud showsPrec :: Int -> FrameOptions -> ShowS # show :: FrameOptions -> String # showList :: [FrameOptions] -> ShowS # | |
Eq FrameOptions Source # | |
Defined in Chart.Hud (==) :: FrameOptions -> FrameOptions -> Bool # (/=) :: FrameOptions -> FrameOptions -> Bool # | |
type Rep FrameOptions Source # | |
Defined in Chart.Hud type Rep FrameOptions = D1 ('MetaData "FrameOptions" "Chart.Hud" "chart-svg-0.4.1.1-IWqM7MKR0pA4JJOsSfAD0k" 'False) (C1 ('MetaCons "FrameOptions" 'PrefixI 'True) (S1 ('MetaSel ('Just "frame") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe RectStyle)) :*: S1 ('MetaSel ('Just "buffer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double))) |
defaultFrameOptions :: FrameOptions Source #
The official hud frame
Placement of elements around (what is implicity but maybe shouldn't just be) a rectangular canvas
Instances
Generic Place Source # | |
Show Place Source # | |
Eq Place Source # | |
type Rep Place Source # | |
Defined in Chart.Hud type Rep Place = D1 ('MetaData "Place" "Chart.Hud" "chart-svg-0.4.1.1-IWqM7MKR0pA4JJOsSfAD0k" '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)))))) |
The bar on an axis representing the x or y plane.
>>>
defaultAxisBar
AxisBar {style = RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.05 0.05 0.05 0.40}, size = 4.0e-3, buffer = 1.0e-2, overhang = 2.0e-3}
Instances
Generic AxisBar Source # | |
Show AxisBar Source # | |
Eq AxisBar Source # | |
type Rep AxisBar Source # | |
Defined in Chart.Hud type Rep AxisBar = D1 ('MetaData "AxisBar" "Chart.Hud" "chart-svg-0.4.1.1-IWqM7MKR0pA4JJOsSfAD0k" 'False) (C1 ('MetaCons "AxisBar" 'PrefixI 'True) ((S1 ('MetaSel ('Just "style") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RectStyle) :*: S1 ('MetaSel ('Just "size") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)) :*: (S1 ('MetaSel ('Just "buffer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double) :*: S1 ('MetaSel ('Just "overhang") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)))) |
defaultAxisBar :: AxisBar Source #
The official axis bar
Options for titles. Defaults to center aligned, and placed at Top of the hud
>>>
defaultTitle "title"
Title {text = "title", style = TextStyle {size = 0.12, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.45, vsize = 1.1, vshift = -0.25, rotation = Nothing, scalex = ScaleX, frame = Nothing}, place = PlaceTop, anchor = AnchorMiddle, buffer = 4.0e-2}
Instances
Generic Title Source # | |
Show Title Source # | |
Eq Title Source # | |
type Rep Title Source # | |
Defined in Chart.Hud type Rep Title = D1 ('MetaData "Title" "Chart.Hud" "chart-svg-0.4.1.1-IWqM7MKR0pA4JJOsSfAD0k" 'False) (C1 ('MetaCons "Title" 'PrefixI 'True) ((S1 ('MetaSel ('Just "text") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "style") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TextStyle)) :*: (S1 ('MetaSel ('Just "place") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Place) :*: (S1 ('MetaSel ('Just "anchor") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Anchor) :*: S1 ('MetaSel ('Just "buffer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double))))) |
defaultTitle :: Text -> Title Source #
The official hud title
xy coordinate markings
>>>
defaultTicks
Ticks {style = TickRound (FormatN {fstyle = FSCommaPrec, sigFigs = Just 1, maxDistinguishIterations = 4, addLPad = True, cutRightZeros = True}) 8 TickExtend, gtick = Just (GlyphStyle {size = 3.0e-2, color = Colour 0.05 0.05 0.05 0.40, borderColor = Colour 0.05 0.05 0.05 0.40, borderSize = 4.0e-3, shape = VLineGlyph, rotation = Nothing, translate = Nothing},3.0e-2), ttick = Just (TextStyle {size = 5.0e-2, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.45, vsize = 1.1, vshift = -0.25, rotation = Nothing, scalex = ScaleX, frame = Nothing},3.3e-2), ltick = Just (LineStyle {size = 5.0e-3, color = Colour 0.05 0.05 0.05 0.05, linecap = Nothing, linejoin = Nothing, dasharray = Nothing, dashoffset = Nothing},0.0)}
Instances
Generic Ticks Source # | |
Show Ticks Source # | |
Eq Ticks Source # | |
type Rep Ticks Source # | |
Defined in Chart.Hud type Rep Ticks = D1 ('MetaData "Ticks" "Chart.Hud" "chart-svg-0.4.1.1-IWqM7MKR0pA4JJOsSfAD0k" 'False) (C1 ('MetaCons "Ticks" 'PrefixI 'True) ((S1 ('MetaSel ('Just "style") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TickStyle) :*: S1 ('MetaSel ('Just "gtick") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (GlyphStyle, Double)))) :*: (S1 ('MetaSel ('Just "ttick") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (TextStyle, Double))) :*: S1 ('MetaSel ('Just "ltick") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (LineStyle, Double)))))) |
defaultGlyphTick :: GlyphStyle Source #
The official glyph tick
defaultTextTick :: TextStyle Source #
The official text tick
defaultLineTick :: LineStyle Source #
The official line tick
defaultTicks :: Ticks Source #
The official tick
Style of tick marks on an axis.
TickNone | no ticks on axis |
TickLabels [Text] | specific labels (equidistant placement) |
TickRound FormatN Int TickExtend | sensibly rounded ticks, a guide to how many, and whether to extend beyond the data bounding box |
TickExact FormatN Int | exactly n equally spaced ticks |
TickPlaced [(Double, Text)] | specific labels and placement |
Instances
defaultTickStyle :: TickStyle Source #
The official tick style
>>>
defaultTickStyle
TickRound (FormatN {fstyle = FSCommaPrec, sigFigs = Just 1, maxDistinguishIterations = 4, addLPad = True, cutRightZeros = True}) 8 TickExtend
tickStyleText :: TickStyle -> Text Source #
textifier
data TickExtend Source #
Whether Ticks are allowed to extend the data range
Instances
Generic TickExtend Source # | |
Defined in Chart.Hud type Rep TickExtend :: Type -> Type # from :: TickExtend -> Rep TickExtend x # to :: Rep TickExtend x -> TickExtend # | |
Show TickExtend Source # | |
Defined in Chart.Hud showsPrec :: Int -> TickExtend -> ShowS # show :: TickExtend -> String # showList :: [TickExtend] -> ShowS # | |
Eq TickExtend Source # | |
Defined in Chart.Hud (==) :: TickExtend -> TickExtend -> Bool # (/=) :: TickExtend -> TickExtend -> Bool # | |
type Rep TickExtend Source # | |
adjustTicks :: Adjustments -> HudBox -> DataBox -> Place -> Ticks -> Ticks Source #
adjust Tick for sane font sizes etc
data Adjustments Source #
options for prettifying axis decorations
>>>
defaultAdjustments
Adjustments {maxXRatio = 8.0e-2, maxYRatio = 6.0e-2, angledRatio = 0.12, allowDiagonal = True}
Adjustments | |
|
Instances
defaultAdjustments :: Adjustments Source #
The official hud adjustments.
data LegendOptions Source #
Legend options
>>>
defaultLegendOptions
LegendOptions {size = 0.3, buffer = 0.1, vgap = 0.2, hgap = 0.1, textStyle = TextStyle {size = 0.18, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.45, vsize = 1.1, vshift = -0.25, rotation = Nothing, scalex = ScaleX, frame = Nothing}, innerPad = 0.1, outerPad = 2.0e-2, frame = Just (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.05 0.05 0.05 1.00, color = Colour 0.05 0.05 0.05 0.00}), place = PlaceRight, overallScale = 0.25, content = []}
Instances
defaultLegendOptions :: LegendOptions Source #
The official legend options
Option to Hud
legend :: LegendOptions -> State HudChart ChartTree Source #
Make a legend from LegendOptions
legendHud :: LegendOptions -> ChartTree -> State HudChart ChartTree Source #
Make a legend hud element, from a bespoke ChartTree.
legendFrame :: LegendOptions -> ChartTree -> ChartTree Source #
frame a legend