diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Sven Heyll and Lindenbaum GmbH (c) 2016, 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bench/Encoder.hs b/bench/Encoder.hs new file mode 100644 --- /dev/null +++ b/bench/Encoder.hs @@ -0,0 +1,86 @@ +module Main + ( main + ) where + +import Control.Monad +import Control.Monad.Logger +import Data.Conduit +import Data.MediaBus +import Data.MediaBus.FdkAac +import Data.Conduit.List +import Data.Time.Clock +import Data.Typeable +import Criterion.Main +import Control.Lens +import Data.Vector.Storable as V +import Data.Word +import GHC.TypeLits + +main :: IO () +main = + defaultMain + [bgroupFromTestDuration 1000 16000, bgroupFromTestDuration 1000 48000] + +bgroupFromTestDuration :: NominalDiffTime -> Int -> Benchmark +bgroupFromTestDuration testdur samplesPerSecond = + bgroup + (show testdur Prelude.++ " ptime=20ms " Prelude.++ show samplesPerSecond Prelude.++ + " Hz") $ + let frameCount = ceiling (testdur / ptime) + ptime = 20 / 1000 + in [ bgroup + "AAC HE" + [ bench "Stereo" $ + nfIO $ + encodeNFrames (aacEncoderConfig aacHe16KhzStereo) $ + testFrames testdur frameCount + , bench "Mono" $ + nfIO $ + encodeNFrames (aacEncoderConfig aacHe16KhzMono) $ + testFrames testdur frameCount + ] + , bgroup + "AAC LC" + [ bench "Stereo" $ + nfIO $ + encodeNFrames (aacEncoderConfig aacLc16KhzStereo) $ + testFrames testdur frameCount + , bench "Mono" $ + nfIO $ + encodeNFrames (aacEncoderConfig aacLc16KhzMono) $ + testFrames testdur frameCount + ] + ] + +encodeNFrames + :: forall r channels aot. + ( CanBeSample (Pcm channels S16) + , CanBeBlank (Pcm channels S16) + , Show (Pcm channels S16) + , KnownRate r + , KnownChannelLayout channels + , Show (AacAotProxy aot) + , KnownNat (GetAacAot aot) + , Typeable r + ) + => AacEncoderConfig r channels aot + -> [Stream SrcId32 SeqNum16 (Ticks r Word64) () (Audio r channels (Raw S16))] + -> IO [Stream SrcId32 SeqNum16 (Ticks r Word64) (AacEncoderInfo r channels aot) (Audio r channels (Aac aot))] +encodeNFrames cfg pcms = + runStdoutLoggingT $ + runConduitRes $ sourceList pcms .| encodeLinearToAacC cfg .| consume + +testFrames + :: (KnownRate r, IsPcmValue (Pcm channels S16)) + => NominalDiffTime + -> Int + -> [Stream SrcId32 SeqNum16 (Ticks r Word64) () (Audio r channels (Raw S16))] +testFrames frameDuration frames = + [ MkStream + (Next + (MkFrame + (fromIntegral x * (nominalDiffTime # frameDuration)) + (fromIntegral x) + (blankFor frameDuration))) + | x <- [0 .. frames] + ] diff --git a/examples/Main.hs b/examples/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Main.hs @@ -0,0 +1,30 @@ +module Main + ( main + ) where + +import Control.Monad +import Control.Monad.Logger +import Data.Conduit +import Data.MediaBus +import Data.MediaBus.FdkAac + +main :: IO () +main = void encodeOneSeconfOfSilence + +encodeOneSeconfOfSilence + :: IO [Stream SrcId32 + SeqNum16 + (Ticks64 (Hz 48000)) + (AacEncoderInfo (Hz 48000) Stereo 'HighEfficiency) + (Audio (Hz 48000) Stereo (Aac 'HighEfficiency))] +encodeOneSeconfOfSilence = + runStdoutLoggingT $ + runConduitRes $ + yieldNextFrame (MkFrame 0 0 pcmAudioOneSecond) + .| encodeLinearToAacC encoderConfig + .| traceShowSink 1 "Example Trace" + + where + pcmAudioOneSecond :: Audio (Hz 48000) Stereo (Raw S16) + pcmAudioOneSecond = blankFor 1 + encoderConfig = aacEncoderConfig aacHe48KhzStereo diff --git a/mediabus-fdk-aac.cabal b/mediabus-fdk-aac.cabal new file mode 100644 --- /dev/null +++ b/mediabus-fdk-aac.cabal @@ -0,0 +1,112 @@ +name: mediabus-fdk-aac +version: 0.3.0.0 +cabal-version: >=1.10 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: 2016, 2017 Sven Heyll, Lindenbaum GmbH +maintainer: sven.heyll@lindenbaum.eu +homepage: https://github.com/lindenbaum/mediabus-fdk-aac +synopsis: Mediabus plugin for the Frauenhofer ISO-14496-3 AAC FDK +description: + Please see README.md +category: Sound +author: Sven Heyll + +library + exposed-modules: + Data.MediaBus.FdkAac.Encoder + Data.MediaBus.FdkAac.Conduit.Encoder + Data.MediaBus.FdkAac + build-depends: + base >=4.9 && <5, + bytestring >=0.10.8.1 && <0.11, + conduit >=1.2.9 && <1.3, + conduit-combinators >=1.1.0 && <1.2, + containers >=0.5.7.1 && <0.6, + deepseq >=1.4.2.0 && <1.5, + inline-c >=0.5.6.1 && <0.6, + lens >=4.15.1 && <4.16, + mediabus >=0.3.2.0 && <0.4, + monad-logger >=0.3.20.2 && <0.4, + random ==1.1.*, + resourcet >=1.1.9 && <1.2, + spool ==0.1.*, + tagged >=0.8.5 && <0.9, + text >=1.2.2.1 && <1.3, + time >=1.6.0.1 && <1.7, + transformers >=0.5.2.0 && <0.6, + vector >=0.11.0.0 && <0.12 + cc-options: -std=c99 -Wall -O2 + pkgconfig-depends: fdk-aac >=0.1.4 + c-sources: + src/Data/MediaBus/FdkAac/EncoderFdkWrapper.c + default-language: Haskell2010 + default-extensions: BangPatterns ConstraintKinds CPP DataKinds + DefaultSignatures DeriveDataTypeable DeriveFunctor DeriveGeneric + DuplicateRecordFields FlexibleInstances FlexibleContexts + FunctionalDependencies GADTs GeneralizedNewtypeDeriving + KindSignatures MultiParamTypeClasses NamedFieldPuns + OverloadedStrings QuasiQuotes RecordWildCards RankNTypes + ScopedTypeVariables StandaloneDeriving TemplateHaskell + TupleSections TypeApplications TypeFamilies TypeInType + TypeOperators TypeSynonymInstances UnicodeSyntax + extra-libraries: + m + hs-source-dirs: src + other-modules: + Data.MediaBus.FdkAac.EncoderFdkWrapper + ghc-options: -O2 -Wall -funbox-strict-fields -fno-warn-unused-do-bind + +test-suite examples + type: exitcode-stdio-1.0 + main-is: Main.hs + build-depends: + base >=4.9.1.0 && <4.10, + deepseq >=1.4.2.0 && <1.5, + ghc-prim >=0.5.0.0 && <0.6, + lens >=4.15.1 && <4.16, + monad-logger >=0.3.20.2 && <0.4, + mediabus-fdk-aac >=0.3.0.0 && <0.4, + mediabus >=0.3.2.0 && <0.4, + conduit >=1.2.9 && <1.3, + vector >=0.11.0.0 && <0.12 + default-language: Haskell2010 + default-extensions: BangPatterns ConstraintKinds CPP DataKinds + DefaultSignatures DeriveDataTypeable DeriveFunctor DeriveGeneric + DuplicateRecordFields FlexibleInstances FlexibleContexts + FunctionalDependencies GADTs GeneralizedNewtypeDeriving + KindSignatures MultiParamTypeClasses NamedFieldPuns + OverloadedStrings QuasiQuotes RecordWildCards RankNTypes + ScopedTypeVariables StandaloneDeriving TemplateHaskell + TupleSections TypeApplications TypeFamilies TypeInType + TypeOperators TypeSynonymInstances UnicodeSyntax + hs-source-dirs: examples + ghc-options: -O2 -Wall -funbox-strict-fields -fno-warn-unused-do-bind + +benchmark encoder-benchmark + type: exitcode-stdio-1.0 + main-is: Encoder.hs + build-depends: + base >=4.9.1.0 && <4.10, + deepseq >=1.4.2.0 && <1.5, + ghc-prim >=0.5.0.0 && <0.6, + lens >=4.15.1 && <4.16, + monad-logger >=0.3.20.2 && <0.4, + criterion >=1.1.4.0 && <1.2, + mediabus-fdk-aac >=0.3.0.0 && <0.4, + mediabus >=0.3.2.0 && <0.4, + conduit >=1.2.9 && <1.3, + vector >=0.11.0.0 && <0.12 + default-language: Haskell2010 + default-extensions: BangPatterns ConstraintKinds CPP DataKinds + DefaultSignatures DeriveDataTypeable DeriveFunctor DeriveGeneric + DuplicateRecordFields FlexibleInstances FlexibleContexts + FunctionalDependencies GADTs GeneralizedNewtypeDeriving + KindSignatures MultiParamTypeClasses NamedFieldPuns + OverloadedStrings QuasiQuotes RecordWildCards RankNTypes + ScopedTypeVariables StandaloneDeriving TemplateHaskell + TupleSections TypeApplications TypeFamilies TypeInType + TypeOperators TypeSynonymInstances UnicodeSyntax + hs-source-dirs: bench + ghc-options: -O2 -Wall -funbox-strict-fields -fno-warn-unused-do-bind diff --git a/src/Data/MediaBus/FdkAac.hs b/src/Data/MediaBus/FdkAac.hs new file mode 100644 --- /dev/null +++ b/src/Data/MediaBus/FdkAac.hs @@ -0,0 +1,9 @@ +-- | A MediaBus adapter for the Frauenhofer AAC encoder/decoder. +-- This module reexports the high-level encoding and decoding functions. +module Data.MediaBus.FdkAac + ( module Data.MediaBus.FdkAac.Encoder + , module Data.MediaBus.FdkAac.Conduit.Encoder + ) where + +import Data.MediaBus.FdkAac.Conduit.Encoder +import Data.MediaBus.FdkAac.Encoder diff --git a/src/Data/MediaBus/FdkAac/Conduit/Encoder.hs b/src/Data/MediaBus/FdkAac/Conduit/Encoder.hs new file mode 100644 --- /dev/null +++ b/src/Data/MediaBus/FdkAac/Conduit/Encoder.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE RankNTypes #-} + +-- | This module defines a conduit to encode linear audio into AAC. +module Data.MediaBus.FdkAac.Conduit.Encoder + ( encodeLinearToAacC + ) where + +import Conduit +import Control.Lens +import Control.Monad +import Control.Monad.Logger +import Control.Monad.Trans.State.Strict as State +import Data.MediaBus +import Data.MediaBus.FdkAac.Encoder +import Data.String +import Data.Tagged +import Data.Typeable +import GHC.TypeLits + + +-- * Conduit Based 'Stream' Encoding +-- | A conduit that receives signed 16 bit, mono or stereo, 'Raw' 'Audio' and +-- yields AAC encoded frames. The timestamps of the input frames will be +-- regarded such that gaps in the timestamps are reflected in the generated +-- frames. The sequence numbering will be +encodeLinearToAacC + :: forall channels r aot i s t m. + ( MonadLoggerIO m + , MonadThrow m + , MonadResource m + , KnownChannelLayout channels + , KnownRate r + , Typeable r + , Show (AacAotProxy aot) + , KnownNat (GetAacAot aot) + , Show i + , Show t + , Typeable t + , LocalOrd t + , Show s + , Typeable s + , Num t + , Num s + , CanBeSample (Pcm channels S16) + , Show (Pcm channels S16) + , Integral t + ) + => AacEncoderConfig r channels aot + -> Conduit (Stream i s (Ticks r t) () (Audio r channels (Raw S16))) m (Stream i s (Ticks r t) (AacEncoderInfo r channels aot) (Audio r channels (Aac aot))) +encodeLinearToAacC aacCfg = do + (Tagged enc, info) <- lift $ aacEncoderAllocate aacCfg + (_res, _st, ()) <- + prefixLogsC (show enc ++ " - ") $ + runRWSC + enc + (MkAacEncSt @r @channels @aot 0) + (evalStateC + (initialReframerState :: ReframerSt s (Ticks r t)) + (encodeThenFlush info)) + return () + where + encodeThenFlush info = do + awaitForever go + aacs <- lift $ lift flushAacEncoder + Prelude.mapM_ yieldAacFrame aacs + where + go (MkStream (Next f)) = do + let reframeFrame = f & framePayload %~ getDurationTicks + $logDebug (fromString ("in: " ++ show f)) + pushRes <- lift $ pushFrame reframeFrame + case pushRes of + Nothing -> return () + Just er -> do + $logInfo + (fromString + ("frame timing problem: " ++ show er ++ ", frame: " ++ + show reframeFrame)) + lift $ State.get >>= $logInfoSH + aacs <- lift $ lift flushAacEncoder + Prelude.mapM_ yieldAacFrame aacs + lift $ + pushStartFrame + (reframeFrame ^. frameTimestamp + reframeFrame ^. framePayload) + aacs <- + lift $ lift $ + encodeLinearToAac (view framePayload f) + Prelude.mapM_ yieldAacFrame aacs + go start@(MkStream (Start (MkFrameCtx fi ft fs _fp))) = do + lift $ pushStartFrame ft + lift $ $logDebug (fromString ("in: " ++ show start)) + let outStart = MkFrameCtx fi ft fs info + lift $ $logDebug (fromString ("out: " ++ show outStart)) + yieldStartFrameCtx outStart + yieldAacFrame fc = + let wantDur = getDurationTicks fc + in when (wantDur > 0) $ do + frm <- lift $ generateFrame wantDur + when (frm ^. framePayload < wantDur) $ do + $logInfo + (fromString + ("encoder generated more output than input, input: " ++ + show (frm ^. framePayload) ++ + " < output: " ++ + show wantDur)) + availDur <- lift nextFrameAvailableDuration + $logInfo + (fromString + ("samples enqueuend in the encoder delay lines: " ++ + show availDur)) + rfst <- lift $ State.get + $logInfoSH rfst + let outFrm = frm & framePayload .~ fc + $logDebug (fromString ("out: " ++ show outFrm)) + yieldNextFrame outFrm diff --git a/src/Data/MediaBus/FdkAac/Encoder.hs b/src/Data/MediaBus/FdkAac/Encoder.hs new file mode 100644 --- /dev/null +++ b/src/Data/MediaBus/FdkAac/Encoder.hs @@ -0,0 +1,410 @@ +{-# LANGUAGE RankNTypes #-} + +-- | This module defines a type-safe, high-level interface to encode linear +-- audio into AAC. This interface is still relatively low-level. +-- For an easy to use, high-level interface please consult +-- 'Data.MediaBus.FdkAac.Conduit.Encoder'. +module Data.MediaBus.FdkAac.Encoder + ( aacFrameSize + , aacFrameMediaData + , Aac + , aacHe48KhzStereo + , aacHe16KhzStereo + , aacHe48KhzMono + , aacHe16KhzMono + , aacLc48KhzStereo + , aacLc16KhzStereo + , aacLc48KhzMono + , aacLc16KhzMono + , aacEncoderConfig + , AacEncoderInfo(..) + , aacEncoderInfoId + , aacEncoderInfoDelay + , aacEncoderInfoFrameSize + , aacEncoderInfoAudioSpecificConfig + , type AacEncoderConfig + , type AacEncoderContext + , AacAot(..) + , AacAotProxy(..) + , type GetAacAot + , aacEncoderAllocate + , type AacEncT + , AacEncSt(..) + , numberOfDelayedSamples + , encodeLinearToAac + , flushAacEncoder + ) where + +import Conduit +import Control.DeepSeq +import Control.Lens +import Control.Monad.Logger +import Control.Monad.Trans.RWS.Strict +import Control.Monad.Trans.Resource +import Data.Kind +import Data.Maybe +import Data.MediaBus +import Data.MediaBus.FdkAac.EncoderFdkWrapper +import Data.Proxy +import Data.String +import Data.Tagged +import qualified Data.Vector.Storable as V +import Data.Word +import GHC.Generics (Generic) +import GHC.TypeLits +import Text.Printf + +-- * MediaBus Aac Encoder +-- | This is the media type for AAC encoded audio data. +data Aac (aot :: AacAot) + +data instance Audio r c (Aac aot) = MkAacFrame{aacFrameMediaData + :: !(V.Vector Word8), + aacFrameSize :: !Word64} + deriving (Generic) + +instance (KnownRate r, KnownChannelLayout c, Show (AacAotProxy aot)) => + IsMedia (Audio r c (Aac aot)) + +instance (KnownRate r, KnownChannelLayout c, Show (AacAotProxy aot)) => + HasMedia (Audio r c (Aac aot)) (Audio r c (Aac aot)) where + type MediaFrom (Audio r c (Aac aot)) = Audio r c (Aac aot) + type MediaTo (Audio r c (Aac aot)) = Audio r c (Aac aot) + media = iso id id + +instance HasMediaBuffer (Audio r c (Aac aot)) (Audio r c (Aac aot)) where + type MediaBufferFrom (Audio r c (Aac aot)) = MediaBuffer Word8 + type MediaBufferTo (Audio r c (Aac aot)) = MediaBuffer Word8 + mediaBuffer = + lens + (MkMediaBuffer . aacFrameMediaData) + (\aacFrame -> \(MkMediaBuffer v) -> aacFrame {aacFrameMediaData = v}) + +instance (KnownRate r) => + HasDuration (Audio r c (Aac aot)) where + getDuration MkAacFrame {aacFrameSize} = + from nominalDiffTime # (MkTicks aacFrameSize :: Ticks r Word64) + getDurationTicks MkAacFrame {aacFrameSize} = + convertTicks (MkTicks aacFrameSize :: Ticks r Word64) + +instance NFData (Audio r c (Aac aot)) + +instance (KnownRate r, KnownChannelLayout c, Show (AacAotProxy aot)) => + Show (Audio r c (Aac aot)) where + showsPrec d MkAacFrame {aacFrameMediaData, aacFrameSize} = + showParen + (d > 10) + (showString "aac frame: " . + showsPrec 11 (MkShowMedia :: MediaDescription (Audio r c (Aac aot))) . + showString ", samples: " . + shows aacFrameSize . + showString ", data: " . + showsPrec 11 (V.length aacFrameMediaData) . showString " bytes starting with: " . + showsPrec 11 (V.take 16 aacFrameMediaData)) + +instance (KnownRate r, KnownChannelLayout c, Show (AacAotProxy aot)) => + Show (MediaDescription (Audio r c (Aac aot))) where + showsPrec d _ = + showParen + (d > 10) + (showsPrec 11 (MkAacAotProxy :: AacAotProxy aot) . showChar ' ' . + showsPrec 11 (MkRateProxy :: RateProxy r) . + showChar ' ' . + showsPrec 11 (MkChannelLayoutProxy :: ChannelLayoutProxy c)) + +-- ** Aac Configuration +-- | Create the 'Config' value needed to intialize the encoder from type-level +-- audio stream settings. +aacEncoderConfig + :: forall rate channels aot proxy. + (KnownRate rate, KnownChannelLayout channels, KnownNat (GetAacAot aot)) + => proxy (Audio rate channels (Aac aot)) -> AacEncoderConfig rate channels aot +aacEncoderConfig _pa = + let pr :: Proxy rate + pr = Proxy + pch :: Proxy channels + pch = Proxy + pco :: AacAotProxy aot + pco = MkAacAotProxy + in Tagged $ + simpleConfig + (getAacAot pco) + (numberOfChannels pch) + (fromInteger (rateVal pr)) + +-- *** Pre-defined Aac media Proxies +-- | 48 kHz Stereo 'HighEfficiency' +aacHe48KhzStereo :: Proxy (Audio (Hz 48000) Stereo (Aac 'HighEfficiency)) +aacHe48KhzStereo = Proxy + +-- | 16 kHz Stereo 'HighEfficiency' +aacHe16KhzStereo :: Proxy (Audio (Hz 16000) Stereo (Aac 'HighEfficiency)) +aacHe16KhzStereo = Proxy + +-- | 48 kHz Mono 'HighEfficiency' +aacHe48KhzMono :: Proxy (Audio (Hz 48000) Mono (Aac 'HighEfficiency)) +aacHe48KhzMono = Proxy + +-- | 16 kHz Mono 'HighEfficiency' +aacHe16KhzMono :: Proxy (Audio (Hz 16000) Mono (Aac 'HighEfficiency)) +aacHe16KhzMono = Proxy + +-- | 48 kHz Stereo 'LowComplexity' +aacLc48KhzStereo :: Proxy (Audio (Hz 48000) Stereo (Aac 'LowComplexity)) +aacLc48KhzStereo = Proxy + +-- | 16 kHz Stereo 'LowComplexity' +aacLc16KhzStereo :: Proxy (Audio (Hz 16000) Stereo (Aac 'LowComplexity)) +aacLc16KhzStereo = Proxy + +-- | 48 kHz Mono 'LowComplexity' +aacLc48KhzMono :: Proxy (Audio (Hz 48000) Mono (Aac 'LowComplexity)) +aacLc48KhzMono = Proxy + +-- | 16 kHz Mono 'LowComplexity' +aacLc16KhzMono :: Proxy (Audio (Hz 16000) Mono (Aac 'LowComplexity)) +aacLc16KhzMono = Proxy + +-- | The encoding specific information, created __by the encoder__ during +-- initialization. +data AacEncoderInfo (rate :: Rate) (channels :: Type) (aot :: AacAot) = MkAacEncoderInfo + { _aacEncoderInfoDelay :: !Word64 + -- ^ Number of samples that the output will be delayed through the encoding + -- mechanism (e.g. aot delay lines) + , _aacEncoderInfoFrameSize :: !Word64 + -- ^ Number of samples that are encoded into each frame. + , _aacEncoderInfoAudioSpecificConfig :: !(V.Vector Word8) + -- ^ The audio specific configuration /box/ as specified in ISO/IEC 14496-3 + -- section 1.6, that the encoder generates. + , _aacEncoderInfoId :: String + -- ^ Identification string for one specific encoder, derived from the natice + -- C pointer in 'encoderHandle'. + } deriving Generic + +instance NFData (AacEncoderInfo r c a) + +instance ( KnownRate r + , KnownChannelLayout c + , Show (AacAotProxy aot) + , KnownNat (GetAacAot aot) + ) => + Show (AacEncoderInfo r c aot) where + showsPrec d MkAacEncoderInfo { _aacEncoderInfoDelay + , _aacEncoderInfoFrameSize + , _aacEncoderInfoAudioSpecificConfig + , _aacEncoderInfoId + } = + showParen + (d > 10) + (showString _aacEncoderInfoId . showString " " . + showsPrec 11 (MkShowMedia :: MediaDescription (Audio r c (Aac aot))) . + showParen + True + (showString "encoding delay: " . showsPrec 11 _aacEncoderInfoDelay . + showString ", samples per frame: " . + showsPrec 11 _aacEncoderInfoFrameSize . + showString ", audio specific config: " . + showsPrec 11 _aacEncoderInfoAudioSpecificConfig)) + +-- | Tag a 'Config' with the compile time configuration parameters. +type AacEncoderConfig rate channels aot = Tagged '( rate, channels, aot) Config + +-- | Tag an 'Encoder' with the compile time configuration parameters. +type AacEncoderContext rate channels aot = Tagged '( rate, channels, aot) Encoder + +-- ** Audio Object Types +-- | Type level symbol to indicate that the AAC audio coding is used for the +-- respective media. This is a phantom type to index the 'Audio' data family. +data AacAot + = LowComplexity -- ^ corresponds to audio object type @2@ + | HighEfficiency -- ^ corresponds to audio object type @5@ + deriving (Show) + +instance Show (AacAotProxy 'LowComplexity) where + showsPrec _ _ = showString "low-complexity" + +instance Show (AacAotProxy 'HighEfficiency) where + showsPrec _ _ = showString "high-efficiency" + +-- | Convert the 'AacAot' to an ISO/IEC 14496-3 Audio Object Type value. +type family GetAacAot (c :: AacAot) :: Nat where + GetAacAot 'LowComplexity = 2 + GetAacAot 'HighEfficiency = 5 + +-- | Convert the 'AacAot' to an ISO/IEC 14496-3 Audio Object Type value. +getAacAot + :: forall aot c proxy. + (Integral aot, KnownNat (GetAacAot c)) + => proxy c -> aot +getAacAot _ = + let px :: Proxy (GetAacAot c) + px = Proxy + in fromInteger $ natVal px + +-- | Proxy for showing an 'AacAot' +data AacAotProxy (aot :: AacAot) = + MkAacAotProxy + +-- * Encoder Initialization +-- | Allocate a new encoder instance in a 'ResourceT' monad such that it will +-- automatically be released and the freed. +aacEncoderAllocate + :: ( KnownRate rate + , KnownChannelLayout channels + , Show (AacAotProxy aot) + , KnownNat (GetAacAot aot) + , MonadIO m + , MonadResource m + , MonadThrow m + , MonadLoggerIO m + ) + => AacEncoderConfig rate channels aot + -> m (AacEncoderContext rate channels aot, AacEncoderInfo rate channels aot) +aacEncoderAllocate (Tagged cfg) = do + let destroyAndLog logger enc = + runLoggingT + (do $logDebug (fromString (printf "%s destroying" (show enc))) + res <- liftIO (destroy enc) + case res of + AacEncOk -> + $logInfo (fromString (printf "%s destroyed" (show enc))) + other -> + $logError + (fromString + (printf + "%s failed to destroy: %s" + (show enc) + (show other)))) + logger + logger <- askLoggerIO + (rkey, eres) <- allocate (create cfg) (Prelude.mapM_ (destroyAndLog logger)) + case eres of + Left err -> do + $logError (fromString (printf "encoder allocation failed: %s" (show err))) + release rkey + throwM err + Right enc@MkEncoder {encoderDelay, frameSize, audioSpecificConfig} -> do + let i = + MkAacEncoderInfo + { _aacEncoderInfoDelay = fromIntegral encoderDelay + , _aacEncoderInfoFrameSize = fromIntegral frameSize + , _aacEncoderInfoAudioSpecificConfig = audioSpecificConfig + , _aacEncoderInfoId = show enc + } + $logInfo (fromString (printf "allocated: %s" (show i))) + return (Tagged enc, i) + +-- * Stateful Encoding + +-- | Type alias for the internal RWS monad of the aac encoder. +type AacEncT rate channels aot m a = RWST Encoder () (AacEncSt rate channels aot) m a + +-- | The internal state for 'encodeLinearToAac' +newtype AacEncSt (rate :: Rate) channels (aot :: AacAot) = MkAacEncSt + { _numberOfDelayedSamples :: Word64 + -- ^ The number of input samples currently buffered in the delay lines of the encoder. + } deriving (Show) + +-- | An internal 'Iso' for the 'AacEncSt' +numberOfDelayedSamples :: Iso' (AacEncSt (rate :: Rate) channels (aot :: AacAot)) Word64 +numberOfDelayedSamples = iso _numberOfDelayedSamples MkAacEncSt + +-- | Convert linear audio to AAC encoded audio with the given encoder settings. +encodeLinearToAac + :: ( KnownRate rate + , KnownChannelLayout channels + , KnownRate rate + , Show (AacAotProxy aot) + , CanBeSample (Pcm channels S16) + , MonadIO m + , MonadThrow m + , MonadLogger m + ) + => Audio rate channels (Raw S16) + -> AacEncT rate channels aot m [Audio rate channels (Aac aot)] +encodeLinearToAac !aIn = + let dIn = V.unsafeCast (aIn ^. mediaBuffer . mediaBufferVector) + in encodeSampleVector dIn [] + +-- | Convert linear audio to AAC encoded audio with the given encoder settings, +-- from a raw sample vector. +-- If the sample vector contains more that the encoder can swallow at a time, +-- the encoder is repeatedly called until all input is consumed. +encodeSampleVector + :: forall m channels rate aot. + ( MonadLogger m + , MonadIO m + , MonadThrow m + , KnownChannelLayout channels + , KnownRate rate + , Show (AacAotProxy aot) + , V.Storable (Pcm channels S16) + ) + => V.Vector Word16 + -> [Audio rate channels (Aac aot)] + -> AacEncT rate channels aot m [Audio rate channels (Aac aot)] +encodeSampleVector dIn acc + | V.length dIn <= 0 = return [] + | otherwise = do + e <- ask + eres <- liftIO $ encode e dIn + case eres of + Left err -> do + $logError (fromString (printf "encoding failed: %s" (show err))) + throwM err + Right fr -> returnAccOrEncodeAgain acc fr + +-- | Flush any left over input and then also flush delay lines of the AAC encoder. +flushAacEncoder + :: ( MonadIO m + , MonadLogger m + , MonadThrow m + , KnownChannelLayout channels + , KnownRate r + , Show (AacAotProxy aot) + , V.Storable (Pcm channels S16) + ) + => AacEncT r channels aot m [Audio r channels (Aac aot)] +flushAacEncoder = do + d <- use numberOfDelayedSamples + e <- ask + $logDebug (fromString (printf "flushing %d samples" d)) + eres <- liftIO $ flush e + case eres of + Left err -> do + $logError (fromString (printf "flushing failed: %s" (show err))) + throwM err + Right fr -> do + $logInfo (fromString (printf "flushed frame: %s" (show fr))) + returnAccOrEncodeAgain [] fr + +-- | Internal function +returnAccOrEncodeAgain + :: ( MonadLogger m + , MonadIO m + , MonadThrow m + , KnownChannelLayout channels + , KnownRate rate + , Show (AacAotProxy aot) + , V.Storable (Pcm channels S16) + ) + => [Audio rate channels (Aac aot)] + -> EncodeResult + -> AacEncT rate channels aot m [Audio rate channels (Aac aot)] +returnAccOrEncodeAgain acc MkEncodeResult { encodeResultLeftOverInput + , encodeResultSamples + , encodeResultConsumedFrames + } = do + numberOfDelayedSamples += encodeResultConsumedFrames + delayed <- use numberOfDelayedSamples + let acc' = maybe acc (\es -> MkAacFrame es encoded : acc) encodeResultSamples + encoded = + if isJust encodeResultSamples + then delayed + else 0 + numberOfDelayedSamples -= encoded + case encodeResultLeftOverInput of + Nothing -> return (reverse acc') + Just rest -> encodeSampleVector rest acc' + +makeLenses ''AacEncoderInfo diff --git a/src/Data/MediaBus/FdkAac/EncoderFdkWrapper.c b/src/Data/MediaBus/FdkAac/EncoderFdkWrapper.c new file mode 100644 --- /dev/null +++ b/src/Data/MediaBus/FdkAac/EncoderFdkWrapper.c @@ -0,0 +1,200 @@ + +#include + +#include + +#include "fdk-aac/aacenc_lib.h" + +uintptr_t inline_c_Data_MediaBus_FdkAac_EncoderFdkWrapper_0_e88399b3eaf706673efe095f84ff92194fa12ff2(int * aacEncoderCfgErrorP_inline_c_0, unsigned configChannelMode_inline_c_1, unsigned configModules_inline_c_2, unsigned configChannels_inline_c_3, int * aacEncoderCfgErrorP_inline_c_4, unsigned configAot_inline_c_5, int * aacEncoderCfgErrorP_inline_c_6, unsigned configSbrMode_inline_c_7, int * aacEncoderCfgErrorP_inline_c_8, unsigned configSampleRate_inline_c_9, int * aacEncoderCfgErrorP_inline_c_10, int * aacEncoderCfgErrorP_inline_c_11, unsigned configBitRateMode_inline_c_12, int * aacEncoderCfgErrorP_inline_c_13, unsigned configBitRate_inline_c_14, int * aacEncoderCfgErrorP_inline_c_15, unsigned configBandwidth_inline_c_16, unsigned configBandwidth_inline_c_17, int * aacEncoderCfgErrorP_inline_c_18, int * aacEncoderCfgErrorP_inline_c_19, unsigned configSignallingMode_inline_c_20, int * aacEncoderCfgErrorP_inline_c_21, unsigned configAfterburner_inline_c_22, int * aacEncoderCfgErrorP_inline_c_23, int * aacEncoderCfgErrorP_inline_c_24, int * aacEncoderCfgErrorP_inline_c_25, unsigned confBufMaxLen_inline_c_26, unsigned char * confBufP_inline_c_27, unsigned * confBufSizeP_inline_c_28, unsigned * encDelayP_inline_c_29, unsigned * frameSizeP_inline_c_30, int * errorCodeP_inline_c_31) { + + AACENC_ERROR e = AACENC_OK; + HANDLE_AACENCODER phAacEncoder; + AACENC_InfoStruct pInfo; + CHANNEL_MODE channelMode; + *(aacEncoderCfgErrorP_inline_c_0) = 13; + + switch (configChannelMode_inline_c_1) { + case 1: channelMode = MODE_1; break; + case 2: channelMode = MODE_2; break; + case 3: channelMode = MODE_1_2; break; + case 4: channelMode = MODE_1_2_1; break; + case 5: channelMode = MODE_1_2_2; break; + case 6: channelMode = MODE_1_2_2_1; break; + default: channelMode = 0; break; + } + + e = aacEncOpen(&phAacEncoder, configModules_inline_c_2, configChannels_inline_c_3); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_4) = 0; + goto e0; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_AOT, (const UINT) configAot_inline_c_5); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_6) = 1; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_SBR_MODE, (const UINT) configSbrMode_inline_c_7); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_8) = 2; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_SAMPLERATE, (const UINT) configSampleRate_inline_c_9); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_10) = 3; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_CHANNELMODE, channelMode); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_11) = 4; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_BITRATEMODE, (const UINT) configBitRateMode_inline_c_12); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_13) = 5; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_BITRATE, (const UINT) configBitRate_inline_c_14); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_15) = 6; + goto e1; + } + if ((const UINT) configBandwidth_inline_c_16 != 0) { + e = aacEncoder_SetParam(phAacEncoder, AACENC_BANDWIDTH, (const UINT) configBandwidth_inline_c_17); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_18) = 7; + goto e1; + } + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_TRANSMUX, TT_MP4_RAW); // TODO extract from TRANSPORT_TYPE in FDK_audio.h + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_19) = 8; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_SIGNALING_MODE, (const UINT) configSignallingMode_inline_c_20); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_21) = 9; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_AFTERBURNER, (const UINT) configAfterburner_inline_c_22); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_23) = 10; + goto e1; + } + e = aacEncEncode(phAacEncoder, NULL, NULL, NULL, NULL); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_24) = 11; + goto e1; + } + e = aacEncInfo(phAacEncoder, &pInfo); + if (e != AACENC_OK) { + *(aacEncoderCfgErrorP_inline_c_25) = 12; + goto e1; + } + + for (unsigned int i = 0; i < pInfo.confSize && i < confBufMaxLen_inline_c_26; ++i) { + *(confBufP_inline_c_27 + i) = pInfo.confBuf[i]; + } + *(confBufSizeP_inline_c_28) = pInfo.confSize; + *(encDelayP_inline_c_29) = pInfo.encoderDelay; + *(frameSizeP_inline_c_30) = pInfo.frameLength; + return ((uintptr_t) phAacEncoder); + + e1: + if (AACENC_OK != aacEncClose(&phAacEncoder)) { + printf("Failed to free the AAC Encoder.\n"); + } + + e0: + *(errorCodeP_inline_c_31) = e; + return (uintptr_t)NULL; + +} + + +int inline_c_Data_MediaBus_FdkAac_EncoderFdkWrapper_1_922d89f2c2b9a2bb7dbc4bbc946440f71a320f2a(uintptr_t encoderHandle_inline_c_0, long vec_inline_c_1, short * vec_inline_c_2, long vec_inline_c_3, long unsafeOutBuffer_inline_c_4, unsigned char * unsafeOutBuffer_inline_c_5, int * numOutBytesP_inline_c_6, int * numInSamplesP_inline_c_7, int * numAncBytesP_inline_c_8) { + + AACENC_ERROR e; + HANDLE_AACENCODER phAacEncoder = (HANDLE_AACENCODER) encoderHandle_inline_c_0; + + + AACENC_BufDesc inBuffDesc; + INT inBuffIds[1] = {IN_AUDIO_DATA}; + INT inBuffSizes[1] = {vec_inline_c_1 * 2}; + INT inBuffElSizes[1] = {2}; + void* inBuffBuffers[1] = {vec_inline_c_2}; + inBuffDesc.numBufs = 1; + inBuffDesc.bufs = inBuffBuffers; + inBuffDesc.bufferIdentifiers = inBuffIds; + inBuffDesc.bufSizes = inBuffSizes; + inBuffDesc.bufElSizes = inBuffElSizes; + AACENC_InArgs inArgs = + { .numInSamples = vec_inline_c_3 + , .numAncBytes = 0 }; + + + AACENC_BufDesc outBuffDesc; + INT outBuffIds[1] = {OUT_BITSTREAM_DATA}; + INT outBuffSizes[1] = {unsafeOutBuffer_inline_c_4}; + INT outBuffElSizes[1] = {1}; + void* outBuffBuffers[1] = {unsafeOutBuffer_inline_c_5}; + outBuffDesc.numBufs = 1; + outBuffDesc.bufs = outBuffBuffers; + outBuffDesc.bufferIdentifiers = outBuffIds; + outBuffDesc.bufSizes = outBuffSizes; + outBuffDesc.bufElSizes = outBuffElSizes; + AACENC_OutArgs outArgs; + + e = aacEncEncode (phAacEncoder, &inBuffDesc, &outBuffDesc, + &inArgs, &outArgs); + *(numOutBytesP_inline_c_6) = outArgs.numOutBytes; + *(numInSamplesP_inline_c_7) = outArgs.numInSamples; + *(numAncBytesP_inline_c_8) = outArgs.numAncBytes; + + return e; + +} + + +int inline_c_Data_MediaBus_FdkAac_EncoderFdkWrapper_2_666791a4914d28907cccec9952c8fb7e36c63ac9(uintptr_t encoderHandle_inline_c_0, long unsafeOutBuffer_inline_c_1, unsigned char * unsafeOutBuffer_inline_c_2, int * numOutBytesP_inline_c_3, int * numInSamplesP_inline_c_4, int * numAncBytesP_inline_c_5) { + + AACENC_ERROR e; + HANDLE_AACENCODER phAacEncoder = (HANDLE_AACENCODER) encoderHandle_inline_c_0; + + + AACENC_BufDesc inBuffDesc; + inBuffDesc.numBufs = 0; + + AACENC_InArgs inArgs = + { .numInSamples = -1 + , .numAncBytes = 0 }; + + AACENC_BufDesc outBuffDesc; + INT outBuffIds[1] = {OUT_BITSTREAM_DATA}; + INT outBuffSizes[1] = {unsafeOutBuffer_inline_c_1}; + INT outBuffElSizes[1] = {1}; + void* outBuffBuffers[1] = {unsafeOutBuffer_inline_c_2}; + outBuffDesc.numBufs = 1; + outBuffDesc.bufs = outBuffBuffers; + outBuffDesc.bufferIdentifiers = outBuffIds; + outBuffDesc.bufSizes = outBuffSizes; + outBuffDesc.bufElSizes = outBuffElSizes; + AACENC_OutArgs outArgs; + + e = aacEncEncode (phAacEncoder, &inBuffDesc, &outBuffDesc, + &inArgs, &outArgs); + *(numOutBytesP_inline_c_3) = outArgs.numOutBytes; + *(numInSamplesP_inline_c_4) = outArgs.numInSamples; + *(numAncBytesP_inline_c_5) = outArgs.numAncBytes; + + return e; + +} + + +int inline_c_Data_MediaBus_FdkAac_EncoderFdkWrapper_3_8fd9c8ff1f367d8600d391d8958211c9959d567d(uintptr_t encoderHandle_inline_c_0) { + + HANDLE_AACENCODER phAacEncoder = (HANDLE_AACENCODER) encoderHandle_inline_c_0; + return aacEncClose(&phAacEncoder); + +} + diff --git a/src/Data/MediaBus/FdkAac/EncoderFdkWrapper.hs b/src/Data/MediaBus/FdkAac/EncoderFdkWrapper.hs new file mode 100644 --- /dev/null +++ b/src/Data/MediaBus/FdkAac/EncoderFdkWrapper.hs @@ -0,0 +1,511 @@ +-- | An internal module that tightly wraps around the Frauenhofer Development +-- Toolkit for AAC audio. +module Data.MediaBus.FdkAac.EncoderFdkWrapper + ( AacEncErrorCode(..) + , toAacEncErrorCode + , simpleConfig + , Config(..) + , CreateFailure(..) + , CreateFailedAt(..) + , Encoder(..) + , create + , EncodeResult(..) + , EncodeFailure(..) + , encode + , flush + , destroy + ) where + +import Control.Exception +import Data.Coerce +import Data.Int +import Data.Monoid +import qualified Data.Vector.Storable as V +import qualified Data.Vector.Storable.Mutable as VM +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr) +import qualified Language.C.Inline as C +import Text.Printf + +C.context (C.baseCtx <> C.vecCtx) + +C.include "" + +C.include "" + +C.include "fdk-aac/aacenc_lib.h" + +-- | Call into the native code to initialize an encoder context, if everything +-- works out great, an 'Encoder' is returned. Use 'destroy' to release the +-- resources associated with an 'Encoder'. +create :: Config -> IO (Either CreateFailure Encoder) +create config@(MkConfig { configModules + , configChannels + , configAot + , configSampleRate + , configBitRate + , configBitRateMode + , configBandwidth + , configSbrMode + , configSignallingMode + , configChannelMode + , configAfterburner + }) = do + let confBufMaxLen = 255 :: CUInt + confBufC <- mallocForeignPtrBytes (fromIntegral confBufMaxLen) + ((encDelayC, confBufSizeC, frameSizeC, aacEncoderCfgErrorC, errorCodeC), hPtr) <- + withForeignPtr confBufC $ \confBufP -> + C.withPtrs $ \(encDelayP, confBufSizeP, frameSizeP, aacEncoderCfgErrorP, errorCodeP) -> + [C.block| uintptr_t { + AACENC_ERROR e = AACENC_OK; + HANDLE_AACENCODER phAacEncoder; + AACENC_InfoStruct pInfo; + CHANNEL_MODE channelMode; + *($(int* aacEncoderCfgErrorP)) = 13; + + switch ($(unsigned int configChannelMode)) { + case 1: channelMode = MODE_1; break; + case 2: channelMode = MODE_2; break; + case 3: channelMode = MODE_1_2; break; + case 4: channelMode = MODE_1_2_1; break; + case 5: channelMode = MODE_1_2_2; break; + case 6: channelMode = MODE_1_2_2_1; break; + default: channelMode = 0; break; + } + + e = aacEncOpen(&phAacEncoder, $(unsigned int configModules), $(unsigned int configChannels)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 0; + goto e0; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_AOT, (const UINT) $(unsigned int configAot)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 1; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_SBR_MODE, (const UINT) $(unsigned int configSbrMode)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 2; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_SAMPLERATE, (const UINT) $(unsigned int configSampleRate)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 3; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_CHANNELMODE, channelMode); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 4; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_BITRATEMODE, (const UINT) $(unsigned int configBitRateMode)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 5; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_BITRATE, (const UINT) $(unsigned int configBitRate)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 6; + goto e1; + } + if ((const UINT) $(unsigned int configBandwidth) != 0) { + e = aacEncoder_SetParam(phAacEncoder, AACENC_BANDWIDTH, (const UINT) $(unsigned int configBandwidth)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 7; + goto e1; + } + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_TRANSMUX, TT_MP4_RAW); // TODO extract from TRANSPORT_TYPE in FDK_audio.h + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 8; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_SIGNALING_MODE, (const UINT) $(unsigned int configSignallingMode)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 9; + goto e1; + } + e = aacEncoder_SetParam(phAacEncoder, AACENC_AFTERBURNER, (const UINT) $(unsigned int configAfterburner)); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 10; + goto e1; + } + e = aacEncEncode(phAacEncoder, NULL, NULL, NULL, NULL); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 11; + goto e1; + } + e = aacEncInfo(phAacEncoder, &pInfo); + if (e != AACENC_OK) { + *($(int* aacEncoderCfgErrorP)) = 12; + goto e1; + } + + for (unsigned int i = 0; i < pInfo.confSize && i < $(unsigned int confBufMaxLen); ++i) { + *($(unsigned char* confBufP) + i) = pInfo.confBuf[i]; + } + *($(unsigned int* confBufSizeP)) = pInfo.confSize; + *($(unsigned int* encDelayP)) = pInfo.encoderDelay; + *($(unsigned int* frameSizeP)) = pInfo.frameLength; + return ((uintptr_t) phAacEncoder); + + e1: + if (AACENC_OK != aacEncClose(&phAacEncoder)) { + printf("Failed to free the AAC Encoder.\n"); + } + + e0: + *($(int* errorCodeP)) = e; + return (uintptr_t)NULL; + } |] + if hPtr == 0 + then return + (Left + MkCreateFailure + { createFailureErrorCode = toAacEncErrorCode errorCodeC + , createFailureAt = toEnum (fromIntegral aacEncoderCfgErrorC) + , createFailureInputConfig = config + }) + else do + let ascVM = VM.unsafeFromForeignPtr0 confBufC (fromIntegral confBufSizeC) + asc <- V.freeze ascVM + let outSize = fromIntegral (768 * configChannels) + outV <- VM.new outSize + return $ + Right $ + MkEncoder + { encoderHandle = hPtr + , channelCount = configChannels + , encoderDelay = fromIntegral encDelayC + , frameSize = fromIntegral frameSizeC + , unsafeOutBuffer = outV + , audioSpecificConfig = coerce asc + } + +-- | A subset of the possible encoder configuration parameters +data Config = MkConfig + { configModules :: !CUInt + , configChannels :: !CUInt + , configAot :: !CUInt + , configSampleRate :: !CUInt + , configBitRate :: !CUInt + , configBitRateMode :: !CUInt + , configBandwidth :: !CUInt -- ^ The audio frequency bandwidth to be considered + -- when compressing audio, if @0@ the setting is + -- not applied. + , configSbrMode :: !CUInt + , configSignallingMode :: !CUInt + , configChannelMode :: !CUInt + , configAfterburner :: !CUInt + } deriving (Eq, Show) + +-- | Generate a 'Config' from three simple parameters +simpleConfig :: Word8 -> Int -> Word32 -> Config +simpleConfig !aot !channels !sampleRate = + let !configModules = 0x17 + !configChannels = fromIntegral channels + !highEfficiency = configAot == 5 + !configAot = fromIntegral aot + !configSampleRate = fromIntegral sampleRate + !configBitRate = + configChannelMode * + round + (fromIntegral configSampleRate * + ((if highEfficiency + then 0.625 + else 1.5) :: Double -- + )) + !configBitRateMode = 0 + !configBandwidth = 0 + !configSbrMode = fromIntegral (fromEnum highEfficiency) + !configSignallingMode = + if highEfficiency + then 2 + else 0 + !configChannelMode = fromIntegral channels + !configAfterburner = 1 + in MkConfig + { configModules + , configChannels + , configAot + , configSampleRate + , configBitRate + , configBitRateMode + , configBandwidth + , configSbrMode + , configSignallingMode + , configChannelMode + , configAfterburner + } + +-- | Description of the context in which the 'create' function failed. +data CreateFailure = MkCreateFailure + { createFailureErrorCode :: AacEncErrorCode + , createFailureAt :: CreateFailedAt + , createFailureInputConfig :: Config + } deriving (Show, Eq) + +instance Exception CreateFailure + +-- | This sum type narrows down the specific step that failed, +-- in the @inline-c@ wrapper code in the 'create' function. +data CreateFailedAt + = AacEncOpen + | AacEncSetAot + | AacEncSetSbrMode + | AacEncSetSampleRate + | AacEncSetChannelMode + | AacEncSetBitRateMode + | AacEncSetBitRate + | AacEncSetBandwidth + | AacEncSetTransMux + | AacEncSetSignalingMode + | AacEncSetAfterburner + | AacEncApplyConfig + | AacEncReadInfo + | AacEncUnknownError + deriving (Eq, Show, Enum) + +-- | Handle for a specific encoder, can be created with 'aacEncoderNew'. +data Encoder = MkEncoder + { encoderHandle :: !CUIntPtr + , unsafeOutBuffer :: !(VM.IOVector CUChar) + , channelCount :: !CUInt + , encoderDelay :: !Word32 + , frameSize :: !Word32 + , audioSpecificConfig :: !(V.Vector Word8) + } + +-- | This instance only shows the 'encoderHandle' as hex string. +instance Show Encoder where + showsPrec d MkEncoder {encoderHandle} = + showParen (d > 10) $ + showString (printf "fdk-aac-enc: %016X" (toInteger encoderHandle)) + +-- | Encode Samples. +encode :: Encoder -> V.Vector Word16 -> IO (Either EncodeFailure EncodeResult) +encode enc@MkEncoder {encoderHandle, unsafeOutBuffer} !vecW16 = do + let vec = coerce vecW16 + toEncodeResult vec enc =<< + (C.withPtrs $ \(numOutBytesP, numInSamplesP, numAncBytesP) -> + [C.block| int { + AACENC_ERROR e; + HANDLE_AACENCODER phAacEncoder = (HANDLE_AACENCODER) $(uintptr_t encoderHandle); + + /* Input buffer */ + AACENC_BufDesc inBuffDesc; + INT inBuffIds[1] = {IN_AUDIO_DATA}; + INT inBuffSizes[1] = {$vec-len:vec * 2}; + INT inBuffElSizes[1] = {2}; + void* inBuffBuffers[1] = {$vec-ptr:(short *vec)}; + inBuffDesc.numBufs = 1; + inBuffDesc.bufs = inBuffBuffers; + inBuffDesc.bufferIdentifiers = inBuffIds; + inBuffDesc.bufSizes = inBuffSizes; + inBuffDesc.bufElSizes = inBuffElSizes; + AACENC_InArgs inArgs = + { .numInSamples = $vec-len:vec + , .numAncBytes = 0 }; + + /* Ouput buffer */ + AACENC_BufDesc outBuffDesc; + INT outBuffIds[1] = {OUT_BITSTREAM_DATA}; + INT outBuffSizes[1] = {$vec-len:unsafeOutBuffer}; + INT outBuffElSizes[1] = {1}; + void* outBuffBuffers[1] = {$vec-ptr:(unsigned char *unsafeOutBuffer)}; + outBuffDesc.numBufs = 1; + outBuffDesc.bufs = outBuffBuffers; + outBuffDesc.bufferIdentifiers = outBuffIds; + outBuffDesc.bufSizes = outBuffSizes; + outBuffDesc.bufElSizes = outBuffElSizes; + AACENC_OutArgs outArgs; + + e = aacEncEncode (phAacEncoder, &inBuffDesc, &outBuffDesc, + &inArgs, &outArgs); + *($(int* numOutBytesP)) = outArgs.numOutBytes; + *($(int* numInSamplesP)) = outArgs.numInSamples; + *($(int* numAncBytesP)) = outArgs.numAncBytes; + + return e; + }|]) + +-- | Encode the contents of the delay lines of the encoder. +flush :: Encoder -> IO (Either EncodeFailure EncodeResult) +flush enc@(MkEncoder {encoderHandle, unsafeOutBuffer}) = do + toEncodeResult mempty enc =<< + (C.withPtrs $ \(numOutBytesP, numInSamplesP, numAncBytesP) -> + [C.block| int { + AACENC_ERROR e; + HANDLE_AACENCODER phAacEncoder = (HANDLE_AACENCODER) $(uintptr_t encoderHandle); + + /* Input buffer */ + AACENC_BufDesc inBuffDesc; + inBuffDesc.numBufs = 0; + + AACENC_InArgs inArgs = + { .numInSamples = -1 + , .numAncBytes = 0 }; + + AACENC_BufDesc outBuffDesc; + INT outBuffIds[1] = {OUT_BITSTREAM_DATA}; + INT outBuffSizes[1] = {$vec-len:unsafeOutBuffer}; + INT outBuffElSizes[1] = {1}; + void* outBuffBuffers[1] = {$vec-ptr:(unsigned char *unsafeOutBuffer)}; + outBuffDesc.numBufs = 1; + outBuffDesc.bufs = outBuffBuffers; + outBuffDesc.bufferIdentifiers = outBuffIds; + outBuffDesc.bufSizes = outBuffSizes; + outBuffDesc.bufElSizes = outBuffElSizes; + AACENC_OutArgs outArgs; + + e = aacEncEncode (phAacEncoder, &inBuffDesc, &outBuffDesc, + &inArgs, &outArgs); + *($(int* numOutBytesP)) = outArgs.numOutBytes; + *($(int* numInSamplesP)) = outArgs.numInSamples; + *($(int* numAncBytesP)) = outArgs.numAncBytes; + + return e; + } |]) + +-- | Internal function +toEncodeResult + :: V.Vector C.CShort + -> Encoder + -> ((C.CInt, C.CInt, C.CInt), CInt) + -> IO (Either EncodeFailure EncodeResult) +toEncodeResult vec MkEncoder {unsafeOutBuffer, channelCount} ((numOutBytes, numInSamples, numAncBytes), retCode) = + let retCode' = toAacEncErrorCode retCode + in + if retCode' /= AacEncOk && retCode' /= AacEncEncodeEof + then return $ + Left + MkEncodeFailure + { encodeFailureCode = toAacEncErrorCode retCode + , encodeFailureNumOutBytes = fromIntegral numOutBytes + , encodeFailureNumInSamples = fromIntegral numInSamples + , encodeFailureNumAncBytes = fromIntegral numAncBytes + } + else do + let !numInSamplesI = fromIntegral numInSamples + !consumedFrames = + fromIntegral numInSamplesI `div` fromIntegral channelCount + !leftOverInput = + if numInSamplesI >= V.length vec + then Nothing + else let !inSliceLen = V.length vec - numInSamplesI + !inSlice = V.slice numInSamplesI inSliceLen vec + in Just inSlice + !numOutBytesI = fromIntegral numOutBytes + !encodedOutput <- + if numOutBytesI == 0 + then return Nothing + else do + !outTooLarge <- V.freeze unsafeOutBuffer + return $ Just $ V.force $ V.slice 0 numOutBytesI outTooLarge + return $ + Right + MkEncodeResult + { encodeResultConsumedFrames = consumedFrames + , encodeResultLeftOverInput = coerce leftOverInput + , encodeResultSamples = coerce encodedOutput + } + +-- | Result of 'encode' +data EncodeResult = MkEncodeResult + { encodeResultConsumedFrames :: !Word64 -- ^ Number of samples from the input + -- that were processed by the encoder + , encodeResultLeftOverInput :: !(Maybe (V.Vector Word16)) -- ^ The unprocessed + -- rest of the input. + -- Only if the input + -- is larger than the + -- encoders frame + -- length a left over + -- is returned. + , encodeResultSamples :: !(Maybe (V.Vector Word8)) -- ^ Encoded output. If less + -- than the frame length + -- samples have been + -- encoded, then the result + -- will be 'Nothing' + -- otherwise it is the + -- encoded AAC content + -- representing the encded + -- samples delayed by + -- 'frameLength'. + } + +instance Show EncodeResult where + showsPrec d MkEncodeResult { encodeResultConsumedFrames + , encodeResultLeftOverInput + , encodeResultSamples + } = + showParen (d > 10) $ + showString "encode result: consumed input samples: " . + shows encodeResultConsumedFrames . + showString ", left over input values: " . + (maybe (showString "n/a") (shows . V.length) encodeResultLeftOverInput) . + showString ", encoded output bytes: " . + (maybe (showString "n/a") (shows . V.length) encodeResultSamples) + +-- | Information about encoder when an 'encode' failure occured. +data EncodeFailure = MkEncodeFailure + { encodeFailureCode :: !AacEncErrorCode + , encodeFailureNumOutBytes :: !Word64 + , encodeFailureNumInSamples :: !Int16 + , encodeFailureNumAncBytes :: !Word64 + } deriving (Eq) + +instance Exception EncodeFailure + +instance Show EncodeFailure where + show MkEncodeFailure {..} = + printf + "(FDK AAC encode error: %s, numOutBytes: %d, numInSamples: %d, numAncBytes: %d)" + (show encodeFailureCode) + encodeFailureNumOutBytes + encodeFailureNumInSamples + encodeFailureNumAncBytes + +-- | Close an FDK-AAC encoder. +destroy :: Encoder -> IO AacEncErrorCode +destroy MkEncoder {encoderHandle} = do + toAacEncErrorCode . fromIntegral <$> + [C.block| int { + HANDLE_AACENCODER phAacEncoder = (HANDLE_AACENCODER) $(uintptr_t encoderHandle); + return aacEncClose(&phAacEncoder); + } |] + +-- | Error codes from the C-library, translated to this sum type +data AacEncErrorCode + = AacEncOk + | AacEncInvalidHandle + | AacEncMemoryError + | AacEncUnsupportedParameter + | AacEncInvalidConfig + | AacEncInitError + | AacEncInitAacError + | AacEncInitSbrError + | AacEncInitTpError + | AacEncInitMetaError + | AacEncEncoderError + | AacEncEncodeEof + | AacEncErrorOther CInt + deriving (Eq, Show) + +-- | Create an 'AacEncErrorCode' from the @int@ returned by the C-code. +toAacEncErrorCode :: CInt -> AacEncErrorCode +toAacEncErrorCode e = + case e of + 0x00 -> AacEncOk + 0x20 -> AacEncInvalidHandle + 0x21 -> AacEncMemoryError + 0x22 -> AacEncUnsupportedParameter + 0x23 -> AacEncInvalidConfig + 0x40 -> AacEncInitError + 0x41 -> AacEncInitAacError + 0x42 -> AacEncInitSbrError + 0x43 -> AacEncInitTpError + 0x44 -> AacEncInitMetaError + 0x60 -> AacEncEncoderError + 0x80 -> AacEncEncodeEof + othr -> AacEncErrorOther othr