diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2013 Corbin Simpson + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Sound/Fluidsynth.hs b/Sound/Fluidsynth.hs new file mode 100644 --- /dev/null +++ b/Sound/Fluidsynth.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Sound.Fluidsynth + (newSettings + ,newSynth + ,newDriver + ,newPlayer + ,loadSF + ,playerAdd + ,playerPlay + ,playerJoin + ,synthNoteOn + ,synthNoteOff) +where + +import Control.Monad +import Foreign.C.String +import Foreign.C.Types +import Foreign.ForeignPtr.Safe + +import Sound.Fluidsynth.Internal + +newtype Settings = Settings (ForeignPtr C'fluid_settings_t) +newtype Synth = Synth (ForeignPtr C'fluid_synth_t) +newtype Driver = Driver (ForeignPtr C'fluid_audio_driver_t) +newtype Player = Player (ForeignPtr C'fluid_player_t) + +newtype Channel = Channel Int + deriving (Num) +newtype Key = Key Int + deriving (Num) +newtype Velocity = Velocity Int + deriving (Num) + +newSettings :: IO Settings +newSettings = do + ptr <- c'new_fluid_settings + settings <- newForeignPtr p'delete_fluid_settings ptr + withForeignPtr settings $ \ptr' -> + withCAString "audio.driver" $ \cstr -> + withCAString "alsa" $ \cstr' -> + void $ c'fluid_settings_setstr ptr' cstr cstr' + return $! Settings settings + +newSynth :: Settings -> IO Synth +newSynth (Settings settings) = do + withForeignPtr settings $ \ptr -> do + ptr' <- c'new_fluid_synth ptr + synth <- newForeignPtr p'delete_fluid_synth ptr' + return $! Synth synth + +newDriver :: Settings -> Synth -> IO Driver +newDriver (Settings settings) (Synth synth) = do + withForeignPtr settings $ \ptr -> do + withForeignPtr synth $ \ptr' -> do + ptr'' <- c'new_fluid_audio_driver ptr ptr' + driver <- newForeignPtr p'delete_fluid_audio_driver ptr'' + return $! Driver driver + +newPlayer :: Synth -> IO Player +newPlayer (Synth synth) = do + withForeignPtr synth $ \ptr -> do + ptr' <- c'new_fluid_player ptr + player <- newForeignPtr p'delete_fluid_player ptr' + return $! Player player + +loadSF :: Synth -> String -> IO () +loadSF (Synth synth) path = do + withForeignPtr synth $ \ptr -> + withCAString path $ \cstr -> + void $ c'fluid_synth_sfload ptr cstr 1 + +synthNoteOn :: Synth -> Channel -> Key -> Velocity -> IO () +synthNoteOn (Synth synth) (Channel c) (Key k) (Velocity v) = + void $ withForeignPtr synth $ \ptr -> + c'fluid_synth_noteon ptr (fromIntegral c) (fromIntegral k) + (fromIntegral v) + +synthNoteOff :: Synth -> Channel -> Key -> IO () +synthNoteOff (Synth synth) (Channel c) (Key k) = + withForeignPtr synth $ \ptr -> + void $ c'fluid_synth_noteoff ptr (fromIntegral c) (fromIntegral k) + +playerAdd :: Player -> String -> IO () +playerAdd (Player player) path = do + withForeignPtr player $ \ptr -> + withCAString path $ \cstr -> + void $ c'fluid_player_add ptr cstr + +playerPlay :: Player -> IO () +playerPlay (Player player) = do + withForeignPtr player c'fluid_player_play + return () + +playerJoin :: Player -> IO () +playerJoin (Player player) = do + withForeignPtr player c'fluid_player_join + return () diff --git a/Sound/Fluidsynth/Internal.hsc b/Sound/Fluidsynth/Internal.hsc new file mode 100644 --- /dev/null +++ b/Sound/Fluidsynth/Internal.hsc @@ -0,0 +1,117 @@ +#include +#include + +module Sound.Fluidsynth.Internal where +#strict_import + +#opaque_t fluid_settings_t + +#ccall new_fluid_settings , IO (Ptr ) +#ccall delete_fluid_settings , Ptr -> IO () +#ccall fluid_settings_get_type , Ptr -> CString -> IO CInt +#ccall fluid_settings_setstr , Ptr -> CString \ + -> CString -> IO CInt +#ccall fluid_settings_getstr , Ptr -> CString \ + -> Ptr CString -> IO CInt +#ccall fluid_settings_setnum , Ptr -> CString \ + -> CDouble -> IO CInt +#ccall fluid_settings_getnum , Ptr -> CString \ + -> Ptr CDouble -> IO CInt +#ccall fluid_settings_setint , Ptr -> CString \ + -> CInt -> IO CInt +#ccall fluid_settings_getint , Ptr -> CString \ + -> Ptr CInt -> IO CInt + +#num FLUID_NO_TYPE +#num FLUID_NUM_TYPE +#num FLUID_INT_TYPE +#num FLUID_STR_TYPE +#num FLUID_SET_TYPE + +#opaque_t fluid_synth_t + +#ccall new_fluid_synth , Ptr -> IO (Ptr ) +#ccall delete_fluid_synth , Ptr -> IO () +#ccall fluid_synth_noteon , Ptr -> CInt -> CInt -> CInt \ + -> IO CInt +#ccall fluid_synth_noteoff , Ptr -> CInt -> CInt -> IO CInt +#ccall fluid_synth_cc , Ptr -> CInt -> CInt -> CInt -> IO CInt +#ccall fluid_synth_pitch_bend , Ptr -> CInt -> CInt -> IO CInt +#ccall fluid_synth_pitch_wheel_sens , Ptr -> CInt -> CInt \ + -> IO CInt +#ccall fluid_synth_program_change , Ptr -> CInt -> CInt \ + -> IO CInt +#ccall fluid_synth_bank_select , Ptr -> CInt -> CInt \ + -> IO CInt +#ccall fluid_synth_sfload , Ptr -> CString -> CInt -> IO CInt +#ccall fluid_synth_sfreload , Ptr -> CUInt -> IO CInt +#ccall fluid_synth_sfunload , Ptr -> CUInt -> CInt -> IO CInt + +#opaque_t fluid_audio_driver_t + +#ccall new_fluid_audio_driver , Ptr \ + -> Ptr \ + -> IO (Ptr ) +#ccall delete_fluid_audio_driver , Ptr -> IO () + +#opaque_t fluid_player_t + +#ccall new_fluid_player , Ptr -> IO (Ptr ) +#ccall delete_fluid_player , Ptr -> IO () +#ccall fluid_player_add , Ptr -> CString -> IO CInt +#ccall fluid_player_play , Ptr -> IO CInt +#ccall fluid_player_stop , Ptr -> IO CInt +#ccall fluid_player_join , Ptr -> IO CInt + +#opaque_t fluid_event_t + +#ccall new_fluid_event , IO (Ptr ) +#ccall delete_fluid_event , Ptr -> IO () +#ccall fluid_event_set_source , Ptr -> CShort -> IO () +#ccall fluid_event_set_dest , Ptr -> CShort -> IO () +#ccall fluid_event_timer , Ptr -> Ptr () -> IO () +#ccall fluid_event_note , Ptr -> CInt -> CShort -> CShort \ + -> CUInt -> IO () +#ccall fluid_event_noteon , Ptr -> CInt -> CShort -> CShort \ + -> IO () +#ccall fluid_event_noteoff , Ptr -> CInt -> CShort -> IO () +#ccall fluid_event_program_change , Ptr -> CInt -> CShort \ + -> IO () +#ccall fluid_event_pitch_bend , Ptr -> CInt -> CInt -> IO () +#ccall fluid_event_pitch_wheelsens , Ptr -> CInt -> CShort \ + -> IO () +#ccall fluid_event_volume , Ptr -> CInt -> CShort -> IO () +#ccall fluid_event_get_source , Ptr -> CShort +#ccall fluid_event_get_dest , Ptr -> CShort + +#opaque_t fluid_sequencer_t + +#callback fluid_event_callback_t , \ + FunPtr (CUInt -> Ptr -> Ptr \ + -> Ptr () -> IO ()) + +#ccall new_fluid_sequencer , IO (Ptr ) +#ccall delete_fluid_sequencer , Ptr -> IO () +#ccall fluid_sequencer_register_client , Ptr -> CString \ + -> Ptr \ + -> Ptr () -> IO CShort +#ccall fluid_sequencer_unregister_client , Ptr -> CShort \ + -> IO () +#ccall fluid_sequencer_count_clients , Ptr -> IO CInt +#ccall fluid_sequencer_get_client_id , Ptr -> CInt \ + -> IO CShort +#ccall fluid_sequencer_get_client_name , Ptr -> CInt \ + -> IO CString +#ccall fluid_sequencer_client_is_dest , Ptr -> CInt \ + -> IO CInt +#ccall fluid_sequencer_send_now , Ptr \ + -> Ptr -> IO () +#ccall fluid_sequencer_send_at , Ptr \ + -> Ptr -> CUInt -> Int -> IO () +#ccall fluid_sequencer_get_tick , Ptr -> IO CUInt +#ccall fluid_sequencer_set_time_scale , Ptr -> CDouble \ + -> IO () +#ccall fluid_sequencer_get_time_scale , Ptr -> IO CDouble + +#ccall fluid_sequencer_register_fluidsynth , Ptr \ + -> Ptr -> IO CShort diff --git a/fluidsynth.cabal b/fluidsynth.cabal new file mode 100644 --- /dev/null +++ b/fluidsynth.cabal @@ -0,0 +1,28 @@ +-- Initial fluidsynth.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: fluidsynth +version: 0.1.0.0 +synopsis: Haskell bindings to FluidSynth +description: Simple Haskell bindings to FluidSynth. +homepage: https://github.com/MostAwesomeDude/hsfluidsynth +license: MIT +license-file: LICENSE +author: Corbin Simpson +maintainer: cds@corbinsimpson.com +-- copyright: +category: Sound +build-type: Simple +cabal-version: >=1.8 + +source-repository head + type: git + location: git://github.com/MostAwesomeDude/hsfluidsynth.git + +library + exposed-modules: Sound.Fluidsynth + other-modules: Sound.Fluidsynth.Internal + build-depends: base >= 3 && < 5, + bindings-DSL >= 1.0.6 && < 1.1 + extra-libraries: fluidsynth + extensions: ForeignFunctionInterface