sdl2-mixer-1.2.0.0/cbits/0000755000000000000000000000000014120100736013122 5ustar0000000000000000sdl2-mixer-1.2.0.0/examples/0000755000000000000000000000000014120107627013642 5ustar0000000000000000sdl2-mixer-1.2.0.0/examples/Basic/0000755000000000000000000000000014120121161014650 5ustar0000000000000000sdl2-mixer-1.2.0.0/examples/BasicRaw/0000755000000000000000000000000014120121426015326 5ustar0000000000000000sdl2-mixer-1.2.0.0/examples/Effect/0000755000000000000000000000000014120121167015031 5ustar0000000000000000sdl2-mixer-1.2.0.0/examples/Jumbled/0000755000000000000000000000000014120121456015220 5ustar0000000000000000sdl2-mixer-1.2.0.0/examples/Music/0000755000000000000000000000000014120123623014714 5ustar0000000000000000sdl2-mixer-1.2.0.0/src/0000755000000000000000000000000014120123600012600 5ustar0000000000000000sdl2-mixer-1.2.0.0/src/SDL/0000755000000000000000000000000014120120300013214 5ustar0000000000000000sdl2-mixer-1.2.0.0/src/SDL/Raw/0000755000000000000000000000000014120121732013757 5ustar0000000000000000sdl2-mixer-1.2.0.0/src/SDL/Mixer.hs0000644000000000000000000011547614120120300014652 0ustar0000000000000000{-# 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 -- -- Bindings to the @SDL2_mixer@ library. 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, -- ** Alternative openAudio, closeAudio, -- * Loading audio data -- -- | 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. -- ** 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, -- ** Controlling playback pause, resume, halt, haltAfter, haltGroup, -- ** Setting the volume Volume, HasVolume (..), -- ** Querying for status playing, playingCount, paused, pausedCount, playedLast, Fading, fading, -- ** Fading out fadeOut, fadeOutGroup, -- ** Reacting to finish whenChannelFinished, -- * 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. -- ** Playing music playMusic, Position, fadeInMusic, fadeInMusicAt, fadeInMusicAtMOD, -- ** Controlling playback pauseMusic, haltMusic, resumeMusic, rewindMusic, setMusicPosition, setMusicPositionMOD, -- ** Setting the volume setMusicVolume, getMusicVolume, -- ** Querying for status playingMusic, pausedMusic, fadingMusic, MusicType (..), musicType, playingMusicType, -- ** Fading out fadeOutMusic, -- ** 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 (forM, void, when, (<=<), (>=>)) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Bits ((.&.), (.|.)) import Data.ByteString as BS (ByteString, readFile) import Data.ByteString.Unsafe (unsafeUseAsCStringLen) 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 (castForeignPtr, newForeignPtr_) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (FunPtr, Ptr, castPtr, freeHaskellFunPtr, nullFunPtr, nullPtr) import Foreign.Storable (Storable (peek)) import SDL (SDLException (SDLCallFailed)) import SDL.Internal.Exception ( 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. -- -- Note that calling this is not strictly necessary: support for a certain -- format will be loaded automatically when attempting to load data in that -- format. Using 'initialize' allows you to decide /when/ to load support. -- -- You may call this function multiple times. initialize :: (Foldable f, MonadIO m) => f InitFlag -> m () initialize flags = do let raw = foldl (\a b -> a .|. initToCInt b) 0 flags throwIf_ ((/= raw) . (.&. raw)) "SDL.Mixer.initialize" "Mix_Init" $ SDL.Raw.Mixer.init raw -- | Used with 'initialize' to designate loading support for a particular -- sample/music format. data InitFlag = InitFLAC | InitMOD | InitMP3 | InitOGG 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 -- | Cleans up any loaded libraries, freeing memory. quit :: MonadIO m => m () quit = SDL.Raw.Mixer.quit -- FIXME: May not free all init'd libs! Check docs. -- | Gets the major, minor, patch versions of the linked @SDL2_mixer@ library. version :: (Integral a, MonadIO m) => m (a, a, a) version = liftIO $ do SDL.Raw.Version major minor patch <- peek =<< SDL.Raw.Mixer.getVersion return (fromIntegral major, fromIntegral minor, fromIntegral patch) -- | Initializes the @SDL2_mixer@ API. -- -- This should be the first function you call after initializing @SDL@ itself -- 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 conf csize act = do openAudio conf csize finally act closeAudio -- | An alternative to 'withAudio', also initializes the @SDL2_mixer@ API. -- -- However, 'openAudio' does not take care of automatically calling -- 'closeAudio' after a computation ends, so you have to take care to do so -- manually. openAudio :: MonadIO m => Audio -> ChunkSize -> m () openAudio Audio {..} chunkSize = throwIfNeg_ "SDL.Mixer.openAudio" "Mix_OpenAudio" $ SDL.Raw.Mixer.openAudio (fromIntegral audioFrequency) (formatToWord audioFormat) (outputToCInt audioOutput) (fromIntegral chunkSize) -- | An audio configuration. Use this with 'withAudio'. data Audio = Audio { -- | 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 } -- | A default 'Audio' configuration. -- -- Same as 'Data.Default.Class.def'. -- -- Uses 22050 as the 'audioFrequency', 'FormatS16_Sys' as the 'audioFormat' and -- 'Stereo' as the 'audioOutput'. defaultAudio :: Audio defaultAudio = def -- | The size of each mixed sample. -- -- The smaller this is, the more often callbacks will be invoked. If this is -- made too small on a slow system, the sounds may skip. If made too large, -- sound effects could lag. type ChunkSize = Int -- | A sample format. data Format = -- | 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 FormatU16_LSB -> SDL.Raw.Mixer.AUDIO_U16LSB FormatS16_LSB -> SDL.Raw.Mixer.AUDIO_S16LSB FormatU16_MSB -> SDL.Raw.Mixer.AUDIO_U16MSB FormatS16_MSB -> SDL.Raw.Mixer.AUDIO_S16MSB FormatU16_Sys -> SDL.Raw.Mixer.AUDIO_U16SYS FormatS16_Sys -> SDL.Raw.Mixer.AUDIO_S16SYS wordToFormat :: SDL.Raw.Mixer.Format -> Format wordToFormat = \case 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 SDL.Raw.Mixer.AUDIO_S16MSB -> FormatS16_MSB SDL.Raw.Mixer.AUDIO_U16SYS -> FormatU16_Sys SDL.Raw.Mixer.AUDIO_S16SYS -> FormatS16_Sys _ -> error "SDL.Mixer.wordToFormat: unknown Format." -- | The number of sound channels in output. data Output = Mono | Stereo deriving stock (Eq, Ord, Bounded, Read, Show) outputToCInt :: Output -> CInt outputToCInt = \case Mono -> 1 Stereo -> 2 cIntToOutput :: CInt -> Output cIntToOutput = \case 1 -> Mono 2 -> Stereo _ -> error "SDL.Mixer.cIntToOutput: unknown number of channels." -- | Get the audio format in use by the opened audio device. -- -- This may or may not match the 'Audio' you asked for when calling -- 'withAudio'. queryAudio :: MonadIO m => m Audio queryAudio = liftIO . alloca $ \freq -> alloca $ \form -> alloca $ \chan -> do void . throwIf0 "SDL.Mixer.queryAudio" "Mix_QuerySpec" $ SDL.Raw.Mixer.querySpec freq form chan Audio <$> (fromIntegral <$> peek freq) <*> (wordToFormat <$> peek form) <*> (cIntToOutput <$> peek chan) -- | Shut down and clean up the @SDL2_mixer@ API. -- -- After calling this, all audio stops. -- -- You don't have to call this if you're using 'withAudio'. closeAudio :: MonadIO m => m () closeAudio = SDL.Raw.Mixer.closeAudio -- | A class of all values that can be loaded from some source. You can load -- both 'Chunk's and 'Music' this way. -- -- 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 . BS.readFile) -- | Frees the value's memory. It should no longer be used. -- -- __Note that you shouldn't free those values that are currently playing.__ free :: MonadIO m => a -> m () -- | A volume, where 0 is silent and 128 loudest. -- -- 'Volume's lesser than 0 or greater than 128 function as if they are 0 and -- 128, respectively. type Volume = Int volumeToCInt :: Volume -> CInt volumeToCInt = fromIntegral . max 0 . min 128 -- | 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/ -- 'Volume' of all 'Channel's. getVolume :: MonadIO m => a -> m Volume -- | Sets a value's 'Volume'. -- -- If the value is a 'Chunk', the volume setting only takes effect when the -- 'Chunk' is used on a 'Channel', being mixed into the output. -- -- In case of being used on a 'Channel', the volume setting takes effect -- during the final mix, along with the 'Chunk' volume. For instance, setting -- the 'Volume' of a certain 'Channel' to 64 will halve the volume of all -- 'Chunk's played on that 'Channel'. If 'AllChannels' is used, sets all -- 'Channel's to the given 'Volume' instead. setVolume :: MonadIO m => Volume -> a -> m () -- | Returns the names of all chunk decoders currently available. -- -- These depend on the availability of shared libraries for each of the -- formats. The list may contain any of the following, and possibly others: -- @WAVE@, @AIFF@, @VOC@, @OFF@, @FLAC@, @MP3@. chunkDecoders :: MonadIO m => m [String] chunkDecoders = liftIO $ do num <- SDL.Raw.Mixer.getNumChunkDecoders forM [0 .. num - 1] $ SDL.Raw.Mixer.getChunkDecoder >=> peekCString -- | A loaded audio chunk. 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" "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) = fromIntegral <$> SDL.Raw.Mixer.volumeChunk p (-1) setVolume v (Chunk p) = void . SDL.Raw.Mixer.volumeChunk p $ volumeToCInt v -- | A mixing channel. -- -- Use the 'Integral' instance to define these: the first channel is 0, the -- second 1 and so on. -- -- The default number of 'Channel's available at startup is 8, so note that you -- cannot usemore than these starting 8 if you haven't created more with -- 'setChannels'. -- -- The starting 'Volume' of each 'Channel' is the maximum: 128. 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 -- The lowest-numbered channel is CHANNEL_POST, or -2, for post processing -- effects. This function makes sure a channel is higher than CHANNEL_POST. clipChan :: CInt -> CInt clipChan = max SDL.Raw.Mixer.CHANNEL_POST -- | Prepares a given number of 'Channel's for use. -- -- There are 8 such 'Channel's already prepared for use after 'withAudio' is -- called. -- -- You may call this multiple times, even with sounds playing. If setting a -- lesser number of 'Channel's than are currently in use, the higher 'Channel's -- will be stopped, their finish callbacks invoked, and their memory freed. -- Passing in 0 or less will therefore stop and free all mixing channels. -- -- Any 'Music' playing is not affected by this function. setChannels :: MonadIO m => Int -> m () setChannels = void . SDL.Raw.Mixer.allocateChannels . fromIntegral . max 0 -- | Gets the number of 'Channel's currently in use. getChannels :: MonadIO m => m Int getChannels = fromIntegral <$> SDL.Raw.Mixer.allocateChannels (-1) -- | Reserve a given number of 'Channel's, starting from 'Channel' 0. -- -- A reserved 'Channel' is considered not to be available for playing samples -- when using any 'play' or 'fadeIn' function variant with 'AllChannels'. In -- other words, whenever you let 'SDL.Mixer' pick the first available 'Channel' -- itself, these reserved 'Channel's will not be considered. reserveChannels :: MonadIO m => Int -> m Int reserveChannels = fmap fromIntegral . SDL.Raw.Mixer.reserveChannels . fromIntegral -- | Gets the most recent 'Chunk' played on a 'Channel', if any. -- -- Using 'AllChannels' is not valid here, and will return 'Nothing'. -- -- Note that the returned 'Chunk' might be invalid if it was already 'free'd. playedLast :: MonadIO m => Channel -> m (Maybe Chunk) playedLast (Channel c) = do p <- SDL.Raw.Mixer.getChunk $ clipChan c return $ if p == nullPtr then Nothing else Just (Chunk p) -- | 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 :: Channel pattern AllChannels = -1 instance HasVolume Channel where setVolume v (Channel c) = void . SDL.Raw.Mixer.volume (clipChan c) $ volumeToCInt v getVolume (Channel c) = fromIntegral <$> SDL.Raw.Mixer.volume (clipChan c) (-1) -- | Play a 'Chunk' once, using the first available 'Channel'. play :: MonadIO m => Chunk -> m () play = void . playOn (-1) Once -- | Same as 'play', but keeps playing the 'Chunk' forever. playForever :: MonadIO m => Chunk -> m () playForever = void . playOn (-1) Forever -- | How many times should a certain 'Chunk' be played? newtype Times = Times CInt deriving stock (Eq, Ord) deriving newtype (Enum, Integral, Real, Num) -- | A shorthand for playing once. pattern Once :: Times pattern Once = 1 -- | A shorthand for looping a 'Chunk' forever. pattern Forever :: Times pattern Forever = 0 -- | Same as 'play', but plays the 'Chunk' using a given 'Channel' a certain -- number of 'Times'. -- -- If 'AllChannels' is used, then plays the 'Chunk' using the first available -- 'Channel' instead. -- -- Returns the 'Channel' that was used. playOn :: MonadIO m => Channel -> Times -> Chunk -> m Channel playOn = playLimit NoLimit -- | A time in milliseconds. type Milliseconds = Int -- | An upper limit of time, in milliseconds. type Limit = Milliseconds -- | A lack of an upper limit. pattern NoLimit :: Limit pattern NoLimit = -1 -- | Same as 'playOn', but imposes an upper limit in 'Milliseconds' to how long -- the 'Chunk' can play. -- -- The playing may still stop before the limit is reached. -- -- 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" ( 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 -- 'Milliseconds'. -- -- 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 -- | Same as 'fadeIn', but allows you to specify the 'Channel' to play on and -- how many 'Times' to play it, similar to 'playOn'. -- -- If 'AllChannels' is used, will play the 'Chunk' on the first available -- 'Channel'. -- -- Returns the 'Channel' that was used. fadeInOn :: MonadIO m => Channel -> Times -> Milliseconds -> Chunk -> m Channel fadeInOn = fadeInLimit NoLimit -- | Same as 'fadeInOn', but imposes an upper 'Limit' to how long the 'Chunk' -- 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 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) -- | Gradually fade out a given playing 'Channel' during the next -- 'Milliseconds', even if it is 'pause'd. -- -- If 'AllChannels' is used, fades out all the playing 'Channel's instead. fadeOut :: MonadIO m => Milliseconds -> Channel -> m () fadeOut ms (Channel c) = void $ SDL.Raw.Mixer.fadeOutChannel (clipChan c) $ fromIntegral ms -- | Same as 'fadeOut', but fades out an entire 'Group' instead. -- -- Using 'DefaultGroup' here is the same as calling 'fadeOut' with -- 'AllChannels'. fadeOutGroup :: MonadIO m => Milliseconds -> Group -> m () fadeOutGroup ms = \case DefaultGroup -> fadeOut ms AllChannels Group g -> void $ SDL.Raw.Mixer.fadeOutGroup g $ fromIntegral ms -- | Pauses the given 'Channel', if it is actively playing. -- -- If 'AllChannels' is used, will pause all actively playing 'Channel's -- instead. -- -- Note that 'pause'd 'Channel's may still be 'halt'ed. pause :: MonadIO m => Channel -> m () pause (Channel c) = SDL.Raw.Mixer.pause $ clipChan c -- | Resumes playing a 'Channel', or all 'Channel's if 'AllChannels' is used. resume :: MonadIO m => Channel -> m () resume (Channel c) = SDL.Raw.Mixer.resume $ clipChan c -- | Halts playback on a 'Channel', or all 'Channel's if 'AllChannels' is used. halt :: MonadIO m => Channel -> m () halt (Channel c) = void $ SDL.Raw.Mixer.haltChannel $ clipChan c -- | Same as 'halt', but only does so after a certain number of 'Milliseconds'. -- -- If 'AllChannels' is used, it will halt all the 'Channel's after the given -- time instead. haltAfter :: MonadIO m => Milliseconds -> Channel -> m () haltAfter ms (Channel c) = void . SDL.Raw.Mixer.expireChannel (clipChan c) $ fromIntegral ms -- | Same as 'halt', but halts an entire 'Group' instead. -- -- Note that using 'DefaultGroup' here is the same as calling 'halt' -- 'AllChannels'. haltGroup :: MonadIO m => Group -> m () haltGroup = \case DefaultGroup -> halt AllChannels 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... {-# NOINLINE channelFinishedFunPtr #-} channelFinishedFunPtr :: IORef (FunPtr (SDL.Raw.Mixer.Channel -> IO ())) channelFinishedFunPtr = unsafePerformIO $ newIORef nullFunPtr -- | Sets a callback that gets invoked each time a 'Channel' finishes playing. -- -- A 'Channel' finishes playing both when playback ends normally and when it is -- 'halt'ed (also possibly via 'setChannels'). -- -- __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' SDL.Raw.Mixer.channelFinished callbackRaw -- Free the function we set last time, if any. lastFunPtr <- readIORef channelFinishedFunPtr when (lastFunPtr /= nullFunPtr) $ freeHaskellFunPtr lastFunPtr -- Then remember the new one. And weep in shame. writeIORef channelFinishedFunPtr callbackRaw -- | Returns whether the given 'Channel' is playing or not. -- -- If 'AllChannels' is used, this returns whether /any/ of the channels is -- currently playing. playing :: MonadIO m => Channel -> m Bool playing (Channel c) = (> 0) <$> SDL.Raw.Mixer.playing (clipChan c) -- | Returns how many 'Channel's are currently playing. playingCount :: MonadIO m => m Int playingCount = fromIntegral <$> SDL.Raw.Mixer.playing (-1) -- | Returns whether the given 'Channel' is paused or not. -- -- If 'AllChannels' is used, this returns whether /any/ of the channels is -- currently paused. paused :: MonadIO m => Channel -> m Bool paused (Channel c) = (> 0) <$> SDL.Raw.Mixer.paused (clipChan c) -- | Returns how many 'Channel's are currently paused. pausedCount :: MonadIO m => m Int pausedCount = fromIntegral <$> SDL.Raw.Mixer.paused (-1) -- | Describes whether a 'Channel' is fading in, out, or not at all. data Fading = NoFading | FadingIn | FadingOut 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.FADING_OUT -> FadingOut _ -> error "SDL.Mixer.wordToFading: unknown Fading value." -- | Returns a `Channel`'s 'Fading' status. -- -- Note that using 'AllChannels' here is not valid, and will simply return the -- 'Fading' status of the first 'Channel' instead. fading :: MonadIO m => Channel -> m Fading fading (Channel c) = wordToFading <$> SDL.Raw.Mixer.fadingChannel (clipChan c) -- | A group of 'Channel's. -- -- Grouping 'Channel's together allows you to perform some operations on all of -- them at once. -- -- By default, all 'Channel's are members of the 'DefaultGroup'. 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 :: Group pattern DefaultGroup = -1 -- | Assigns a given 'Channel' to a certain 'Group'. -- -- If 'DefaultGroup' is used, assigns the 'Channel' the the default starting -- 'Group' (essentially /ungrouping/ them). -- -- If 'AllChannels' is used, assigns all 'Channel's to the given 'Group'. -- -- Returns whether the 'Channel' was successfully grouped or not. Failure is -- poosible if the 'Channel' does not exist, for instance. group :: MonadIO m => Group -> Channel -> m Bool group wrapped@(Group g) channel = 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. 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. -- | Same as 'groupChannel', but groups all 'Channel's between the first and -- last given, inclusive. -- -- If 'DefaultGroup' is used, assigns the entire 'Channel' span to the default -- starting 'Group' (essentially /ungrouping/ them). -- -- Using 'AllChannels' is invalid. -- -- Returns the number of 'Channel's successfully grouped. This number may be -- less than the number of 'Channel's given, for instance if some of them do -- not exist. 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 -- | Returns the number of 'Channels' within a 'Group'. -- -- If 'DefaultGroup' is used, will return the number of all 'Channel's, since -- all of them are within the default 'Group'. groupCount :: MonadIO m => Group -> m Int groupCount (Group g) = fromIntegral <$> SDL.Raw.Mixer.groupCount g -- | Gets the first inactive (not playing) 'Channel' within a given 'Group', -- if any. -- -- Using 'DefaultGroup' will give you the first inactive 'Channel' out of all -- that exist. getAvailable :: MonadIO m => Group -> m (Maybe Channel) getAvailable (Group g) = do found <- SDL.Raw.Mixer.groupAvailable g return $ if found >= 0 then Just $ fromIntegral found else Nothing -- | Gets the oldest actively playing 'Channel' within a given 'Group'. -- -- Returns 'Nothing' when the 'Group' is empty or no 'Channel's within it are -- playing. getOldest :: MonadIO m => Group -> m (Maybe Channel) getOldest (Group g) = do found <- SDL.Raw.Mixer.groupOldest g return $ if found >= 0 then Just $ fromIntegral found else Nothing -- | Gets the newest actively playing 'Channel' within a given 'Group'. -- -- Returns 'Nothing' when the 'Group' is empty or no 'Channel's within it are -- playing. getNewest :: MonadIO m => Group -> m (Maybe Channel) getNewest (Group g) = do found <- SDL.Raw.Mixer.groupNewer g return $ if found >= 0 then Just $ fromIntegral found else Nothing -- | Returns the names of all music decoders currently available. -- -- These depend on the availability of shared libraries for each of the -- formats. The list may contain any of the following, and possibly others: -- @WAVE@, @MODPLUG@, @MIKMOD@, @TIMIDITY@, @FLUIDSYNTH@, @NATIVEMIDI@, @OGG@, -- @FLAC@, @MP3@. musicDecoders :: MonadIO m => m [String] musicDecoders = liftIO $ do num <- SDL.Raw.Mixer.getNumMusicDecoders forM [0 .. num - 1] $ SDL.Raw.Mixer.getMusicDecoder >=> peekCString -- | A loaded music file. -- -- 'Music' is played on a separate channel different from the normal mixing -- 'Channel's. -- -- To manipulate 'Music' outside of post-processing callbacks, use the music -- variant functions listed below. 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" "Mix_LoadMUS_RW" $ SDL.Raw.Mixer.loadMUS_RW rw 0 free (Music p) = liftIO $ SDL.Raw.Mixer.freeMusic p -- | Plays a given 'Music' a certain number of 'Times'. -- -- The previously playing 'Music' will be halted, unless it is fading out in -- which case a blocking wait occurs until it fades out completely. playMusic :: MonadIO m => Times -> Music -> m () playMusic times (Music p) = throwIfNeg_ "SDL.Mixer.playMusic" "Mix_PlayMusic" $ SDL.Raw.Mixer.playMusic p $ case times of Forever -> (-1) Times t -> max 1 t -- Interpretation differs from normal play? :/ -- | Pauses 'Music' playback, if it is actively playing. -- -- You may still 'haltMusic' paused 'Music'. pauseMusic :: MonadIO m => m () pauseMusic = SDL.Raw.Mixer.pauseMusic -- | Halts 'Music' playback. haltMusic :: MonadIO m => m () haltMusic = void SDL.Raw.Mixer.haltMusic -- | Resumes 'Music' playback. -- -- This works on both paused and halted 'Music'. -- -- If 'Music' is currently actively playing, this has no effect. resumeMusic :: MonadIO m => m () resumeMusic = SDL.Raw.Mixer.resumeMusic -- | Returns whether a 'Music' is currently playing or not. -- -- Note that this returns 'True' even if the 'Music' is currently paused. playingMusic :: MonadIO m => m Bool playingMusic = (> 0) <$> SDL.Raw.Mixer.playingMusic -- | Returns whether a 'Music' is currently paused or not. -- -- Note that this returns 'False' if the 'Music' is currently halted. pausedMusic :: MonadIO m => m Bool pausedMusic = (> 0) <$> SDL.Raw.Mixer.pausedMusic -- | Rewinds the 'Music' to the beginning. -- -- When playing new 'Music', it starts at the beginning by default. -- -- This function only works with @MOD@, @OGG@, @MP3@ and @NATIVEMIDI@ streams. rewindMusic :: MonadIO m => m () rewindMusic = SDL.Raw.Mixer.rewindMusic -- | Plays a given 'Music' a number of 'Times', but fading it in during a -- certain number of 'Milliseconds'. -- -- The fading only occurs during the first time the 'Music' is played. fadeInMusic :: MonadIO m => Milliseconds -> Times -> Music -> m () fadeInMusic ms times (Music p) = throwIfNeg_ "SDL.Mixer.fadeInMusic" "Mix_FadeInMusic" $ SDL.Raw.Mixer.fadeInMusic p t' (fromIntegral ms) where t' = case times of Forever -> (-1) Times t -> max 1 t -- | Gradually fade out the 'Music' over a given number of 'Milliseconds'. -- -- The 'Music' is set to fade out only when it is playing and not fading -- already. -- -- Returns whether the 'Music' was successfully set to fade out. fadeOutMusic :: MonadIO m => Milliseconds -> m Bool fadeOutMusic = fmap (== 1) . SDL.Raw.Mixer.fadeOutMusic . fromIntegral -- | A position in milliseconds within a piece of 'Music'. type Position = Milliseconds -- | Set the 'Position' for currently playing 'Music'. -- -- Note: this only works for @OGG@ and @MP3@ 'Music'. setMusicPosition :: MonadIO m => Position -> m () setMusicPosition at = do rewindMusic -- Due to weird behaviour for MP3s... throwIfNeg_ "SDL.Mixer.setMusicPosition" "Mix_SetMusicPosition" $ SDL.Raw.Mixer.setMusicPosition $ realToFrac at / 1000.0 -- | Similar to 'setMusicPosition', but works only with @MOD@ 'Music'. -- -- Pass in the pattern number. setMusicPositionMOD :: MonadIO m => Int -> m () setMusicPositionMOD n = do throwIfNeg_ "SDL.Mixer.setMusicPositionMOD" "Mix_SetMusicPosition" $ SDL.Raw.Mixer.setMusicPosition $ realToFrac n -- | Same as 'fadeInMusic', but with a custom starting `Music`'s 'Position'. -- -- Note that this only works on 'Music' that 'setMusicPosition' works on. fadeInMusicAt :: MonadIO m => Position -> Milliseconds -> Times -> Music -> m () fadeInMusicAt at ms times (Music p) = throwIfNeg_ "SDL.Mixer.fadeInMusicAt" "Mix_FadeInMusicPos" $ SDL.Raw.Mixer.fadeInMusicPos p t' (fromIntegral ms) (realToFrac at / 1000.0) where t' = case times of Forever -> (-1) Times t -> max 1 t -- | Same as 'fadeInMusicAt', but works with @MOD@ 'Music'. -- -- Instead of milliseconds, specify the position with a pattern number. fadeInMusicAtMOD :: MonadIO m => Int -> Milliseconds -> Times -> Music -> m () fadeInMusicAtMOD at ms times (Music p) = throwIfNeg_ "SDL.Mixer.fadeInMusicAtMOD" "Mix_FadeInMusicPos" $ SDL.Raw.Mixer.fadeInMusicPos p t' (fromIntegral ms) (realToFrac at) where t' = case times of Forever -> (-1) Times t -> max 1 t -- | Returns the `Music`'s 'Fading' status. fadingMusic :: MonadIO m => m Fading fadingMusic = wordToFading <$> SDL.Raw.Mixer.fadingMusic -- | Gets the current 'Volume' setting for 'Music'. getMusicVolume :: MonadIO m => m Volume getMusicVolume = fromIntegral <$> SDL.Raw.Mixer.volumeMusic (-1) -- | Sets the 'Volume' for 'Music'. -- -- Note that this won't work if any 'Music' is currently fading. setMusicVolume :: MonadIO m => Volume -> m () setMusicVolume v = void . SDL.Raw.Mixer.volumeMusic $ volumeToCInt v -- | A `Music`'s type. data MusicType = CMD | WAV | MOD | MID | OGG | MP3 | FLAC 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 -- | Gets the 'MusicType' of a given 'Music'. musicType :: Music -> Maybe MusicType musicType (Music p) = wordToMusicType $ unsafePerformIO (SDL.Raw.Mixer.getMusicType p) -- | Gets the 'MusicType' of currently playing 'Music', if any. playingMusicType :: MonadIO m => m (Maybe MusicType) playingMusicType = wordToMusicType <$> SDL.Raw.Mixer.getMusicType nullPtr -- More quackery, but this time for the music finished callback. {-# NOINLINE musicFinishedFunPtr #-} musicFinishedFunPtr :: IORef (FunPtr (IO ())) musicFinishedFunPtr = unsafePerformIO $ newIORef nullFunPtr -- | Sets a callback that gets invoked each time a 'Music' finishes playing. -- -- __Note: don't call other 'SDL.Mixer' functions within this callback.__ whenMusicFinished :: MonadIO m => IO () -> m () whenMusicFinished callback = liftIO $ do callbackRaw <- SDL.Raw.Mixer.wrapMusicCallback callback SDL.Raw.Mixer.hookMusicFinished callbackRaw lastFunPtr <- readIORef musicFinishedFunPtr when (lastFunPtr /= nullFunPtr) $ freeHaskellFunPtr lastFunPtr writeIORef musicFinishedFunPtr callbackRaw -- | A post-processing effect as a function operating on a mutable stream. -- -- __Note that, at the moment, this is a stream of bytes. Depending on the__ -- __'Audio' 'Format' you're using, you're probably going to want to treat is__ -- __as a stream of 16-bit values instead.__ type Effect = Channel -> IOVector Word8 -> IO () -- TODO: Don't hardcode Word8. -- | A function called when a processor is finished being used. -- -- This allows you to clean up any state you might have had. type EffectFinished = Channel -> IO () -- | A way to refer to the special 'Channel' used for post-processing effects. -- -- You can only use this value with 'effect' and the other in-built effect -- functions such as 'effectPan' and 'effectDistance'. pattern PostProcessing :: Channel pattern PostProcessing = SDL.Raw.Mixer.CHANNEL_POST -- | Adds a post-processing 'Effect' to a certain 'Channel'. -- -- A `Channel`'s 'Effect's are called in the order they were added. -- -- Returns an action that, when executed, removes this 'Effect'. __Note: do__ -- __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 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. removed <- SDL.Raw.Mixer.unregisterEffect channel ef' freeHaskellFunPtr ef' >> freeHaskellFunPtr fin' when (removed == 0) $ do err <- getError throwIO $ SDLCallFailed "SDL.Raw.Mixer.removeEffect" "Mix_UnregisterEffect" err -- | Applies an in-built effect implementing panning. -- -- Sets the left-channel and right-channel 'Volume' to the given values. -- -- This only works when `Audio`'s 'Output' is 'Stereo', which is the default. -- -- Returns an action that, when executed, removes this effect. That action -- simply calls 'effectPan' with 'Volumes' 128 and 128. effectPan :: MonadIO m => Channel -> Volume -> Volume -> m (m ()) effectPan channel@(Channel c) lVol rVol = do void . throwIf0 "SDL.Raw.Mixer.effectPan" "Mix_SetPanning" $ SDL.Raw.Mixer.setPanning c (wordVol lVol) (wordVol rVol) return . void $ effectPan channel 128 128 wordVol :: Volume -> Word8 wordVol = fromIntegral . min 255 . (* 2) . volumeToCInt -- | Applies a different volume based on the distance (as 'Word8') specified. -- -- The volume is loudest at distance 0, quietest at distance 255. -- -- Returns an action that, when executed, removes this effect. That action -- simply calls 'effectDistance' with a distance of 0. effectDistance :: MonadIO m => Channel -> Word8 -> m (m ()) effectDistance channel@(Channel c) dist = do void . throwIf0 "SDL.Raw.Mixer.effectDistance" "Mix_SetDistance" $ SDL.Raw.Mixer.setDistance c dist return . void $ effectDistance channel 0 -- | Simulates a simple 3D audio effect. -- -- Accepts the angle in degrees (as 'Int16') in relation to the source of the -- sound (0 is directly in front, 90 directly to the right, and so on) and a -- distance (as 'Word8') from the source of the sound (where 255 is very far -- away, and 0 extremely close). -- -- Returns an action that, when executed, removes this effect. That action -- simply calls 'effectPosition' with both angle and distance set to 0. effectPosition :: MonadIO m => Channel -> Int16 -> Word8 -> m (m ()) effectPosition channel@(Channel c) angle dist = do void . throwIf0 "SDL.Raw.Mixer.effectPosition" "Mix_SetPosition" $ SDL.Raw.Mixer.setPosition c angle dist return . void $ effectPosition channel 0 0 -- | Swaps the left and right channel sound. -- -- If given 'True', will swap the sound channels. -- -- Returns an action that, when executed, removes this effect. That action -- simply calls 'effectReverseStereo' with 'False'. effectReverseStereo :: MonadIO m => Channel -> Bool -> m (m ()) effectReverseStereo channel@(Channel c) rev = do void . throwIf0 "SDL.Raw.Mixer.effectReverseStereo" "Mix_SetReverseStereo" $ SDL.Raw.Mixer.setReverseStereo c (if rev then 1 else 0) return . void $ effectReverseStereo channel False -- Music -- TODO: hookMusic -- TODO: setMusicCMD -- TODO: getMusicHookData -- Effects -- TODO: setPostMix -- SoundFonts -- TODO: setSynchroValue -- TODO: getSynchroValue -- TODO: setSoundFonts -- TODO: getSoundFonts -- TODO: eachSoundFont sdl2-mixer-1.2.0.0/src/SDL/Raw/Helper.hs0000644000000000000000000000602614120121316015534 0ustar0000000000000000{-# 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 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: -- -- * A foreign import of @cname@, named as @fname'@. -- * An always-inline MonadIO version of @fname'@, named @fname@. 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. -- The generated function accepts n arguments. args <- replicateM (countArgs t') $ newName "x" -- If the function has no arguments, then we just liftIO it directly. -- 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 [] 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 (ForallT _ _ t) -> count n t (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. liftType :: Type -> Q Type liftType = \case AppT _ t -> do 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 sdl2-mixer-1.2.0.0/src/SDL/Raw/Mixer.hsc0000644000000000000000000002750514120120536015554 0ustar0000000000000000{-| Module : SDL.Raw.Mixer License : BSD3 Stability : experimental Raw bindings to the @SDL2_mixer@ library. No error-handling is done here. For more information about specific function behaviour, see the @SDL2_mixer@ documentation. -} {-# 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 #-} module SDL.Raw.Mixer ( -- * General getVersion , pattern SDL_MIXER_MAJOR_VERSION , pattern SDL_MIXER_MINOR_VERSION , pattern SDL_MIXER_PATCHLEVEL , InitFlag , init , pattern INIT_FLAC , pattern INIT_MOD , pattern INIT_MP3 , pattern INIT_OGG , quit , Format , pattern DEFAULT_FORMAT , pattern DEFAULT_FREQUENCY , pattern DEFAULT_CHANNELS , openAudio , pattern AUDIO_U8 , pattern AUDIO_S8 , pattern AUDIO_U16LSB , pattern AUDIO_S16LSB , pattern AUDIO_U16MSB , pattern AUDIO_S16MSB , pattern AUDIO_U16 , pattern AUDIO_S16 , pattern AUDIO_U16SYS , pattern AUDIO_S16SYS , closeAudio , querySpec -- * Samples , getNumChunkDecoders , getChunkDecoder , Chunk(..) , loadWAV , loadWAV_RW , quickLoadWAV , quickLoadRaw , pattern MAX_VOLUME , volumeChunk , freeChunk -- * Channels , allocateChannels , pattern CHANNELS , Channel , volume , playChannel , playChannelTimed , fadeInChannel , fadeInChannelTimed , pause , resume , haltChannel , expireChannel , fadeOutChannel , channelFinished , wrapChannelCallback , playing , paused , Fading , fadingChannel , pattern NO_FADING , pattern FADING_OUT , pattern FADING_IN , getChunk -- * Groups , reserveChannels , Tag , groupChannel , groupChannels , groupCount , groupAvailable , groupOldest , groupNewer , fadeOutGroup , haltGroup -- * Music , getNumMusicDecoders , getMusicDecoder , Music , loadMUS , loadMUS_RW , loadMUSType_RW , freeMusic , playMusic , fadeInMusic , fadeInMusicPos , hookMusic , volumeMusic , pauseMusic , resumeMusic , rewindMusic , setMusicPosition , setMusicCMD , haltMusic , fadeOutMusic , wrapMusicCallback , hookMusicFinished , MusicType , getMusicType , pattern MUS_NONE , pattern MUS_CMD , pattern MUS_WAV , pattern MUS_MOD , pattern MUS_MID , pattern MUS_OGG , pattern MUS_MP3 , pattern MUS_FLAC , playingMusic , pausedMusic , fadingMusic , getMusicHookData -- * Effects , Effect , wrapEffect , EffectFinished , wrapEffectFinished , registerEffect , pattern CHANNEL_POST , unregisterEffect , unregisterAllEffects , setPostMix , setPanning , setDistance , setPosition , setReverseStereo -- * MikMod , setSynchroValue , getSynchroValue -- * MIDI backends , setSoundFonts , getSoundFonts , eachSoundFont ) where #include "SDL_mixer.h" import Data.Int (Int16) import Data.Word (Word8, Word16, Word32) import Foreign.C.String (CString) import Foreign.C.Types (CInt(..), CDouble(..)) import Foreign.Ptr (Ptr, FunPtr) import Foreign.Storable (Storable(..)) import Prelude hiding (init) import SDL.Raw.Helper (liftF) import SDL.Raw.Types (RWops(..), Version(..)) -- 4.1 General liftF "getVersion" "Mix_Linked_Version" [t|IO (Ptr Version)|] pattern SDL_MIXER_MAJOR_VERSION = (#const SDL_MIXER_MAJOR_VERSION) pattern SDL_MIXER_MINOR_VERSION = (#const SDL_MIXER_MINOR_VERSION) pattern SDL_MIXER_PATCHLEVEL = (#const SDL_MIXER_PATCHLEVEL) type InitFlag = CInt liftF "init" "Mix_Init" [t|InitFlag -> IO CInt|] pattern INIT_FLAC = (#const MIX_INIT_FLAC) pattern INIT_MOD = (#const MIX_INIT_MOD) pattern INIT_MP3 = (#const MIX_INIT_MP3) pattern INIT_OGG = (#const MIX_INIT_OGG) liftF "quit" "Mix_Quit" [t|IO ()|] type Format = Word16 pattern DEFAULT_FREQUENCY = (#const MIX_DEFAULT_FREQUENCY) pattern DEFAULT_CHANNELS = (#const MIX_DEFAULT_CHANNELS) liftF "openAudio" "Mix_OpenAudio" [t|CInt -> Format -> CInt -> CInt -> IO CInt|] pattern AUDIO_U8 = (#const AUDIO_U8) pattern AUDIO_S8 = (#const AUDIO_S8) pattern AUDIO_U16LSB = (#const AUDIO_U16LSB) pattern AUDIO_S16LSB = (#const AUDIO_S16LSB) pattern AUDIO_U16MSB = (#const AUDIO_U16MSB) pattern AUDIO_S16MSB = (#const AUDIO_S16MSB) pattern AUDIO_U16 = (#const AUDIO_U16) pattern AUDIO_S16 = (#const AUDIO_S16) pattern AUDIO_U16SYS = (#const AUDIO_U16SYS) pattern AUDIO_S16SYS = (#const AUDIO_S16SYS) pattern DEFAULT_FORMAT = (#const MIX_DEFAULT_FORMAT) liftF "closeAudio" "Mix_CloseAudio" [t|IO ()|] liftF "querySpec" "Mix_QuerySpec" [t|Ptr CInt -> Ptr Format -> Ptr CInt -> IO CInt|] -- 4.2 Samples liftF "getNumChunkDecoders" "Mix_GetNumChunkDecoders" [t|IO CInt|] liftF "getChunkDecoder" "Mix_GetChunkDecoder" [t|CInt -> IO CString|] data Chunk = Chunk { chunkAllocated :: CInt , chunkAbuf :: Ptr Word8 , chunkAlen :: Word32 , chunkVolume :: Word8 } deriving stock (Eq, Show) instance Storable Chunk where alignment = sizeOf sizeOf _ = (#size Mix_Chunk) peek ptr = Chunk <$> (#peek Mix_Chunk, allocated) ptr <*> (#peek Mix_Chunk, abuf) ptr <*> (#peek Mix_Chunk, alen) ptr <*> (#peek Mix_Chunk, volume) ptr poke ptr (Chunk {..}) = do (#poke Mix_Chunk, allocated) ptr chunkAllocated (#poke Mix_Chunk, abuf) ptr chunkAbuf (#poke Mix_Chunk, alen) ptr chunkAlen (#poke Mix_Chunk, volume) ptr chunkVolume liftF "loadWAV" "Mix_LoadWAV_helper" [t|CString -> IO (Ptr Chunk)|] liftF "loadWAV_RW" "Mix_LoadWAV_RW" [t|Ptr RWops -> CInt -> IO (Ptr Chunk)|] liftF "quickLoadWAV" "Mix_QuickLoad_WAV" [t|Ptr Word8 -> IO (Ptr Chunk)|] liftF "quickLoadRaw" "Mix_QuickLoad_RAW" [t|Ptr Word8 -> IO (Ptr Chunk)|] pattern MAX_VOLUME = (#const MIX_MAX_VOLUME) liftF "volumeChunk" "Mix_VolumeChunk" [t|Ptr Chunk -> CInt -> IO CInt|] liftF "freeChunk" "Mix_FreeChunk" [t|Ptr Chunk -> IO ()|] -- 4.3 Channels liftF "allocateChannels" "Mix_AllocateChannels" [t|CInt -> IO CInt|] pattern CHANNELS = (#const MIX_CHANNELS) type Channel = CInt liftF "volume" "Mix_Volume" [t|Channel -> CInt -> IO CInt|] liftF "playChannel" "Mix_PlayChannel_helper" [t|Channel -> Ptr Chunk -> CInt -> IO CInt|] liftF "playChannelTimed" "Mix_PlayChannelTimed" [t|Channel -> Ptr Chunk -> CInt -> CInt -> IO CInt|] liftF "fadeInChannel" "Mix_FadeInChannel_helper" [t|Channel -> Ptr Chunk -> CInt -> CInt -> IO CInt|] liftF "fadeInChannelTimed" "Mix_FadeInChannelTimed" [t|Channel -> Ptr Chunk -> CInt -> CInt -> CInt -> IO CInt|] liftF "pause" "Mix_Pause" [t|Channel -> IO ()|] liftF "resume" "Mix_Resume" [t|Channel -> IO ()|] liftF "haltChannel" "Mix_HaltChannel" [t|Channel -> IO CInt|] liftF "expireChannel" "Mix_ExpireChannel" [t|Channel -> CInt -> IO CInt|] liftF "fadeOutChannel" "Mix_FadeOutChannel" [t|Channel -> CInt -> IO CInt|] foreign import ccall "wrapper" wrapChannelCallback :: (Channel -> IO ()) -> IO (FunPtr (Channel -> IO ())) liftF "channelFinished" "Mix_ChannelFinished" [t|FunPtr (Channel -> IO ()) -> IO ()|] liftF "playing" "Mix_Playing" [t|Channel -> IO CInt|] liftF "paused" "Mix_Paused" [t|Channel -> IO CInt|] type Fading = (#type Mix_Fading) pattern NO_FADING = (#const MIX_NO_FADING) pattern FADING_IN = (#const MIX_FADING_IN) pattern FADING_OUT = (#const MIX_FADING_OUT) liftF "fadingChannel" "Mix_FadingChannel" [t|Channel -> IO Fading|] liftF "getChunk" "Mix_GetChunk" [t|Channel -> IO (Ptr Chunk)|] -- 4.4 Groups liftF "reserveChannels" "Mix_ReserveChannels" [t|CInt -> IO CInt|] type Tag = CInt liftF "groupChannel" "Mix_GroupChannel" [t|Channel -> Tag -> IO CInt|] liftF "groupChannels" "Mix_GroupChannels" [t|Channel -> Channel -> Tag -> IO CInt|] liftF "groupCount" "Mix_GroupCount" [t|Tag -> IO CInt|] liftF "groupAvailable" "Mix_GroupAvailable" [t|Tag -> IO CInt|] liftF "groupOldest" "Mix_GroupOldest" [t|Tag -> IO CInt|] liftF "groupNewer" "Mix_GroupNewer" [t|Tag -> IO CInt|] liftF "fadeOutGroup" "Mix_FadeOutGroup" [t|Tag -> CInt -> IO CInt|] liftF "haltGroup" "Mix_HaltGroup" [t|Tag -> IO CInt|] -- 4.5 Music liftF "getNumMusicDecoders" "Mix_GetNumMusicDecoders" [t|IO CInt|] liftF "getMusicDecoder" "Mix_GetMusicDecoder" [t|CInt -> IO CString|] data Music liftF "loadMUS" "Mix_LoadMUS" [t|CString -> IO (Ptr Music)|] liftF "loadMUS_RW" "Mix_LoadMUS_RW" [t|Ptr RWops -> CInt -> IO (Ptr Music)|] type MusicType = (#type Mix_MusicType) liftF "loadMUSType_RW" "Mix_LoadMUSType_RW" [t|Ptr RWops -> MusicType -> CInt -> IO (Ptr Music)|] pattern MUS_NONE = (#const MUS_NONE) pattern MUS_CMD = (#const MUS_CMD) pattern MUS_WAV = (#const MUS_WAV) pattern MUS_MOD = (#const MUS_MOD) pattern MUS_MID = (#const MUS_MID) pattern MUS_OGG = (#const MUS_OGG) pattern MUS_MP3 = (#const MUS_MP3) pattern MUS_FLAC = (#const MUS_FLAC) liftF "freeMusic" "Mix_FreeMusic" [t|Ptr Music -> IO ()|] liftF "playMusic" "Mix_PlayMusic" [t|Ptr Music -> CInt -> IO CInt|] liftF "fadeInMusic" "Mix_FadeInMusic" [t|Ptr Music -> CInt -> CInt -> IO CInt|] liftF "fadeInMusicPos" "Mix_FadeInMusicPos" [t|Ptr Music -> CInt -> CInt -> CDouble -> IO CInt|] liftF "hookMusic" "Mix_HookMusic" [t|FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO ()) -> Ptr () -> IO ()|] liftF "volumeMusic" "Mix_VolumeMusic" [t|CInt -> IO CInt|] liftF "pauseMusic" "Mix_PauseMusic" [t|IO ()|] liftF "resumeMusic" "Mix_ResumeMusic" [t|IO ()|] liftF "rewindMusic" "Mix_RewindMusic" [t|IO ()|] liftF "setMusicPosition" "Mix_SetMusicPosition" [t|CDouble -> IO CInt|] liftF "setMusicCMD" "Mix_SetMusicCMD" [t|CString -> IO CInt|] liftF "haltMusic" "Mix_HaltMusic" [t|IO CInt|] liftF "fadeOutMusic" "Mix_FadeOutMusic" [t|CInt -> IO CInt|] foreign import ccall "wrapper" wrapMusicCallback :: IO () -> IO (FunPtr (IO ())) liftF "hookMusicFinished" "Mix_HookMusicFinished" [t|FunPtr (IO ()) -> IO ()|] liftF "getMusicType" "Mix_GetMusicType" [t|Ptr Music -> IO MusicType|] liftF "playingMusic" "Mix_PlayingMusic" [t|IO CInt|] liftF "pausedMusic" "Mix_PausedMusic" [t|IO CInt|] liftF "fadingMusic" "Mix_FadingChannel" [t|IO Fading|] liftF "getMusicHookData" "Mix_GetMusicHookData" [t|IO (Ptr ())|] -- 4.6 Effects pattern CHANNEL_POST = (#const MIX_CHANNEL_POST) type Effect = Channel -> Ptr () -> CInt -> Ptr() -> IO () foreign import ccall "wrapper" wrapEffect :: Effect -> IO (FunPtr Effect) type EffectFinished = Channel -> Ptr () -> IO () foreign import ccall "wrapper" wrapEffectFinished :: EffectFinished -> IO (FunPtr EffectFinished) liftF "registerEffect" "Mix_RegisterEffect" [t|Channel -> FunPtr Effect -> FunPtr EffectFinished -> Ptr () -> IO CInt|] liftF "unregisterEffect" "Mix_UnregisterEffect" [t|Channel -> FunPtr Effect -> IO CInt|] liftF "unregisterAllEffects" "Mix_UnregisterAllEffects" [t|Channel -> IO CInt|] liftF "setPostMix" "Mix_SetPostMix" [t|FunPtr (Ptr () -> Ptr Word8 -> CInt -> IO ()) -> Ptr () -> IO ()|] liftF "setPanning" "Mix_SetPanning" [t|Channel -> Word8 -> Word8 -> IO CInt|] liftF "setDistance" "Mix_SetDistance" [t|Channel -> Word8 -> IO CInt|] liftF "setPosition" "Mix_SetPosition" [t|Channel -> Int16 -> Word8 -> IO CInt|] liftF "setReverseStereo" "Mix_SetReverseStereo" [t|Channel -> CInt -> IO CInt|] -- ?.? Not documented liftF "setSynchroValue" "Mix_SetSynchroValue" [t|CInt -> IO CInt|] liftF "getSynchroValue" "Mix_GetSynchroValue" [t|IO CInt|] liftF "setSoundFonts" "Mix_SetSoundFonts" [t|Ptr CString -> IO CInt|] liftF "getSoundFonts" "Mix_GetSoundFonts" [t|IO (Ptr CString)|] liftF "eachSoundFont" "Mix_EachSoundFont" [t|FunPtr (CString -> Ptr () -> IO CInt) -> Ptr () -> IO CInt|] sdl2-mixer-1.2.0.0/cbits/helpers.c0000644000000000000000000000112014120100736014722 0ustar0000000000000000#include "SDL2/SDL.h" #include "SDL2/SDL_mixer.h" // These were all macros in SDL_mixer.h. extern DECLSPEC Mix_Chunk * SDLCALL Mix_LoadWAV_helper( char *file) { return Mix_LoadWAV_RW(SDL_RWFromFile(file, "rb"), 1); } extern DECLSPEC int SDLCALL Mix_PlayChannel_helper( int channel, Mix_Chunk *chunk, int loops) { return Mix_PlayChannelTimed(channel, chunk, loops, -1); } extern DECLSPEC int SDLCALL Mix_FadeInChannel_helper( int channel, Mix_Chunk *chunk, int loops, int ms) { return Mix_FadeInChannelTimed(channel, chunk, loops, ms, -1); } sdl2-mixer-1.2.0.0/examples/Music/Main.hs0000644000000000000000000000163414120123623016140 0ustar0000000000000000import 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-1.2.0.0/examples/Effect/Main.hs0000644000000000000000000000322114120121167016247 0ustar0000000000000000import 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 sdl2-mixer-1.2.0.0/examples/BasicRaw/Main.hs0000644000000000000000000000250114120121426016544 0ustar0000000000000000{-# 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 " 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 sdl2-mixer-1.2.0.0/examples/Jumbled/Main.hs0000644000000000000000000000200414120121456016434 0ustar0000000000000000import 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 sdl2-mixer-1.2.0.0/examples/Basic/Main.hs0000644000000000000000000000161714120121634016102 0ustar0000000000000000import 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 " 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 sdl2-mixer-1.2.0.0/README.md0000644000000000000000000000151114120124275013277 0ustar0000000000000000# sdl2-mixer [![Hackage](https://img.shields.io/hackage/v/sdl2-mixer.svg)](https://hackage.haskell.org/package/sdl2-mixer) [![GitLab](https://gitlab.homotopic.tech/haskell/sdl2-mixer/badges/master/pipeline.svg)](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 stack exec -- sdl2-mixer-raw stack exec -- sdl2-mixer-music stack exec -- sdl2-mixer-jumbled ... stack exec -- sdl2-mixer-effect ``` sdl2-mixer-1.2.0.0/ChangeLog.md0000644000000000000000000000010414120110562014160 0ustar0000000000000000# Changelog for sdl2-mixer ## v0.1.2.0 * Compatibility with GHC-9 sdl2-mixer-1.2.0.0/LICENSE0000644000000000000000000000304014120113141013012 0ustar0000000000000000Copyright (c) 2015 Vladimir Semyonov, 2015 Siniša Biđin, 2021 Daniel Firth 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 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. 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. sdl2-mixer-1.2.0.0/sdl2-mixer.cabal0000644000000000000000000001062114120125747015001 0ustar0000000000000000cabal-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 , Daniel Firth 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://gitlab.homotopic.tech/haskell/sdl2-mixer library exposed-modules: SDL.Mixer SDL.Raw.Helper SDL.Raw.Mixer other-modules: Paths_sdl2_mixer hs-source-dirs: 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 pkgconfig-depends: SDL2_mixer >= 2.0.0 build-depends: 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 autogen-modules: Paths_sdl2_mixer 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 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 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 executable sdl2-mixer-effect 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 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