opusfile (empty) → 0.1.0.0

raw patch · 7 files changed

+339/−0 lines, 7 filesdep +OpenALdep +StateVardep +basesetup-changed

Dependencies added: OpenAL, StateVar, base, bytestring, opusfile

Files

• ChangeLog.md +7/−0
• LICENSE +30/−0
• README.md +14/−0
• Setup.hs +2/−0
• examples/openal-playfile/Main.hs +67/−0
• opusfile.cabal +69/−0
• src/Sound/OpusFile.hs +150/−0

@@ -0,0 +1,7 @@+# Changelog for opusfile++## Unreleased changes++## [0.1.0.0] Initial import++[0.1.0.0]: https://gitlab.com/dpwiz/opusfile/-/tree/v0.1.0.0

@@ -0,0 +1,30 @@+Copyright Alexander Bondarenko (c) 2020++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 Alexander Bondarenko 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.

@@ -0,0 +1,14 @@+# opusfile++https://opus-codec.org/++> Opus is a totally open, royalty-free, highly versatile audio codec.+> Opus is unmatched for interactive speech and music transmission over the Internet,+> but is also intended for storage and streaming applications.++My intention were to use the Opus codec for game assets with OpenAL.+There's `examples/openal-playfile` exactly for this.++You'll need `libopusfile-dev` or something like that for your distro.++Add to package dependencies and import `Sound.OpusFile` qualified.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,67 @@+module Main where++import Control.Concurrent (threadDelay)+import Data.StateVar (($=))+import System.Environment (getArgs)+import Text.Printf (printf)++import qualified Data.ByteString as ByteString+import qualified Foreign+import qualified Sound.OpenAL as OpenAL+import qualified Sound.OpusFile as OpusFile++main :: IO ()+main = getArgs >>= \case+  [] ->+    putStrLn "Usage: openal-playfile <filename.opus>"+  files ->+    withAL $+      mapM_ playFile files++playFile :: FilePath -> IO ()+playFile filename = do+  (time, source) <- sourceOpusFile filename+  OpenAL.play [source]+  putStrLn $ printf "Playing %s (%.1f s)" (show filename) time+  threadDelay $ truncate (time * 1000000)++sourceOpusFile :: FilePath -> IO (Double, OpenAL.Source)+sourceOpusFile filePath = do+  Right file <- ByteString.readFile filePath >>= OpusFile.openMemoryBS+  pcm <- OpusFile.decodeInt16 file+  OpusFile.free file++  buffer <- OpenAL.genObjectName+  Foreign.withForeignPtr (OpusFile.pcmData pcm) \ptr -> do+    let+      mreg =+        OpenAL.MemoryRegion ptr (fromIntegral $ OpusFile.pcmSize pcm)++      alFormat =+        case OpusFile.pcmChannels pcm of+          Right OpusFile.Stereo ->+            OpenAL.Stereo16+          Right OpusFile.Mono ->+            OpenAL.Mono16+          Left n ->+            error $ "unexpected channels: " <> show n++    OpenAL.bufferData buffer $= OpenAL.BufferData mreg alFormat 48000++  source <- OpenAL.genObjectName+  OpenAL.buffer source $= Just buffer+  pure (OpusFile.pcmTime pcm, source)++withAL :: IO () -> IO ()+withAL action = do+  OpenAL.openDevice Nothing >>= \case+    Nothing ->+      error  "boo. no device"+    Just device -> do+      OpenAL.createContext device [] >>= \case+        Nothing ->+          error "OpenAL.createContext failed"+        Just ctx ->+          OpenAL.currentContext $= Just ctx+      () <- action+      OpenAL.closeDevice device >>= print

@@ -0,0 +1,69 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack+--+-- hash: c7063700f8e088ab3fbf8e386eba0e501f42d8f6332ae31aaa74b2084bea9b1f++name:           opusfile+version:        0.1.0.0+synopsis:       FFI bindings for libopusfile+category:       Sound+author:         Alexander Bondarenko+maintainer:     aenor.realm@gmail.com+copyright:      Alexander Bondarenko+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/dpwiz/opusfile++flag executables+  manual: True+  default: False++library+  exposed-modules:+      Sound.OpusFile+  other-modules:+      Paths_opusfile+  hs-source-dirs:+      src+  default-extensions:+      BlockArguments+      LambdaCase+      TypeApplications+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+  extra-libraries:+      opusfile+  build-depends:+      base >=4.7 && <5+    , bytestring+  default-language: Haskell2010++executable example-openal+  main-is: Main.hs+  other-modules:+      Paths_opusfile+  hs-source-dirs:+      examples/openal-playfile+  default-extensions:+      BlockArguments+      LambdaCase+      TypeApplications+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-maxN4+  build-depends:+      OpenAL+    , StateVar+    , base >=4.7 && <5+    , bytestring+    , opusfile+  if !flag(executables)+    buildable: False+  default-language: Haskell2010

@@ -0,0 +1,150 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Sound.OpusFile+  ( Handle(..)+  , OggOpusFile+  , openMemoryBS+  , openMemory+  , free++  , Channels(..)+  , channelCount+  , pcmTotal++  , Pcm(..)+  , decodeInt16+  ) where++import Data.ByteString (ByteString)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Int (Int16, Int64)+import Foreign (ForeignPtr, Ptr)+import Foreign.C.Types (CChar, CInt(..))+import System.IO.Unsafe (unsafePerformIO)++import qualified Foreign++-- * Loading++newtype Handle = Handle (Ptr OggOpusFile)+  deriving (Eq, Show)++data OggOpusFile++openMemoryBS :: ByteString -> IO (Either Int Handle)+openMemoryBS bs = unsafeUseAsCStringLen bs \(dataPtr, dataLen) ->+  openMemory dataPtr (fromIntegral dataLen)++openMemory :: Ptr CChar -> CInt -> IO (Either Int Handle)+openMemory dataPtr dataLen =+  Foreign.alloca \errorPtr -> do+    oggOpusFile <- op_test_memory dataPtr dataLen errorPtr+    Foreign.peek errorPtr >>= \case+      0 -> do+        op_test_open oggOpusFile >>= \case+          0 ->+            pure $ Right (Handle oggOpusFile)+          err ->+            pure $ Left (fromIntegral err)+      err ->+        pure $ Left (fromIntegral err)++free :: Handle -> IO ()+free (Handle handle) = op_free handle++-- * Information++data Channels+  = Mono+  | Stereo+  deriving (Eq, Ord, Show, Enum, Bounded)++channelCount :: Handle -> Either Int Channels+channelCount (Handle handle) =+  case unsafePerformIO (op_channel_count handle) of+    1 -> Right Mono+    2 -> Right Stereo+    n -> Left (fromIntegral n)++pcmTotal :: Handle -> Int+pcmTotal (Handle handle) =+  fromIntegral $ unsafePerformIO (op_pcm_total handle)++-- * Decoding++data Pcm a = Pcm+  { pcmData     :: ForeignPtr a+  , pcmSize     :: Int+  , pcmTime     :: Double+  , pcmChannels :: Either Int Channels+  }+  deriving (Eq, Show)++decodeInt16 :: Handle -> IO (Pcm Int16)+decodeInt16 h@(Handle handle) = do+  fptr <- Foreign.mallocForeignPtrBytes byteSize+  Foreign.withForeignPtr fptr (go 0) >>= \case+    Left ret ->+      error $ show ret+    Right _samplesDone ->+      pure Pcm+        { pcmData     = fptr+        , pcmSize     = byteSize+        , pcmTime     = fromIntegral hPcmSize / 48000+        , pcmChannels = hPcmChannels+        }++  where+    hPcmChannels = channelCount h+    hPcmSize = pcmTotal h++    byteSize = hPcmSize * numChannels * sampleBytes+    samples = hPcmSize * numChannels++    numChannels = case hPcmChannels of+      Right Mono   -> 1+      Right Stereo -> 2+      Left n       -> n++    sampleBytes = Foreign.sizeOf (undefined :: Int16)++    go samplesRead buf = do+      ret <- op_read+        handle+        buf+        (fromIntegral samples)+        Foreign.nullPtr+      if ret < 0 then+        pure $ Left ret+      else do+        let samplesDone = samplesRead + fromIntegral ret+        if samplesDone < hPcmSize then+          go samplesDone $+            Foreign.plusPtr buf (fromIntegral ret * numChannels * sampleBytes)+        else+          pure $ Right samplesDone++-- * FFI++foreign import ccall "op_free"+  op_free :: Ptr OggOpusFile -> IO ()++foreign import ccall "op_test_memory"+  op_test_memory :: Ptr CChar -> CInt -> Ptr CInt -> IO (Ptr OggOpusFile)++foreign import ccall "op_test_open"+  op_test_open :: Ptr OggOpusFile -> IO CInt++foreign import ccall "op_channel_count"+  op_channel_count :: Ptr OggOpusFile -> IO CInt++foreign import ccall "op_pcm_total"+  op_pcm_total :: Ptr OggOpusFile -> IO Int64++foreign import ccall "op_read"+  op_read+    :: Ptr OggOpusFile -- _of+    -> Ptr Int16       -- _pcm+    -> CInt            -- _buf_size+    -> Ptr CInt        -- _li+    -> IO CInt