module Graphics.Rendering.HSparklines
(
SparkOptions(..)
,rgb
,make
,smoothSpark
,barSpark
,savePngFile
,encodePngAsDataUrl
) where
import Codec.Binary.Base64 ( encode )
import Control.Monad
import Data.ByteString ( unpack )
import Data.List
import Data.Ord
import Graphics.GD
make :: SparkOptions -> [Float] -> IO Image
make so@(SmoothOptions {}) dp = renderSmooth so dp
make so@(BarOptions {}) dp = renderBar so dp
data SparkOptions = SmoothOptions
{
step :: Int
,height :: Int
,limits :: (Int,Int)
,bgColor :: Color
,minColor :: Color
,maxColor :: Color
,lastColor :: Color
,minMarker :: Bool
,maxMarker :: Bool
,lastMarker :: Bool
}
| BarOptions
{
step :: Int
,height :: Int
,limits :: (Int,Int)
,bgColor :: Color
,minColor :: Color
,maxColor :: Color
,lastColor :: Color
,minMarker :: Bool
,maxMarker :: Bool
,lastMarker :: Bool
}
deriving (Show)
smoothSpark :: SparkOptions
smoothSpark = SmoothOptions
{
step = 2
,height = 20
,limits = (0,100)
,bgColor = white
,minColor = red
,maxColor = green
,lastColor = blue
,minMarker = True
,maxMarker = True
,lastMarker = True
}
barSpark :: SparkOptions
barSpark = BarOptions
{
step = 2
,height = 20
,limits = (0,100)
,bgColor = white
,minColor = red
,maxColor = green
,lastColor = blue
,minMarker = True
,maxMarker = True
,lastMarker = True
}
renderSmooth :: SparkOptions -> [Float] -> IO Image
renderSmooth opt ds = do
let w = 4 + (step opt) * (length ds 1)
h = height opt
dmin = fst (limits opt)
dmax = snd (limits opt)
coords = zip [1,(1+(step opt))..(1+(step opt)*(length ds))]
[h round( (y(fi dmin)) / ((fi (dmaxdmin+1)) / (fi (h4))) )
| y <- ds ]
minpt = maximumBy (comparing snd) coords
maxpt = minimumBy (comparing snd) coords
endpt = last coords
img <- newImage (w,h)
drawFilledRectangle (0,0) (w,h) (bgColor opt) img
zipWithM_ (\p1 p2 -> antiAliased (drawLine p1 p2) grey img)
coords (drop 1 coords)
when (minMarker opt) (uncurry drawFilledRectangle (boxpt minpt) (minColor opt) img)
when (maxMarker opt) (uncurry drawFilledRectangle (boxpt maxpt) (maxColor opt) img)
when (lastMarker opt) (uncurry drawFilledRectangle (boxpt endpt) (lastColor opt)
img)
return img
renderBar :: SparkOptions -> [Float] -> IO Image
renderBar opt ds = do
let w = 4 + (step opt) * (length ds 1) + bw2 * length ds
h = height opt
dmin = fst (limits opt)
dmax = snd (limits opt)
bw = 1
bw2 = 2 * bw
coords = zip [1,(1+(step opt)+bw2)..(1+((step opt)+bw2)*(length ds))]
[h round( (y(fi dmin)) / ((fi (dmaxdmin+1)) / (fi (h4))) )
| y <- ds ]
minpt = maximumBy (comparing snd) coords
maxpt = minimumBy (comparing snd) coords
endpt = last coords
img <- newImage (w,h)
drawFilledRectangle (0,0) (w,h) (bgColor opt) img
forM_ coords $ \(x,y) ->
antiAliased (drawFilledRectangle (xbw,y) (x+bw,h)) grey img
when (minMarker opt) (uncurry drawFilledRectangle (boxpt minpt) (minColor opt) img)
when (maxMarker opt) (uncurry drawFilledRectangle (boxpt maxpt) (maxColor opt) img)
when (lastMarker opt) (uncurry drawFilledRectangle (boxpt endpt) (lastColor opt)
img)
return img
encodePngAsDataUrl :: Image -> IO String
encodePngAsDataUrl img = savePngByteString img >>= return . encode . unpack
fi :: (Num b, Integral a) => a -> b
fi x = fromIntegral x
boxpt :: (Num a) => (a,a) -> ((a,a),(a,a))
boxpt (x,y) = (,) (x1,y1) (x+1,y+1)
white,grey,red,green,blue :: Color
white = rgb 0xff 0xff 0xff
grey = rgb 0x88 0x88 0x88
red = rgb 0xff 0x00 0x00
green = rgb 0x00 0xff 0x00
blue = rgb 0x00 0x00 0xff