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
- newtype Hud = Hud {}
- data Priority a = Priority {}
- type ChartBox = Rect Double
- type DataBox = Rect Double
- data HudChart = HudChart {}
- data HudChartSection
- hudChartBox' :: HudChartSection -> Getter HudChart (Maybe (Rect Double))
- data HudOptions = HudOptions {
- axes :: [Priority AxisOptions]
- frames :: [Priority FrameOptions]
- legends :: [Priority LegendOptions]
- titles :: [Priority TitleOptions]
- defaultHudOptions :: HudOptions
- colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions
- toHuds :: HudOptions -> DataBox -> (Maybe DataBox, [Hud])
- appendHud :: ChartTree -> HudChart -> HudChart
- makeHuds :: [HudChart -> ChartTree] -> HudChart -> HudChart
- fromHudChart :: HudChart -> ChartTree
- runHudWith :: ChartBox -> [Hud] -> ChartTree -> ChartTree
- projectChartTreeWith :: ChartAspect -> HudOptions -> ChartTree -> ChartTree
- addHud :: ChartAspect -> HudOptions -> ChartTree -> ChartTree
- initialCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double
- finalCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double
- data AxisOptions = AxisOptions {
- axisBar :: Maybe AxisBar
- adjustments :: Maybe Adjustments
- ticks :: Ticks
- place :: Place
- defaultXAxisOptions :: AxisOptions
- defaultYAxisOptions :: AxisOptions
- data FrameOptions = FrameOptions {}
- defaultFrameOptions :: FrameOptions
- data Place
- flipPlace :: Place -> Place
- data AxisBar = AxisBar {}
- defaultAxisBar :: AxisBar
- data TitleOptions = TitleOptions {}
- defaultTitleOptions :: Text -> TitleOptions
- data Ticks = Ticks {}
- data TickStyle = TickStyle {}
- defaultGlyphTickStyleX :: TickStyle
- defaultGlyphTickStyleY :: TickStyle
- defaultTextTick :: TickStyle
- defaultLineTick :: TickStyle
- defaultXTicks :: Ticks
- defaultYTicks :: Ticks
- data Tick
- = TickNone
- | TickLabels [Text]
- | TickRound FormatN Int TickExtend
- | TickExact FormatN Int
- | TickPlaced [(Double, Text)]
- defaultTick :: Tick
- data TickExtend
- formatN' :: Lens' Tick (Maybe FormatN)
- numTicks' :: Lens' Tick (Maybe Int)
- tickExtend' :: Lens' Tick (Maybe TickExtend)
- adjustTicks :: Adjustments -> ChartBox -> DataBox -> Place -> Ticks -> Ticks
- data Adjustments = Adjustments {
- maxXRatio :: Double
- maxYRatio :: Double
- angledRatio :: Double
- allowDiagonal :: Bool
- defaultAdjustments :: Adjustments
- data LegendOptions = LegendOptions {}
- defaultLegendOptions :: LegendOptions
- axisHud :: AxisOptions -> DataBox -> HudChart -> ChartTree
- titleHud :: TitleOptions -> HudChart -> ChartTree
- frameHud :: FrameOptions -> HudChart -> ChartTree
- legendHud :: LegendOptions -> HudChart -> ChartTree
Hud
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 (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)] & over (#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)))
Instances
Functor Priority Source # | |
Generic (Priority a) Source # | |
Show a => Show (Priority a) Source # | |
Eq a => Eq (Priority a) Source # | |
Ord a => Ord (Priority a) Source # | |
type Rep (Priority a) Source # | |
Defined in Chart.Hud type Rep (Priority a) = D1 ('MetaData "Priority" "Chart.Hud" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "Priority" 'PrefixI 'True) (S1 ('MetaSel ('Just "priority") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double) :*: S1 ('MetaSel ('Just "item") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))) |
Named pair 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.
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.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "HudChart" 'PrefixI 'True) (S1 ('MetaSel ('Just "chartSection") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ChartTree) :*: S1 ('MetaSel ('Just "hudSection") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ChartTree))) |
data HudChartSection Source #
A section of a HudChart
CanvasSection | The canvas without any style allowances |
CanvasStyleSection | The canvas portion including style boundaries. |
HudSection | The hud and canvas sections, not including style. |
HudStyleSection | The hud and canvas sections, including style |
Instances
Generic HudChartSection Source # | |
Defined in Chart.Hud type Rep HudChartSection :: Type -> Type # from :: HudChartSection -> Rep HudChartSection x # to :: Rep HudChartSection x -> HudChartSection # | |
Show HudChartSection Source # | |
Defined in Chart.Hud showsPrec :: Int -> HudChartSection -> ShowS # show :: HudChartSection -> String # showList :: [HudChartSection] -> ShowS # | |
Eq HudChartSection Source # | |
Defined in Chart.Hud (==) :: HudChartSection -> HudChartSection -> Bool # (/=) :: HudChartSection -> HudChartSection -> Bool # | |
type Rep HudChartSection Source # | |
Defined in Chart.Hud type Rep HudChartSection = D1 ('MetaData "HudChartSection" "Chart.Hud" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) ((C1 ('MetaCons "CanvasSection" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CanvasStyleSection" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "HudSection" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "HudStyleSection" 'PrefixI 'False) (U1 :: Type -> Type))) |
hudChartBox' :: HudChartSection -> Getter HudChart (Maybe (Rect Double)) Source #
The Rect
of a particular HudChartSection
of a HudChart
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.
colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions Source #
alter a colour with a function
Hud Processing
toHuds :: HudOptions -> DataBox -> (Maybe DataBox, [Hud]) Source #
Make Huds and potential data box extension; from a HudOption and an initial data box.
makeHuds :: [HudChart -> ChartTree] -> HudChart -> HudChart Source #
Add huds to the hud section of a HudChart
, given a list of hud makers.
fromHudChart :: HudChart -> ChartTree Source #
:: ChartBox | initial canvas |
-> [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).
projectChartTreeWith :: ChartAspect -> HudOptions -> ChartTree -> ChartTree Source #
Add HudOptions
to a ChartTree
and scale to the ChartAspect
.
addHud :: ChartAspect -> HudOptions -> ChartTree -> ChartTree Source #
Decorate a ChartTree with HudOptions
initialCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double Source #
Compute a Rect representing the initial chart canvas from a ChartAspect
and maybe a ChartTree
, before the addition of style and hud elements.
>>>
initialCanvas (FixedAspect 1.5) (Just $ unnamed [RectChart defaultRectStyle [one]])
Rect (-0.75) 0.75 (-0.5) 0.5
finalCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double Source #
Compute a Rect representing the final chart canvas from a ChartAspect
and maybe a ChartTree
. The difference between initialCanvas
and finalCanvas is using the actual chart canvas for CanvasAspect.
>>>
finalCanvas (CanvasAspect 1.5) (Just $ unnamed [RectChart defaultRectStyle [one]])
Rect (-0.5) 0.5 (-0.5) 0.5
Hud options
data AxisOptions Source #
axis options
AxisOptions | |
|
Instances
defaultXAxisOptions :: AxisOptions Source #
The official X-axis
defaultYAxisOptions :: AxisOptions Source #
The official Y-axis
data FrameOptions Source #
Options for hud frames
>>>
defaultFrameOptions
FrameOptions {frame = Just (Style {size = 6.0e-2, borderSize = 0.0, color = Colour 1.00 1.00 1.00 0.02, borderColor = Colour 0.00 0.00 0.00 0.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}), anchorTo = HudStyleSection, buffer = 0.0}
Instances
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.6.0.0-HjsGv1l8hv76XDZORokPY6" '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 unchanged if PlaceAbsolute
.
>>>
flipPlace PlaceLeft
PlaceRight
The bar on an axis representing the x or y plane.
>>>
defaultAxisBar
AxisBar {style = Style {size = 6.0e-2, borderSize = 0.0, color = Colour 0.05 0.05 0.05 0.40, borderColor = Colour 0.00 0.00 0.00 0.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}, size = 4.0e-3, buffer = 1.0e-2, overhang = 2.0e-3, anchorTo = CanvasSection}
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.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "AxisBar" 'PrefixI 'True) ((S1 ('MetaSel ('Just "style") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Style) :*: 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) :*: S1 ('MetaSel ('Just "anchorTo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HudChartSection))))) |
defaultAxisBar :: AxisBar Source #
The official axis bar
data TitleOptions Source #
Options for titles. Defaults to center aligned, and placed at Top of the hud
>>>
defaultTitleOptions "title"
TitleOptions {text = "title", style = Style {size = 0.12, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, 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}, place = PlaceTop, anchor = AnchorMiddle, buffer = 4.0e-2}
Instances
defaultTitleOptions :: Text -> TitleOptions Source #
The official hud title
axis tick markings
>>>
defaultXTicks
Ticks {tick = TickRound (FormatN {fstyle = FSCommaPrec, sigFigs = Just 1, maxDistinguishIterations = 4, addLPad = True, cutRightZeros = True}) 5 TickExtend, glyphTick = Just (TickStyle {style = Style {size = 3.0e-2, borderSize = 4.0e-3, color = Colour 0.05 0.05 0.05 0.40, borderColor = Colour 0.05 0.05 0.05 0.40, scaleP = ScalePY, 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 = VLineGlyph}, anchorTo = CanvasSection, buffer = 1.0e-2}), textTick = Just (TickStyle {style = Style {size = 4.0e-2, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, 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}, anchorTo = HudStyleSection, buffer = 1.0e-2}), lineTick = Just (TickStyle {style = Style {size = 5.0e-3, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 0.05, 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}, anchorTo = CanvasSection, buffer = 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.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "Ticks" 'PrefixI 'True) ((S1 ('MetaSel ('Just "tick") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Tick) :*: S1 ('MetaSel ('Just "glyphTick") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TickStyle))) :*: (S1 ('MetaSel ('Just "textTick") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TickStyle)) :*: S1 ('MetaSel ('Just "lineTick") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TickStyle))))) |
Common elements across all tick types.
Instances
Generic TickStyle Source # | |
Show TickStyle Source # | |
Eq TickStyle Source # | |
type Rep TickStyle Source # | |
Defined in Chart.Hud type Rep TickStyle = D1 ('MetaData "TickStyle" "Chart.Hud" "chart-svg-0.6.0.0-HjsGv1l8hv76XDZORokPY6" 'False) (C1 ('MetaCons "TickStyle" 'PrefixI 'True) (S1 ('MetaSel ('Just "style") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Style) :*: (S1 ('MetaSel ('Just "anchorTo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HudChartSection) :*: S1 ('MetaSel ('Just "buffer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)))) |
defaultGlyphTickStyleX :: TickStyle Source #
The official glyph tick
defaultGlyphTickStyleY :: TickStyle Source #
The official glyph tick
defaultTextTick :: TickStyle Source #
The official text tick
defaultLineTick :: TickStyle Source #
The official line tick
defaultXTicks :: Ticks Source #
The official X-axis tick
defaultYTicks :: Ticks Source #
The official Y-axis 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
defaultTick :: Tick Source #
The official tick style
>>>
defaultTick
TickRound (FormatN {fstyle = FSCommaPrec, sigFigs = Just 1, maxDistinguishIterations = 4, addLPad = True, cutRightZeros = True}) 5 TickExtend
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 # | |
numTicks' :: Lens' Tick (Maybe Int) Source #
Lens between number of ticks and a Tick.
Only for TickRound and TickExact
tickExtend' :: Lens' Tick (Maybe TickExtend) Source #
Lens between a FormatN and a Tick.
adjustTicks :: Adjustments -> ChartBox -> 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 {legendSize = 0.3, buffer = 0.1, vgap = 0.2, hgap = 0.1, textStyle = Style {size = 0.16, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, 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}, innerPad = 0.1, outerPad = 2.0e-2, frame = Just (Style {size = 6.0e-2, borderSize = 5.0e-3, color = Colour 0.05 0.05 0.05 0.00, borderColor = Colour 0.05 0.05 0.05 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}), place = PlaceRight, scaleChartsBy = 0.25, scaleP = ScalePX, legendCharts = []}
Instances
defaultLegendOptions :: LegendOptions Source #
The official legend options
Convert Hud elements to charts
legendHud :: LegendOptions -> HudChart -> ChartTree Source #
Make a legend from LegendOptions
given an existing HudChart