module Diagrams.TwoD.Image
    (
      DImage(..), ImageData(..)
    , Embedded, External, Native
    , image
    , loadImageEmb
    , loadImageExt
    , uncheckedImageRef
    , raster
    , rasterDia
    ) where
import           Codec.Picture
import           Codec.Picture.Types  (dynamicMap)
import           Data.Colour          (AlphaColour)
import           Data.Semigroup
import           Data.Typeable        (Typeable)
import           Diagrams.Core
import           Diagrams.Attributes  (colorToSRGBA)
import           Diagrams.TwoD.Path   (isInsideEvenOdd)
import           Diagrams.TwoD.Shapes (rect)
import           Diagrams.TwoD.Types
import           Linear.Affine
data Embedded deriving Typeable
data External deriving Typeable
data Native (t :: *) deriving Typeable
data ImageData :: * -> * where
  ImageRaster :: DynamicImage -> ImageData Embedded
  ImageRef    :: FilePath -> ImageData External
  ImageNative :: t -> ImageData (Native t)
data DImage :: * -> * -> * 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 Fractional n => Transformable (DImage n a) where
  transform t1 (DImage iD w h t2) = DImage iD w h (t1 <> t2)
instance Fractional n => HasOrigin (DImage n a) where
  moveOriginTo p = translate (origin .-. p)
image :: (TypeableFloat n, Typeable a, Renderable (DImage n a) b)
      => DImage n a -> QDiagram b V2 n Any
image img
  = mkQD (Prim img)
         (getEnvelope r)
         (getTrace r)
         mempty
         (Query $ \p -> Any (isInsideEvenOdd p r))
  where
    r = rect (fromIntegral w) (fromIntegral h)
    DImage _ w h _ = img
loadImageEmb :: Num n => FilePath -> IO (Either String (DImage n 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 :: Num n => FilePath -> IO (Either String (DImage n 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 :: Num n => FilePath -> Int -> Int -> DImage n External
uncheckedImageRef path w h = DImage (ImageRef path) w h mempty
rasterDia :: (TypeableFloat n, Renderable (DImage n Embedded) b)
          => (Int -> Int -> AlphaColour Double) -> Int -> Int -> QDiagram b V2 n Any
rasterDia f w h = image $ raster f w h
raster :: Num n => (Int -> Int -> AlphaColour Double) -> Int -> Int -> DImage n 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 Fractional n => (Renderable (DImage n a) NullBackend) where
  render _ _ = mempty