sdl2-mixer 1.1.0 → 1.2.0.0
raw patch · 18 files changed
+802/−681 lines, 18 filesdep ~basesetup-changednew-component:exe:sdl2-mixer-basic-jumblednew-component:exe:sdl2-mixer-basic-rawnew-uploader
Dependency ranges changed: base
Files
- ChangeLog.md +5/−0
- LICENSE +2/−2
- README.md +23/−0
- Setup.hs +0/−2
- examples/Basic.hs +0/−49
- examples/Basic/Main.hs +48/−0
- examples/BasicRaw.hs +0/−61
- examples/BasicRaw/Main.hs +62/−0
- examples/Effect.hs +0/−64
- examples/Effect/Main.hs +61/−0
- examples/Jumbled.hs +0/−44
- examples/Jumbled/Main.hs +41/−0
- examples/Music.hs +0/−40
- examples/Music/Main.hs +37/−0
- sdl2-mixer.cabal +134/−114
- src/SDL/Mixer.hs +322/−269
- src/SDL/Raw/Helper.hs +60/−33
- src/SDL/Raw/Mixer.hsc +7/−3
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for sdl2-mixer++## v0.1.2.0++* Compatibility with GHC-9
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015 Vladimir Semyonov+Copyright (c) 2015 Vladimir Semyonov, 2015 Siniša Biđin, 2021 Daniel Firth All rights reserved. @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Vladimir Semyonov nor the names of other+ * Neither the names of the aforementioned authors nor other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+ README.md view
@@ -0,0 +1,23 @@+# sdl2-mixer++[](https://hackage.haskell.org/package/sdl2-mixer)+[](https://gitlab.homotopic.tech/haskell/sdl2-mixer)++Haskell bindings to SDL2_mixer. Provides both raw and high level bindings.++The+[original SDL2_mixer documentation](http://www.libsdl.org/projects/SDL_mixer/docs/SDL_mixer.html)+can also help, as the bindings are close to a direct mapping.++## Examples++Several example executables are included with the library. You can find them in+the `examples` directory.++```bash+stack exec -- sdl2-mixer-basic <file>+stack exec -- sdl2-mixer-raw <file>+stack exec -- sdl2-mixer-music <file>+stack exec -- sdl2-mixer-jumbled <file1> ... <fileN>+stack exec -- sdl2-mixer-effect <file>+```
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
− examples/Basic.hs
@@ -1,49 +0,0 @@-import qualified SDL.Mixer as Mix-import qualified SDL--import Control.Monad (when)-import Data.Default.Class (def)-import System.Environment (getArgs)-import System.Exit (exitFailure)--main :: IO ()-main = do- -- read arguments- fileName <- do- args <- getArgs- case args of- (arg:_) -> return arg- _ -> do- putStrLn "Usage: cabal run sdl2-mixer-basic <sound filename>"- exitFailure-- -- initialize libraries- SDL.initialize [SDL.InitAudio]- Mix.initialize [Mix.InitMP3]-- -- open device- Mix.openAudio def 256-- -- open file- sound <- Mix.load fileName-- -- play file- Mix.play sound-- -- wait until finished- whileTrueM $ Mix.playing Mix.AllChannels-- -- free resources- Mix.free sound-- -- close device- Mix.closeAudio-- -- quit- Mix.quit- SDL.quit--whileTrueM :: Monad m => m Bool -> m ()-whileTrueM cond = do- loop <- cond- when loop $ whileTrueM cond
+ examples/Basic/Main.hs view
@@ -0,0 +1,48 @@+import Control.Monad (when)+import Data.Default.Class (def)+import qualified SDL+import qualified SDL.Mixer as Mix+import System.Environment (getArgs)+import System.Exit (exitFailure)++main :: IO ()+main = do+ -- read arguments+ fileName <- do+ args <- getArgs+ case args of+ (arg : _) -> return arg+ _ -> do+ putStrLn "Usage: cabal run sdl2-mixer-basic <sound filename>"+ exitFailure++ -- initialize libraries+ SDL.initialize [SDL.InitAudio]+ Mix.initialize [Mix.InitMP3]++ -- open device+ Mix.openAudio def 256++ -- open file+ sound <- Mix.load fileName++ -- play file+ Mix.play sound++ -- wait until finished+ whileTrueM $ Mix.playing Mix.AllChannels++ -- free resources+ Mix.free sound++ -- close device+ Mix.closeAudio++ -- quit+ Mix.quit+ SDL.quit++whileTrueM :: Monad m => m Bool -> m ()+whileTrueM cond = do+ loop <- cond+ when loop $ whileTrueM cond
− examples/BasicRaw.hs
@@ -1,61 +0,0 @@-import qualified SDL.Raw.Mixer as Mix-import qualified SDL--import Control.Monad (unless, when)-import Foreign.C.String (withCString)-import Foreign.Ptr (nullPtr)-import System.Environment (getArgs)-import System.Exit (exitFailure)--main :: IO ()-main = do- -- read arguments- fileName <- do- args <- getArgs- case args of- (arg:_) -> return arg- _ -> do- putStrLn "Usage: cabal run sdl2-mixer-raw <sound filename>"- exitFailure-- -- initialize libraries- SDL.initialize [SDL.InitAudio]- _ <- Mix.init Mix.INIT_MP3-- let rate = 22050- format = Mix.AUDIO_S16SYS- channels = 2- bufsize = 256-- -- open device- result <- Mix.openAudio rate format channels bufsize- assert $ result == 0-- -- open file- sound <- withCString fileName $ \cstr -> Mix.loadWAV cstr- assert $ sound /= nullPtr-- -- play file- channel <- Mix.playChannel (-1) sound 0- assert $ channel /= -1-- -- wait until finished- whileTrueM $ (/= 0) <$> Mix.playing channel-- -- free resources- Mix.freeChunk sound-- -- close device- Mix.closeAudio-- -- quit- Mix.quit- SDL.quit--assert :: Bool -> IO ()-assert = flip unless $ error "Assertion failed"--whileTrueM :: Monad m => m Bool -> m ()-whileTrueM cond = do- loop <- cond- when loop $ whileTrueM cond
+ examples/BasicRaw/Main.hs view
@@ -0,0 +1,62 @@+{-# OPTIONS_GHC -fno-warn-monomorphism-restriction #-}++import Control.Monad (unless, when)+import Foreign.C.String (withCString)+import Foreign.Ptr (nullPtr)+import qualified SDL+import qualified SDL.Raw.Mixer as Mix+import System.Environment (getArgs)+import System.Exit (exitFailure)++main :: IO ()+main = do+ -- read arguments+ fileName <- do+ args <- getArgs+ case args of+ (arg : _) -> return arg+ _ -> do+ putStrLn "Usage: cabal run sdl2-mixer-raw <sound filename>"+ exitFailure++ -- initialize libraries+ SDL.initialize [SDL.InitAudio]+ _ <- Mix.init Mix.INIT_MP3++ let rate = 22050+ format = Mix.AUDIO_S16SYS+ channels = 2+ bufsize = 256++ -- open device+ result <- Mix.openAudio rate format channels bufsize+ assert $ result == 0++ -- open file+ sound <- withCString fileName $ \cstr -> Mix.loadWAV cstr+ assert $ sound /= nullPtr++ -- play file+ channel <- Mix.playChannel (-1) sound 0+ assert $ channel /= -1++ -- wait until finished+ whileTrueM $ (/= 0) <$> Mix.playing channel++ -- free resources+ Mix.freeChunk sound++ -- close device+ Mix.closeAudio++ -- quit+ Mix.quit+ SDL.quit++assert :: Bool -> IO ()+assert = flip unless $ error "Assertion failed"++whileTrueM :: Monad m => m Bool -> m ()+whileTrueM cond = do+ loop <- cond+ when loop $ whileTrueM cond
− examples/Effect.hs
@@ -1,64 +0,0 @@-module Main where--import Data.Int (Int16)-import Data.Word (Word8)-import Control.Monad (when, forM_)-import System.Environment (getArgs)-import System.Exit (exitFailure)--import qualified SDL-import qualified SDL.Mixer as Mix-import qualified Data.Vector.Storable.Mutable as MV--main :: IO ()-main = do- SDL.initialize [SDL.InitAudio]-- Mix.withAudio Mix.defaultAudio 256 $ do- putStr "Available music decoders: "- print =<< Mix.musicDecoders-- args <- getArgs- case args of- [] -> putStrLn "Usage: cabal run sdl2-mixer-effect FILE" >> exitFailure- xs -> runExample $ head xs-- SDL.quit---- An effect that does something silly: lowers the volume 2 times.-halveVolume :: MV.IOVector Word8 -> IO ()-halveVolume bytes = do- let shorts = MV.unsafeCast bytes :: MV.IOVector Int16- forM_ [0 .. MV.length shorts - 1] $ \i -> do- s <- MV.read shorts i- MV.write shorts i $ div s 2---- Apply an Effect on the Music being played.-runExample :: FilePath -> IO ()-runExample path = do-- -- Add effects, get back effect removal actions.- -- The volume should be FOUR times as low after this.- popEffects <-- mapM (Mix.effect Mix.PostProcessing (\_ -> return ()) . const)- [halveVolume, halveVolume]-- -- Then give the left channel louder music than the right one.- popPan <- Mix.effectPan Mix.PostProcessing 128 64-- music <- Mix.load path- Mix.playMusic Mix.Once music-- delayWhile Mix.playingMusic-- -- The effects are no longer applied after this.- sequence_ $ popPan : popEffects-- Mix.free music--delayWhile :: IO Bool -> IO ()-delayWhile check = loop'- where- loop' = do- still <- check- when still $ SDL.delay 300 >> delayWhile check
+ examples/Effect/Main.hs view
@@ -0,0 +1,61 @@+import Control.Monad (forM_, when)+import Data.Int (Int16)+import qualified Data.Vector.Storable.Mutable as MV+import Data.Word (Word8)+import qualified SDL+import qualified SDL.Mixer as Mix+import System.Environment (getArgs)+import System.Exit (exitFailure)++main :: IO ()+main = do+ SDL.initialize [SDL.InitAudio]++ Mix.withAudio Mix.defaultAudio 256 $ do+ putStr "Available music decoders: "+ print =<< Mix.musicDecoders++ args <- getArgs+ case args of+ [] -> putStrLn "Usage: cabal run sdl2-mixer-effect FILE" >> exitFailure+ xs -> runExample $ head xs++ SDL.quit++-- An effect that does something silly: lowers the volume 2 times.+halveVolume :: MV.IOVector Word8 -> IO ()+halveVolume bytes = do+ let shorts = MV.unsafeCast bytes :: MV.IOVector Int16+ forM_ [0 .. MV.length shorts - 1] $ \i -> do+ s <- MV.read shorts i+ MV.write shorts i $ div s 2++-- Apply an Effect on the Music being played.+runExample :: FilePath -> IO ()+runExample path = do+ -- Add effects, get back effect removal actions.+ -- The volume should be FOUR times as low after this.+ popEffects <-+ mapM+ (Mix.effect Mix.PostProcessing (\_ -> return ()) . const)+ [halveVolume, halveVolume]++ -- Then give the left channel louder music than the right one.+ popPan <- Mix.effectPan Mix.PostProcessing 128 64++ music <- Mix.load path+ Mix.playMusic Mix.Once music++ delayWhile Mix.playingMusic++ -- The effects are no longer applied after this.+ sequence_ $ popPan : popEffects++ Mix.free music++delayWhile :: IO Bool -> IO ()+delayWhile check = loop'+ where+ loop' = do+ still <- check+ when still $ SDL.delay 300 >> delayWhile check
− examples/Jumbled.hs
@@ -1,44 +0,0 @@-module Main where--import Control.Monad (when)-import Data.Default.Class (def)-import System.Environment (getArgs)-import System.Exit (exitFailure)--import qualified SDL-import qualified SDL.Mixer as Mix--main :: IO ()-main = do- SDL.initialize [SDL.InitAudio]-- Mix.withAudio def 256 $ do- putStr "Available chunk decoders: "- print =<< Mix.chunkDecoders-- args <- getArgs- case args of- [] -> do- putStrLn "Usage: cabal run sdl2-mixer-jumbled FILE..."- exitFailure- xs -> runExample xs-- SDL.quit---- | Play each of the sounds at the same time!-runExample :: [FilePath] -> IO ()-runExample paths = do- Mix.setChannels $ length paths- Mix.whenChannelFinished $ \c -> putStrLn $ show c ++ " finished playing!"- chunks <- mapM Mix.load paths- mapM_ Mix.play chunks- delayWhile $ Mix.playing Mix.AllChannels- Mix.setChannels 0- mapM_ Mix.free chunks--delayWhile :: IO Bool -> IO ()-delayWhile check = loop'- where- loop' = do- still <- check- when still $ SDL.delay 300 >> delayWhile check
+ examples/Jumbled/Main.hs view
@@ -0,0 +1,41 @@+import Control.Monad (when)+import Data.Default.Class (def)+import qualified SDL+import qualified SDL.Mixer as Mix+import System.Environment (getArgs)+import System.Exit (exitFailure)++main :: IO ()+main = do+ SDL.initialize [SDL.InitAudio]++ Mix.withAudio def 256 $ do+ putStr "Available chunk decoders: "+ print =<< Mix.chunkDecoders++ args <- getArgs+ case args of+ [] -> do+ putStrLn "Usage: cabal run sdl2-mixer-jumbled FILE..."+ exitFailure+ xs -> runExample xs++ SDL.quit++-- | Play each of the sounds at the same time!+runExample :: [FilePath] -> IO ()+runExample paths = do+ Mix.setChannels $ length paths+ Mix.whenChannelFinished $ \c -> putStrLn $ show c ++ " finished playing!"+ chunks <- mapM Mix.load paths+ mapM_ Mix.play chunks+ delayWhile $ Mix.playing Mix.AllChannels+ Mix.setChannels 0+ mapM_ Mix.free chunks++delayWhile :: IO Bool -> IO ()+delayWhile check = loop'+ where+ loop' = do+ still <- check+ when still $ SDL.delay 300 >> delayWhile check
− examples/Music.hs
@@ -1,40 +0,0 @@-module Main where--import Control.Monad (when)-import System.Environment (getArgs)-import System.Exit (exitFailure)--import qualified SDL-import qualified SDL.Mixer as Mix--main :: IO ()-main = do- SDL.initialize [SDL.InitAudio]-- Mix.withAudio Mix.defaultAudio 256 $ do- putStr "Available music decoders: "- print =<< Mix.musicDecoders-- args <- getArgs- case args of- [] -> putStrLn "Usage: cabal run sdl2-mixer-music FILE" >> exitFailure- xs -> runExample $ head xs-- SDL.quit---- | Play the given file as a Music.-runExample :: FilePath -> IO ()-runExample path = do- music <- Mix.load path- print $ Mix.musicType music- Mix.whenMusicFinished $ putStrLn "Music finished playing!"- Mix.playMusic Mix.Once music- delayWhile Mix.playingMusic- Mix.free music--delayWhile :: IO Bool -> IO ()-delayWhile check = loop'- where- loop' = do- still <- check- when still $ SDL.delay 300 >> delayWhile check
+ examples/Music/Main.hs view
@@ -0,0 +1,37 @@+import Control.Monad (when)+import qualified SDL+import qualified SDL.Mixer as Mix+import System.Environment (getArgs)+import System.Exit (exitFailure)++main :: IO ()+main = do+ SDL.initialize [SDL.InitAudio]++ Mix.withAudio Mix.defaultAudio 256 $ do+ putStr "Available music decoders: "+ print =<< Mix.musicDecoders++ args <- getArgs+ case args of+ [] -> putStrLn "Usage: cabal run sdl2-mixer-music FILE" >> exitFailure+ xs -> runExample $ head xs++ SDL.quit++-- | Play the given file as a Music.+runExample :: FilePath -> IO ()+runExample path = do+ music <- Mix.load path+ print $ Mix.musicType music+ Mix.whenMusicFinished $ putStrLn "Music finished playing!"+ Mix.playMusic Mix.Once music+ delayWhile Mix.playingMusic+ Mix.free music++delayWhile :: IO Bool -> IO ()+delayWhile check = loop'+ where+ loop' = do+ still <- check+ when still $ SDL.delay 300 >> delayWhile check
sdl2-mixer.cabal view
@@ -1,135 +1,155 @@-name: sdl2-mixer-version: 1.1.0-synopsis: Bindings to SDL2_mixer.-description: Haskell bindings to SDL2_mixer.-license: BSD3-license-file: LICENSE-author: Vladimir Semyonov <tempname011@gmail.com>- Siniša Biđin <sinisa@bidin.eu>-maintainer: Siniša Biđin <sinisa@bidin.eu>-copyright: Copyright © 2015 Vladimir Semyonov- Copyright © 2015 Siniša Biđin-category: Sound, Foreign-build-type: Simple-cabal-version: >=1.10+cabal-version: 2.2 +-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: sdl2-mixer+version: 1.2.0.0+synopsis: Haskell bindings to SDL2_mixer+category: Sound, Foreign+bug-reports: https://gitlab.homotopic.tech/haskell/sdl2-mixer/issues+author: Vladimir Semyonov,+ Siniša Biđin,+ Daniel Firth+maintainer: Siniša Biđin <sinisa@bidin.eu>,+ Daniel Firth <dan.firth@homotopic.tech>+copyright: 2015 Vladimir Semyonov,+ 2015 Siniša Biđin,+ 2021 Daniel Firth+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md+ source-repository head- type: git- location: https://github.com/sbidin/sdl2-mixer.git+ type: git+ location: https://gitlab.homotopic.tech/haskell/sdl2-mixer library- ghc-options: -Wall- exposed-modules:- SDL.Mixer,- SDL.Raw.Mixer-+ SDL.Mixer+ SDL.Raw.Helper+ SDL.Raw.Mixer other-modules:- SDL.Raw.Helper-+ Paths_sdl2_mixer hs-source-dirs:- src-- includes:- SDL_mixer.h-+ src+ ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe+ c-sources:+ cbits/helpers.c extra-libraries:- SDL2_mixer-+ SDL2_mixer pkgconfig-depends:- SDL2_mixer >= 2.0.0-- c-sources:- cbits/helpers.c-+ SDL2_mixer >= 2.0.0 build-depends:- base >= 4.7 && < 5,- bytestring >= 0.10.4.0,- data-default-class >= 0.0.1,- lifted-base >= 0.2,- monad-control >= 1.0,- sdl2 >= 2.0.0,- template-haskell,- vector >= 0.10-- default-language:- Haskell2010--flag example- description: Build the example executables- default: False--executable sdl2-mixer-basic- ghc-options: -Wall- hs-source-dirs: examples- main-is: Basic.hs+ base >=4.9 && <5+ , bytestring >=0.10.4.0+ , data-default-class >=0.0.1+ , lifted-base >=0.2+ , monad-control >=1.0+ , sdl2 >=2.0.0+ , template-haskell >=2.10+ , vector >=0.10 default-language: Haskell2010-- if flag(example)- build-depends:- base >= 4.7 && < 5,- data-default-class >= 0.0.1,- sdl2 >= 2.0.0,- sdl2-mixer- else- buildable: False+ autogen-modules: Paths_sdl2_mixer -executable sdl2-mixer-raw- ghc-options: -Wall- hs-source-dirs: examples- main-is: BasicRaw.hs+executable sdl2-mixer-basic+ main-is: Main.hs+ other-modules:+ Paths_sdl2_mixer+ hs-source-dirs:+ examples/Basic+ ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N+ c-sources:+ cbits/helpers.c+ extra-libraries:+ SDL2_mixer+ pkgconfig-depends:+ SDL2_mixer >= 2.0.0+ build-depends:+ base >=4.9 && <5+ , data-default-class >=0.0.1+ , sdl2 >=2.0.0+ , sdl2-mixer default-language: Haskell2010 - if flag(example)- build-depends:- base >= 4.7 && < 5,- sdl2 >= 2.0.0,- sdl2-mixer- else- buildable: False--executable sdl2-mixer-jumbled- ghc-options: -Wall- hs-source-dirs: examples- main-is: Jumbled.hs+executable sdl2-mixer-basic-jumbled+ main-is: Main.hs+ other-modules:+ Paths_sdl2_mixer+ hs-source-dirs:+ examples/Jumbled+ ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N+ c-sources:+ cbits/helpers.c+ extra-libraries:+ SDL2_mixer+ pkgconfig-depends:+ SDL2_mixer >= 2.0.0+ build-depends:+ base >=4.9 && <5+ , data-default-class >=0.0.1+ , sdl2 >=2.0.0+ , sdl2-mixer default-language: Haskell2010 - if flag(example)- build-depends:- base >= 4.7 && < 5,- data-default-class >= 0.0.1,- sdl2 >= 2.0.0,- sdl2-mixer- else- buildable: False--executable sdl2-mixer-music- ghc-options: -Wall- hs-source-dirs: examples- main-is: Music.hs+executable sdl2-mixer-basic-raw+ main-is: Main.hs+ other-modules:+ Paths_sdl2_mixer+ hs-source-dirs:+ examples/BasicRaw+ ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N+ c-sources:+ cbits/helpers.c+ extra-libraries:+ SDL2_mixer+ pkgconfig-depends:+ SDL2_mixer >= 2.0.0+ build-depends:+ base >=4.9 && <5+ , sdl2 >=2.0.0+ , sdl2-mixer default-language: Haskell2010 - if flag(example)- build-depends:- base >= 4.7 && < 5,- data-default-class >= 0.0.1,- sdl2 >= 2.0.0,- sdl2-mixer- else- buildable: False- executable sdl2-mixer-effect- ghc-options: -Wall -threaded- hs-source-dirs: examples- main-is: Effect.hs+ main-is: Main.hs+ other-modules:+ Paths_sdl2_mixer+ hs-source-dirs:+ examples/Effect+ ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N+ c-sources:+ cbits/helpers.c+ extra-libraries:+ SDL2_mixer+ pkgconfig-depends:+ SDL2_mixer >= 2.0.0+ build-depends:+ base >=4.9 && <5+ , sdl2 >=2.0.0+ , sdl2-mixer+ , vector >=0.10 default-language: Haskell2010 - if flag(example)- build-depends:- base >= 4.7 && < 5,- data-default-class >= 0.0.1,- sdl2 >= 2.0.0,- sdl2-mixer,- vector >= 0.10- else- buildable: False+executable sdl2-mixer-music+ main-is: Main.hs+ other-modules:+ Paths_sdl2_mixer+ hs-source-dirs:+ examples/Music+ ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N+ c-sources:+ cbits/helpers.c+ extra-libraries:+ SDL2_mixer+ pkgconfig-depends:+ SDL2_mixer >= 2.0.0+ build-depends:+ base >=4.9 && <5+ , sdl2 >=2.0.0+ , sdl2-mixer+ default-language: Haskell2010
src/SDL/Mixer.hs view
@@ -1,200 +1,208 @@-{-|+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} -Module : SDL.Mixer-License : BSD3-Stability : experimental+-- |+--+-- Module : SDL.Mixer+-- License : BSD3+-- Stability : experimental+--+-- Bindings to the @SDL2_mixer@ library.+module SDL.Mixer+ ( -- * Audio setup -Bindings to the @SDL2_mixer@ library.+ -- --}+ -- | In order to use the rest of the library, you need to+ -- supply 'withAudio' or 'openAudio' with an 'Audio' configuration.+ withAudio,+ Audio (..),+ Format (..),+ Output (..),+ defaultAudio,+ ChunkSize,+ queryAudio, -{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+ -- ** Alternative+ openAudio,+ closeAudio, -module SDL.Mixer- (- -- * Audio setup- --- -- | In order to use the rest of the library, you need to- -- supply 'withAudio' or 'openAudio' with an 'Audio' configuration.- withAudio- , Audio(..)- , Format(..)- , Output(..)- , defaultAudio- , ChunkSize- , queryAudio+ -- * Loading audio data - -- ** Alternative- , openAudio- , closeAudio+ -- - -- * Loading audio data- --- -- | Use 'load' or 'decode' to get both 'Chunk' and 'Music' values.- , Loadable(..)- , Chunk(..)- , chunkDecoders- , Music(..)- , musicDecoders+ -- | Use 'load' or 'decode' to get both 'Chunk' and 'Music' values.+ Loadable (..),+ Chunk (..),+ chunkDecoders,+ Music (..),+ musicDecoders, - -- * Chunks- --- -- | 'Chunk's are played on 'Channel's, which can be combined into 'Group's.+ -- * Chunks - -- ** Playing chunks- , Channel- , pattern AllChannels- , setChannels- , getChannels- , play- , playForever- , Times- , pattern Once- , pattern Forever- , playOn- , Milliseconds- , Limit- , pattern NoLimit- , playLimit- , fadeIn- , fadeInOn- , fadeInLimit+ -- - -- ** Grouping channels- , reserveChannels- , Group- , pattern DefaultGroup- , group- , groupSpan- , groupCount- , getAvailable- , getOldest- , getNewest+ -- | 'Chunk's are played on 'Channel's, which can be combined into 'Group's. - -- ** Controlling playback- , pause- , resume- , halt- , haltAfter- , haltGroup+ -- ** Playing chunks+ Channel,+ pattern AllChannels,+ setChannels,+ getChannels,+ play,+ playForever,+ Times,+ pattern Once,+ pattern Forever,+ playOn,+ Milliseconds,+ Limit,+ pattern NoLimit,+ playLimit,+ fadeIn,+ fadeInOn,+ fadeInLimit, - -- ** Setting the volume- , Volume- , HasVolume(..)+ -- ** Grouping channels+ reserveChannels,+ Group,+ pattern DefaultGroup,+ group,+ groupSpan,+ groupCount,+ getAvailable,+ getOldest,+ getNewest, - -- ** Querying for status- , playing- , playingCount- , paused- , pausedCount- , playedLast- , Fading- , fading+ -- ** Controlling playback+ pause,+ resume,+ halt,+ haltAfter,+ haltGroup, - -- ** Fading out- , fadeOut- , fadeOutGroup+ -- ** Setting the volume+ Volume,+ HasVolume (..), - -- ** Reacting to finish- , whenChannelFinished+ -- ** Querying for status+ playing,+ playingCount,+ paused,+ pausedCount,+ playedLast,+ Fading,+ fading, - -- * Music- --- -- | 'Chunk's and 'Music' differ by the way they are played. While multiple- -- 'Chunk's can be played on different desired 'Channel's at the same time,- -- there can only be one 'Music' playing at the same time.- --- -- Therefore, the functions used for 'Music' are separate.+ -- ** Fading out+ fadeOut,+ fadeOutGroup, - -- ** Playing music- , playMusic- , Position- , fadeInMusic- , fadeInMusicAt- , fadeInMusicAtMOD+ -- ** Reacting to finish+ whenChannelFinished, - -- ** Controlling playback- , pauseMusic- , haltMusic- , resumeMusic- , rewindMusic- , setMusicPosition- , setMusicPositionMOD+ -- * Music - -- ** Setting the volume- , setMusicVolume- , getMusicVolume+ -- - -- ** Querying for status- , playingMusic- , pausedMusic- , fadingMusic- , MusicType(..)- , musicType- , playingMusicType+ -- | 'Chunk's and 'Music' differ by the way they are played. While multiple+ -- 'Chunk's can be played on different desired 'Channel's at the same time,+ -- there can only be one 'Music' playing at the same time.+ --+ -- Therefore, the functions used for 'Music' are separate. - -- ** Fading out- , fadeOutMusic+ -- ** Playing music+ playMusic,+ Position,+ fadeInMusic,+ fadeInMusicAt,+ fadeInMusicAtMOD, - -- ** Reacting to finish- , whenMusicFinished+ -- ** Controlling playback+ pauseMusic,+ haltMusic,+ resumeMusic,+ rewindMusic,+ setMusicPosition,+ setMusicPositionMOD, - -- * Effects- , Effect- , EffectFinished- , pattern PostProcessing- , effect+ -- ** Setting the volume+ setMusicVolume,+ getMusicVolume, - -- ** In-built effects- , effectPan- , effectDistance- , effectPosition- , effectReverseStereo+ -- ** Querying for status+ playingMusic,+ pausedMusic,+ fadingMusic,+ MusicType (..),+ musicType,+ playingMusicType, - -- * Other- , initialize- , InitFlag(..)- , quit- , version+ -- ** Fading out+ fadeOutMusic, - ) where+ -- ** Reacting to finish+ whenMusicFinished, + -- * Effects+ Effect,+ EffectFinished,+ pattern PostProcessing,+ effect,++ -- ** In-built effects+ effectPan,+ effectDistance,+ effectPosition,+ effectReverseStereo,++ -- * Other+ initialize,+ InitFlag (..),+ quit,+ version,+ )+where+ import Control.Exception (throwIO) import Control.Exception.Lifted (finally)-import Control.Monad (void, forM, when)+import Control.Monad (forM, void, when, (<=<), (>=>)) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Control (MonadBaseControl)-import Data.Bits ((.|.), (.&.))-import Data.ByteString (ByteString, readFile)+import Data.Bits ((.&.), (.|.))+import Data.ByteString as BS (ByteString, readFile) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.Default.Class (Default(def))-import Data.Foldable (foldl)+import Data.Default.Class (Default (def)) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Int (Int16) import Data.Vector.Storable.Mutable (IOVector, unsafeFromForeignPtr0) import Data.Word (Word8) import Foreign.C.String (peekCString) import Foreign.C.Types (CInt)-import Foreign.ForeignPtr (newForeignPtr_, castForeignPtr)+import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) import Foreign.Marshal.Alloc (alloca)-import Foreign.Ptr (FunPtr, nullFunPtr, freeHaskellFunPtr)-import Foreign.Ptr (Ptr, castPtr, nullPtr)-import Foreign.Storable (Storable(..))-import Prelude hiding (foldl, readFile)-import SDL (SDLException(SDLCallFailed))+import Foreign.Ptr (FunPtr, Ptr, castPtr, freeHaskellFunPtr, nullFunPtr, nullPtr)+import Foreign.Storable (Storable (peek))+import SDL (SDLException (SDLCallFailed)) import SDL.Internal.Exception-import SDL.Raw.Filesystem (rwFromConstMem)-import System.IO.Unsafe (unsafePerformIO)-+ ( getError,+ throwIf0,+ throwIfNeg,+ throwIfNeg_,+ throwIfNull,+ throwIf_,+ ) import qualified SDL.Raw+import SDL.Raw.Filesystem (rwFromConstMem) import qualified SDL.Raw.Mixer+import System.IO.Unsafe (unsafePerformIO) -- | Initialize the library by loading support for a certain set of -- sample/music formats.@@ -217,14 +225,14 @@ | InitMOD | InitMP3 | InitOGG- deriving (Eq, Ord, Bounded, Read, Show)+ deriving stock (Eq, Ord, Bounded, Read, Show) initToCInt :: InitFlag -> CInt initToCInt = \case- InitFLAC -> SDL.Raw.Mixer.INIT_FLAC- InitMOD -> SDL.Raw.Mixer.INIT_MOD- InitMP3 -> SDL.Raw.Mixer.INIT_MP3- InitOGG -> SDL.Raw.Mixer.INIT_OGG+ InitFLAC -> SDL.Raw.Mixer.INIT_FLAC+ InitMOD -> SDL.Raw.Mixer.INIT_MOD+ InitMP3 -> SDL.Raw.Mixer.INIT_MP3+ InitOGG -> SDL.Raw.Mixer.INIT_OGG -- | Cleans up any loaded libraries, freeing memory. quit :: MonadIO m => m ()@@ -242,8 +250,8 @@ -- with 'SDL.Init.InitAudio'. -- -- Automatically cleans up the API when the inner computation finishes.-withAudio- :: (MonadBaseControl IO m, MonadIO m) => Audio -> ChunkSize -> m a -> m a+withAudio ::+ (MonadBaseControl IO m, MonadIO m) => Audio -> ChunkSize -> m a -> m a withAudio conf csize act = do openAudio conf csize finally act closeAudio@@ -254,7 +262,7 @@ -- 'closeAudio' after a computation ends, so you have to take care to do so -- manually. openAudio :: MonadIO m => Audio -> ChunkSize -> m ()-openAudio (Audio {..}) chunkSize =+openAudio Audio {..} chunkSize = throwIfNeg_ "SDL.Mixer.openAudio" "Mix_OpenAudio" $ SDL.Raw.Mixer.openAudio (fromIntegral audioFrequency)@@ -264,16 +272,22 @@ -- | An audio configuration. Use this with 'withAudio'. data Audio = Audio- { audioFrequency :: Int -- ^ A sampling frequency.- , audioFormat :: Format -- ^ An output sample format.- , audioOutput :: Output -- ^ 'Mono' or 'Stereo' output.- } deriving (Eq, Read, Show)+ { -- | A sampling frequency.+ audioFrequency :: Int,+ -- | An output sample format.+ audioFormat :: Format,+ -- | 'Mono' or 'Stereo' output.+ audioOutput :: Output+ }+ deriving stock (Eq, Read, Show) instance Default Audio where- def = Audio { audioFrequency = SDL.Raw.Mixer.DEFAULT_FREQUENCY- , audioFormat = wordToFormat SDL.Raw.Mixer.DEFAULT_FORMAT- , audioOutput = cIntToOutput SDL.Raw.Mixer.DEFAULT_CHANNELS- }+ def =+ Audio+ { audioFrequency = SDL.Raw.Mixer.DEFAULT_FREQUENCY,+ audioFormat = wordToFormat SDL.Raw.Mixer.DEFAULT_FORMAT,+ audioOutput = cIntToOutput SDL.Raw.Mixer.DEFAULT_CHANNELS+ } -- | A default 'Audio' configuration. --@@ -293,20 +307,28 @@ -- | A sample format. data Format- = FormatU8 -- ^ Unsigned 8-bit samples.- | FormatS8 -- ^ Signed 8-bit samples.- | FormatU16_LSB -- ^ Unsigned 16-bit samples, in little-endian byte order.- | FormatS16_LSB -- ^ Signed 16-bit samples, in little-endian byte order.- | FormatU16_MSB -- ^ Unsigned 16-bit samples, in big-endian byte order.- | FormatS16_MSB -- ^ signed 16-bit samples, in big-endian byte order.- | FormatU16_Sys -- ^ Unsigned 16-bit samples, in system byte order.- | FormatS16_Sys -- ^ Signed 16-bit samples, in system byte order.- deriving (Eq, Ord, Bounded, Read, Show)+ = -- | Unsigned 8-bit samples.+ FormatU8+ | -- | Signed 8-bit samples.+ FormatS8+ | -- | Unsigned 16-bit samples, in little-endian byte order.+ FormatU16_LSB+ | -- | Signed 16-bit samples, in little-endian byte order.+ FormatS16_LSB+ | -- | Unsigned 16-bit samples, in big-endian byte order.+ FormatU16_MSB+ | -- | signed 16-bit samples, in big-endian byte order.+ FormatS16_MSB+ | -- | Unsigned 16-bit samples, in system byte order.+ FormatU16_Sys+ | -- | Signed 16-bit samples, in system byte order.+ FormatS16_Sys+ deriving stock (Eq, Ord, Bounded, Read, Show) formatToWord :: Format -> SDL.Raw.Mixer.Format formatToWord = \case- FormatU8 -> SDL.Raw.Mixer.AUDIO_U8- FormatS8 -> SDL.Raw.Mixer.AUDIO_S8+ FormatU8 -> SDL.Raw.Mixer.AUDIO_U8+ FormatS8 -> SDL.Raw.Mixer.AUDIO_S8 FormatU16_LSB -> SDL.Raw.Mixer.AUDIO_U16LSB FormatS16_LSB -> SDL.Raw.Mixer.AUDIO_S16LSB FormatU16_MSB -> SDL.Raw.Mixer.AUDIO_U16MSB@@ -316,8 +338,8 @@ wordToFormat :: SDL.Raw.Mixer.Format -> Format wordToFormat = \case- SDL.Raw.Mixer.AUDIO_U8 -> FormatU8- SDL.Raw.Mixer.AUDIO_S8 -> FormatS8+ SDL.Raw.Mixer.AUDIO_U8 -> FormatU8+ SDL.Raw.Mixer.AUDIO_S8 -> FormatS8 SDL.Raw.Mixer.AUDIO_U16LSB -> FormatU16_LSB SDL.Raw.Mixer.AUDIO_S16LSB -> FormatS16_LSB SDL.Raw.Mixer.AUDIO_U16MSB -> FormatU16_MSB@@ -328,11 +350,11 @@ -- | The number of sound channels in output. data Output = Mono | Stereo- deriving (Eq, Ord, Bounded, Read, Show)+ deriving stock (Eq, Ord, Bounded, Read, Show) outputToCInt :: Output -> CInt outputToCInt = \case- Mono -> 1+ Mono -> 1 Stereo -> 2 cIntToOutput :: CInt -> Output@@ -347,8 +369,9 @@ -- 'withAudio'. queryAudio :: MonadIO m => m Audio queryAudio =- liftIO .- alloca $ \freq ->+ liftIO+ . alloca+ $ \freq -> alloca $ \form -> alloca $ \chan -> do void . throwIf0 "SDL.Mixer.queryAudio" "Mix_QuerySpec" $@@ -372,13 +395,12 @@ -- Note that you must call 'withAudio' before using these, since they have to -- know the audio configuration to properly convert the data for playback. class Loadable a where- -- | Load the value from a 'ByteString'. decode :: MonadIO m => ByteString -> m a -- | Same as 'decode', but loads from a file instead. load :: MonadIO m => FilePath -> m a- load = (decode =<<) . liftIO . readFile+ load = decode <=< (liftIO . BS.readFile) -- | Frees the value's memory. It should no longer be used. --@@ -396,7 +418,6 @@ -- | A class of all values that have a 'Volume'. class HasVolume a where- -- | Gets the value's currently set 'Volume'. -- -- If the value is a 'Channel' and 'AllChannels' is used, gets the /average/@@ -424,24 +445,24 @@ chunkDecoders = liftIO $ do num <- SDL.Raw.Mixer.getNumChunkDecoders- forM [0 .. num - 1] $ \i ->- SDL.Raw.Mixer.getChunkDecoder i >>= peekCString+ forM [0 .. num - 1] $ SDL.Raw.Mixer.getChunkDecoder >=> peekCString -- | A loaded audio chunk.-newtype Chunk = Chunk (Ptr SDL.Raw.Mixer.Chunk) deriving (Eq, Show)+newtype Chunk = Chunk (Ptr SDL.Raw.Mixer.Chunk)+ deriving stock (Eq, Show) instance Loadable Chunk where decode bytes = liftIO $ do unsafeUseAsCStringLen bytes $ \(cstr, len) -> do rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)- fmap Chunk .- throwIfNull "SDL.Mixer.decode<Chunk>" "Mix_LoadWAV_RW" $- SDL.Raw.Mixer.loadWAV_RW rw 0+ fmap Chunk+ . throwIfNull "SDL.Mixer.decode<Chunk>" "Mix_LoadWAV_RW"+ $ SDL.Raw.Mixer.loadWAV_RW rw 0 free (Chunk p) = liftIO $ SDL.Raw.Mixer.freeChunk p instance HasVolume Chunk where- getVolume (Chunk p) = fmap fromIntegral $ SDL.Raw.Mixer.volumeChunk p (-1)+ getVolume (Chunk p) = fromIntegral <$> SDL.Raw.Mixer.volumeChunk p (-1) setVolume v (Chunk p) = void . SDL.Raw.Mixer.volumeChunk p $ volumeToCInt v -- | A mixing channel.@@ -454,12 +475,14 @@ -- 'setChannels'. -- -- The starting 'Volume' of each 'Channel' is the maximum: 128.-newtype Channel = Channel CInt deriving (Eq, Ord, Enum, Integral, Real, Num)+newtype Channel = Channel CInt+ deriving stock (Eq, Ord)+ deriving newtype (Enum, Integral, Real, Num) instance Show Channel where show = \case AllChannels -> "AllChannels"- Channel c -> "Channel " ++ show c+ Channel c -> "Channel " ++ show c -- The lowest-numbered channel is CHANNEL_POST, or -2, for post processing -- effects. This function makes sure a channel is higher than CHANNEL_POST.@@ -507,13 +530,14 @@ -- | Use this value when you wish to perform an operation on /all/ 'Channel's. -- -- For more information, see each of the functions accepting a 'Channel'.-pattern AllChannels = (-1) :: Channel+pattern AllChannels :: Channel+pattern AllChannels = -1 instance HasVolume Channel where setVolume v (Channel c) = void . SDL.Raw.Mixer.volume (clipChan c) $ volumeToCInt v getVolume (Channel c) =- fmap fromIntegral $ SDL.Raw.Mixer.volume (clipChan c) (-1)+ fromIntegral <$> SDL.Raw.Mixer.volume (clipChan c) (-1) -- | Play a 'Chunk' once, using the first available 'Channel'. play :: MonadIO m => Chunk -> m ()@@ -524,13 +548,17 @@ playForever = void . playOn (-1) Forever -- | How many times should a certain 'Chunk' be played?-newtype Times = Times CInt deriving (Eq, Ord, Enum, Integral, Real, Num)+newtype Times = Times CInt+ deriving stock (Eq, Ord)+ deriving newtype (Enum, Integral, Real, Num) -- | A shorthand for playing once.-pattern Once = 1 :: Times+pattern Once :: Times+pattern Once = 1 -- | A shorthand for looping a 'Chunk' forever.-pattern Forever = 0 :: Times+pattern Forever :: Times+pattern Forever = 0 -- | Same as 'play', but plays the 'Chunk' using a given 'Channel' a certain -- number of 'Times'.@@ -549,7 +577,8 @@ type Limit = Milliseconds -- | A lack of an upper limit.-pattern NoLimit = (-1) :: Limit+pattern NoLimit :: Limit+pattern NoLimit = -1 -- | Same as 'playOn', but imposes an upper limit in 'Milliseconds' to how long -- the 'Chunk' can play.@@ -559,10 +588,16 @@ -- This is the most generic play function variant. playLimit :: MonadIO m => Limit -> Channel -> Times -> Chunk -> m Channel playLimit l (Channel c) (Times t) (Chunk p) =- throwIfNeg "SDL.Mixer.playLimit" "Mix_PlayChannelTimed" $- fmap fromIntegral $- SDL.Raw.Mixer.playChannelTimed- (clipChan c) p (max (-1) $ t - 1) (fromIntegral l)+ throwIfNeg+ "SDL.Mixer.playLimit"+ "Mix_PlayChannelTimed"+ ( fromIntegral+ <$> SDL.Raw.Mixer.playChannelTimed+ (clipChan c)+ p+ (max (-1) $ t - 1)+ (fromIntegral l)+ ) -- | Same as 'play', but fades in the 'Chunk' by making the 'Channel' 'Volume' -- start at 0 and rise to a full 128 over the course of a given number of@@ -571,7 +606,7 @@ -- The 'Chunk' may end playing before the fade-in is complete, if it doesn't -- last as long as the given fade-in time. fadeIn :: MonadIO m => Milliseconds -> Chunk -> m ()-fadeIn ms = void . fadeInOn AllChannels Once ms+fadeIn ms = void . fadeInOn AllChannels Once ms -- | Same as 'fadeIn', but allows you to specify the 'Channel' to play on and -- how many 'Times' to play it, similar to 'playOn'.@@ -587,14 +622,23 @@ -- can play, similar to 'playLimit'. -- -- This is the most generic fade-in function variant.-fadeInLimit- :: MonadIO m =>- Limit -> Channel -> Times -> Milliseconds -> Chunk -> m Channel+fadeInLimit ::+ MonadIO m =>+ Limit ->+ Channel ->+ Times ->+ Milliseconds ->+ Chunk ->+ m Channel fadeInLimit l (Channel c) (Times t) ms (Chunk p) = throwIfNeg "SDL.Mixer.fadeInLimit" "Mix_FadeInChannelTimed" $- fromIntegral <$>- SDL.Raw.Mixer.fadeInChannelTimed- (clipChan c) p (max (-1) $ t - 1) (fromIntegral ms) (fromIntegral l)+ fromIntegral+ <$> SDL.Raw.Mixer.fadeInChannelTimed+ (clipChan c)+ p+ (max (-1) $ t - 1)+ (fromIntegral ms)+ (fromIntegral l) -- | Gradually fade out a given playing 'Channel' during the next -- 'Milliseconds', even if it is 'pause'd.@@ -611,7 +655,7 @@ fadeOutGroup :: MonadIO m => Milliseconds -> Group -> m () fadeOutGroup ms = \case DefaultGroup -> fadeOut ms AllChannels- Group g -> void $ SDL.Raw.Mixer.fadeOutGroup g $ fromIntegral ms+ Group g -> void $ SDL.Raw.Mixer.fadeOutGroup g $ fromIntegral ms -- | Pauses the given 'Channel', if it is actively playing. --@@ -645,7 +689,7 @@ haltGroup :: MonadIO m => Group -> m () haltGroup = \case DefaultGroup -> halt AllChannels- Group g -> void $ SDL.Raw.Mixer.haltGroup $ max 0 g+ Group g -> void $ SDL.Raw.Mixer.haltGroup $ max 0 g -- Quackery of the highest order! We keep track of a pointer we gave SDL_mixer, -- so we can free it at a later time. May the gods have mercy...@@ -661,7 +705,6 @@ -- __Note: don't call other 'SDL.Mixer' functions within this callback.__ whenChannelFinished :: MonadIO m => (Channel -> IO ()) -> m () whenChannelFinished callback = liftIO $ do- -- Sets the callback. let callback' = callback . Channel callbackRaw <- SDL.Raw.Mixer.wrapChannelCallback callback'@@ -698,12 +741,12 @@ -- | Describes whether a 'Channel' is fading in, out, or not at all. data Fading = NoFading | FadingIn | FadingOut- deriving (Eq, Ord, Show, Read)+ deriving stock (Eq, Ord, Show, Read) wordToFading :: SDL.Raw.Mixer.Fading -> Fading wordToFading = \case- SDL.Raw.Mixer.NO_FADING -> NoFading- SDL.Raw.Mixer.FADING_IN -> FadingIn+ SDL.Raw.Mixer.NO_FADING -> NoFading+ SDL.Raw.Mixer.FADING_IN -> FadingIn SDL.Raw.Mixer.FADING_OUT -> FadingOut _ -> error "SDL.Mixer.wordToFading: unknown Fading value." @@ -721,10 +764,13 @@ -- them at once. -- -- By default, all 'Channel's are members of the 'DefaultGroup'.-newtype Group = Group CInt deriving (Eq, Ord, Enum, Integral, Real, Num)+newtype Group = Group CInt+ deriving stock (Eq, Ord)+ deriving newtype (Enum, Integral, Real, Num) -- | The default 'Group' all 'Channel's are in the moment they are created.-pattern DefaultGroup = (-1) :: Group+pattern DefaultGroup :: Group+pattern DefaultGroup = -1 -- | Assigns a given 'Channel' to a certain 'Group'. --@@ -740,15 +786,13 @@ case channel of AllChannels -> do total <- getChannels- if total > 0 then- (> 0) <$> groupSpan wrapped 0 (Channel $ fromIntegral $ total - 1)- else- return True -- No channels available -- still a success probably.+ if total > 0+ then (> 0) <$> groupSpan wrapped 0 (Channel $ fromIntegral $ total - 1)+ else return True -- No channels available -- still a success probably. Channel c ->- if c >= 0 then- (== 1) <$> SDL.Raw.Mixer.groupChannel c g- else- return False -- Can't group the post-processing channel or below.+ if c >= 0+ then (== 1) <$> SDL.Raw.Mixer.groupChannel c g+ else return False -- Can't group the post-processing channel or below. -- | Same as 'groupChannel', but groups all 'Channel's between the first and -- last given, inclusive.@@ -764,8 +808,8 @@ groupSpan :: MonadIO m => Group -> Channel -> Channel -> m Int groupSpan wrap@(Group g) from@(Channel c1) to@(Channel c2) | c1 < 0 || c2 < 0 = return 0- | c1 > c2 = groupSpan wrap to from- | otherwise = fromIntegral <$> SDL.Raw.Mixer.groupChannels c1 c2 g+ | c1 > c2 = groupSpan wrap to from+ | otherwise = fromIntegral <$> SDL.Raw.Mixer.groupChannels c1 c2 g -- | Returns the number of 'Channels' within a 'Group'. --@@ -812,8 +856,7 @@ musicDecoders = liftIO $ do num <- SDL.Raw.Mixer.getNumMusicDecoders- forM [0 .. num - 1] $ \i ->- SDL.Raw.Mixer.getMusicDecoder i >>= peekCString+ forM [0 .. num - 1] $ SDL.Raw.Mixer.getMusicDecoder >=> peekCString -- | A loaded music file. --@@ -822,15 +865,16 @@ -- -- To manipulate 'Music' outside of post-processing callbacks, use the music -- variant functions listed below.-newtype Music = Music (Ptr SDL.Raw.Mixer.Music) deriving (Eq, Show)+newtype Music = Music (Ptr SDL.Raw.Mixer.Music)+ deriving stock (Eq, Show) instance Loadable Music where decode bytes = liftIO $ do unsafeUseAsCStringLen bytes $ \(cstr, len) -> do rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)- fmap Music .- throwIfNull "SDL.Mixer.decode<Music>" "Mix_LoadMUS_RW" $- SDL.Raw.Mixer.loadMUS_RW rw 0+ fmap Music+ . throwIfNull "SDL.Mixer.decode<Music>" "Mix_LoadMUS_RW"+ $ SDL.Raw.Mixer.loadMUS_RW rw 0 free (Music p) = liftIO $ SDL.Raw.Mixer.freeMusic p @@ -933,7 +977,10 @@ fadeInMusicAt at ms times (Music p) = throwIfNeg_ "SDL.Mixer.fadeInMusicAt" "Mix_FadeInMusicPos" $ SDL.Raw.Mixer.fadeInMusicPos- p t' (fromIntegral ms) (realToFrac at / 1000.0)+ p+ t'+ (fromIntegral ms)+ (realToFrac at / 1000.0) where t' = case times of Forever -> (-1)@@ -946,7 +993,10 @@ fadeInMusicAtMOD at ms times (Music p) = throwIfNeg_ "SDL.Mixer.fadeInMusicAtMOD" "Mix_FadeInMusicPos" $ SDL.Raw.Mixer.fadeInMusicPos- p t' (fromIntegral ms) (realToFrac at)+ p+ t'+ (fromIntegral ms)+ (realToFrac at) where t' = case times of Forever -> (-1)@@ -958,7 +1008,7 @@ -- | Gets the current 'Volume' setting for 'Music'. getMusicVolume :: MonadIO m => m Volume-getMusicVolume = fmap fromIntegral $ SDL.Raw.Mixer.volumeMusic (-1)+getMusicVolume = fromIntegral <$> SDL.Raw.Mixer.volumeMusic (-1) -- | Sets the 'Volume' for 'Music'. --@@ -975,19 +1025,19 @@ | OGG | MP3 | FLAC- deriving (Eq, Show, Read, Ord, Bounded)+ deriving stock (Eq, Show, Read, Ord, Bounded) wordToMusicType :: SDL.Raw.Mixer.MusicType -> Maybe MusicType wordToMusicType = \case- SDL.Raw.Mixer.MUS_NONE -> Nothing- SDL.Raw.Mixer.MUS_CMD -> Just CMD- SDL.Raw.Mixer.MUS_WAV -> Just WAV- SDL.Raw.Mixer.MUS_MOD -> Just MOD- SDL.Raw.Mixer.MUS_MID -> Just MID- SDL.Raw.Mixer.MUS_OGG -> Just OGG- SDL.Raw.Mixer.MUS_MP3 -> Just MP3- SDL.Raw.Mixer.MUS_FLAC -> Just FLAC- _ -> Nothing+ SDL.Raw.Mixer.MUS_NONE -> Nothing+ SDL.Raw.Mixer.MUS_CMD -> Just CMD+ SDL.Raw.Mixer.MUS_WAV -> Just WAV+ SDL.Raw.Mixer.MUS_MOD -> Just MOD+ SDL.Raw.Mixer.MUS_MID -> Just MID+ SDL.Raw.Mixer.MUS_OGG -> Just OGG+ SDL.Raw.Mixer.MUS_MP3 -> Just MP3+ SDL.Raw.Mixer.MUS_FLAC -> Just FLAC+ _ -> Nothing -- | Gets the 'MusicType' of a given 'Music'. musicType :: Music -> Maybe MusicType@@ -1030,7 +1080,8 @@ -- -- You can only use this value with 'effect' and the other in-built effect -- functions such as 'effectPan' and 'effectDistance'.-pattern PostProcessing = SDL.Raw.Mixer.CHANNEL_POST :: Channel+pattern PostProcessing :: Channel+pattern PostProcessing = SDL.Raw.Mixer.CHANNEL_POST -- | Adds a post-processing 'Effect' to a certain 'Channel'. --@@ -1040,23 +1091,25 @@ -- __execute this returned action more than once.__ effect :: MonadIO m => Channel -> EffectFinished -> Effect -> m (m ()) effect (Channel channel) fin ef = do-- ef' <- liftIO $ SDL.Raw.Mixer.wrapEffect $ \c p len _ -> do- fp <- castForeignPtr <$> newForeignPtr_ p- ef (Channel c) . unsafeFromForeignPtr0 fp $ fromIntegral len+ ef' <- liftIO $+ SDL.Raw.Mixer.wrapEffect $ \c p len _ -> do+ fp <- castForeignPtr <$> newForeignPtr_ p+ ef (Channel c) . unsafeFromForeignPtr0 fp $ fromIntegral len - fin' <- liftIO $ SDL.Raw.Mixer.wrapEffectFinished $ \c _ ->- fin $ Channel c+ fin' <- liftIO $+ SDL.Raw.Mixer.wrapEffectFinished $ \c _ ->+ fin $ Channel c result <- SDL.Raw.Mixer.registerEffect channel ef' fin' nullPtr - if result == 0 then do- liftIO $ do- freeHaskellFunPtr ef' >> freeHaskellFunPtr fin'- err <- getError- throwIO $ SDLCallFailed "SDL.Raw.Mixer.addEffect" "Mix_RegisterEffect" err- else- return . liftIO $ do -- The unregister action.+ if result == 0+ then do+ liftIO $ do+ freeHaskellFunPtr ef' >> freeHaskellFunPtr fin'+ err <- getError+ throwIO $ SDLCallFailed "SDL.Raw.Mixer.addEffect" "Mix_RegisterEffect" err+ else return . liftIO $ do+ -- The unregister action. removed <- SDL.Raw.Mixer.unregisterEffect channel ef' freeHaskellFunPtr ef' >> freeHaskellFunPtr fin' when (removed == 0) $ do@@ -1079,7 +1132,7 @@ return . void $ effectPan channel 128 128 wordVol :: Volume -> Word8-wordVol = fromIntegral . min 255 . (*2) . volumeToCInt+wordVol = fromIntegral . min 255 . (* 2) . volumeToCInt -- | Applies a different volume based on the distance (as 'Word8') specified. --
src/SDL/Raw/Helper.hs view
@@ -1,22 +1,42 @@-{-|--Module : SDL.Raw.Helper-License : BSD3--Exposes a way to automatically generate a foreign import alongside its lifted,-inlined MonadIO variant. Use this to simplify the package's SDL.Raw.* modules.---}--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} +-- |+--+-- Module : SDL.Raw.Helper+-- License : BSD3+--+-- Exposes a way to automatically generate a foreign import alongside its lifted,+-- inlined MonadIO variant. Use this to simplify the package's SDL.Raw.* modules. module SDL.Raw.Helper (liftF) where -import Control.Monad (replicateM)-import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad (replicateM)+import Control.Monad.IO.Class (MonadIO, liftIO) import Language.Haskell.TH+ ( Body (NormalB),+ Callconv (CCall),+ Clause (Clause),+ Dec (ForeignD, FunD, PragmaD, SigD),+ Exp (AppE, VarE),+ Foreign (ImportF),+ Inline (Inline),+ Name,+ Pat (VarP),+ Phases (AllPhases),+ Pragma (InlineP),+ Q,+ RuleMatch (FunLike),+ Safety (Safe),+ TyVarBndr (PlainTV),+ Type (AppT, ArrowT, ConT, ForallT, SigT, VarT),+ mkName,+ newName,+#if MIN_VERSION_template_haskell(2,17,0)+ Specificity(SpecifiedSpec)+#endif+ ) -- | Given a name @fname@, a name of a C function @cname@ and the desired -- Haskell type @ftype@, this function generates:@@ -26,8 +46,8 @@ liftF :: String -> String -> Q Type -> Q [Dec] liftF fname cname ftype = do let f' = mkName $ fname ++ "'" -- Direct binding.- let f = mkName fname -- Lifted.- t' <- ftype -- Type of direct binding.+ let f = mkName fname -- Lifted.+ t' <- ftype -- Type of direct binding. -- The generated function accepts n arguments. args <- replicateM (countArgs t') $ newName "x"@@ -36,39 +56,42 @@ -- However, this fails to typecheck without an explicit type signature. -- Therefore, we include one. TODO: Can we get rid of this? sigd <- case args of- [] -> ((:[]) . SigD f) `fmap` liftType t'- _ -> return []+ [] -> ((: []) . SigD f) `fmap` liftType t'+ _ -> return [] - return $ concat- [- [ ForeignD $ ImportF CCall Safe cname f' t'- , PragmaD $ InlineP f Inline FunLike AllPhases- ]- , sigd- , [ FunD f- [ Clause- (map VarP args)- (NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args])- []+ return $+ concat+ [ [ ForeignD $ ImportF CCall Safe cname f' t',+ PragmaD $ InlineP f Inline FunLike AllPhases+ ],+ sigd,+ [ FunD+ f+ [ Clause+ (map VarP args)+ (NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args])+ []+ ] ] ]- ] -- | How many arguments does a function of a given type take? countArgs :: Type -> Int countArgs = count 0 where+ count :: Num p => p -> Type -> p count !n = \case- (AppT (AppT ArrowT _) t) -> count (n+1) t+ (AppT (AppT ArrowT _) t) -> count (n + 1) t (ForallT _ _ t) -> count n t- (SigT t _) -> count n t- _ -> n+ (SigT t _) -> count n t+ _ -> n -- | An expression where f is applied to n arguments. applyTo :: Name -> [Exp] -> Exp applyTo f [] = VarE f applyTo f es = loop (tail es) . AppE (VarE f) $ head es where+ loop :: Foldable t => t Exp -> Exp -> Exp loop as e = foldl AppE e as -- | Fuzzily speaking, converts a given IO type into a MonadIO m one.@@ -78,7 +101,11 @@ m <- newName "m" return $ ForallT+#if MIN_VERSION_template_haskell(2,17,0)+ [PlainTV m SpecifiedSpec]+#else [PlainTV m]+#endif [AppT (ConT ''MonadIO) $ VarT m] (AppT (VarT m) t) t -> return t
src/SDL/Raw/Mixer.hsc view
@@ -11,7 +11,12 @@ -} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-exported-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -fno-warn-missing-local-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}@@ -46,8 +51,7 @@ , pattern AUDIO_S16 , pattern AUDIO_U16SYS , pattern AUDIO_S16SYS- , closeAudio- , querySpec+ , closeAudio , querySpec -- * Samples , getNumChunkDecoders@@ -234,7 +238,7 @@ , chunkAbuf :: Ptr Word8 , chunkAlen :: Word32 , chunkVolume :: Word8- } deriving (Eq, Show)+ } deriving stock (Eq, Show) instance Storable Chunk where alignment = sizeOf