{-# LANGUAGE TupleSections #-}

module Brillo.Juicy (
  -- * Conversion from JuicyPixels' types to brillo' Picture
  fromDynamicImage,
  fromImageRGBA8,
  fromImageRGB8,
  fromImageY8,
  fromImageYA8,
  fromImageYCbCr8,

  -- * Loading a brillo Picture from a file through JuicyPixels
  loadJuicy,
  loadJuicyWithMetadata,
  loadJuicyJPG,
  loadJuicyPNG,

  -- * From brillo, exported here for convenience
  loadBMP,
)
where

import Brillo.Data.Bitmap (
  BitmapFormat (BitmapFormat),
  PixelFormat (PxRGBA),
  RowOrder (TopToBottom),
  bitmapOfForeignPtr,
  loadBMP,
 )
import Brillo.Data.Picture (Picture)
import Codec.Picture (
  DynamicImage (
    ImageRGB8,
    ImageRGBA8,
    ImageRGBF,
    ImageY8,
    ImageYA8,
    ImageYCbCr8,
    ImageYF
  ),
  Image (..),
  Pixel8,
  PixelRGB8,
  PixelRGBA8,
  PixelYA8,
  PixelYCbCr8,
  readImage,
  readImageWithMetadata,
  readJpeg,
  readPng,
 )
import Codec.Picture.Metadata (Metadatas)
import Codec.Picture.Types (
  ColorConvertible (promoteImage),
  ColorSpaceConvertible (convertImage),
 )
import Data.Vector.Storable (unsafeToForeignPtr)


{-| Tries to convert a 'DynamicImage' from JuicyPixels to a brillo 'Picture'.
All formats except RGBF and YF should successfully yield a 'Picture'.
-}
fromDynamicImage :: DynamicImage -> Maybe Picture
fromDynamicImage :: DynamicImage -> Maybe Picture
fromDynamicImage (ImageY8 Image Pixel8
img) = Picture -> Maybe Picture
forall a. a -> Maybe a
Just (Picture -> Maybe Picture) -> Picture -> Maybe Picture
forall a b. (a -> b) -> a -> b
$ Image Pixel8 -> Picture
fromImageY8 Image Pixel8
img
fromDynamicImage (ImageYA8 Image PixelYA8
img) = Picture -> Maybe Picture
forall a. a -> Maybe a
Just (Picture -> Maybe Picture) -> Picture -> Maybe Picture
forall a b. (a -> b) -> a -> b
$ Image PixelYA8 -> Picture
fromImageYA8 Image PixelYA8
img
fromDynamicImage (ImageRGB8 Image PixelRGB8
img) = Picture -> Maybe Picture
forall a. a -> Maybe a
Just (Picture -> Maybe Picture) -> Picture -> Maybe Picture
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> Picture
fromImageRGB8 Image PixelRGB8
img
fromDynamicImage (ImageRGBA8 Image PixelRGBA8
img) = Picture -> Maybe Picture
forall a. a -> Maybe a
Just (Picture -> Maybe Picture) -> Picture -> Maybe Picture
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA8 -> Picture
fromImageRGBA8 Image PixelRGBA8
img
fromDynamicImage (ImageYCbCr8 Image PixelYCbCr8
img) = Picture -> Maybe Picture
forall a. a -> Maybe a
Just (Picture -> Maybe Picture) -> Picture -> Maybe Picture
forall a b. (a -> b) -> a -> b
$ Image PixelYCbCr8 -> Picture
fromImageYCbCr8 Image PixelYCbCr8
img
fromDynamicImage (ImageRGBF Image PixelRGBF
_) = Maybe Picture
forall a. Maybe a
Nothing
fromDynamicImage (ImageYF Image PixelF
_) = Maybe Picture
forall a. Maybe a
Nothing
fromDynamicImage DynamicImage
_ = Maybe Picture
forall a. Maybe a
Nothing


{-| O(N) conversion from 'PixelRGBA8' image to brillo 'Picture',
where N is the number of pixels.
-}
fromImageRGBA8 :: Image PixelRGBA8 -> Picture
fromImageRGBA8 :: Image PixelRGBA8 -> Picture
fromImageRGBA8 (Image{imageWidth :: forall a. Image a -> Int
imageWidth = Int
w, imageHeight :: forall a. Image a -> Int
imageHeight = Int
h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData = Vector (PixelBaseComponent PixelRGBA8)
imgDat}) = do
  let (ForeignPtr Pixel8
ptr, Int
_, Int
_) = Vector Pixel8 -> (ForeignPtr Pixel8, Int, Int)
forall a. Vector a -> (ForeignPtr a, Int, Int)
unsafeToForeignPtr Vector Pixel8
Vector (PixelBaseComponent PixelRGBA8)
imgDat
  Int -> Int -> BitmapFormat -> ForeignPtr Pixel8 -> Bool -> Picture
bitmapOfForeignPtr Int
w Int
h (RowOrder -> PixelFormat -> BitmapFormat
BitmapFormat RowOrder
TopToBottom PixelFormat
PxRGBA) ForeignPtr Pixel8
ptr Bool
True
{-# INLINE fromImageRGBA8 #-}


{-| Creation of a brillo 'Picture' by promoting (through 'promoteImage')
the 'PixelRGB8' image to 'PixelRGBA8' and calling 'fromImageRGBA8'.
-}
fromImageRGB8 :: Image PixelRGB8 -> Picture
fromImageRGB8 :: Image PixelRGB8 -> Picture
fromImageRGB8 = Image PixelRGBA8 -> Picture
fromImageRGBA8 (Image PixelRGBA8 -> Picture)
-> (Image PixelRGB8 -> Image PixelRGBA8)
-> Image PixelRGB8
-> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage
{-# INLINE fromImageRGB8 #-}


{-| Creation of a brillo 'Picture' by promoting (through 'promoteImage')
the 'PixelY8' image to 'PixelRGBA8' and calling 'fromImageRGBA8'.
-}
fromImageY8 :: Image Pixel8 -> Picture
fromImageY8 :: Image Pixel8 -> Picture
fromImageY8 = Image PixelRGBA8 -> Picture
fromImageRGBA8 (Image PixelRGBA8 -> Picture)
-> (Image Pixel8 -> Image PixelRGBA8) -> Image Pixel8 -> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage
{-# INLINE fromImageY8 #-}


{-| Creation of a brillo 'Picture' by promoting (through 'promoteImage')
the 'PixelYA8' image to 'PixelRGBA8' and calling 'fromImageRGBA8'.
-}
fromImageYA8 :: Image PixelYA8 -> Picture
fromImageYA8 :: Image PixelYA8 -> Picture
fromImageYA8 = Image PixelRGBA8 -> Picture
fromImageRGBA8 (Image PixelRGBA8 -> Picture)
-> (Image PixelYA8 -> Image PixelRGBA8)
-> Image PixelYA8
-> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage
{-# INLINE fromImageYA8 #-}


{-| Creation of a brillo 'Picture' by promoting (through 'promoteImage')
the 'PixelYCbCr8' image to 'PixelRGBA8' and calling 'fromImageRGBA8'.
-}
fromImageYCbCr8 :: Image PixelYCbCr8 -> Picture
fromImageYCbCr8 :: Image PixelYCbCr8 -> Picture
fromImageYCbCr8 = Image PixelRGB8 -> Picture
fromImageRGB8 (Image PixelRGB8 -> Picture)
-> (Image PixelYCbCr8 -> Image PixelRGB8)
-> Image PixelYCbCr8
-> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage
{-# INLINE fromImageYCbCr8 #-}


{-| Tries to load an image file into a Picture
  using 'readImage' from JuicyPixels.
  It means it'll try to successively read the content
  as an image in the following order,
  until it succeeds (or fails on all of them):
  jpeg, png, bmp, gif, hdr (the last two are not supported)
  This is handy when you don't know
  what format the image contained in the file is encoded with.
  If you know the format in advance,
  use 'loadBMP', 'loadJuicyJPG' or 'loadJuicyPNG'
-}
loadJuicy :: FilePath -> IO (Maybe Picture)
loadJuicy :: FilePath -> IO (Maybe Picture)
loadJuicy = (FilePath -> IO (Either FilePath DynamicImage))
-> FilePath -> IO (Maybe Picture)
loadWith FilePath -> IO (Either FilePath DynamicImage)
readImage
{-# INLINE loadJuicy #-}


loadJuicyWithMetadata :: FilePath -> IO (Maybe (Picture, Metadatas))
loadJuicyWithMetadata :: FilePath -> IO (Maybe (Picture, Metadatas))
loadJuicyWithMetadata = (FilePath -> IO (Either FilePath (DynamicImage, Metadatas)))
-> FilePath -> IO (Maybe (Picture, Metadatas))
loadWithMetadata FilePath -> IO (Either FilePath (DynamicImage, Metadatas))
readImageWithMetadata
{-# INLINE loadJuicyWithMetadata #-}


loadJuicyJPG :: FilePath -> IO (Maybe Picture)
loadJuicyJPG :: FilePath -> IO (Maybe Picture)
loadJuicyJPG = (FilePath -> IO (Either FilePath DynamicImage))
-> FilePath -> IO (Maybe Picture)
loadWith FilePath -> IO (Either FilePath DynamicImage)
readJpeg
{-# INLINE loadJuicyJPG #-}


loadJuicyPNG :: FilePath -> IO (Maybe Picture)
loadJuicyPNG :: FilePath -> IO (Maybe Picture)
loadJuicyPNG = (FilePath -> IO (Either FilePath DynamicImage))
-> FilePath -> IO (Maybe Picture)
loadWith FilePath -> IO (Either FilePath DynamicImage)
readPng
{-# INLINE loadJuicyPNG #-}


loadWith
  :: (FilePath -> IO (Either String DynamicImage))
  -> FilePath
  -> IO (Maybe Picture)
loadWith :: (FilePath -> IO (Either FilePath DynamicImage))
-> FilePath -> IO (Maybe Picture)
loadWith FilePath -> IO (Either FilePath DynamicImage)
reader FilePath
fp = do
  Either FilePath DynamicImage
eImg <- FilePath -> IO (Either FilePath DynamicImage)
reader FilePath
fp
  Maybe Picture -> IO (Maybe Picture)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Picture -> IO (Maybe Picture))
-> Maybe Picture -> IO (Maybe Picture)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe Picture)
-> (DynamicImage -> Maybe Picture)
-> Either FilePath DynamicImage
-> Maybe Picture
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Picture -> FilePath -> Maybe Picture
forall a b. a -> b -> a
const Maybe Picture
forall a. Maybe a
Nothing) DynamicImage -> Maybe Picture
fromDynamicImage Either FilePath DynamicImage
eImg


loadWithMetadata
  :: (FilePath -> IO (Either String (DynamicImage, Metadatas)))
  -> FilePath
  -> IO (Maybe (Picture, Metadatas))
loadWithMetadata :: (FilePath -> IO (Either FilePath (DynamicImage, Metadatas)))
-> FilePath -> IO (Maybe (Picture, Metadatas))
loadWithMetadata FilePath -> IO (Either FilePath (DynamicImage, Metadatas))
reader FilePath
fp = do
  Either FilePath (DynamicImage, Metadatas)
eImg <- FilePath -> IO (Either FilePath (DynamicImage, Metadatas))
reader FilePath
fp
  Maybe (Picture, Metadatas) -> IO (Maybe (Picture, Metadatas))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Picture, Metadatas) -> IO (Maybe (Picture, Metadatas)))
-> Maybe (Picture, Metadatas) -> IO (Maybe (Picture, Metadatas))
forall a b. (a -> b) -> a -> b
$
    (FilePath -> Maybe (Picture, Metadatas))
-> ((DynamicImage, Metadatas) -> Maybe (Picture, Metadatas))
-> Either FilePath (DynamicImage, Metadatas)
-> Maybe (Picture, Metadatas)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (Maybe (Picture, Metadatas)
-> FilePath -> Maybe (Picture, Metadatas)
forall a b. a -> b -> a
const Maybe (Picture, Metadatas)
forall a. Maybe a
Nothing)
      (\(DynamicImage
x, Metadatas
y) -> (Picture -> (Picture, Metadatas))
-> Maybe Picture -> Maybe (Picture, Metadatas)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Metadatas
y) (DynamicImage -> Maybe Picture
fromDynamicImage DynamicImage
x))
      Either FilePath (DynamicImage, Metadatas)
eImg