{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Chart.Glyph
( GlyphOptions(..)
, GlyphShape(..)
, glyphShape
, glyph_
, glyphs
, lglyphs
, glyphChart
, glyphChart_
, lglyphChart
, lglyphChart_
) where
import Chart.Core
import Chart.Text
import Diagrams.Prelude hiding (Color, D, scaleX, scaleY)
import NumHask.Pair
import NumHask.Prelude
import NumHask.Rect
data GlyphOptions = GlyphOptions
{ size :: Double
, color :: AlphaColour Double
, borderColor :: AlphaColour Double
, borderSize :: Double
, shape :: GlyphShape
} deriving (Show, Generic)
instance Default GlyphOptions where
def = GlyphOptions 0.03 ublue ugrey 0.015 Circle
data GlyphShape
= Circle
| Square
| Ellipse Double
| Triangle
| Pentagon
| Hexagon
| Septagon
| Octagaon
| RectSharp Double
| RectRounded Double
Double
| VLine Double
| HLine Double
deriving (Show)
glyphShape :: GlyphShape -> (Double -> Chart b)
glyphShape Circle = \x -> circle (x / 2)
glyphShape Square = square
glyphShape (Ellipse a) = ellipseXY a
glyphShape Triangle = triangle
glyphShape Pentagon = pentagon
glyphShape Hexagon = hexagon
glyphShape Septagon = septagon
glyphShape Octagaon = octagon
glyphShape (RectSharp a) = \x -> rect (a * x) x
glyphShape (RectRounded a r) = \x -> roundedRect (a * x) x r
glyphShape (VLine a) = \x -> vrule x # scaleX (1.6 / 0.5 * a)
glyphShape (HLine a) = \x -> hrule x # scaleY (1.6 / 0.5 * a)
glyph_ :: GlyphOptions -> Chart b
glyph_ (GlyphOptions s c bc bs sh) = glyphShape sh s # fcA c # lcA bc # lwN bs
glyphs :: (R2 r, Traversable f) => GlyphOptions -> f (r Double) -> Chart b
glyphs opts xs = mconcat $ toList $ (\x -> positioned x (glyph_ opts)) <$> xs
glyphChart ::
(Traversable f)
=> [GlyphOptions]
-> Rect Double
-> Rect Double
-> [f (Pair Double)]
-> Chart b
glyphChart optss asp r xyss =
mconcat $ zipWith glyphs optss (projectss r asp xyss)
glyphChart_ ::
(Traversable f)
=> [GlyphOptions]
-> Rect Double
-> [f (Pair Double)]
-> Chart b
glyphChart_ optss asp xyss = glyphChart optss asp (range xyss) xyss
lglyphs ::
(R2 r, Traversable f)
=> LabelOptions
-> GlyphOptions
-> f (Text, r Double)
-> Chart b
lglyphs lopts gopts xs =
mconcat $
toList $ (\(t, x) -> moveTo (p_ x) $ labelled lopts t (glyph_ gopts)) <$> xs
lglyphChart ::
(Traversable f)
=> [LabelOptions]
-> [GlyphOptions]
-> Rect Double
-> Rect Double
-> [f (Text, Pair Double)]
-> Chart b
lglyphChart ls gs asp r xyss =
mconcat $
getZipList $
lglyphs <$> ZipList ls <*> ZipList gs <*>
ZipList
(zipWith
zip
(map fst . toList <$> xyss)
(projectss r asp (map snd . toList <$> xyss)))
lglyphChart_ ::
(Traversable f)
=> [LabelOptions]
-> [GlyphOptions]
-> Rect Double
-> [f (Text, Pair Double)]
-> Chart b
lglyphChart_ ls gs asp xyss =
lglyphChart ls gs asp (range (map snd . toList <$> xyss)) xyss