module Diagrams.TwoD.Image
(
DImage(..), ImageData(..)
, Embedded, External
, image
, loadImageEmb
, loadImageExt
, uncheckedImageRef
, raster
, rasterDia
) where
import Codec.Picture
import Codec.Picture.Types (dynamicMap)
import Data.Typeable (Typeable)
import Data.Colour (AlphaColour)
import Diagrams.Core
import Diagrams.Attributes (colorToSRGBA)
import Diagrams.Path (Path)
import Diagrams.TwoD.Path (isInsideEvenOdd)
import Diagrams.TwoD.Shapes (rect)
import Diagrams.TwoD.Types (R2, T2)
import Data.AffineSpace ((.-.))
import Data.Semigroup
data Embedded deriving Typeable
data External deriving Typeable
data ImageData :: * -> * where
ImageRaster :: DynamicImage -> ImageData Embedded
ImageRef :: FilePath -> ImageData External
data DImage :: * -> * where
DImage :: ImageData t -> Int -> Int -> T2 -> DImage t
deriving Typeable
type instance V (DImage a) = R2
instance Transformable (DImage a) where
transform t1 (DImage iD w h t2) = DImage iD w h (t1 <> t2)
instance HasOrigin (DImage a) where
moveOriginTo p = translate (origin .-. p)
image :: (Typeable a, Renderable (DImage a) b) => DImage a -> Diagram b R2
image img = mkQD (Prim (img)) (getEnvelope r) (getTrace r) mempty
(Query $ \p -> Any (isInsideEvenOdd p r))
where
r :: Path R2
r = rect (fromIntegral w) (fromIntegral h)
DImage _ w h _ = img
loadImageEmb :: FilePath -> IO (Either String (DImage Embedded))
loadImageEmb path = do
dImg <- readImage path
return $ case dImg of
Left msg -> Left msg
Right img -> Right (DImage (ImageRaster img) w h mempty)
where
w = dynamicMap imageWidth img
h = dynamicMap imageHeight img
loadImageExt :: FilePath -> IO (Either String (DImage External))
loadImageExt path = do
dImg <- readImage path
return $ case dImg of
Left msg -> Left msg
Right img -> Right $ DImage (ImageRef path) w h mempty
where
w = dynamicMap imageWidth img
h = dynamicMap imageHeight img
uncheckedImageRef :: FilePath -> Int -> Int -> DImage External
uncheckedImageRef path w h = DImage (ImageRef path) w h mempty
rasterDia :: Renderable (DImage Embedded) b
=> (Int -> Int -> AlphaColour Double) -> Int -> Int -> Diagram b R2
rasterDia f w h = image $ raster f w h
raster :: (Int -> Int -> AlphaColour Double) -> Int -> Int -> DImage Embedded
raster f w h = DImage (ImageRaster (ImageRGBA8 img)) w h mempty
where
img = generateImage g w h
g x y = fromAlphaColour $ f x y
fromAlphaColour :: AlphaColour Double -> PixelRGBA8
fromAlphaColour c = PixelRGBA8 r g b a
where
(r, g, b, a) = (int r', int g', int b', int a')
(r', g', b', a') = colorToSRGBA c
int x = round (255 * x)
instance Renderable (DImage a) NullBackend where
render _ _ = mempty