    {-# 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
      dImg <- FilePath -> IO (Either FilePath DynamicImage)
    readImage FilePath
    path
      return $ case 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