YampaSynth 0.0.2 → 0.1
raw patch · 7 files changed
+45/−49 lines, 7 files
Files
- LICENSE +1/−1
- README +1/−4
- YampaSynth.cabal +2/−3
- src/Main/Gtk.hs +0/−3
- src/Main/OpenAL.hs +1/−1
- src/Player/Gtk.hs +38/−37
- src/Player/OpenAL.hs +2/−0
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2007, George Giorgidze and Henrik Nilsson+Copyright (c) 2007 - 2010, George Giorgidze and Henrik Nilsson All rights reserved.
README view
@@ -29,7 +29,7 @@ Aforementioned dependencies are enough to build yampasynth-wav application. To build yampasynth-openal in addition you will need OpenAL package from Hackage.- To build yampasynth-gtk in addition you will need to install Gtk2Hs, available from Gtk2Hs website (http://www.haskell.org/gtk2hs/).+ To build yampasynth-gtk in addition you will need to install GTK and Glade from Hackage. For further details about dependencies see cabal package description file (YampaSynth.cabal). @@ -76,6 +76,3 @@ On some linux systems (including my Ubuntu 7.10, OpenAL version libopenal0a 1:0.0.8) there are some issues with original C library, it is very buggy. For example on my system there were problems with ALSA output, so I had to put "(define devices '(native esd))" into my "~/.openalrc" file. Also output was not that good on sampling rates other than 11025, 22050 and 44100. In general I recommend to use these sampling rates if you experience similar problems.---George Giorgidze (Last Update: Apr 5, 2008)
YampaSynth.cabal view
@@ -1,9 +1,9 @@ name: YampaSynth-version: 0.0.2+version: 0.1 cabal-Version: >= 1.2 license: BSD3 license-file: LICENSE-copyright: (c) 2007-2008 George Giorgidze and Henrik Nilsson+copyright: (c) 2007-2010 George Giorgidze and Henrik Nilsson author: George Giorgidze and Henrik Nilsson maintainer: George Giorgidze (GGG at CS dot NOTT dot AC dot UK) homepage: http://www.cs.nott.ac.uk/~ggg/@@ -26,7 +26,6 @@ This is mainly a proof of concept, but already useful to some extent. build-type: Simple-tested-with: GHC==6.8.2 data-files: gui/YampaSynth.glade, README
src/Main/Gtk.hs view
@@ -5,10 +5,7 @@ import Player.Gtk import SynthParams -import Data.Char import Numeric-import Control.Monad-import System.IO import System.Environment import System.Console.GetOpt
src/Main/OpenAL.hs view
@@ -60,5 +60,5 @@ 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+ Player.OpenAL.play sampleRate' (64 * 1024) signalFunction hPutStrLn stderr "Done."
src/Player/Gtk.hs view
@@ -16,7 +16,8 @@ import Foreign.Storable import Foreign.Marshal.Alloc -import Graphics.UI.Gtk hiding (Event)+import Graphics.UI.Gtk hiding (eventKeyName)+import Graphics.UI.Gtk.Gdk.Events hiding (Event) import Graphics.UI.Gtk.Glade import Sound.OpenAL@@ -27,21 +28,21 @@ mVarMessage <- newEmptyMVar mVarReplyGui <- newEmptyMVar mVarKeyboardActive <- newEmptyMVar- refKeyboardStatus <- newIORef $ (Map.empty :: Map.Map String ()) - - unsafeInitGUIForThreadedRTS --initGUI- + refKeyboardStatus <- newIORef $ (Map.empty :: Map.Map String ())++ _ <- initGUI+ guiDescFile <- getDataFileName "gui/YampaSynth.glade" Just xml <- xmlNew guiDescFile window <- xmlGetWidget xml castToWindow "window1"- onDestroy window $ do+ _ <- onDestroy window $ do deInitOpenAL device context pSource pBuffer mainQuit let onKeyPressWindow e = do b <- isEmptyMVar mVarKeyboardActive- if b + if b then return () else do let k = eventKeyName e@@ -59,41 +60,41 @@ else do let k = eventKeyName e modifyIORef refKeyboardStatus (\m -> Map.delete k m)- putMVar mVarMessage (NoteOff {channel = 0, key = str2key k, velocity = 85}) + putMVar mVarMessage (NoteOff {channel = 0, key = str2key k, velocity = 85}) return True- onKeyPress window onKeyPressWindow- onKeyRelease window onKeyReleaseWindow- + _ <- onKeyPress window onKeyPressWindow+ _ <- onKeyRelease window onKeyReleaseWindow+ combobox <- xmlGetWidget xml castToComboBox "combobox1" comboBoxSetActive combobox 0- - onChanged combobox $ do++ _ <- on combobox changed $ do b <- isEmptyMVar mVarKeyboardActive if b then return () else do- mi <- comboBoxGetActive combobox- case mi of- Nothing -> return ()- Just i -> putMVar mVarMessage (ProgramChange { channel = 0, preset = fromIntegral i })+ i <- comboBoxGetActive combobox+ if i < 0+ then return ()+ else putMVar mVarMessage (ProgramChange { channel = 0, preset = fromIntegral i }) return () playButton <- xmlGetWidget xml castToButton "button1" stopButton <- xmlGetWidget xml castToButton "button2" widgetSetSensitivity stopButton False - onClicked playButton $ do- forkIO $ runSynth sampleRate' sampleNumber' pSource pBuffer- mVarMessage mVarReplyGui synth+ _ <- onClicked playButton $ do+ _ <- forkIO $ runSynth sampleRate' sampleNumber' pSource pBuffer+ mVarMessage mVarReplyGui synth widgetSetSensitivity playButton False widgetSetSensitivity stopButton True- mi <- comboBoxGetActive combobox- case mi of- Nothing -> return ()- Just i -> putMVar mVarMessage (ProgramChange { channel = 0, preset = fromIntegral i })+ i <- comboBoxGetActive combobox+ if i < 0+ then return ()+ else putMVar mVarMessage (ProgramChange { channel = 0, preset = fromIntegral i }) putMVar mVarKeyboardActive () - onClicked stopButton $ do+ _ <- onClicked stopButton $ do putMVar mVarMessage TrackEnd takeMVar mVarReplyGui widgetSetSensitivity stopButton False@@ -106,24 +107,24 @@ runSynth :: Int -> Int -> Source -> Buffer -> MVar Message -> MVar () -> SF (Event [Message]) (Sample, Event ()) -> IO () runSynth sampleRate' sampleNumber' pSource pBuffer mVarMessage mVarReplyGui synth = do- + mVarMaybeChunk <- newEmptyMVar mVarReplyPlayer <- newEmptyMVar - forkIO $ process sampleRate' pSource pBuffer mVarMaybeChunk mVarReplyPlayer+ _ <- forkIO $ process sampleRate' pSource pBuffer mVarMaybeChunk mVarReplyPlayer ir <- newIORef (0 :: Int) let sampleSize = sizeOf (undefined :: Int16) chunkSize' = sampleNumber' * sampleSize chunkData' <- mallocBytes chunkSize'- - let chunk = Chunk chunkData' chunkSize' ++ let chunk = Chunk chunkData' chunkSize' sense _ = do let dt = 1.0 / fromIntegral sampleRate' maybeMsg <- tryTakeMVar mVarMessage case maybeMsg of- Nothing -> return (dt, Just noEvent) - Just msg -> return (dt, Just (Event [msg])) + Nothing -> return (dt, Just noEvent)+ Just msg -> return (dt, Just (Event [msg])) actuate _ (s,e) = if (isEvent e) then return True else do@@ -138,9 +139,9 @@ else do writeIORef ir (i + 1) return False- + reactimate (return noEvent) sense actuate synth- + i <- readIORef ir putMVar mVarMaybeChunk (Just $ chunk {chunkSize = i * sampleSize}) takeMVar mVarReplyPlayer@@ -149,8 +150,8 @@ free (chunkData chunk) putMVar mVarReplyGui ()- - ++ str2key :: String -> Key str2key s = case s of "p" -> 64@@ -170,7 +171,7 @@ "w" -> 50 "2" -> 49 "q" -> 48- + "m" -> 59 - 12 "j" -> 58 - 12 "n" -> 57 - 12@@ -183,5 +184,5 @@ "x" -> 50 - 12 "s" -> 49 - 12 "z" -> 48 - 12- + _ -> 0
src/Player/OpenAL.hs view
@@ -110,8 +110,10 @@ waitForSource pSource putMVar mVarReply () Just chunk -> do+ unqueueBuffers pSource [pBuffer] (bufferData pBuffer) $= createBufferData sampleRate' chunk putMVar mVarReply ()+ queueBuffers pSource [pBuffer] Sound.OpenAL.play [pSource] waitForSource pSource process sampleRate' pSource pBuffer mVarMaybeChunk mVarReply