module Graphics.Rendering.Chart.SparkLine
(
SparkLine(..)
, SparkOptions(..)
, smoothSpark
, barSpark
, sparkSize
, renderSparkLine
, sparkLineToRenderable
, sparkWidth
) where
import Control.Monad
import Data.List
import Data.Ord
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Renderable
import Data.Colour
import Data.Colour.Names
data SparkLine = SparkLine { SparkLine -> SparkOptions
sl_options :: SparkOptions
, SparkLine -> [Double]
sl_data :: [Double]
}
data SparkOptions = SparkOptions
{ SparkOptions -> Bool
so_smooth :: Bool
, SparkOptions -> Int
so_step :: Int
, SparkOptions -> Int
so_height :: Int
, SparkOptions -> (Double, Double)
so_limits :: (Double,Double)
, SparkOptions -> Colour Double
so_bgColor :: Colour Double
, SparkOptions -> Colour Double
so_minColor :: Colour Double
, SparkOptions -> Colour Double
so_maxColor :: Colour Double
, SparkOptions -> Colour Double
so_lastColor :: Colour Double
, SparkOptions -> Bool
so_minMarker :: Bool
, SparkOptions -> Bool
so_maxMarker :: Bool
, SparkOptions -> Bool
so_lastMarker :: Bool
} deriving (Int -> SparkOptions -> ShowS
[SparkOptions] -> ShowS
SparkOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SparkOptions] -> ShowS
$cshowList :: [SparkOptions] -> ShowS
show :: SparkOptions -> String
$cshow :: SparkOptions -> String
showsPrec :: Int -> SparkOptions -> ShowS
$cshowsPrec :: Int -> SparkOptions -> ShowS
Show)
smoothSpark :: SparkOptions
smoothSpark :: SparkOptions
smoothSpark = SparkOptions
{ so_smooth :: Bool
so_smooth = Bool
True
, so_step :: Int
so_step = Int
2
, so_height :: Int
so_height = Int
20
, so_limits :: (Double, Double)
so_limits = (Double
0,Double
100)
, so_bgColor :: Colour Double
so_bgColor = forall a. (Ord a, Floating a) => Colour a
white
, so_minColor :: Colour Double
so_minColor = forall a. (Ord a, Floating a) => Colour a
red
, so_maxColor :: Colour Double
so_maxColor = forall a. (Ord a, Floating a) => Colour a
green
, so_lastColor :: Colour Double
so_lastColor = forall a. (Ord a, Floating a) => Colour a
blue
, so_minMarker :: Bool
so_minMarker = Bool
True
, so_maxMarker :: Bool
so_maxMarker = Bool
True
, so_lastMarker :: Bool
so_lastMarker = Bool
True
}
barSpark :: SparkOptions
barSpark :: SparkOptions
barSpark = SparkOptions
smoothSpark { so_smooth :: Bool
so_smooth=Bool
False }
sparkLineToRenderable :: SparkLine -> Renderable ()
sparkLineToRenderable :: SparkLine -> Renderable ()
sparkLineToRenderable SparkLine
sp = Renderable
{ minsize :: BackendProgram (Double, Double)
minsize = let (Int
w,Int
h) = SparkLine -> (Int, Int)
sparkSize SparkLine
sp in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w , forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
, render :: (Double, Double) -> BackendProgram (PickFn ())
render = \(Double, Double)
_rect-> SparkLine -> BackendProgram (PickFn ())
renderSparkLine SparkLine
sp
}
instance ToRenderable SparkLine where
toRenderable :: SparkLine -> Renderable ()
toRenderable = SparkLine -> Renderable ()
sparkLineToRenderable
sparkWidth :: SparkLine -> Int
sparkWidth :: SparkLine -> Int
sparkWidth SparkLine{sl_options :: SparkLine -> SparkOptions
sl_options=SparkOptions
opt, sl_data :: SparkLine -> [Double]
sl_data=[Double]
ds} =
let w :: Int
w = Int
4 forall a. Num a => a -> a -> a
+ (SparkOptions -> Int
so_step SparkOptions
opt) forall a. Num a => a -> a -> a
* (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
extrawidth
extrawidth :: Int
extrawidth | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
| Bool
otherwise = Int
bw forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds
bw :: Int
bw | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
| Bool
otherwise = Int
2
in Int
w
sparkSize :: SparkLine -> (Int,Int)
sparkSize :: SparkLine -> (Int, Int)
sparkSize SparkLine
s = (SparkLine -> Int
sparkWidth SparkLine
s, SparkOptions -> Int
so_height (SparkLine -> SparkOptions
sl_options SparkLine
s))
renderSparkLine :: SparkLine -> BackendProgram (PickFn ())
renderSparkLine :: SparkLine -> BackendProgram (PickFn ())
renderSparkLine SparkLine{sl_options :: SparkLine -> SparkOptions
sl_options=SparkOptions
opt, sl_data :: SparkLine -> [Double]
sl_data=[Double]
ds} =
let w :: Int
w = Int
4 forall a. Num a => a -> a -> a
+ (SparkOptions -> Int
so_step SparkOptions
opt) forall a. Num a => a -> a -> a
* (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
extrawidth
extrawidth :: Int
extrawidth | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
| Bool
otherwise = Int
bw forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds
bw :: Int
bw | SparkOptions -> Bool
so_smooth SparkOptions
opt = Int
0
| Bool
otherwise = Int
2
h :: Int
h = SparkOptions -> Int
so_height SparkOptions
opt
dmin :: Double
dmin = forall a b. (a, b) -> a
fst (SparkOptions -> (Double, Double)
so_limits SparkOptions
opt)
dmax :: Double
dmax = forall a b. (a, b) -> b
snd (SparkOptions -> (Double, Double)
so_limits SparkOptions
opt)
coords :: [Point]
coords = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x Double
y-> Double -> Double -> Point
Point (forall b a. (Num b, Integral a) => a -> b
fi Int
x) Double
y)
[Int
1,(Int
1forall a. Num a => a -> a -> a
+Int
bwforall a. Num a => a -> a -> a
+SparkOptions -> Int
so_step SparkOptions
opt)..(Int
1forall a. Num a => a -> a -> a
+(SparkOptions -> Int
so_step SparkOptions
optforall a. Num a => a -> a -> a
+Int
bw)forall a. Num a => a -> a -> a
*(forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ds))]
[ forall b a. (Num b, Integral a) => a -> b
fi Int
h forall a. Num a => a -> a -> a
- ( (Double
yforall a. Num a => a -> a -> a
-Double
dmin) forall a. Fractional a => a -> a -> a
/
((Double
dmaxforall a. Num a => a -> a -> a
-Double
dminforall a. Num a => a -> a -> a
+Double
1) forall a. Fractional a => a -> a -> a
/ forall b a. (Num b, Integral a) => a -> b
fi (Int
hforall a. Num a => a -> a -> a
-Int
4)) )
| Double
y <- [Double]
ds ]
minpt :: Point
minpt = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point -> Double
p_y) [Point]
coords
maxpt :: Point
maxpt = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point -> Double
p_y) [Point]
coords
endpt :: Point
endpt = forall a. [a] -> a
last [Point]
coords
boxpt :: Point -> Rect
boxpt :: Point -> Rect
boxpt (Point Double
x Double
y) = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point (Double
xforall a. Num a => a -> a -> a
-Double
1)(Double
yforall a. Num a => a -> a -> a
-Double
1)) (Double -> Double -> Point
Point (Double
xforall a. Num a => a -> a -> a
+Double
1)(Double
yforall a. Num a => a -> a -> a
+Double
1))
fi :: (Num b, Integral a) => a -> b
fi :: forall b a. (Num b, Integral a) => a -> b
fi = forall a b. (Integral a, Num b) => a -> b
fromIntegral
in do
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_bgColor SparkOptions
opt))) forall a b. (a -> b) -> a -> b
$ do
Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
0 Double
0) (Double -> Double -> Point
Point (forall b a. (Num b, Integral a) => a -> b
fi Int
w) (forall b a. (Num b, Integral a) => a -> b
fi Int
h))))
if SparkOptions -> Bool
so_smooth SparkOptions
opt
then do
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (Double -> AlphaColour Double -> LineStyle
solidLine Double
1 (forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
grey)) forall a b. (a -> b) -> a -> b
$ do
[Point]
p <- [Point] -> BackendProgram [Point]
alignStrokePoints [Point]
coords
[Point] -> BackendProgram ()
strokePointPath [Point]
p
else do
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
grey)) forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Point]
coords forall a b. (a -> b) -> a -> b
$ \ (Point Double
x Double
y) ->
Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point (Double
xforall a. Num a => a -> a -> a
-Double
1) Double
y) (Double -> Double -> Point
Point (Double
xforall a. Num a => a -> a -> a
+Double
1) (forall b a. (Num b, Integral a) => a -> b
fi Int
h))))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SparkOptions -> Bool
so_minMarker SparkOptions
opt) forall a b. (a -> b) -> a -> b
$ do
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_minColor SparkOptions
opt))) forall a b. (a -> b) -> a -> b
$ do
Path
p <- Path -> BackendProgram Path
alignFillPath (Rect -> Path
rectPath (Point -> Rect
boxpt Point
minpt))
Path -> BackendProgram ()
fillPath Path
p
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SparkOptions -> Bool
so_maxMarker SparkOptions
opt) forall a b. (a -> b) -> a -> b
$ do
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_maxColor SparkOptions
opt))) forall a b. (a -> b) -> a -> b
$ do
Path
p <- Path -> BackendProgram Path
alignFillPath (Rect -> Path
rectPath (Point -> Rect
boxpt Point
maxpt))
Path -> BackendProgram ()
fillPath Path
p
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SparkOptions -> Bool
so_lastMarker SparkOptions
opt) forall a b. (a -> b) -> a -> b
$ do
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (AlphaColour Double -> FillStyle
solidFillStyle (forall a. Num a => Colour a -> AlphaColour a
opaque (SparkOptions -> Colour Double
so_lastColor SparkOptions
opt))) forall a b. (a -> b) -> a -> b
$ do
Path
p <- Path -> BackendProgram Path
alignFillPath (Rect -> Path
rectPath (Point -> Rect
boxpt Point
endpt))
Path -> BackendProgram ()
fillPath Path
p
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. PickFn a
nullPickFn