Giters

tonyday567 / chart-svg-dev

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

chart-svg-dev

https://img.shields.io/hackage/v/chart-svg-dev.svg https://github.com/tonyday567/chart-svg-dev/workflows/haskell-ci/badge.svg

chart-svg-dev is a development environment for chart-svg.

Imports

:r
:set -Wno-type-defaults
:set -Wno-name-shadowing
:set -XOverloadedLabels
:set -XOverloadedStrings
:set -XTupleSections
:set -XQuasiQuotes
import Lib
import Prelude
import Control.Category ((>>>))
import Data.Function
import Data.Maybe
import Data.Bool
import Faker.Lorem
import Chart
import Prettychart
import Chart.Examples
import Optics.Core
import Data.ByteString.Char8 qualified as C
import Data.Text qualified as T
import Control.Monad
import NumHask.Prelude qualified as NH
import Data.Functor.Identity
import Data.Bifunctor
import Prettyprinter
import Text.Pretty.Simple
import MarkupParse
import DotParse
import DotParse.Examples
import Data.String.Interpolate
(display, quit) <- startChartServer (Just "chart-svg-dev")

writeAllExamples

display lineExample

co = rectExample
asp = view (#markupOptions % #chartAspect) co
csAndHud = addHud asp (view #hudOptions co) (view #chartTree co)
viewbox = finalCanvas asp (Just csAndHud)
ctFinal = set styleBox' (Just viewbox) csAndHud
view box' ctFinal
view styleBox' ctFinal
view safeBox' ctFinal
view safeStyleBox' ctFinal
padSingletons <$> view styleBox' ctFinal
viewbox

dotparse debugging

  • [ ] check examples, nh, base
  • [X] nodeSize, nodeHeight
  • [X] boxes
cfg = defaultChartConfig
exGraph = defaultGraph & addStatements (toStatements Directed (C.pack . show <$> exAGraph)) & set (attL NodeType (ID "shape")) (Just $ ID "box")
exGraphAugmented <- processGraph exGraph
exChart = graphToChartWith cfg (T.pack . label) exGraphAugmented & set (#markupOptions % #chartAspect) ChartAspect
display exChart

pPrint defaultChartConfig

pPrint exGraphAugmented

simpler example

  • [X] simpler example
  • [X] direct
:{
ex1 = [i|
digraph {
    node [height=0.5;shape=circle]
    graph [overlap=false;size="1!";splines=spline]
    edge [arrowsize=0.5]
    rankdir="TB"
    1
    2
    1 -> 2
    }
|]
:}

Graph

g1 = runDotParser ex1 :: Graph
g1

g1' <- processGraph g1
pPrint $ dotPrint defaultDotConfig g1'

c1 = graphToChartWith defaultChartConfig g1' & set (#markupOptions % #chartAspect) ChartAspect & set (#chartTree % charts' % each % #chartStyle % #scaleP) ScalePArea
display c1
pPrint c1


-- :t c1 & view #chartTree & view safeStyleBox'
c1 & forgetHud & view #chartTree & view safeStyleBox'

testAll

import Data.Proxy
testDotParser (Proxy :: Proxy Graph) defaultDotConfig ex0
testAll

nh

import DotParse.Examples.NumHask qualified as NH
g <- processGraph (NH.dotGraphNH Directed)
display $ (graphToChartWith defaultChartConfig NH.toLink g)

import DotParse.Examples.NumHask qualified as NH
g <- processGraph (NH.dotGraphNH Directed)
display $ (graphToChartWith (defaultChartConfig & set #textSize 12 & set #chartVshift (-4)) (T.pack . label) g)

toLink

import DotParse.Examples.NumHask qualified as NH
g <- processGraph (NH.dotGraphNH Directed)
cNH = graphToChartWith (defaultChartConfig & set #textSize 12 & set #vshift (-4)) NH.toLink g & over (#chartTree % charts' % each) (\c -> c & bool (set (#chartStyle % #size) 0) id (isNothing . view (#chartData % textData') $ c))
cNH' = forgetHud cNH & set (#markupOptions % #chartAspect) UnscaledAspect & over (#chartTree % charts' % each) (\c -> c & bool (set (#chartStyle % #size) 0.03) id (isNothing . view (#chartData % textData') $ c))
display cNH'

import DotParse.Examples.NumHask qualified as NH
g <- processGraph (NH.dotGraphNH Directed)
cNH = graphToChartWith (defaultChartConfig & set #textSize 12 & set #chartVshift (-4)) NH.toLinkNH g & set (#markupOptions % #chartAspect) ChartAspect
display cNH

cNH deconstruction

ss = cNH & toListOf (#chartTree % charts' % each) & fmap sbox
l = cNH & toListOf (#chartTree % charts' % each)
z = reverse l & drop 1
view styleBox' (unnamed z)
sbox <$> take 1 z
take 1 z

pPrint cNH

AST

import DotParse.Examples.AST
gAST = dotAST allSC componentEdges
C.writeFile "other/ast.dot" $ dotPrint defaultDotConfig gAST
bsSvg <- processDotWith Directed ["-Tsvg"] (dotPrint defaultDotConfig gAST)
C.writeFile "other/ast.svg" bsSvg

chartSocketPage

showRGB light

pPrint $ chartSocketPage (Just "test")

v06 Changes

Chart.Compound

Chart.Bar

barTextCharts textShiftVert

Chart.Hud

  • defaultPriority
  • HudBox
  • CanvasBox
  • ChartBox
  • canvasBox’
  • canvasStyleBox’
  • hudBox’
  • hudStyleBox’
  • runHud
  • HudChartSection
  • hudChartBox’
  • closes
  • fromEffect
  • applyChartAspect
  • getHudBox
  • appendHud
  • makeHuds
  • projectChartTreeWith
  • addHud
  • finalCanvas
  • defaultAxisOptions
  • defaultXAxisOptions
  • defaultYAxisOptions
  • placeText
  • flipPlace

Title ==> TitleOptions

  • defaultGlyphTick
  • defaultGlyphTickStyleX
  • defaultGlyphTickStyleY
  • defaultTicks
  • defaultXTicks
  • defaultTick

TickStyle ==> Tick

formatN’ numTicks’ tickExtend’

  • axisHud
  • titleHud
  • legend
  • legendFrame
  • freezeAxes
  • freezeTicks

Priority refactor Hud refactor

Chart.Markup

  • forgetHud

CssPreferColorScheme ==> PreferColorScheme CssShapeRendering ==> ShapeRendering

  • defaultCssFontFamilies

Primitive

  • ChartData (..),
  • rectData’,
  • lineData’,
  • glyphData’,
  • textData’,
  • pathData’,
  • blankData’,
  • pattern RectChart,
  • pattern LineChart,
  • pattern GlyphChart,
  • pattern TextChart,
  • pattern PathChart,
  • pattern BlankChart,
  • pattern LineChart1,
  • scaleP
  • projectChartDataWith
  • scaleStyle,
  • colourChart,
  • scaleChartData,
  • colourStyle
  • safeBox’
  • safeStyleBox’
  • overText
  • blankChart

Chart.Style

  • Style (..),
  • defaultStyle,
  • scaleStyle,

gpalette <== gpalette1

  • ScaleP
  • scaleRatio

Data.Colour

palette <== palette1 paletteO <== palette1a

Chart.Surface

  • surfaceLegendChart,
  • surfaceAxisOptions,
  • surfaceLegendAxisOptions,
  • gridReferenceChart,
  • addSurfaceLegend,

Chart.Data

  • singletonGuard
  • isSingleton

axis –> axisHud title –> titleHud legend –> legendHud

example problems

pathExample

display $ pathExample & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #anchorTo) CanvasStyleSection & set (#hudOptions % #axes % each % #item % #bar %? #anchorTo) CanvasStyleSection


ps = [ StartP (Point 0 0), LineP (Point 1 0), CubicP (Point 0.2 0) (Point 0.25 1) (Point 1 1), QuadP (Point (-1) 2) (Point 0 1), ArcP (ArcInfo (Point 1 1) (-pi / 6) False False) (Point 0 0)]
ts = [ "StartP (Point 0 0)", "LineP (Point 1 0)", "CubicP (Point 0.2 0) (Point 0.25 1) (Point 1 1)", "QuadP (Point (-1) 2) (Point 0 1)", "ArcP (ArcInfo (Point 1 1) (-pi / 6) False False) (Point 0 0)"]
path' = PathChart (defaultPathStyle & #color .~ palette1a 0 0.05 & #borderColor .~ palette1a 1 0.3) ps
c0 = GlyphChart defaultGlyphStyle ((SquareGlyph,) . pointPath <$> ps)
midp = Point 0 0 : zipWith (\(Point x y) (Point x' y') -> Point ((x + x') / 2) ((y + y') / 2)) (drop 1 (pointPath <$> ps)) (pointPath <$> ps)
offp = [Point (-0.35) 0.05, Point 0 0.05, Point (-0.2) 0, Point (-0.1) 0.1, Point 0 (-0.1)]
t0 = TextChart (defaultTextStyle & set #size 0.025) (zip ts (zipWith addp offp midp))
display $ mempty & #charts .~ named "path" [path', c0] <> named "pathtext" [t0] & #hudOptions .~ defaultHudOptions & #markupOptions % #chartAspect .~ ChartAspect & #markupOptions % #cssOptions % #preferColorScheme .~ PreferHud & #markupOptions % #cssOptions % #cssExtra .~ fillSwitch (dark, light) "dark" "pathtext"

lineExample

co = lineExample & set (#hudOptions % #legends % each % _2 % #size) 0.2 & set (#hudOptions % #legends % each % _2 % #frame) (Just defaultRectStyle) & set (#hudOptions % #legends % each % _2 % #vgap) 0 & set (#hudOptions % #legends % each % _2 % #outerPad) 0 & set (#hudOptions % #legends % each % _2 % #innerPad) 0 & set (#hudOptions % #legends % each % _2 % #textStyle % #frame) (Just defaultRectStyle) & set (#hudOptions % #legends % each % _2 % #overallScale) 0.5 & set (#hudOptions % #legends % each % _2 % #scaleP) ScalePX
writeChartOptions "other/line.svg" co
display co

frame bug

  • [X] add scaleP for legendoptions

lineExample legend with zero gaps and padding highlights that:

  • charts scale independently in the X and Y dimensions
  • chart styles scale proportionately.

Thus legends have to choose to compromise by adopting X, Y, Area or MinDim

lo0 = defaultLegendOptions & set (#textStyle % #frame) (Just defaultRectStyle) & set #vgap 0 & set #hgap 0 & set #outerPad 0 & set #innerPad 0 & set #overallScale 0.2 & set #size 0.3 & set #legendCharts (take 3 $ fromMaybe undefined $ preview (#hudOptions % #legends % ix 0 % _2 % #legendCharts) lineExample) & set #buffer 0

-- manual construction
cs = legendChart lo0
view styleBox' cs

c0 = unnamed [RectChart defaultRectStyle [one]]
cs'' = cs & over (charts' % each) (scaleChart 0.3)
cs''' = placeLegend lo0 one cs'' & set (charts' % each % #style % #scaleP) ScalePX
view styleBox' $ set styleBox' (Just one) (c0 <> cs''')

-- automated construction via HudOptions
display $ (mempty :: ChartOptions) & set #charts c0 & set (#markupOptions % #chartAspect) ChartAspect & set #hudOptions (mempty & set #legends [(100,lo0 & set #scaleP ScalePArea)]) -- defaultHudOptions

large text bug

  • State “Done” from “Next” [2023-11-30 Thu 10:59]

Manual construction and placement for a legend, using ScalePX.

A slight space opens up between the horizontal elements.

lo0 = defaultLegendOptions & set (#textStyle % #frame) (Just defaultRectStyle) & set (#textStyle % #size) 0.16 & set #vgap 0 & set #hgap 0 & set #outerPad 0 & set #innerPad 0 & set #overallScale 0.2 & set #size 0.2 & set #legendCharts (take 3 $ fromMaybe undefined $ preview (#hudOptions % #legends % ix 0 % _2 % #legendCharts) lineExample) & set #buffer 0 & set #scaleP ScalePX

-- manual construction
cs = legendChart lo0 & set (charts' % each % #style % #scaleP) (view #scaleP lo0)
view styleBox' cs

c0 = unnamed [RectChart defaultRectStyle [one]]
cs'' = cs & over (charts' % each) (scaleChart 0.3)
cs''' = placeLegend lo0 one cs''
view styleBox' $ set styleBox' (Just one) (c0 <> cs''')

display $ (mempty :: ChartOptions) & set #charts (c0 <> cs''') & set (#markupOptions % #chartAspect) (FixedAspect 1) & set #hudOptions defaultHudOptions

:t legendEntry lo0 "palette #0"
:t fmap (legendizeChart lo0) <$> (toListOf (#charts % charts') lineExample)
:t view #legendCharts lo0
:t legendText lo0
l = defaultLegendOptions & set (#textStyle % #frame) (Just defaultRectStyle) & set (#textStyle % #size) 0.12 & set #vgap 0 & set #hgap 0 & set #outerPad 0 & set #innerPad 0 & set #overallScale 0.2 & set #size 0.2 & set #legendCharts (take 3 $ fromMaybe undefined $ preview (#hudOptions % #legends % ix 0 % _2 % #legendCharts) lineExample) & set #buffer 0
es = reverse $ uncurry (legendEntry l) <$> view #legendCharts l
twidth = maybe zero (\(Rect x z _ _) -> z - x) (styleBoxes (fst <$> es))
gapwidth t = maybe 0 (\(Rect x z _ _) -> z - x) (sbox t)
twidth
x1 = vert 0 $ hori 0 <$> (\(t,a) -> [unnamed [t], unnamed a]) <$> es
x2 = x1 & set (charts' % each % #style % #scaleP) ScalePArea
display $ (mempty :: ChartOptions) & set #charts x2 & set (#markupOptions % #chartAspect) ChartAspect & set #hudOptions defaultHudOptions

surface legend

display surfaceExample

scale and move basic charts

c' = [RectChart (defaultRectStyle & set #scaleP NoScaleP)  [one]]
cs = (mconcat [named "left" c', named "right" c' & over (charts' % each) (scaleChart 0.5 >>> moveChart (Point 0.8 0.25))])
display $ (mempty :: ChartOptions) & set #charts cs & set #hudOptions defaultHudOptions

scale and move legend

slc = surfaceLegendChart (Range (-0.5) 0.5) (defaultSurfaceLegendOptions dark "surface" & set (#sloLegendOptions % #vgap) 0.1 & set (#sloLegendOptions % #size) 0.6 & set (#sloLegendOptions % #hgap) 0 & set (#sloLegendOptions % #textStyle % #frame) (Just defaultRectStyle) & set (#sloAxisOptions % #ticks % #gtick) (Just (defaultGlyphTick, HLineGlyph, (-0.014))) & set (#sloAxisOptions % #ticks % #ttick) (Just (defaultTextTick, -0.005))) & set (charts' % each % #style % #scaleP) ScaleMinDim
display $ (mempty :: ChartOptions) & set #charts (mconcat [named "proxy" c', slc & set (charts' % each % #style % #scaleP) ScalePArea & over (charts' % each) (scaleChart 1 >>> moveChart (Point 0.6 (-0.3)))]) & set #hudOptions defaultHudOptions

grain = Point 100 100
r = one
f = fst . bimap ((-1.0) *) (fmap ((-1.0) *)) . rosenbrock 1 10
evenColors = trimColour . over lightness' (const 0.55) . palette1 <$> [0 .. 5]
so = defaultSurfaceOptions & #soGrain .~ grain & #soRange .~ r & #soStyle % #surfaceColors .~ evenColors
(cs, rangef) = surfacef f so
slo = defaultSurfaceLegendOptions dark "surface" & set #sloWidth 0.1 & set (#sloStyle % #surfaceColors) evenColors & set (#sloLegendOptions % #vgap) 0.1 & set (#sloLegendOptions % #size) 0.6 & set (#sloLegendOptions % #hgap) 0 & set (#sloLegendOptions % #textStyle % #frame) (Just defaultRectStyle) & set (#sloAxisOptions % #ticks % #gtick) (Just (defaultGlyphTick, HLineGlyph, (-0.014))) & set (#sloAxisOptions % #ticks % #ttick) (Just (defaultTextTick, -0.005))

slc = surfaceLegendChart rangef slo & set (charts' % each % #style % #scaleP) ScaleMinDim
-- display $ (mempty :: ChartOptions) & set #charts (mconcat [named "surface" cs, slc & set (charts' % each % #style % #scaleP) ScalePArea & over (charts' % each) (scaleChart 1 >>> moveChart (Point 0.6 (-0.3)))]) & set #hudOptions defaultHudOptions
display $ (mempty :: ChartOptions) & set #charts (mconcat [slc]) & set #hudOptions defaultHudOptions & #markupOptions .~ (defaultMarkupOptions & #cssOptions % #shapeRendering .~ UseCssCrisp)

addSurfaceLegend version

grain = Point 100 100
r = one
f = fst . bimap ((-1.0) *) (fmap ((-1.0) *)) . rosenbrock 1 10
evenColors = trimColour . over lightness' (const 0.55) . palette1 <$> [0 .. 5]
so = defaultSurfaceOptions & #soGrain .~ grain & #soRange .~ r & #soStyle % #surfaceColors .~ evenColors
(cs, rangef) = surfacef f so
slo = defaultSurfaceLegendOptions dark "surface" & set #sloWidth 0.1 & set (#sloStyle % #surfaceColors) evenColors & set (#sloLegendOptions % #vgap) 0.1 & set (#sloLegendOptions % #size) 0.6 & set (#sloLegendOptions % #hgap) 0 & set (#sloLegendOptions % #textStyle % #frame) (Just defaultRectStyle) & set (#sloAxisOptions % #ticks % #gtick) (Just (defaultGlyphTick, HLineGlyph, (-0.014))) & set (#sloAxisOptions % #ticks % #ttick) (Just (defaultTextTick, -0.005))

slc = surfaceLegendChart rangef slo & set (charts' % each % #style % #scaleP) ScaleMinDim
-- display $ (mempty :: ChartOptions) & set #charts (mconcat [named "surface" cs, slc & set (charts' % each % #style % #scaleP) ScalePArea & over (charts' % each) (scaleChart 1 >>> moveChart (Point 0.6 (-0.3)))]) & set #hudOptions defaultHudOptions
display $ (mempty :: ChartOptions) & set #charts (mconcat [slc]) & set #hudOptions defaultHudOptions & #markupOptions .~ (defaultMarkupOptions & #cssOptions % #shapeRendering .~ UseCssCrisp)
  • [ ] addHud
  • [ ] projectChartTree
  • [ ] mconcat with main chart

co version

display $ (mempty :: ChartOptions) & set #charts (gridReferenceChart rangef slo) & set #hudOptions (mempty & set #axes [(1, view #sloAxisOptions slo & set #place PlaceRight)]) & set #markupOptions (defaultMarkupOptions & set (#cssOptions % #shapeRendering) UseCssCrisp) & set (#markupOptions % #chartAspect) (FixedAspect 0.2)

charttree version

grain = Point 100 100
r = one
f = fst . bimap ((-1.0) *) (fmap ((-1.0) *)) . rosenbrock 1 10
evenColors = trimColour . over lightness' (const 0.55) . palette1 <$> [0 .. 5]
so = defaultSurfaceOptions & #soGrain .~ grain & #soRange .~ r & #soStyle % #surfaceColors .~ evenColors
(cs, rangef) = surfacef f so

slo = defaultSurfaceLegendOptions & set (#sloSurfaceStyle % #surfaceColors) evenColors
grc = gridReferenceChart rangef slo
hoLegend = (mempty :: HudOptions) & set #axes [(1, view #sloAxisOptions slo)]
grcLegend = addHud (FixedAspect (view #sloWidth slo)) hoLegend grc
ct = view #charts surfaceExample
ctbox = fromMaybe one (view styleBox' ct)
legbox = projectOnR ctbox one (view #sloRect slo)
ctBoth = mconcat [projectChartTree legbox grcLegend, ct]
display $ (mempty :: ChartOptions) & set #charts ctBoth & set #markupOptions (defaultMarkupOptions & set (#cssOptions % #shapeRendering) UseCssCrisp) & set (#markupOptions % #chartAspect) ChartAspect & set #hudOptions defaultHudOptions

addSurfaceLegend version

grain = Point 20 20
r = one
f = fst . bimap ((-1.0)
slo = defaultSurfaceLegendOptions & set (#sloSurfaceStyle % #surfaceColors) evenColors & set (#sloDataRange) rangef

cs' = addSurfaceLegend slo (unnamed cs)

display $ (mempty :: ChartOptions) & set #charts cs' & set #markupOptions (defaultMarkupOptions & set (#cssOptions % #shapeRendering) UseCssCrisp) & set (#markupOptions % #chartAspect) ChartAspect & set #hudOptions defaultHudOptions

compoundExample

display compoundExample
  • [X] try a no extend
  • [X] try a ScalePArea
  • [X] simplest decompose

original compoundExample

ts = TickRound (FormatN FSCommaPrec (Just 1) 4 True True) 5 TickExtend
tsf = set (#hudOptions % #axes % each % _2 % #ticks % #style) ts
sap = set (#charts % charts' % each % #style % #scaleP) ScalePArea
co = compoundMerge [lineExample & tsf & sap, unitExample & tsf & sap & #hudOptions % #axes %~ fmap (_2 % #place %~ flipPlace)]
display co

simple experiment

  • [X] titles ok
  • [X] noextend axes ok
  • [X] extend axes
ts = TickRound (FormatN FSCommaPrec (Just 1) 4 True True) 4 NoTickExtend
tse = TickRound (FormatN FSCommaPrec (Just 1) 4 True True) 4 TickExtend
tsf = set (#axes % each % _2 % #ticks % #style)
sap = set (#charts % charts' % each % #style % #scaleP) ScalePArea
ho1 = (mempty :: HudOptions) & set #titles [(3,defaultTitle "chart1")] & set #axes [(2,defaultXAxisOptions), (2,defaultYAxisOptions)] & tsf ts & colourHudOptions (const (palette1 0))
c1 = (mempty :: ChartOptions) & set #hudOptions ho1 & set #charts (named "c1" [Chart defaultRectStyle (RectData [fmap (2*) one])])

ho2 = (mempty :: HudOptions) & set #titles [(3.1,defaultTitle "chart2")] & set #axes [(2,defaultXAxisOptions & set #place PlaceTop), (2,defaultYAxisOptions & set #place PlaceRight)] & tsf ts & colourHudOptions (const (palette1 3))
c2 = (mempty :: ChartOptions) & set #hudOptions ho2 & set #charts (named "c2" [Chart (blob (set opac' 0.3 $ palette1 3)) (RectData [fmap (*0.8) one]), BlankChart defaultStyle [one]])
co = compoundMerge [c1,c2]
display co

ho1 = (mempty :: HudOptions) & set #titles [(3,defaultTitle "chart1")] & set #axes [(2,defaultXAxisOptions), (2,defaultYAxisOptions)] & colourHudOptions (const (palette1 0))
c1 = (mempty :: ChartOptions) & set #hudOptions ho1 & set #charts (named "c1" [Chart defaultRectStyle (RectData [fmap (2*) one])])

ho2 = (mempty :: HudOptions) & set #titles [(3.1,defaultTitle "chart2")] & set #axes [(2,defaultXAxisOptions & set #place PlaceTop), (2,defaultYAxisOptions & set #place PlaceRight)] & colourHudOptions (const (palette1 3))
c2 = (mempty :: ChartOptions) & set #hudOptions ho2 & set #charts (named "c2" [Chart (blob (set opac' 0.3 $ palette1 3)) (RectData [fmap (*0.8) one]), BlankChart defaultStyle [one]])
co = compoundMerge [c1,c2]
display co

stackExample

display $ mempty & set #charts (stack 4 0.1 (replicate 16 $ (view #charts $ (set (#charts % charts' % each % #style % #scaleP) ScalePArea) $ forgetHud lineExample)))

bar & sbar

  • [X] numbers are badly placed on both X and Y axis
  • [X] Not due to negative
  • [X] numbers a bit small
  • [X] vgap on legend
  • [X] legend skewif
  • [X] bar Hori text is still Vert
  • [X] Stacked not showing second series
  • [X] bar Hori axis is wrong, extending beyond the original

zeroised

e1 = barDataExample & over #barData (fmap (fmap (max 1))) & over #barData (fmap (take 4))
display $ barChart (defaultBarOptions & set (#barTextStyles % each % #anchor) AnchorMiddle & set (#barTextStyles % each % #size) 0.2 & set #textGap 0 & set #textGapNegative 0) e1 & set (#markupOptions % #chartAspect) (FixedAspect 1) & set (#charts % charts' % each % #style % #scaleP) ScalePArea

too dependent on original barRect scale

Hori

n = 1
barDataExample' = barDataExample & over #barData (fmap (fmap (*n)))
bo = (defaultBarOptions & set (#barOrientation) Hori & set (#barTextStyles % each % #anchor) AnchorMiddle & set (#barTextStyles % each % #size) 0.03 & set #textGap 0.03 & set #textGapNegative 0.05) & set #textShiftVert (-0.008)
display $ barChart bo barDataExample'

Vert

n = 1
barDataExample' = barDataExample & over #barData (fmap (fmap (*n)))
bo = (defaultBarOptions & set (#barOrientation) Vert & set (#barTextStyles % each % #size) 0.03 & set #textGap 0.03 & set #textGapNegative 0.05) & set #textShiftVert (-0.008)
display $ barChart bo barDataExample' & set (#markupOptions % #chartAspect) (FixedAspect 1.5) & set (#charts % charts' % each % #style % #scaleP) ScalePArea & set (#hudOptions % #frames) [(101, defaultFrameOptions & set #buffer 0.02)] & set (#hudOptions % #legends) []

barRects bo (view #barData barDataExample')
barTexts bo (view #barData barDataExample')

ellipse & quad & cubic

  • [X] title
  • [X] yaxis ticks
  • [X] quad
  • [X] cubic

textExample

  • [X] bad y axis ticks
  • [X] funny axis bar
co = textExample
display co

co & view #chartTree & view box'

forgetHud co & toListOf (#chartTree % charts' % each % #style % #scaleP)

higher number of ticks

co = unitExample & set (#hudOptions % #axes % each % _2 % #ticks % #style % numTicks') (Just 8) & over (#charts % charts' % each % #chartData) (scaleChartData 1)
display co

dateExample

  • [X] y axis ticks being cut off
display $ dateExample & set (#hudOptions % #frames) [(100,defaultFrameOptions & set #buffer 0.05)]

Exact reproduction of proportionate scaling

Scaling of style elements is proportional to the ratio of areas of the before and after rectangle. This means that individual elements do not scale to the exact proportions of the overall projections.

The effect is typically small but in pathological instances can cause irritation.

An extreme example, where:

  • tick and text marks fail to scale properly, if NoScaleP (the default) is used.
  • tick marks (almost) scale on ScalePArea, but text tick fails, because of an auto change in format
scale = NoScaleP
asp = FixedAspect 2
cszero =  (unnamed [blankChart1 one]) & over (charts' % each % #chartData) (scaleChartData 1)
r1 = fmap (*1) (Rect 0 1 0 1)
bar' = (AxisBar (border 0.001 (grey 0.3 1)) 0.05 0 0)
rs1 = border 0.001 (grey 0.3 1)
tt = (defaultTextTick & set #scaleP scale,0)
gt = defaultGlyphTick & set #scaleP scale & set #borderSize 0.001 & set #color (grey 0.3 1) & set #size 0.1
axes0 = [(5,defaultYAxisOptions & set #place PlaceLeft), (5,defaultXAxisOptions & set #place PlaceBottom)] & set (each % _2 % #ticks % #ltick) Nothing & set (each % _2 % #bar) (Just bar') & set (each % _2 % #ticks % #ttick) (Just tt) & set (each % _2 % #ticks % #ttick %? _2) 0 & set (each % _2 % #ticks % #gtick %? _1) gt & set (each % _2 % #ticks % #gtick %? _3) 0.0 & set (each % _2 % #ticks % #ttick %? _1 % #frame) (Just (border 0.005 black))
cozero = (mempty :: ChartOptions) & set #charts cs & set (#hudOptions % #axes) axes0 & set (#hudOptions % #frames) [(1,defaultFrameOptions & set #frame (Just rs1))] & set (#markupOptions % #chartAspect) asp
display cozero

projectChart

  • [X] get CanvasAspect working
  • [X] find a non-exact single projection
  • [X] styleRebox using jam

rebox code

styleRebox is projectWith (r - (styleBox - box)) box projectChartTree is projectWith r styleBox

styleBox_ :: ChartTree -> Maybe (Rect Double)
styleBox_ = styleBoxes . foldOf charts'

styleRebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
styleRebox_ cs r =
  cs
    & over chart' (fromMaybe id $ projectWith <$> r' <*> box_ cs)
  where
    r' = (NH.-) <$> r <*> ((NH.-) <$> styleBox_ cs <*> box_ cs)

-- | 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
styleBox' :: Lens' ChartTree (Maybe (Rect Double))
styleBox' =
  lens styleBox_ styleRebox_

-- | Project a chart tree to a new bounding box, guarding against singleton bounds.
projectChartTree :: Rect Double -> ChartTree -> ChartTree
projectChartTree new ct = case view styleBox' ct of
  Nothing -> ct
  Just b -> ct & over charts' (fmap (projectWith new b))
-- | projects a Chart to a new space from an old rectangular space, preserving linear metric structure.
--
-- FIXME: test singleton protections
--
-- >>> projectWith (fmap (2*) one) one r
-- RectChart (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.02 0.29 0.48 1.00, color = Colour 0.02 0.73 0.80 0.10}) [Rect -1.0 1.0 -1.0 1.0]
projectWith :: Rect Double -> Rect Double -> Chart -> Chart
projectWith new old (Chart s a) =
  Chart (scaleStyle (scaleRatio (view #scaleP s) new old) s) (projectChartDataWith new old a)

projectChartDataWith :: Rect Double -> Rect Double -> ChartData -> ChartData
projectChartDataWith new old (RectData a) = RectData (projectOnR new old <$> a)
projectChartDataWith new old (TextData a) = TextData (second (projectOnP new old) <$> a)
projectChartDataWith new old (LineData a) = LineData (fmap (projectOnP new old) <$> a)
projectChartDataWith new old (GlyphData a) = GlyphData (fmap (second (projectOnP new old)) a)
projectChartDataWith new old (PathData a) = PathData (projectPaths new old a)
projectChartDataWith new old (BlankData a) = BlankData (projectOnR new old <$> a)

projection decomp

co = jal
-- co = tandp
-- co = lineExample & set (#hudOptions % #legends % each % _2 % #place) PlaceRight & set (#markupOptions % #chartAspect) (CanvasAspect 1.5)
asp = co & view (#markupOptions % #chartAspect)
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
finalCT = projectChartTreeN 4 viewbox csAndHud
boxs' = sbox <$> (mconcat $ toListOf charts' finalCT)
ct' = projectChartTree viewbox csAndHud
ct'' = set styleBox' (Just viewbox) csAndHud
putStrLn ("initial:  " <> show (initialCanvas asp Nothing))
putStrLn ("csAndHud: " <> maybe "" show (view styleBox' csAndHud))
putStrLn ("single:   " <> maybe "" show (view styleBox' ct'))
putStrLn ("final:    " <> maybe "" show (view styleBox' finalCT))
putStrLn ("rebox:    " <> maybe "" show (view styleBox' (set styleBox' (Just viewbox) csAndHud)))
ct' == ct''
display (mempty & set #charts csAndHud & set (#markupOptions % #chartAspect) ChartAspect)

multi bulk test

pPrint $ filter ((\(x,_,_) -> not x) . snd) $ second (sameMulti) <$> pathChartOptions

jam

exampleText = ["jam"]
tsScale = defaultTextStyle & set #frame (Just defaultRectStyle) & set #anchor AnchorMiddle & set #scaleP ScaleMinDim
textScale = zipWith (\t x -> TextChart tsScale [(t, Point 0 x)]) exampleText [0..]
ct = unnamed textScale
jam = mempty & #charts .~ ct & set (#hudOptions % #frames) [(100,defaultFrameOptions & set #buffer 0 & set #frame (Just $ blob (grey 0.5 0.1)))] & set (#markupOptions % #chartAspect) (FixedAspect 2) :: ChartOptions
display jam

unscaled + no hud

  • State “Done” from [2023-11-24 Fri 18:03]
co = jam & set (#markupOptions % #chartAspect) UnscaledAspect & set #hudOptions mempty
display co

asp = co & view (#markupOptions % #chartAspect)
icanvas = initialCanvas asp Nothing
cs = view #charts co
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
csAndHudSingle = set styleBox' (Just viewbox) csAndHud
csm = set (styleBoxN' 10) (Just viewbox) csAndHud
csp = projectChartWith (view (#markupOptions % #repeatAspect) co) (view (#markupOptions % #chartAspect) co) (view #hudOptions co) cs

-- addHud
ho = view #hudOptions co
db = maybe one padSingletons (view box' cs)
(mdb, hs) = toHuds ho db
csPadded = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
ivb = initialCanvas asp (Just csPadded)
db' = fromMaybe db mdb
csAndHud' = runHudWith ivb db' hs csPadded
hc0 = cs & set styleBox' (Just ivb)

-- projectWith
new = ivb
old = fromMaybe one $ view styleBox' csPadded
csPaddeds = toListOf charts' csPadded & mconcat
pwData = csPaddeds & over (each % #chartData) (projectChartDataWith new old)
pwC = pwData & over (each % #style) (\s -> scaleStyle (scaleRatio (view #scaleP s) new old) s)
pwRatio = scaleRatio (view #scaleP (head $ view #style <$> pwC)) new old
pwStyle = view #style (head pwC)
pwC' = unnamed pwC


csp & view styleBox' & NH.traverse_ (show >>> ("co:" <>) >>> putStrLn)

icanvas & (show >>> ("initial canvas:" <>) >>> putStrLn)
cs & view styleBox' & NH.traverse_ (show >>> ("initial chart:" <>) >>> putStrLn)
csAndHud & view styleBox' & NH.traverse_ (show >>> ("csAndHud:" <>) >>> putStrLn)
viewbox & (show >>> ("final canvas:" <>) >>> putStrLn)
csAndHudSingle & view styleBox' & NH.traverse_ (show >>> ("single proj:" <>) >>> putStrLn)
csm & view styleBox' & NH.traverse_ (show >>> ("multi proj:" <>) >>> putStrLn)
csPadded & view styleBox' & NH.traverse_ (show >>> ("padding:" <>) >>> putStrLn)
ivb & (show >>> ("initial padded canvas:" <>) >>> putStrLn)
hc0 & view styleBox' & NH.traverse_ (show >>> ("hc0:" <>) >>> putStrLn)
csAndHud' & view styleBox' & NH.traverse_ (show >>> ("runHudWith:" <>) >>> putStrLn)

-- projectWith
ratio new & (show >>> ("ratio new:" <>) >>> putStrLn)
ratio old & (show >>> ("ratio old:" <>) >>> putStrLn)
pwRatio & (show >>> ("scale ratio:" <>) >>> putStrLn)


db' & (show >>> ("data box padded:" <>) >>> putStrLn)

svgViewbox (Rect x z y w) = (x, (-w), (z-x), (w-y))
svgvb = svgViewbox <$> (view styleBox' csm)
svgvb & NH.traverse_ (show >>> ("svg viewbox:" <>) >>> putStrLn)

unscaled + zero frame

  • State “Done” from [2023-11-24 Fri 18:03]
co = jam & set (#markupOptions % #chartAspect) UnscaledAspect & set #hudOptions mempty & set (#hudOptions % #frames) [(100,defaultFrameOptions & set #buffer 0 & set #frame (Just $ blob (grey 0.5 0.1)))]
display co

asp = co & view (#markupOptions % #chartAspect)
icanvas = initialCanvas asp Nothing
cs = view #charts co
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
csAndHudSingle = set styleBox' (Just viewbox) csAndHud
csm = set (styleBoxN' 10) (Just viewbox) csAndHud
csp = projectChartWith (view (#markupOptions % #repeatAspect) co) (view (#markupOptions % #chartAspect) co) (view #hudOptions co) cs

-- addHud
ho = view #hudOptions co
db = maybe one padSingletons (view box' cs)
(mdb, hs) = toHuds ho db
csPadded = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
ivb = initialCanvas asp (Just csPadded)
db' = fromMaybe db mdb
csAndHud' = runHudWith ivb db' hs csPadded
hc0 = cs & set styleBox' (Just ivb)

-- projectWith
new = ivb
old = fromMaybe one $ view styleBox' csPadded
csPaddeds = toListOf charts' csPadded & mconcat
pwData = csPaddeds & over (each % #chartData) (projectChartDataWith new old)
pwC = pwData & over (each % #style) (\s -> scaleStyle (scaleRatio (view #scaleP s) new old) s)
pwRatio = scaleRatio (view #scaleP (head $ view #style <$> pwC)) new old
pwStyle = view #style (head pwC)
pwC' = unnamed pwC


csp & view styleBox' & NH.traverse_ (show >>> ("co:" <>) >>> putStrLn)

icanvas & (show >>> ("initial canvas:" <>) >>> putStrLn)
cs & view styleBox' & NH.traverse_ (show >>> ("initial chart:" <>) >>> putStrLn)
csAndHud & view styleBox' & NH.traverse_ (show >>> ("csAndHud:" <>) >>> putStrLn)
viewbox & (show >>> ("final canvas:" <>) >>> putStrLn)
csAndHudSingle & view styleBox' & NH.traverse_ (show >>> ("single proj:" <>) >>> putStrLn)
csm & view styleBox' & NH.traverse_ (show >>> ("multi proj:" <>) >>> putStrLn)
csPadded & view styleBox' & NH.traverse_ (show >>> ("padding:" <>) >>> putStrLn)
ivb & (show >>> ("initial padded canvas:" <>) >>> putStrLn)
hc0 & view styleBox' & NH.traverse_ (show >>> ("hc0:" <>) >>> putStrLn)
csAndHud' & view styleBox' & NH.traverse_ (show >>> ("runHudWith:" <>) >>> putStrLn)

-- projectWith
ratio new & (show >>> ("ratio new:" <>) >>> putStrLn)
ratio old & (show >>> ("ratio old:" <>) >>> putStrLn)
pwRatio & (show >>> ("scale ratio:" <>) >>> putStrLn)


db' & (show >>> ("data box padded:" <>) >>> putStrLn)

svgViewbox (Rect x z y w) = (x, (-w), (z-x), (w-y))
svgvb = svgViewbox <$> (view styleBox' csm)
svgvb & NH.traverse_ (show >>> ("svg viewbox:" <>) >>> putStrLn)

ChartAspect + no hud

  • State “Done” from [2023-11-26 Sun 07:50]
  • State “Done” from [2023-11-24 Fri 18:03]
  • [X] border cool as!
co = jam & set (#markupOptions % #chartAspect) ChartAspect & set #hudOptions mempty
display co

asp = co & view (#markupOptions % #chartAspect)
icanvas = initialCanvas asp Nothing
cs = view #charts co
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
csAndHudSingle = set styleBox' (Just viewbox) csAndHud
csm = set (styleBoxN' 10) (Just viewbox) csAndHud
csp = projectChartWith (view (#markupOptions % #repeatAspect) co) (view (#markupOptions % #chartAspect) co) (view #hudOptions co) cs

-- addHud
ho = view #hudOptions co
db = maybe one padSingletons (view box' cs)
(mdb, hs) = toHuds ho db
csPadded = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
ivb = initialCanvas asp (Just csPadded)
db' = fromMaybe db mdb
csAndHud' = runHudWith ivb db' hs csPadded
hc0 = cs & set styleBox' (Just ivb)

-- projectWith
new = ivb
old = fromMaybe one $ view styleBox' csPadded
csPaddeds = toListOf charts' csPadded & mconcat
pwData = csPaddeds & over (each % #chartData) (projectChartDataWith new old)
pwC = pwData & over (each % #style) (\s -> scaleStyle (scaleRatio (view #scaleP s) new old) s)
pwRatio = scaleRatio (view #scaleP (head $ view #style <$> pwC)) new old
pwStyle = view #style (head pwC)
pwC' = unnamed pwC


csp & view styleBox' & NH.traverse_ (show >>> ("co:" <>) >>> putStrLn)

icanvas & (show >>> ("initial canvas:" <>) >>> putStrLn)
cs & view styleBox' & NH.traverse_ (show >>> ("initial chart:" <>) >>> putStrLn)
csAndHud & view styleBox' & NH.traverse_ (show >>> ("csAndHud:" <>) >>> putStrLn)
viewbox & (show >>> ("final canvas:" <>) >>> putStrLn)
csAndHudSingle & view styleBox' & NH.traverse_ (show >>> ("single proj:" <>) >>> putStrLn)
csm & view styleBox' & NH.traverse_ (show >>> ("multi proj:" <>) >>> putStrLn)
csPadded & view styleBox' & NH.traverse_ (show >>> ("padding:" <>) >>> putStrLn)
ivb & (show >>> ("initial padded canvas:" <>) >>> putStrLn)
hc0 & view styleBox' & NH.traverse_ (show >>> ("hc0:" <>) >>> putStrLn)
csAndHud' & view styleBox' & NH.traverse_ (show >>> ("runHudWith:" <>) >>> putStrLn)

-- projectWith
ratio new & (show >>> ("ratio new:" <>) >>> putStrLn)
ratio old & (show >>> ("ratio old:" <>) >>> putStrLn)
pwRatio & (show >>> ("scale ratio:" <>) >>> putStrLn)


db' & (show >>> ("data box padded:" <>) >>> putStrLn)

svgViewbox (Rect x z y w) = (x, (-w), (z-x), (w-y))
svgvb = svgViewbox <$> (view styleBox' csm)
svgvb & NH.traverse_ (show >>> ("svg viewbox:" <>) >>> putStrLn)

ChartAspect + zero frame

  • State “Done” from “Next” [2023-11-26 Sun 07:59]
  • State “Done” from [2023-11-26 Sun 07:50]
  • State “Done” from [2023-11-24 Fri 18:03]
co = jam & set (#markupOptions % #chartAspect) ChartAspect & set #hudOptions mempty & set (#hudOptions % #frames) [(100,defaultFrameOptions & set #buffer 0 & set #frame (Just $ blob (grey 0.5 0.1)))]
display co

asp = co & view (#markupOptions % #chartAspect)
icanvas = initialCanvas asp Nothing
cs = view #charts co
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
csAndHudSingle = set styleBox' (Just viewbox) csAndHud
csm = set (styleBoxN' 10) (Just viewbox) csAndHud
csp = projectChartWith (view (#markupOptions % #repeatAspect) co) (view (#markupOptions % #chartAspect) co) (view #hudOptions co) cs

-- addHud
ho = view #hudOptions co
db = maybe one padSingletons (view box' cs)
(mdb, hs) = toHuds ho db
csPadded = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
ivb = initialCanvas asp (Just csPadded)
db' = fromMaybe db mdb
csAndHud' = runHudWith ivb db' hs csPadded
hc0 = cs & set styleBox' (Just ivb)

-- projectWith
new = ivb
old = fromMaybe one $ view styleBox' csPadded
csPaddeds = toListOf charts' csPadded & mconcat
pwData = csPaddeds & over (each % #chartData) (projectChartDataWith new old)
pwC = pwData & over (each % #style) (\s -> scaleStyle (scaleRatio (view #scaleP s) new old) s)
pwRatio = scaleRatio (view #scaleP (head $ view #style <$> pwC)) new old
pwStyle = view #style (head pwC)
pwC' = unnamed pwC


csp & view styleBox' & NH.traverse_ (show >>> ("co:" <>) >>> putStrLn)

icanvas & (show >>> ("initial canvas:" <>) >>> putStrLn)
cs & view styleBox' & NH.traverse_ (show >>> ("initial chart:" <>) >>> putStrLn)
csAndHud & view styleBox' & NH.traverse_ (show >>> ("csAndHud:" <>) >>> putStrLn)
viewbox & (show >>> ("final canvas:" <>) >>> putStrLn)
csAndHudSingle & view styleBox' & NH.traverse_ (show >>> ("single proj:" <>) >>> putStrLn)
csm & view styleBox' & NH.traverse_ (show >>> ("multi proj:" <>) >>> putStrLn)
csPadded & view styleBox' & NH.traverse_ (show >>> ("padding:" <>) >>> putStrLn)
ivb & (show >>> ("initial padded canvas:" <>) >>> putStrLn)
hc0 & view styleBox' & NH.traverse_ (show >>> ("hc0:" <>) >>> putStrLn)
csAndHud' & view styleBox' & NH.traverse_ (show >>> ("runHudWith:" <>) >>> putStrLn)

-- projectWith
ratio new & (show >>> ("ratio new:" <>) >>> putStrLn)
ratio old & (show >>> ("ratio old:" <>) >>> putStrLn)
pwRatio & (show >>> ("scale ratio:" <>) >>> putStrLn)


db' & (show >>> ("data box padded:" <>) >>> putStrLn)

svgViewbox (Rect x z y w) = (x, (-w), (z-x), (w-y))
svgvb = svgViewbox <$> (view styleBox' csm)
svgvb & NH.traverse_ (show >>> ("svg viewbox:" <>) >>> putStrLn)

FixedAspect + no hud

  • State “Done” from “Next” [2023-11-26 Sun 12:04]
  • State “Done” from “Next” [2023-11-26 Sun 07:59]
  • State “Done” from [2023-11-26 Sun 07:50]
  • State “Done” from [2023-11-24 Fri 18:03]

With no hud, the viewbox is keyed off of the styleBox of the chart, which is different to the FixedAspect 1 requested.

co = jam & set (#markupOptions % #chartAspect) (FixedAspect 1) & set #hudOptions mempty & set (#charts % charts' % each % #style % #scaleP) ScaleMinDim & set (#charts % charts' % each % #style % #anchor) AnchorMiddle
display co

asp = co & view (#markupOptions % #chartAspect)
icanvas = initialCanvas asp Nothing
cs = view #charts co
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
csAndHudSingle = set styleBox' (Just viewbox) csAndHud
csm = set (styleBoxN' 10) (Just viewbox) csAndHud
csp = projectChartWith (view (#markupOptions % #repeatAspect) co) (view (#markupOptions % #chartAspect) co) (view #hudOptions co) cs

-- addHud
ho = view #hudOptions co
db = maybe one padSingletons (view box' cs)
(mdb, hs) = toHuds ho db
csPadded = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
ivb = initialCanvas asp (Just csPadded)
db' = fromMaybe db mdb
csAndHud' = runHudWith ivb db' hs csPadded
hc0 = cs & set styleBox' (Just ivb)

-- projectWith
new = ivb
old = fromMaybe one $ view styleBox' csPadded
csPaddeds = toListOf charts' csPadded & mconcat
pwData = csPaddeds & over (each % #chartData) (projectChartDataWith new old)
pwC = pwData & over (each % #style) (\s -> scaleStyle (scaleRatio (view #scaleP s) new old) s)
pwRatio = scaleRatio (view #scaleP (head $ view #style <$> pwC)) new old
pwStyle = view #style (head pwC)
pwC' = unnamed pwC


csp & view styleBox' & NH.traverse_ (show >>> ("co:" <>) >>> putStrLn)

icanvas & (show >>> ("initial canvas:" <>) >>> putStrLn)
cs & view styleBox' & NH.traverse_ (show >>> ("initial chart:" <>) >>> putStrLn)
csAndHud & view styleBox' & NH.traverse_ (show >>> ("csAndHud:" <>) >>> putStrLn)
viewbox & (show >>> ("final canvas:" <>) >>> putStrLn)
csAndHudSingle & view styleBox' & NH.traverse_ (show >>> ("single proj:" <>) >>> putStrLn)
csm & view styleBox' & NH.traverse_ (show >>> ("multi proj:" <>) >>> putStrLn)
csPadded & view styleBox' & NH.traverse_ (show >>> ("padding:" <>) >>> putStrLn)
ivb & (show >>> ("initial padded canvas:" <>) >>> putStrLn)
hc0 & view styleBox' & NH.traverse_ (show >>> ("hc0:" <>) >>> putStrLn)
csAndHud' & view styleBox' & NH.traverse_ (show >>> ("runHudWith:" <>) >>> putStrLn)

-- projectWith
ratio new & (show >>> ("ratio new:" <>) >>> putStrLn)
ratio old & (show >>> ("ratio old:" <>) >>> putStrLn)
pwRatio & (show >>> ("scale ratio:" <>) >>> putStrLn)

db' & (show >>> ("data box padded:" <>) >>> putStrLn)

svgViewbox (Rect x z y w) = (x, (-w), (z-x), (w-y))
svgvb = svgViewbox <$> (view styleBox' csm)
svgvb & NH.traverse_ (show >>> ("svg viewbox:" <>) >>> putStrLn)



toListOf (each % #chartData) csPaddeds
toListOf (each % #chartData) pwData
exp1 = csPaddeds & over (each % #chartData) id & over (each % #style) (\s -> scaleStyle 6 (set #scaleP ScaleMinDim s))

FixedAspect + zero frame

  • State “Done” from “Next” [2023-11-26 Sun 12:08]
  • State “Done” from “Next” [2023-11-26 Sun 12:04]
  • State “Done” from “Next” [2023-11-26 Sun 07:59]
  • State “Done” from [2023-11-26 Sun 07:50]
  • State “Done” from [2023-11-24 Fri 18:03]
co = jam & set (#markupOptions % #chartAspect) (FixedAspect 1) & set #hudOptions mempty & set (#charts % charts' % each % #style % #scaleP) ScaleMinDim & set (#charts % charts' % each % #style % #anchor) AnchorMiddle & set (#hudOptions % #frames) [(100,defaultFrameOptions & set #buffer 0 & set #frame (Just $ blob (grey 0.5 0.1)))]
display co

asp = co & view (#markupOptions % #chartAspect)
icanvas = initialCanvas asp Nothing
cs = view #charts co
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
csAndHudSingle = set styleBox' (Just viewbox) csAndHud
csm = set (styleBoxN' 10) (Just viewbox) csAndHud
csp = projectChartWith (view (#markupOptions % #repeatAspect) co) (view (#markupOptions % #chartAspect) co) (view #hudOptions co) cs

-- addHud
ho = view #hudOptions co
db = maybe one padSingletons (view box' cs)
(mdb, hs) = toHuds ho db
csPadded = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
ivb = initialCanvas asp (Just csPadded)
db' = fromMaybe db mdb
csAndHud' = runHudWith ivb db' hs csPadded
hc0 = cs & set styleBox' (Just ivb)

-- projectWith
new = ivb
old = fromMaybe one $ view styleBox' csPadded
csPaddeds = toListOf charts' csPadded & mconcat
pwData = csPaddeds & over (each % #chartData) (projectChartDataWith new old)
pwC = pwData & over (each % #style) (\s -> scaleStyle (scaleRatio (view #scaleP s) new old) s)
pwRatio = scaleRatio (view #scaleP (head $ view #style <$> pwC)) new old
pwStyle = view #style (head pwC)
pwC' = unnamed pwC


csp & view styleBox' & NH.traverse_ (show >>> ("co:" <>) >>> putStrLn)

icanvas & (show >>> ("initial canvas:" <>) >>> putStrLn)
cs & view styleBox' & NH.traverse_ (show >>> ("initial chart:" <>) >>> putStrLn)
csAndHud & view styleBox' & NH.traverse_ (show >>> ("csAndHud:" <>) >>> putStrLn)
viewbox & (show >>> ("final canvas:" <>) >>> putStrLn)
csAndHudSingle & view styleBox' & NH.traverse_ (show >>> ("single proj:" <>) >>> putStrLn)
csm & view styleBox' & NH.traverse_ (show >>> ("multi proj:" <>) >>> putStrLn)
csPadded & view styleBox' & NH.traverse_ (show >>> ("padding:" <>) >>> putStrLn)
ivb & (show >>> ("initial padded canvas:" <>) >>> putStrLn)
hc0 & view styleBox' & NH.traverse_ (show >>> ("hc0:" <>) >>> putStrLn)
csAndHud' & view styleBox' & NH.traverse_ (show >>> ("runHudWith:" <>) >>> putStrLn)

-- projectWith
ratio new & (show >>> ("ratio new:" <>) >>> putStrLn)
ratio old & (show >>> ("ratio old:" <>) >>> putStrLn)
pwRatio & (show >>> ("scale ratio:" <>) >>> putStrLn)

db' & (show >>> ("data box padded:" <>) >>> putStrLn)

svgViewbox (Rect x z y w) = (x, (-w), (z-x), (w-y))
svgvb = svgViewbox <$> (view styleBox' csm)
svgvb & NH.traverse_ (show >>> ("svg viewbox:" <>) >>> putStrLn)

CanvasAspect + zero frame

  • State “Done” from “Next” [2023-11-26 Sun 12:08]
  • State “Done” from “Next” [2023-11-26 Sun 12:04]
  • State “Done” from “Next” [2023-11-26 Sun 07:59]
  • State “Done” from [2023-11-26 Sun 07:50]
  • State “Done” from [2023-11-24 Fri 18:03]
co = jam & set (#markupOptions % #chartAspect) (CanvasAspect 1) & set #hudOptions mempty & set (#charts % charts' % each % #style % #scaleP) ScaleMinDim & set (#charts % charts' % each % #style % #anchor) AnchorMiddle & set (#hudOptions % #frames) [(100,defaultFrameOptions & set #buffer 0 & set #frame (Just $ blob (grey 0.5 0.1)))]
display co

asp = co & view (#markupOptions % #chartAspect)
icanvas = initialCanvas asp Nothing
cs = view #charts co
csAndHud = addHud (view (#markupOptions % #chartAspect) co) (view #hudOptions co) (view #charts co)
viewbox = finalCanvas asp (Just csAndHud)
csAndHudSingle = set styleBox' (Just viewbox) csAndHud
csm = set (styleBoxN' 10) (Just viewbox) csAndHud
csp = projectChartWith (view (#markupOptions % #repeatAspect) co) (view (#markupOptions % #chartAspect) co) (view #hudOptions co) cs

-- addHud
ho = view #hudOptions co
db = maybe one padSingletons (view box' cs)
(mdb, hs) = toHuds ho db
csPadded = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
ivb = initialCanvas asp (Just csPadded)
db' = fromMaybe db mdb
csAndHud' = runHudWith ivb db' hs csPadded
hc0 = cs & set styleBox' (Just ivb)

-- projectWith
new = ivb
old = fromMaybe one $ view styleBox' csPadded
csPaddeds = toListOf charts' csPadded & mconcat
pwData = csPaddeds & over (each % #chartData) (projectChartDataWith new old)
pwC = pwData & over (each % #style) (\s -> scaleStyle (scaleRatio (view #scaleP s) new old) s)
pwRatio = scaleRatio (view #scaleP (head $ view #style <$> pwC)) new old
pwStyle = view #style (head pwC)
pwC' = unnamed pwC


csp & view styleBox' & NH.traverse_ (show >>> ("co:" <>) >>> putStrLn)

icanvas & (show >>> ("initial canvas:" <>) >>> putStrLn)
cs & view styleBox' & NH.traverse_ (show >>> ("initial chart:" <>) >>> putStrLn)
csAndHud & view styleBox' & NH.traverse_ (show >>> ("csAndHud:" <>) >>> putStrLn)
viewbox & (show >>> ("final canvas:" <>) >>> putStrLn)
csAndHudSingle & view styleBox' & NH.traverse_ (show >>> ("single proj:" <>) >>> putStrLn)
csm & view styleBox' & NH.traverse_ (show >>> ("multi proj:" <>) >>> putStrLn)
csPadded & view styleBox' & NH.traverse_ (show >>> ("padding:" <>) >>> putStrLn)
ivb & (show >>> ("initial padded canvas:" <>) >>> putStrLn)
hc0 & view styleBox' & NH.traverse_ (show >>> ("hc0:" <>) >>> putStrLn)
csAndHud' & view styleBox' & NH.traverse_ (show >>> ("runHudWith:" <>) >>> putStrLn)

-- projectWith
ratio new & (show >>> ("ratio new:" <>) >>> putStrLn)
ratio old & (show >>> ("ratio old:" <>) >>> putStrLn)
pwRatio & (show >>> ("scale ratio:" <>) >>> putStrLn)

db' & (show >>> ("data box padded:" <>) >>> putStrLn)

svgViewbox (Rect x z y w) = (x, (-w), (z-x), (w-y))
svgvb = svgViewbox <$> (view styleBox' csm)
svgvb & NH.traverse_ (show >>> ("svg viewbox:" <>) >>> putStrLn)

styleBoxText

  • State “Done” from [2023-11-26 Sun 07:37]
  • Anchors ok
  • scaleps ok
s0 = defaultTextStyle & set #frame (Just $ defaultRectStyle) & set #anchor AnchorStart & set #scaleP NoScaleP
r0 = styleBoxText s0 "jam" (Point 0 0)
r1 = styleBoxText (scaleStyle 2 s0) "jam" (Point 0 0)
r0
r1
(\x y -> x - 2 * y) <$> r1 <*> r0

import Data.Text qualified as Text
t = "jam"
o = s0
p = Point 0 0
s = o ^. #size
h = o ^. #hsize
v = o ^. #vsize
n1 = o ^. #vshift
x' = s * h * fromIntegral (Text.length t)
y' = s * v
n1' = (-s) * n1
a' = case o ^. #anchor of; AnchorStart -> 0.5; AnchorEnd -> -0.5; AnchorMiddle -> 0.0
mpad = maybe id (\f -> padRect (0.5 * view #borderSize f * view #size o)) (view #frame o)
flat = Rect ((-x' / 2.0) + x' * a') (x' / 2 + x' * a') (-y' / 2 + n1') (y' / 2 + n1')
mpad $ move p $ maybe flat (`rotationBound` flat) (o ^. #rotation)
flat

import Data.Text qualified as Text
t = "jam"
o = scaleStyle 2 s0
p = Point 0 0
s = o ^. #size
h = o ^. #hsize
v = o ^. #vsize
n1 = o ^. #vshift
x' = s * h * fromIntegral (Text.length t)
y' = s * v
n1' = (-s) * n1
a' = case o ^. #anchor of; AnchorStart -> 0.5; AnchorEnd -> -0.5; AnchorMiddle -> 0.0
mpad = maybe id (\f -> padRect (0.5 * view #borderSize f * view #size o)) (view #frame o)
flat = Rect ((-x' / 2.0) + x' * a') (x' / 2 + x' * a') (-y' / 2 + n1') (y' / 2 + n1')
mpad $ move p $ maybe flat (`rotationBound` flat) (o ^. #rotation)
flat

markup manual checks

  • [X] initial padded canvas
view styleBox' csPadded & fmap (ratio * 0.5 >>> (== (let (Rect _ z _ _) = ivb in z)))
  • [X] viewbox svg (x,y,width,height): -0.0003 -0.0483 0.1086 0.0666
  • [X] height: 300
  • [X] width: 489 = 0.1086 / 0.0666 * 300
  • [X] font-size: 0.06 * 15.015015015015013 = .9009
  • [X] border-size: 0.0090 (border-size 0.01 * font-size)
  • [X] text rect: viewbox - 1/2 * border size
pPrint $ markupChartOptions co

text and points

exampleText <- fmap T.pack <$> replicateM 2 (unwords <$> replicateM 3 word)
exampleText

exampleText <- fmap T.pack <$> replicateM 2 (unwords <$> replicateM 3 word)
tsNoScale = defaultTextStyle & set #frame (Just $ defaultRectStyle) & set #anchor AnchorStart & set #scaleP NoScaleP
tsScale = defaultTextStyle & set #frame (Just $ defaultRectStyle) & set #anchor AnchorStart & set #scaleP ScalePArea

textNoScale = zipWith (\t x -> TextChart tsNoScale [(t, Point 0 x)]) exampleText [0..]
textScale = zipWith (\t x -> TextChart tsScale [(t, Point 0 (x+0.2))]) exampleText [0..]
points = Chart defaultGlyphStyle $ GlyphData ((CircleGlyph,) <$> (Point 0 0 :corners4 (Rect 0 1 (-0.5) 0.5)))
cs = textScale <> [points]
csNo = textNoScale <> [points]
ct = unnamed cs
tandp = mempty & #charts .~ ct & #markupOptions % #chartAspect .~ FixedAspect 1 :: ChartOptions
tandpNo = mempty & #charts .~ unnamed csNo & #markupOptions % #chartAspect .~ FixedAspect 1 :: ChartOptions
display tandpNo

fonts

system-ui,-apple-system,”Segoe UI”,Roboto,”Helvetica Neue”,Arial,”Noto Sans”,”Liberation Sans”,sans-serif,”Apple Color Emoji”,”Segoe UI Emoji”,”Segoe UI Symbol”,”Noto Color Emoji”;

SFMono-Regular,Menlo,Monaco,Consolas,”Liberation Mono”,”Courier New”,monospace;

Non-singular Text

co = (mempty :: ChartOptions) & set #charts (unnamed [TextChart defaultTextStyle [("jim", Point 0 0), ("jam",Point 1 1)]]) & set (#charts % charts' % each % #style % #frame) (Just defaultRectStyle) & set #hudOptions defaultHudOptions & set (#charts % charts' % each % #style % #size) 0.2 & set (#charts % charts' % each % #style % #vshift) 0
display co

HudChart lens audit

canvasBox’ makeAxisBar tickGlyph tickText tickLine

hudStyleBox’ frameHud makeAxisBar title tickText legendHud

hudBox’ tickGlyph makeTick

ScaleBorder removal

  • State “Done” from [2023-11-30 Thu 14:36]
display $ glyphsExample & set (#markupOptions % #chartAspect) (FixedAspect 6) & set (#markupOptions % #markupHeight) (Just 200)

:t glyphsExample & over (#charts % charts' % _last) (fmap id) -- ((\(PathGlyph p _, pt) -> (PathGlyph p NoScaleBorder,pt))))

HudChartSection

  • State “Done” from “Next” [2023-12-02 Sat 16:31]
  • [X] axis bar
    • [X] lens with AnchoredTo option
  • [X] distortion in tickGlyphs due to NoScaleP
  • [X] glyph ticks are a consistent hair away from the axis bar
  • [X] textExample and others are a long way away
  • [X] decide on axis bar and glyph tick buffers and section anchors 0.01 0.015
display $ unitExample & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #buffer) 0.01 & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #anchorTo) CanvasSection

decomp

UnscaledAspect is perfect, and then ChartAspect stuffs everything up:

sec = CanvasStyleSection
asp = UnscaledAspect
co = unitExample & set (#hudOptions % #axes % each % #item % #bar %? #buffer) 0.0 & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #buffer) 0.0 & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #anchorTo) sec & set (#markupOptions % #chartAspect) asp  & set (#hudOptions % #axes % each % #item % #ticks % #style % tickExtend' % _Just) TickExtend & set (#hudOptions % #axes % each % #item % #bar %? #anchorTo) sec & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #item % #size) 0.10 & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #item % #shape) SquareGlyph & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #item % #scaleP) NoScaleP & set (#hudOptions % #axes % each % #item % #ticks % #lineTick) Nothing & set (#hudOptions % #axes % each % #item % #ticks % #textTick) Nothing & set (#hudOptions % #frames) []
display co


co & view (#hudOptions % #frames)

:set -Wno-incomplete-uni-patterns
-- pPrint $ (forgetHud co) & view (#chartTree % #tree) & fmap (second (toListOf (each % #chartData)))
co' = forgetHud co
display co'
xs = filter (/=[]) $ (forgetHud co) & toListOf (#chartTree % charts') & fmap (fmap (view #chartData))
(Just b') = view styleBox' (view #chartTree co')
(Just bca') = view styleBox' (view #chartTree (forgetHud $ co & set (#markupOptions % #chartAspect) ChartAspect))
b'
bca'
ratio b'
ratio bca'
csUnscaled = addHud UnscaledAspect (view #hudOptions co) (view #chartTree co)
csChartScaled = addHud ChartAspect (view #hudOptions co) (view #chartTree co)
view styleBox' csUnscaled
view styleBox' csChartScaled
(initialCanvas UnscaledAspect (Just (view #chartTree co)))
(initialCanvas ChartAspect (Just (view #chartTree co)))

unscaled runHudWith breakup

cs = view #chartTree co
ho = view #hudOptions co
asp = UnscaledAspect
    db = maybe one padSingletons (view box' cs)
    (mdb, hs) = toHuds ho db
    cs' = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
    asp0 = initialCanvas asp (Just cs')
    csAndHud = runHudWith asp0 hs cs'
view styleBox' cs'
asp0
view styleBox' csAndHud
unscaledCSsAndHud = csAndHud

ChartAspect runHudWith breakup

cs = view #chartTree co
ho = view #hudOptions co
asp = ChartAspect
    db = maybe one padSingletons (view box' cs)
    (mdb, hs) = toHuds ho db
    cs' = cs <> maybe mempty (\r -> bool (named "datapadding" [BlankChart defaultStyle [r]]) mempty (r == db)) mdb
    asp0 = initialCanvas asp (Just cs')
    csAndHud = runHudWith asp0 hs cs'
view styleBox' cs'
asp0
view styleBox' csAndHud
vb = finalCanvas asp (Just csAndHud)
vb
view styleBox' (projectChartWith asp ho cs)
display $ (mempty :: ChartOptions) & set #chartTree csAndHud & set (#markupOptions % #chartAspect) UnscaledAspect

The problem is in the final set styleBox’, which is operating on NoScaleP styled charts:

ctFinal = set styleBox' (Just vb) $ csAndHud & set (charts' % each % #style % #scaleP) ScalePY
display $ (mempty :: ChartOptions) & set #chartTree ctFinal & set (#markupOptions % #chartAspect) (FixedAspect 1.5)

csAndHud & toListOf (charts' % each % #style % #scaleP)

solution

Scale the xaxis by ScalePX etc:

sec = CanvasSection
asp = FixedAspect 1.5
co = unitExample & set (#hudOptions % #axes % each % #item % #bar %? #buffer) 0.0 & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #buffer) 0.0 & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #anchorTo) sec & set (#markupOptions % #chartAspect) asp  & set (#hudOptions % #axes % each % #item % #ticks % #style % tickExtend' % _Just) TickExtend & set (#hudOptions % #axes % each % #item % #bar %? #anchorTo) sec & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #item % #size) 0.10 & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #item % #shape) SquareGlyph & set (#hudOptions % #axes % each % #item % #ticks % #glyphTick %? #style % #item % #scaleP) NoScaleP & set (#hudOptions % #axes % each % #item % #ticks % #lineTick) Nothing & set (#hudOptions % #axes % each % #item % #ticks % #textTick) Nothing & set (#hudOptions % #frames) [] & set (#hudOptions % #axes % ix 0 % #item % #ticks % #glyphTick %? #style % #item % #scaleP) ScalePX & set (#hudOptions % #axes % ix 1 % #item % #ticks % #glyphTick %? #style % #item % #scaleP) ScalePY
display co


display $ unitExample & set (#markupOptions % #chartAspect) UnscaledAspect

mempty

  • State “Done” from “Next” [2023-12-02 Sat 19:07]
display $ mempty & set #chartTree (view #chartTree unitExample)

pPrint $ mempty & set #chartTree (view #chartTree unitExample) & markupChartOptions

chart-svg mega cleanup checklist

  • State “Done” from “Next” [2023-12-03 Sun 08:02]
  • [X] rerun whole org file and observe results
  • [X] styleBox’ versus projectChartTree
  • [X] text box bug
  • [X] scaling text example
  • [X] examples audit
  • [X] NoScaleP needs to be the default for HudOption elements
  • [X] audit ScaleP usage
  • [X] toggle to switch to ScalePArea when the hud is forgotten
  • [X] surface legend
  • [X] check & fix examples
  • [X] fix compound code and compoundExample
  • [X] v06candidate1
  • [X] Revisit anal all in one
  • [X] diff test back
  • [X] code ToDos
  • [X] remove canvasStyleBox’
  • [X] remove multiple reboxing
  • [X] palette1 ==> palette
  • [X] #charts -> #chartTree
  • [X] move GlyphShape back to Style
  • [X] fix Rect show instance
  • [X] priority refactor
  • [X] buffered
  • [X] better names for tick elements
  • [X] remove placeText
  • [X] tick lenses
  • [X] remove Buffered, TextTickStyle, LineTickStyle
  • [X] FrameOption anchorTo
  • [X] review ScaleP
  • [X] look at mempty examples for redundant markup snippets
    • [X] mempty & set #hudOptions defaultHudOptions & set #chartTree mempty produces a hud still?
  • [X] replace .~ ~% ^.

AST

ChartOptions

data ChartOptions = ChartOptions
  { markupOptions :: MarkupOptions,
    hudOptions :: HudOptions,
    chartTree :: ChartTree
  }

MarkupOptions

data MarkupOptions = MarkupOptions
  { markupHeight :: Maybe Double,
    chartAspect :: ChartAspect,
    cssOptions :: CssOptions,
    renderStyle :: RenderStyle
  }

data ChartAspect
  = FixedAspect Double
  | CanvasAspect Double
  | ChartAspect
  | UnscaledAspect

data CssOptions = CssOptions
  { shapeRendering :: CssShapeRendering,
    preferColorScheme :: CssPreferColorScheme,
    fontFamilies :: ByteString,
    cssExtra :: ByteString}

data RenderStyle = Compact | Indented Int

data CssShapeRendering = UseGeometricPrecision | UseCssCrisp | NoShapeRendering

data CssPreferColorScheme
  = -- | includes css that switches approriate hud elements between light and dark.
    PreferHud
  | PreferDark
  | PreferLight
  | PreferNormal

HudOptions

data HudOptions = HudOptions
  { axes :: [Priority AxisOptions],
    frames :: [Priority FrameOptions],
    legends :: [Priority LegendOptions],
    titles :: [Priority Title]
  }

data Priority a = Priority {priority :: Double, item :: a}

AxisOptions

data AxisOptions = AxisOptions
  { bar :: Maybe AxisBar,
    adjust :: Maybe Adjustments,
    ticks :: Ticks,
    place :: Place
  }

data AxisBar = AxisBar
  { style :: Style,
    size :: Double,
    buffer :: Double,
    overhang :: Double,
    anchorTo :: HudChartSection
  }

data HudChartSection = CanvasSection | CanvasStyleSection | HudSection | HudStyleSection deriving (Eq, Show, Generic)

data Adjustments = Adjustments
  { maxXRatio :: Double,
    maxYRatio :: Double,
    angledRatio :: Double,
    allowDiagonal :: Bool
  }

data Ticks = Ticks
  { tick :: Tick,
    glyphTick :: Maybe TickStyle,
    textTick :: Maybe TickStyle,
    lineTick :: Maybe TickStyle
  }

data Tick
  = TickNone
  | TickLabels [Text]
  | TickRound FormatN Int TickExtend
  | TickExact FormatN Int
  | TickPlaced [(Double, Text)]

data FormatN = FormatN {fstyle :: FStyle, sigFigs :: Maybe Int, maxDistinguishIterations :: Int, addLPad :: Bool, cutRightZeros :: Bool} deriving (Eq, Show, Generic)

data FStyle
  = FSDecimal
  | FSExponent (Maybe Int)
  | FSComma
  | FSFixed Int
  | FSPercent
  | FSDollar
  | FSPrec
  | FSCommaPrec
  | FSNone

data TickExtend = TickExtend | NoTickExtend deriving (Eq, Show, Generic)

data TickStyle = TickStyle
  { style :: Style,
    anchorTo :: HudChartSection,
    buffer :: Double
  }

data Place
  = PlaceLeft
  | PlaceRight
  | PlaceTop
  | PlaceBottom
  | PlaceAbsolute (Point Double)

FrameOptions

data FrameOptions = FrameOptions
  { frame :: Maybe Style,
    anchorTo :: HudChartSection,
    buffer :: Double
  }

LegendOptions

data LegendOptions = LegendOptions
  { size :: Double,
    buffer :: Double,
    vgap :: Double,
    hgap :: Double,
    textStyle :: Style,
    innerPad :: Double,
    outerPad :: Double,
    frame :: Maybe Style,
    place :: Place,
    overallScale :: Double,
    scaleP :: ScaleP,
    legendCharts :: [(Text, [Chart])]
  }

Title

data Title = Title
  { text :: Text,
    style :: Style,
    place :: Place,
    anchor :: Anchor,
    buffer :: Double
  }

data Anchor = AnchorMiddle | AnchorStart | AnchorEnd

ChartTree

newtype ChartTree = ChartTree {tree :: Tree (Maybe Text, [Chart])} deriving (Eq, Show, Generic)

data Chart = Chart {style :: Style, chartData :: ChartData} deriving (Eq, Show, Generic)

data ChartData
  = RectData [Rect Double]
  | LineData [[Point Double]]
  | GlyphData [Point Double]
  | TextData [(Text, Point Double)]
  | PathData [PathData Double]
  | BlankData [Rect Double]

newtype Rect a = Rect' (Compose Point Range a)

-- | pattern of Rect lowerx upperx lowery uppery
pattern Rect :: a -> a -> a -> a -> Rect a
pattern Rect a b c d = Rect' (Compose (Point (Range a b) (Range c d)))

data Point a = Point
  { _x :: a,
    _y :: a
  }

data Range a = Range a a

data PathData a
  = StartP (Point a)
  | LineP (Point a)
  | CubicP (Point a) (Point a) (Point a)
  | QuadP (Point a) (Point a)
  | ArcP (ArcInfo a) (Point a)

data ArcInfo a = ArcInfo
  { radii :: Point a,
    phi :: a,
    large :: Bool,
    clockwise :: Bool
  }

Style

data Style = Style
  { size :: Double,
    borderSize :: Double,
    color :: Colour,
    borderColor :: Colour,
    scaleP :: ScaleP,
    anchor :: Anchor,
    rotation :: Maybe Double,
    translate :: Maybe (Point Double),
    escapeText :: EscapeText,
    frame :: Maybe Style,
    linecap :: Maybe LineCap,
    linejoin :: Maybe LineJoin,
    dasharray :: Maybe [Double],
    dashoffset :: Maybe Double,
    hsize :: Double,
    vsize :: Double,
    vshift :: Double,
    shape :: GlyphShape
  }

newtype Colour = Colour'
  { color' :: Color (Alpha RGB) Double
  }

pattern Colour :: Double -> Double -> Double -> Double -> Colour
pattern Colour r g b a = Colour' (ColorRGBA r g b a)

data ScaleP
  = NoScaleP
  | ScalePX
  | ScalePY
  | ScalePMinDim
  | ScalePArea

data Anchor = AnchorMiddle | AnchorStart | AnchorEnd

data EscapeText = EscapeText | NoEscapeText

data LineCap = LineCapButt | LineCapRound | LineCapSquare deriving (Eq, Show, Generic)

data LineJoin = LineJoinMiter | LineJoinBevel | LineJoinRound deriving (Eq, Show, Generic)

data GlyphShape
  = CircleGlyph
  | SquareGlyph
  | EllipseGlyph Double
  | RectSharpGlyph Double
  | RectRoundedGlyph Double Double Double
  | -- | line width is determined by borderSize
    TriangleGlyph (Point Double) (Point Double) (Point Double)
  | VLineGlyph
  | HLineGlyph
  | PathGlyph ByteString

About

License:Other

Languages

Language:Haskell 100.0%