module Graphics.Rendering.Chart.Plot.AreaSpots
( AreaSpots(..)
, defaultAreaSpots
, area_spots_title
, area_spots_linethick
, area_spots_linecolour
, area_spots_fillcolour
, area_spots_max_radius
, area_spots_values
, AreaSpots4D(..)
, defaultAreaSpots4D
, area_spots_4d_title
, area_spots_4d_linethick
, area_spots_4d_palette
, area_spots_4d_max_radius
, area_spots_4d_values
) where
import qualified Graphics.Rendering.Cairo as C
import Graphics.Rendering.Chart.Types
import Graphics.Rendering.Chart.Plot.Types
import Graphics.Rendering.Chart.Axis
import Data.Accessor.Template
import Data.Colour
import Data.Colour.Names
import Control.Monad
fst3 (a,_,_) = a
snd3 (_,a,_) = a
thd3 (_,_,a) = a
fst4 (a,_,_,_) = a
snd4 (_,a,_,_) = a
thd4 (_,_,a,_) = a
fth4 (_,_,_,a) = a
data AreaSpots z x y = AreaSpots
{ area_spots_title_ :: String
, area_spots_linethick_ :: Double
, area_spots_linecolour_ :: AlphaColour Double
, area_spots_fillcolour_ :: AlphaColour Double
, area_spots_max_radius_ :: Double
, area_spots_values_ :: [(x,y,z)]
}
defaultAreaSpots :: AreaSpots z x y
defaultAreaSpots = AreaSpots
{ area_spots_title_ = ""
, area_spots_linethick_ = 0.1
, area_spots_linecolour_ = opaque blue
, area_spots_fillcolour_ = flip withOpacity 0.2 blue
, area_spots_max_radius_ = 20
, area_spots_values_ = []
}
instance (PlotValue z) => ToPlot (AreaSpots z) where
toPlot p = Plot { plot_render_ = renderAreaSpots p
, plot_legend_ = [(area_spots_title_ p, renderSpotLegend p)]
, plot_all_points_ = ( map fst3 (area_spots_values_ p)
, map snd3 (area_spots_values_ p) )
}
renderAreaSpots :: (PlotValue z) =>
AreaSpots z x y -> PointMapFn x y -> CRender ()
renderAreaSpots p pmap = preserveCState $
forM_ (scaleMax ((area_spots_max_radius_ p)^2)
(area_spots_values_ p))
(\ (x,y,z)-> do
let radius = sqrt z
let (CairoPointStyle drawSpotAt) = filledCircles radius
(area_spots_fillcolour_ p)
drawSpotAt (pmap (LValue x, LValue y))
let (CairoPointStyle drawOutlineAt) = hollowCircles radius
(area_spots_linethick_ p)
(area_spots_linecolour_ p)
drawOutlineAt (pmap (LValue x, LValue y))
)
where
scaleMax :: PlotValue z => Double -> [(x,y,z)] -> [(x,y,Double)]
scaleMax n points = let largest = maximum (map (toValue . thd3) points)
scale v = n * toValue v / largest
in map (\ (x,y,z) -> (x,y, scale z)) points
renderSpotLegend :: AreaSpots z x y -> Rect -> CRender ()
renderSpotLegend p r@(Rect p1 p2) = preserveCState $ do
let radius = min (abs (p_y p1 p_y p2)) (abs (p_x p1 p_x p2))
centre = linearInterpolate p1 p2
let (CairoPointStyle drawSpotAt) = filledCircles radius
(area_spots_fillcolour_ p)
drawSpotAt centre
let (CairoPointStyle drawOutlineAt) = hollowCircles radius
(area_spots_linethick_ p)
(area_spots_linecolour_ p)
drawOutlineAt centre
where
linearInterpolate (Point x0 y0) (Point x1 y1) =
Point (x0 + abs(x1x0)/2) (y0 + abs(y1y0)/2)
data AreaSpots4D z t x y = AreaSpots4D
{ area_spots_4d_title_ :: String
, area_spots_4d_linethick_ :: Double
, area_spots_4d_palette_ :: [Colour Double]
, area_spots_4d_max_radius_ :: Double
, area_spots_4d_values_ :: [(x,y,z,t)]
}
defaultAreaSpots4D :: AreaSpots4D z t x y
defaultAreaSpots4D = AreaSpots4D
{ area_spots_4d_title_ = ""
, area_spots_4d_linethick_ = 0.1
, area_spots_4d_palette_ = [ blue, green, yellow, orange, red ]
, area_spots_4d_max_radius_ = 20
, area_spots_4d_values_ = []
}
instance (PlotValue z, PlotValue t, Show t) => ToPlot (AreaSpots4D z t) where
toPlot p = Plot { plot_render_ = renderAreaSpots4D p
, plot_legend_ = [ (area_spots_4d_title_ p
, renderSpotLegend4D p) ]
, plot_all_points_ = ( map fst4 (area_spots_4d_values_ p)
, map snd4 (area_spots_4d_values_ p) )
}
renderAreaSpots4D :: (PlotValue z, PlotValue t, Show t) =>
AreaSpots4D z t x y -> PointMapFn x y -> CRender ()
renderAreaSpots4D p pmap = preserveCState $
forM_ (scaleMax ((area_spots_4d_max_radius_ p)^2)
(length (area_spots_4d_palette_ p))
(area_spots_4d_values_ p))
(\ (x,y,z,t)-> do
let radius = sqrt z
let colour = (area_spots_4d_palette_ p) !! t
let (CairoPointStyle drawSpotAt)
= filledCircles radius (flip withOpacity 0.2 colour)
drawSpotAt (pmap (LValue x, LValue y))
let (CairoPointStyle drawOutlineAt)
= hollowCircles radius (area_spots_4d_linethick_ p)
(opaque colour)
drawOutlineAt (pmap (LValue x, LValue y))
)
where
scaleMax :: (PlotValue z, PlotValue t, Show t) =>
Double -> Int -> [(x,y,z,t)] -> [(x,y,Double,Int)]
scaleMax n c points = let largest = maximum (map (toValue . thd4) points)
scale v = n * toValue v / largest
colVals = map (toValue . fth4) points
colMin = minimum colVals
colMax = maximum colVals
select t = min (c1) $
truncate ( fromIntegral c
* (toValue tcolMin)
/ (colMaxcolMin))
in map (\ (x,y,z,t) -> (x,y, scale z, select t))
points
renderSpotLegend4D :: AreaSpots4D z t x y -> Rect -> CRender ()
renderSpotLegend4D p r@(Rect p1 p2) = preserveCState $ do
let radius = min (abs (p_y p1 p_y p2)) (abs (p_x p1 p_x p2))
centre = linearInterpolate p1 p2
let (CairoPointStyle drawSpotAt) = filledCircles radius
(flip withOpacity 0.2 $
head (area_spots_4d_palette_ p))
drawSpotAt centre
let (CairoPointStyle drawOutlineAt) = hollowCircles radius
(area_spots_4d_linethick_ p)
(opaque $
head (area_spots_4d_palette_ p))
drawOutlineAt centre
where
linearInterpolate (Point x0 y0) (Point x1 y1) =
Point (x0 + abs(x1x0)/2) (y0 + abs(y1y0)/2)
$( deriveAccessors ''AreaSpots )
$( deriveAccessors ''AreaSpots4D )