{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NegativeLiterals #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
#if ( __GLASGOW_HASKELL__ < 820 )
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#endif
module Chart.Core
(
Chart
, range
, projectss
, aspect
, asquare
, sixbyfour
, golden
, widescreen
, skinny
, AlignH(..)
, AlignV(..)
, alignHU
, alignHTU
, alignVU
, alignVTU
, Orientation(..)
, Place(..)
, positioned
, p_
, r_
, stack
, vert
, hori
, sepVert
, sepHori
, ucolor
, ublue
, ugrey
, scaleX
, scaleY
, scale
) where
import Diagrams.Prelude
hiding (Color, D, aspect, project, scale, scaleX, scaleY, zero)
import qualified Diagrams.Prelude as Diagrams
import qualified Diagrams.TwoD.Text
import NumHask.Pair
import NumHask.Prelude
import NumHask.Rect
import NumHask.Space
type Chart b =
( Renderable (Path V2 Double) b
, Renderable (Diagrams.TwoD.Text.Text Double) b) =>
QDiagram b V2 Double Any
projectss ::
(Functor f, Functor g)
=> Rect Double
-> Rect Double
-> g (f (Pair Double))
-> g (f (Pair Double))
projectss r0 r1 xyss = map (project r0 r1) <$> xyss
range :: (Foldable f, Foldable g) => g (f (Pair Double)) -> Rect Double
range xyss = foldMap space xyss
aspect :: (BoundedField a, Ord a, Multiplicative a, FromInteger a) => a -> Rect a
aspect a = Ranges ((a *) <$> one) one
asquare :: Rect Double
asquare = aspect 1
sixbyfour :: Rect Double
sixbyfour = aspect 1.5
golden :: Rect Double
golden = aspect 1.61803398875
widescreen :: Rect Double
widescreen = aspect 3
skinny :: Rect Double
skinny = aspect 5
data AlignH
= AlignLeft
| AlignCenter
| AlignRight
deriving (Eq, Show)
data AlignV
= AlignTop
| AlignMid
| AlignBottom
deriving (Eq, Show)
alignHU :: AlignH -> Double
alignHU a =
case a of
AlignLeft -> 0.5
AlignCenter -> 0
AlignRight -> -0.5
alignHTU :: AlignH -> Double
alignHTU a =
case a of
AlignLeft -> 0
AlignCenter -> -0.5
AlignRight -> -1
alignVU :: AlignV -> Double
alignVU a =
case a of
AlignTop -> -0.5
AlignMid -> 0
AlignBottom -> 0.5
alignVTU :: AlignV -> Double
alignVTU a =
case a of
AlignTop -> 0.5
AlignMid -> 0
AlignBottom -> -0.5
data Orientation
= Hori
| Vert
deriving (Eq, Show)
data Place
= PlaceLeft
| PlaceRight
| PlaceTop
| PlaceBottom
deriving (Eq, Show)
positioned :: (R2 r) => r Double -> Chart b -> Chart b
positioned p = moveTo (p_ p)
p_ :: (R2 r) => r Double -> Point V2 Double
p_ r = curry p2 (r ^. _x) (r ^. _y)
r_ :: R2 r => r a -> V2 a
r_ r = V2 (r ^. _x) (r ^. _y)
stack ::
( R2 r
, V a ~ V2
, Foldable t
, Juxtaposable a
, Semigroup a
, N a ~ Double
, Monoid a
)
=> r Double
-> (b -> a)
-> t b
-> a
stack dir f xs = foldr (\a x -> beside (r_ dir) (f a) x) mempty xs
vert ::
(V a ~ V2, Foldable t, Juxtaposable a, Semigroup a, N a ~ Double, Monoid a)
=> (b -> a)
-> t b
-> a
vert = stack (Pair 0 -1)
hori ::
(V a ~ V2, Foldable t, Juxtaposable a, Semigroup a, N a ~ Double, Monoid a)
=> (b -> a)
-> t b
-> a
hori = stack (Pair 1 0)
sepHori :: Double -> Chart b -> Chart b
sepHori s x = beside (r2 (0, -1)) x (strutX s)
sepVert :: Double -> Chart b -> Chart b
sepVert s x = beside (r2 (1, 0)) x (strutY s)
ucolor :: (Floating a, Ord a) => a -> a -> a -> a -> AlphaColour a
ucolor r g b o = withOpacity (sRGB r g b) o
ublue :: AlphaColour Double
ublue = ucolor 0.365 0.647 0.855 0.5
ugrey :: AlphaColour Double
ugrey = ucolor 0.4 0.4 0.4 1
instance R1 Pair where
_x f (Pair a b) = (`Pair` b) <$> f a
instance R2 Pair where
_y f (Pair a b) = Pair a <$> f b
_xy f p = fmap (\(V2 a b) -> Pair a b) . f . (\(Pair a b) -> V2 a b) $ p
eps :: N [Point V2 Double]
eps = 1e-8
scaleX ::
(N t ~ Double, Transformable t, R2 (V t), Diagrams.Additive (V t))
=> Double
-> t
-> t
scaleX s =
Diagrams.scaleX
(if s == zero
then eps
else s)
scaleY ::
(N t ~ Double, Transformable t, R2 (V t), Diagrams.Additive (V t))
=> Double
-> t
-> t
scaleY s =
Diagrams.scaleY
(if s == zero
then eps
else s)
scale ::
(N t ~ Double, Transformable t, R2 (V t), Diagrams.Additive (V t))
=> Double
-> t
-> t
scale s =
Diagrams.scale
(if s == zero
then eps
else s)