YampaSynth 0.0.1 → 0.0.2
raw patch · 5 files changed
+27/−38 lines, 5 filesdep ~base
Dependency ranges changed: base
Files
- YampaSynth.cabal +7/−7
- src/Main/OpenAL.hs +7/−9
- src/Main/Wav.hs +7/−9
- src/Player/OpenAL.hs +3/−12
- src/Player/Wav.hs +3/−1
YampaSynth.cabal view
@@ -1,5 +1,5 @@ name: YampaSynth-version: 0.0.1+version: 0.0.2 cabal-Version: >= 1.2 license: BSD3 license-file: LICENSE@@ -41,31 +41,31 @@ executable yampasynth-wav if flag (wav)- build-depends: base, array, bytestring, containers, Yampa, HCodecs+ build-depends: base < 5, array, bytestring, containers, Yampa, HCodecs else buildable: False hs-source-dirs: src main-is: Main/Wav.hs other-modules: SynthBasics, SynthParams, MidiSynth, Player.Wav - ghc-options: -O2 -Wall+ ghc-options: -O3 -Wall executable yampasynth-openal if flag (openal)- build-Depends: base, array, containers, OpenAL, Yampa, HCodecs+ build-Depends: base < 5, array, containers, OpenAL, Yampa, HCodecs else buildable: False hs-source-dirs: src main-is: Main/OpenAL.hs other-modules: SynthBasics, SynthParams, MidiSynth, Player.OpenAL- ghc-options: -threaded -O2 -Wall+ ghc-options: -threaded -O3 -Wall executable yampasynth-gtk if flag (gtk)- build-Depends: base, array, containers, OpenAL, glade, gtk, Yampa, HCodecs + build-Depends: base < 5, array, containers, OpenAL, glade, gtk, Yampa, HCodecs else buildable: False hs-source-dirs: src main-is: Main/Gtk.hs other-modules: SynthBasics, SynthParams, MidiSynth, Player.OpenAL, Player.Gtk- ghc-options: -threaded -O2 -Wall+ ghc-options: -threaded -O3 -Wall
src/Main/OpenAL.hs view
@@ -8,9 +8,7 @@ import FRP.Yampa -import Data.Char import Numeric-import Control.Monad import System.IO import System.Environment import System.Console.GetOpt@@ -44,23 +42,23 @@ return (sr, sf, mf) _ -> fail $ usageInfo "all options are mandatory\n" options - putStrLn "Importing MIDI File ..."+ hPutStrLn stderr "Importing MIDI File ..." eMidi <- Midi.importFile midiFile midi <- case eMidi of Left err -> fail err Right midi -> return midi- putStrLn "Done."+ hPutStrLn stderr "Done." - putStrLn "Importing SoundFontFile ... This may take a while ..."+ hPutStrLn stderr "Importing SoundFontFile ... This may take a while ..." eSoundFont <- SF.importFile soundFontFile soundFont <- case eSoundFont of Left err -> fail err Right sf -> return sf- putStrLn "Done."+ hPutStrLn stderr "Done." - putStrLn "Now you should hear something ..."- putStrLn "If you are getting interruptions decrase sampling rate."+ hPutStrLn stderr "Now you should hear something ..."+ hPutStrLn stderr "If you are getting interruptions decrase sampling rate." let paramsGen = soundFontToSynthParams soundFont signalFunction = midiToEventSource midi >>> midiSynth paramsGen Player.OpenAL.play sampleRate' (256 * 1024) signalFunction- putStrLn "Done."+ hPutStrLn stderr "Done."
src/Main/Wav.hs view
@@ -8,9 +8,7 @@ import FRP.Yampa -import Data.Char import Numeric-import Control.Monad import System.IO import System.Environment import System.Console.GetOpt@@ -31,7 +29,7 @@ , Option ['m'] ["midi"] (ReqArg MidiFile "FILE") "midi FILE to synthesize" , Option ['o'] ["output"] (ReqArg Output "FILE")- "output FILE (.wav file), if FILE argument ommited audio will be sent to sound card in real-time"+ "output FILE (.wav file), if FILE argument equals stdout then the output will be sent to standard output. The output can be piped to an audio/video player (e.g., mplayer)" ] main :: IO ()@@ -46,22 +44,22 @@ return (sr, sf, mf, wf) _ -> fail $ usageInfo "all options are mandatory\n" options - putStrLn "Importing MIDI File ..."+ hPutStrLn stderr "Importing MIDI File ..." eMidi <- Midi.importFile midiFile midi <- case eMidi of Left err -> fail err Right midi -> return midi- putStrLn "Done."+ hPutStrLn stderr "Done." - putStrLn "Importing SoundFontFile ... This may take a while ..."+ hPutStrLn stderr "Importing SoundFontFile ... This may take a while ..." eSoundFont <- SF.importFile soundFontFile soundFont <- case eSoundFont of Left err -> fail err Right sf -> return sf- putStrLn "Done."+ hPutStrLn stderr "Done." - putStrLn $ "Writing WAV audio data to '" ++ wavFile ++ "' ..."+ hPutStrLn stderr $ "Writing WAV audio data to '" ++ wavFile ++ "' ..." let paramsGen = soundFontToSynthParams soundFont sf = midiToEventSource midi >>> midiSynth paramsGen Player.Wav.play wavFile sampleRate' sf- putStrLn "Done."+ hPutStrLn stderr "Done."
src/Player/OpenAL.hs view
@@ -12,20 +12,17 @@ import Sound.OpenAL -import Data.Maybe import Data.Int import Data.IORef-import Control.Monad import Foreign.Storable import Foreign.Marshal.Alloc-import Foreign.Storable import Foreign.Ptr import Control.Concurrent play ::Int -> Int -> SF () (Sample, Event ()) -> IO () play sampleRate' sampleNumber' sf = do mVarEnd <- newEmptyMVar- forkIO $ (play' sampleRate' sampleNumber' sf) >> putMVar mVarEnd ()+ _ <- forkIO $ (play' sampleRate' sampleNumber' sf) >> putMVar mVarEnd () takeMVar mVarEnd return () @@ -36,7 +33,7 @@ mVarMaybeChunk <- newEmptyMVar mVarReply <- newEmptyMVar - forkIO $ process sampleRate' pSource pBuffer mVarMaybeChunk mVarReply+ _ <- forkIO $ process sampleRate' pSource pBuffer mVarMaybeChunk mVarReply ir <- newIORef (0 :: Int) let sampleSize = sizeOf (undefined :: Int16)@@ -78,13 +75,7 @@ case mDevice of Nothing -> fail "opening OpenAL device" Just device -> do- mContext <- createContext device [--- Frequency (fromIntegral 44100)--- , Refresh (fromIntegral 44101)--- Frequency (fromIntegral sampleRate)--- , MonoSources 1--- , StereoSources 0- ]+ mContext <- createContext device [] case mContext of Nothing -> fail "opening OpenAL context" Just context -> do
src/Player/Wav.hs view
@@ -13,7 +13,9 @@ play :: FilePath -> Int -> SF () (Sample, Event ()) -> IO () play filePath sampleRate' signalFunction = do- h <- openFile filePath WriteMode+ h <- case filePath of+ "stdout" -> return stdout+ _ -> openFile filePath WriteMode hSetBuffering h (BlockBuffering (Just 1024)) let a = Audio { sampleRate = sampleRate'