diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# avif + +## 0.1.0.0 + +Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,15 @@ +avif +Copyright (C) 2021 Vanessa McHale + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU Affero General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Affero General Public License for more details. + +You should have received a copy of the GNU Affero General Public License +along with this program. If not, see . diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# avif + +Haskell bindings to [libavif](https://github.com/AOMediaCodec/libavif). diff --git a/avif.cabal b/avif.cabal new file mode 100644 --- /dev/null +++ b/avif.cabal @@ -0,0 +1,75 @@ +cabal-version: 1.18 +name: avif +version: 0.1.0.0 +license: AGPL-3 +license-file: LICENSE +copyright: Copyright: (c) 2021 Vanessa McHale +maintainer: vamchale@gmail.com +author: Vanessa McHale +category: Image, Codec +synopsis: High-level bindings to libavif +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/vmchale/avif + +library + exposed-modules: Codec.Avif + other-modules: Codec.Avif.FFI + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + build-depends: base >=4.7 && <5 + , bytestring + , JuicyPixels + , vector + build-tool-depends: c2hs:c2hs + pkgconfig-depends: libavif + + if impl(ghc >=8.0) + ghc-options: + -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints + + if impl(ghc >=8.4) + ghc-options: -Wmissing-export-lists + + if impl(ghc >=8.2) + ghc-options: -Wcpp-undef + + if impl(ghc >=8.10) + ghc-options: -Wunused-packages + +test-suite avif-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -threaded -rtsopts "-with-rtsopts=-N -K1K" -Wall + -- libyuv is wrong?? lol + -- extra-libraries: jpeg + build-depends: + base, + avif, + tasty, + tasty-hunit, + bytestring, + deepseq + + if impl(ghc >=8.0) + ghc-options: + -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints + + if impl(ghc >=8.4) + ghc-options: -Wmissing-export-lists + + if impl(ghc >=8.2) + ghc-options: -Wcpp-undef + + if impl(ghc >=8.10) + ghc-options: -Wunused-packages diff --git a/src/Codec/Avif.chs b/src/Codec/Avif.chs new file mode 100644 --- /dev/null +++ b/src/Codec/Avif.chs @@ -0,0 +1,85 @@ +module Codec.Avif ( encode + , decode + ) where + +import Codec.Avif.FFI +import Codec.Picture (Image (Image), PixelRGBA8, PixelYCbCr8) +import Control.Applicative (pure) +import Control.Exception (throwIO) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (memcpy) +import qualified Data.ByteString.Unsafe as BS +import Data.Functor ((<$>), (<$)) +import Foreign.Ptr (castPtr) +import Foreign.ForeignPtr (castForeignPtr, newForeignPtr, mallocForeignPtrBytes, withForeignPtr) +import Foreign.Marshal (allocaBytes) +import qualified Data.Vector.Storable as VS +import System.IO.Unsafe (unsafePerformIO) + +#include + +-- PixelYCbCr8? + +throwRes :: AvifResult -> IO () +throwRes AvifResultOk = pure (); throwRes err = throwIO err + +{-# NOINLINE encode #-} +encode :: Image PixelRGBA8 -> BS.ByteString +encode img = unsafePerformIO $ do + avifImgPtr <- avifImageCreate (fromIntegral w) (fromIntegral h) 8 AvifPixelFormatYuv444 + res <- allocaBytes {# sizeof avifRGBImage #} $ \rgbImagePtr -> + allocaBytes {# sizeof avifRWData #} $ \rwDataPtr -> do + avifRGBImageSetDefaults rgbImagePtr avifImgPtr + pxSz <- avifRGBImagePixelSize rgbImagePtr + + preEnc <- avifEncoderCreate + enc <- castForeignPtr <$> newForeignPtr avifEncoderDestroy (castPtr preEnc) + + withForeignPtr imgPtr $ \iPtr -> do + + {# set avifRGBImage.height #} rgbImagePtr (fromIntegral h) + {# set avifRGBImage.width #} rgbImagePtr (fromIntegral w) + {# set avifRGBImage.pixels #} rgbImagePtr (castPtr iPtr) + {# set avifRGBImage.rowBytes #} rgbImagePtr (fromIntegral w*pxSz) + + throwRes =<< avifImageRGBToYUV avifImgPtr rgbImagePtr + + throwRes =<< avifEncoderWrite enc avifImgPtr rwDataPtr + + sz <- {# get avifRWData->size #} rwDataPtr + bs <- {# get avifRWData->data #} rwDataPtr + + BS.packCStringLen (castPtr bs, fromIntegral sz) + + res <$ avifImageDestroy avifImgPtr + + where (Image w h bytes) = img + (imgPtr, _) = VS.unsafeToForeignPtr0 bytes + +{-# NOINLINE decode #-} +decode :: BS.ByteString -> Image PixelRGBA8 +decode bs = unsafePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, sz) -> do + preDec <- avifDecoderCreate + dec <- castForeignPtr <$> newForeignPtr avifDecoderDestroy (castPtr preDec) + avifImg <- avifImageCreateEmpty + + throwRes =<< avifDecoderReadMemory dec avifImg (castPtr ptr) (fromIntegral sz) + + allocaBytes {# sizeof avifRGBImage #} $ \rgbImagePtr -> do + avifRGBImageSetDefaults rgbImagePtr avifImg + avifRGBImageAllocatePixels rgbImagePtr + throwRes =<< avifImageYUVToRGB avifImg rgbImagePtr + + w <- {# get avifRGBImage->width #} rgbImagePtr + h <- {# get avifRGBImage->height #} rgbImagePtr + pxSz <- avifRGBImagePixelSize rgbImagePtr + + pxPtr <- {# get avifRGBImage->pixels #} rgbImagePtr + + let sz' = w * h * pxSz + + outBytes <- mallocForeignPtrBytes (fromIntegral sz') + + withForeignPtr outBytes $ \outPtr -> do + memcpy (castPtr outPtr) (castPtr pxPtr) (fromIntegral sz') + Image (fromIntegral w) (fromIntegral h) (VS.unsafeFromForeignPtr0 outBytes (fromIntegral sz')) <$ (avifRGBImageFreePixels rgbImagePtr *> avifImageDestroy avifImg) diff --git a/src/Codec/Avif/FFI.chs b/src/Codec/Avif/FFI.chs new file mode 100644 --- /dev/null +++ b/src/Codec/Avif/FFI.chs @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Codec.Avif.FFI ( avifImageCreate + , avifImageCreateEmpty + , avifImageDestroy + , avifEncoderCreate + , avifEncoderDestroy + , avifEncoderWrite + , avifDecoderCreate + , avifDecoderDestroy + , avifDecoderReadMemory + , avifRGBImageSetDefaults + , avifRGBImagePixelSize + , avifImageRGBToYUV + , avifImageYUVToRGB + , avifRGBImageAllocatePixels + , avifRGBImageFreePixels + , AvifPixelFormat (..) + , AvifResult (..) + ) where + +import Control.Exception (Exception) +import Data.Coerce (coerce) +import Data.Typeable (Typeable (..)) +import Foreign.C.Types (CInt, CSize) +import Foreign.Ptr (castPtr, Ptr) + +#include + +type UInt8 = {# type uint8_t #} +type UInt32 = {# type uint32_t #} + +{# enum avifPixelFormat as AvifPixelFormat {underscoreToCase} #} +{# enum avifResult as AvifResult {underscoreToCase} deriving (Eq, Show, Typeable) #} + +instance Exception AvifResult where + +-- {# pointer *LZ_Decoder as LZDecoderPtr foreign finalizer LZ_decompress_close as ^ -> LZDecoder #} +data AvifImage -- TODO: finalizer for AvifImage +data AvifEncoder +data AvifDecoder +data AvifRwData +data AvifRGBImage + +{# pointer *avifEncoder as AvifEncoderPtr foreign finalizer avifEncoderDestroy as ^ -> AvifEncoder #} +{# pointer *avifDecoder as AvifDecoderPtr foreign finalizer avifDecoderDestroy as ^ -> AvifDecoder #} + +{# fun avifImageCreate as ^ { `CInt', `CInt', `CInt', `AvifPixelFormat' } -> `Ptr AvifImage' castPtr #} +{# fun avifImageCreateEmpty as ^ { } -> `Ptr AvifImage' castPtr #} +{# fun avifImageDestroy as ^ { castPtr `Ptr AvifImage' } -> `()' #} + +{# fun avifEncoderCreate as ^ { } -> `Ptr AvifEncoder' castPtr #} +{# fun avifEncoderWrite as ^ { `AvifEncoderPtr', castPtr `Ptr AvifImage', castPtr `Ptr AvifRwData' } -> `AvifResult' #} + +{# fun avifDecoderCreate as ^ { } -> `Ptr AvifDecoder' castPtr #} +{# fun avifDecoderReadMemory as ^ { `AvifDecoderPtr', castPtr `Ptr AvifImage', castPtr `Ptr UInt8', coerce `CSize' } -> `AvifResult' #} + +{# fun avifRGBImageSetDefaults as ^ { castPtr `Ptr AvifRGBImage', castPtr `Ptr AvifImage' } -> `()' #} +{# fun avifRGBImagePixelSize as ^ { castPtr `Ptr AvifRGBImage' } -> `UInt32' id #} + +{# fun avifImageRGBToYUV as ^ { castPtr `Ptr AvifImage', castPtr `Ptr AvifRGBImage' } -> `AvifResult' #} +{# fun avifImageYUVToRGB as ^ { castPtr `Ptr AvifImage', castPtr `Ptr AvifRGBImage' } -> `AvifResult' #} + +{# fun avifRGBImageAllocatePixels as ^ { castPtr `Ptr AvifRGBImage' } -> `()' #} +{# fun avifRGBImageFreePixels as ^ { castPtr `Ptr AvifRGBImage' } -> `()' #} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,26 @@ +module Main (main) where + +import Codec.Avif +import Control.Applicative ((<$>)) +import Control.DeepSeq (deepseq) +import qualified Data.ByteString as BS +import Test.Tasty +import Test.Tasty.HUnit + +main :: IO () +main = defaultMain $ + testGroup "Roundtrip" + [ decodeNoThrow "test/data/original.avif" + , decEncNoThrow "test/data/original.avif" + ] + +decodeNoThrow :: FilePath -> TestTree +decodeNoThrow fp = testCase fp $ do + res <- decode <$> BS.readFile fp + assertBool "Doesn't throw exception" (res `deepseq` True) + +decEncNoThrow :: FilePath -> TestTree +decEncNoThrow fp = testCase fp $ do + bytes <- BS.readFile fp + let res = encode (decode bytes) + assertBool "Doesn't throw exception" (res `deepseq` True)