#if ( __GLASGOW_HASKELL__ < 820 )
#endif
module Chart.Rect
( RectOptions(..)
, blob
, box
, clear
, bound
, rect_
, rects
, rectChart
, rectChart_
, Pixel(..)
, pixel_
, pixels
, pixelChart
, pixelChart_
, PixelationOptions(..)
, pixelate
, pixelateChart
) where
import Chart.Core
import Diagrams.Prelude hiding (Color, D, scaleX, scaleY, (<>))
import NumHask.Pair
import NumHask.Prelude
import NumHask.Range
import NumHask.Rect
import NumHask.Space
data RectOptions = RectOptions
{ rectBorderSize :: Double
, rectBorderColor :: AlphaColour Double
, rectColor :: AlphaColour Double
}
instance Default RectOptions where
def = RectOptions 0.005 ugrey ublue
blob :: AlphaColour Double -> RectOptions
blob c = RectOptions 0 transparent c
clear :: RectOptions
clear = RectOptions 0 transparent transparent
box :: AlphaColour Double -> RectOptions
box c = RectOptions 0.015 c transparent
bound :: RectOptions -> Double -> Chart b -> Chart b
bound (RectOptions bs bc c) p x =
(boundingRect x' # lcA bc # lwN bs # fcA c) <> x'
where
x' = pad p x
rect_ ::
( N b ~ Double
, V b ~ V2
, Transformable b
, HasOrigin b
, TrailLike b
, HasStyle b
)
=> RectOptions
-> Rect Double
-> b
rect_ (RectOptions bs bc c) (Rect x z y w) =
unitSquare # moveTo (p2 (0.5, 0.5)) # scaleX (z x) # scaleY (w y) #
moveTo (p2 (x, y)) #
fcA c #
lcA bc #
lwN bs
rects ::
( V a ~ V2
, N a ~ Double
, Functor t
, HasStyle a
, TrailLike a
, HasOrigin a
, Transformable a
, Foldable t
, Monoid a
)
=> RectOptions
-> t (Rect Double)
-> a
rects opts xs = mconcat $ toList $ rect_ opts <$> xs
rectChart ::
(Traversable f)
=> [RectOptions]
-> Aspect
-> Rect Double
-> [f (Rect Double)]
-> Chart b
rectChart optss (Aspect asp) r rs =
mconcat . zipWith rects optss $ fmap (projectRect r asp) <$> rs
rectChart_ ::
(Traversable f) => [RectOptions] -> Aspect -> [f (Rect Double)] -> Chart b
rectChart_ optss asp rs = rectChart optss asp (fold $ fold <$> rs) rs
data Pixel = Pixel
{ pixelRect :: Rect Double
, pixelColor :: AlphaColour Double
}
pixel_ :: Pixel -> Chart b
pixel_ (Pixel (Rect x z y w) c) =
unitSquare # moveTo (p2 (0.5, 0.5)) # scaleX (z x) # scaleY (w y) #
moveTo (p2 (x, y)) #
fcA c #
lcA transparent #
lw 0
pixels :: (Traversable f) => f Pixel -> Chart b
pixels ps = mconcat $ toList $ pixel_ <$> ps
pixelChart :: (Traversable f) => Aspect -> Rect Double -> [f Pixel] -> Chart b
pixelChart (Aspect asp) r pss =
mconcat $ pixels . projectPixels r asp . toList <$> pss
where
projectPixels r0 r1 ps =
zipWith Pixel (projectRect r0 r1 . pixelRect <$> ps) (pixelColor <$> ps)
pixelChart_ :: (Traversable f) => Aspect -> [f Pixel] -> Chart b
pixelChart_ asp ps = pixelChart asp (fold $ fold . map pixelRect <$> ps) ps
data PixelationOptions = PixelationOptions
{ pixelationGradient :: Range (AlphaColour Double)
, pixelationGrain :: Pair Int
}
instance Default PixelationOptions where
def = PixelationOptions
(Range (ucolor 0.47 0.73 0.86 1) (ucolor 0.01 0.06 0.22 1))
(Pair 40 40)
pixelate ::
PixelationOptions -> Rect Double -> (Pair Double -> Double) -> [Pixel]
pixelate (PixelationOptions (Range lc0 uc0) grain) xy f = zipWith Pixel g cs
where
g = gridSpace xy grain
xs = f . mid <$> g
(Range lx ux) = space xs
cs = (\x -> blend ((x lx) / (ux lx)) lc0 uc0) <$> xs
pixelateChart ::
PixelationOptions
-> Aspect
-> Rect Double
-> (Pair Double -> Double)
-> Chart b
pixelateChart opts asp xy f = pixelChart asp xy [pixelate opts xy f]