{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE EmptyDataDecls        #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Image
-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Importing external images into diagrams.  Usage example: To create
-- a diagram from an embedded image with width 1 and height set
-- according to the aspect ratio, use @image img # scaleUToX 1@, where
-- @img@ is a value of type @DImage n e@, created with a function like
-- 'loadImageEmb', 'loadImageExt', or 'raster'.
-----------------------------------------------------------------------------

module Diagrams.TwoD.Image
    (
      DImage(..), ImageData(..)
    , Embedded, External, Native
    , image
    , embeddedImage
    , loadImageEmb
    , loadImageEmbBS
    , loadImageExt
    , uncheckedImageRef
    , raster
    , rasterDia
    ) where

import           Codec.Picture

import           Data.Colour          (AlphaColour)
import           Data.Kind            (Type)
import           Data.Semigroup
import           Data.Typeable        (Typeable)

import           Diagrams.Core

import           Diagrams.Attributes  (colorToSRGBA)
import           Diagrams.Path        (Path)
import           Diagrams.Query
import           Diagrams.TwoD.Path   (isInsideEvenOdd)
import           Diagrams.TwoD.Shapes (rect)
import           Diagrams.TwoD.Types

import           Data.ByteString

import           Linear.Affine

data Embedded deriving Typeable
data External deriving Typeable
data Native (t :: Type) deriving Typeable

-- | 'ImageData' is either a JuicyPixels @DynamicImage@ tagged as 'Embedded' or
--   a reference tagged as 'External'. Additionally 'Native' is provided for
--   external libraries to hook into.
data ImageData :: Type -> Type where
  ImageRaster :: DynamicImage -> ImageData Embedded
  ImageRef    :: FilePath -> ImageData External
  ImageNative :: t -> ImageData (Native t)

-------------------------------------------------------------------------------
-- | An image primitive, the two ints are width followed by height.
--   Will typically be created by @loadImageEmb@ or @loadImageExt@ which,
--   will handle setting the width and height to the actual width and height
--   of the image.
data DImage :: Type -> Type -> Type where
  DImage :: ImageData t -> Int -> Int -> Transformation V2 n -> DImage n t
  deriving Typeable

type instance V (DImage n a) = V2
type instance N (DImage n a) = n

instance RealFloat n => HasQuery (DImage n a) Any where
  getQuery :: DImage n a -> Query (V (DImage n a)) (N (DImage n a)) Any
getQuery (DImage ImageData a
_ Int
w Int
h Transformation V2 n
_) = -- transform t $
    (Point (V (DImage n a)) (N (DImage n a)) -> Any)
-> Query (V (DImage n a)) (N (DImage n a)) Any
forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query ((Point (V (DImage n a)) (N (DImage n a)) -> Any)
 -> Query (V (DImage n a)) (N (DImage n a)) Any)
-> (Point (V (DImage n a)) (N (DImage n a)) -> Any)
-> Query (V (DImage n a)) (N (DImage n a)) Any
forall a b. (a -> b) -> a -> b
$ \Point (V (DImage n a)) (N (DImage n a))
p -> Bool -> Any
Any (Path V2 n -> Point (V (Path V2 n)) (N (Path V2 n)) -> Bool
forall t. HasQuery t Crossings => t -> Point (V t) (N t) -> Bool
isInsideEvenOdd Path V2 n
r Point (V (Path V2 n)) (N (Path V2 n))
Point (V (DImage n a)) (N (DImage n a))
p)
    where
    r :: Path V2 n
r = n -> n -> Path V2 n
forall n. RealFloat n => n -> n -> Path V2 n
rectPath (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)

instance Fractional n => Transformable (DImage n a) where
  transform :: Transformation (V (DImage n a)) (N (DImage n a))
-> DImage n a -> DImage n a
transform Transformation (V (DImage n a)) (N (DImage n a))
t1 (DImage ImageData a
iD Int
w Int
h Transformation V2 n
t2) = ImageData a -> Int -> Int -> Transformation V2 n -> DImage n a
forall t n.
ImageData t -> Int -> Int -> Transformation V2 n -> DImage n t
DImage ImageData a
iD Int
w Int
h (Transformation (V (DImage n a)) (N (DImage n a))
Transformation V2 n
t1 Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall a. Semigroup a => a -> a -> a
<> Transformation V2 n
t2)

instance Fractional n => HasOrigin (DImage n a) where
  moveOriginTo :: Point (V (DImage n a)) (N (DImage n a)) -> DImage n a -> DImage n a
moveOriginTo Point (V (DImage n a)) (N (DImage n a))
p = Vn (DImage n a) -> DImage n a -> DImage n a
forall t. Transformable t => Vn t -> t -> t
translate (Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point (V (DImage n a)) (N (DImage n a))
Point V2 n
p)

-- | Make a 'DImage' into a 'Diagram'.
image :: (TypeableFloat n, Typeable a, Renderable (DImage n a) b)
      => DImage n a -> QDiagram b V2 n Any
image :: forall n a b.
(TypeableFloat n, Typeable a, Renderable (DImage n a) b) =>
DImage n a -> QDiagram b V2 n Any
image DImage n a
img
  = Prim b V2 n
-> Envelope V2 n
-> Trace V2 n
-> SubMap b V2 n Any
-> Query V2 n Any
-> QDiagram b V2 n Any
forall b (v :: * -> *) n m.
Prim b v n
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD (DImage n a -> Prim b (V (DImage n a)) (N (DImage n a))
forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim DImage n a
img)
         (Path V2 n -> Envelope (V (Path V2 n)) (N (Path V2 n))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope Path V2 n
r)
         (Path V2 n -> Trace (V (Path V2 n)) (N (Path V2 n))
forall a. Traced a => a -> Trace (V a) (N a)
getTrace Path V2 n
r)
         SubMap b V2 n Any
forall a. Monoid a => a
mempty
         ((Point V2 n -> Any) -> Query V2 n Any
forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query ((Point V2 n -> Any) -> Query V2 n Any)
-> (Point V2 n -> Any) -> Query V2 n Any
forall a b. (a -> b) -> a -> b
$ \Point V2 n
p -> Bool -> Any
Any (Path V2 n -> Point (V (Path V2 n)) (N (Path V2 n)) -> Bool
forall t. HasQuery t Crossings => t -> Point (V t) (N t) -> Bool
isInsideEvenOdd Path V2 n
r Point (V (Path V2 n)) (N (Path V2 n))
Point V2 n
p))
  where
    r :: Path V2 n
r = n -> n -> Path V2 n
forall n. RealFloat n => n -> n -> Path V2 n
rectPath (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
    -- should we use the transform here?
    DImage ImageData a
_ Int
w Int
h Transformation V2 n
_ = DImage n a
img

rectPath :: RealFloat n => n -> n -> Path V2 n
rectPath :: forall n. RealFloat n => n -> n -> Path V2 n
rectPath = n -> n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect

-- | Read a JuicyPixels @DynamicImage@ and wrap it in a 'DImage'.
--   The width and height of the image are set to their actual values.
embeddedImage :: Num n => DynamicImage -> DImage n Embedded
embeddedImage :: forall n. Num n => DynamicImage -> DImage n Embedded
embeddedImage DynamicImage
img = ImageData Embedded
-> Int -> Int -> Transformation V2 n -> DImage n Embedded
forall t n.
ImageData t -> Int -> Int -> Transformation V2 n -> DImage n t
DImage (DynamicImage -> ImageData Embedded
ImageRaster DynamicImage
img) Int
w Int
h Transformation V2 n
forall a. Monoid a => a
mempty
  where
    w :: Int
w = (forall pixel. Pixel pixel => Image pixel -> Int)
-> DynamicImage -> Int
forall a.
(forall pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap Image pixel -> Int
forall pixel. Pixel pixel => Image pixel -> Int
forall a. Image a -> Int
imageWidth DynamicImage
img
    h :: Int
h = (forall pixel. Pixel pixel => Image pixel -> Int)
-> DynamicImage -> Int
forall a.
(forall pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap Image pixel -> Int
forall pixel. Pixel pixel => Image pixel -> Int
forall a. Image a -> Int
imageHeight DynamicImage
img

-- | Use JuicyPixels to read a file in any format and wrap it in a 'DImage'.
--   The width and height of the image are set to their actual values.
loadImageEmb :: Num n => FilePath -> IO (Either String (DImage n Embedded))
loadImageEmb :: forall n.
Num n =>
FilePath -> IO (Either FilePath (DImage n Embedded))
loadImageEmb FilePath
path = (DynamicImage -> DImage n Embedded)
-> Either FilePath DynamicImage
-> Either FilePath (DImage n Embedded)
forall a b. (a -> b) -> Either FilePath a -> Either FilePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DynamicImage -> DImage n Embedded
forall n. Num n => DynamicImage -> DImage n Embedded
embeddedImage (Either FilePath DynamicImage
 -> Either FilePath (DImage n Embedded))
-> IO (Either FilePath DynamicImage)
-> IO (Either FilePath (DImage n Embedded))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO (Either FilePath DynamicImage)
readImage FilePath
path

-- | A pure variant of 'loadImageEmb'
loadImageEmbBS :: Num n => ByteString -> Either String (DImage n Embedded)
loadImageEmbBS :: forall n.
Num n =>
ByteString -> Either FilePath (DImage n Embedded)
loadImageEmbBS ByteString
bs = DynamicImage -> DImage n Embedded
forall n. Num n => DynamicImage -> DImage n Embedded
embeddedImage (DynamicImage -> DImage n Embedded)
-> Either FilePath DynamicImage
-> Either FilePath (DImage n Embedded)
forall a b. (a -> b) -> Either FilePath a -> Either FilePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ByteString -> Either FilePath DynamicImage
decodeImage ByteString
bs

-- | Check that a file exists, and use JuicyPixels to figure out
--   the right size, but save a reference to the image instead
--   of the raster data
loadImageExt :: Num n => FilePath -> IO (Either String (DImage n External))
loadImageExt :: forall n.
Num n =>
FilePath -> IO (Either FilePath (DImage n External))
loadImageExt FilePath
path = do
  Either FilePath DynamicImage
dImg <- FilePath -> IO (Either FilePath DynamicImage)
readImage FilePath
path
  Either FilePath (DImage n External)
-> IO (Either FilePath (DImage n External))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (DImage n External)
 -> IO (Either FilePath (DImage n External)))
-> Either FilePath (DImage n External)
-> IO (Either FilePath (DImage n External))
forall a b. (a -> b) -> a -> b
$ case Either FilePath DynamicImage
dImg of
    Left FilePath
msg  -> FilePath -> Either FilePath (DImage n External)
forall a b. a -> Either a b
Left FilePath
msg
    Right DynamicImage
img -> DImage n External -> Either FilePath (DImage n External)
forall a b. b -> Either a b
Right (DImage n External -> Either FilePath (DImage n External))
-> DImage n External -> Either FilePath (DImage n External)
forall a b. (a -> b) -> a -> b
$ ImageData External
-> Int -> Int -> Transformation V2 n -> DImage n External
forall t n.
ImageData t -> Int -> Int -> Transformation V2 n -> DImage n t
DImage (FilePath -> ImageData External
ImageRef FilePath
path) Int
w Int
h Transformation V2 n
forall a. Monoid a => a
mempty
      where
        w :: Int
w = (forall pixel. Pixel pixel => Image pixel -> Int)
-> DynamicImage -> Int
forall a.
(forall pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap Image pixel -> Int
forall pixel. Pixel pixel => Image pixel -> Int
forall a. Image a -> Int
imageWidth DynamicImage
img
        h :: Int
h = (forall pixel. Pixel pixel => Image pixel -> Int)
-> DynamicImage -> Int
forall a.
(forall pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap Image pixel -> Int
forall pixel. Pixel pixel => Image pixel -> Int
forall a. Image a -> Int
imageHeight DynamicImage
img

-- | Make an "unchecked" image reference; have to specify a
--   width and height. Unless the aspect ratio of the external
--   image is the w :: h, then the image will be distorted.
uncheckedImageRef :: Num n => FilePath -> Int -> Int -> DImage n External
uncheckedImageRef :: forall n. Num n => FilePath -> Int -> Int -> DImage n External
uncheckedImageRef FilePath
path Int
w Int
h = ImageData External
-> Int -> Int -> Transformation V2 n -> DImage n External
forall t n.
ImageData t -> Int -> Int -> Transformation V2 n -> DImage n t
DImage (FilePath -> ImageData External
ImageRef FilePath
path) Int
w Int
h Transformation V2 n
forall a. Monoid a => a
mempty

-- | Crate a diagram from raw raster data.
rasterDia :: (TypeableFloat n, Renderable (DImage n Embedded) b)
          => (Int -> Int -> AlphaColour Double) -> Int -> Int -> QDiagram b V2 n Any
rasterDia :: forall n b.
(TypeableFloat n, Renderable (DImage n Embedded) b) =>
(Int -> Int -> AlphaColour Double)
-> Int -> Int -> QDiagram b V2 n Any
rasterDia Int -> Int -> AlphaColour Double
f Int
w Int
h = DImage n Embedded -> QDiagram b V2 n Any
forall n a b.
(TypeableFloat n, Typeable a, Renderable (DImage n a) b) =>
DImage n a -> QDiagram b V2 n Any
image (DImage n Embedded -> QDiagram b V2 n Any)
-> DImage n Embedded -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> AlphaColour Double)
-> Int -> Int -> DImage n Embedded
forall n.
Num n =>
(Int -> Int -> AlphaColour Double)
-> Int -> Int -> DImage n Embedded
raster Int -> Int -> AlphaColour Double
f Int
w Int
h

-- | Create an image "from scratch" by specifying the pixel data
raster :: Num n => (Int -> Int -> AlphaColour Double) -> Int -> Int -> DImage n Embedded
raster :: forall n.
Num n =>
(Int -> Int -> AlphaColour Double)
-> Int -> Int -> DImage n Embedded
raster Int -> Int -> AlphaColour Double
f Int
w Int
h = ImageData Embedded
-> Int -> Int -> Transformation V2 n -> DImage n Embedded
forall t n.
ImageData t -> Int -> Int -> Transformation V2 n -> DImage n t
DImage (DynamicImage -> ImageData Embedded
ImageRaster (Image PixelRGBA8 -> DynamicImage
ImageRGBA8 Image PixelRGBA8
img)) Int
w Int
h Transformation V2 n
forall a. Monoid a => a
mempty
  where
    img :: Image PixelRGBA8
img = (Int -> Int -> PixelRGBA8) -> Int -> Int -> Image PixelRGBA8
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> PixelRGBA8
g Int
w Int
h
    g :: Int -> Int -> PixelRGBA8
g Int
x Int
y = AlphaColour Double -> PixelRGBA8
fromAlphaColour (AlphaColour Double -> PixelRGBA8)
-> AlphaColour Double -> PixelRGBA8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AlphaColour Double
f Int
x Int
y

fromAlphaColour :: AlphaColour Double -> PixelRGBA8
fromAlphaColour :: AlphaColour Double -> PixelRGBA8
fromAlphaColour AlphaColour Double
c = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
r Pixel8
g Pixel8
b Pixel8
a
  where
    (Pixel8
r, Pixel8
g, Pixel8
b, Pixel8
a) = (Double -> Pixel8
forall {a} {b}. (RealFrac a, Integral b) => a -> b
int Double
r', Double -> Pixel8
forall {a} {b}. (RealFrac a, Integral b) => a -> b
int Double
g', Double -> Pixel8
forall {a} {b}. (RealFrac a, Integral b) => a -> b
int Double
b', Double -> Pixel8
forall {a} {b}. (RealFrac a, Integral b) => a -> b
int Double
a')
    (Double
r', Double
g', Double
b', Double
a') = AlphaColour Double -> (Double, Double, Double, Double)
forall c. Color c => c -> (Double, Double, Double, Double)
colorToSRGBA AlphaColour Double
c
    int :: a -> b
int a
x = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a
255 a -> a -> a
forall a. Num a => a -> a -> a
* a
x)

instance Fractional n => (Renderable (DImage n a) NullBackend) where
  render :: NullBackend
-> DImage n a
-> Render NullBackend (V (DImage n a)) (N (DImage n a))
render NullBackend
_ DImage n a
_ = Render NullBackend (V (DImage n a)) (N (DImage n a))
Render NullBackend V2 n
forall a. Monoid a => a
mempty