diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2007, George Giorgidze and Henrik Nilsson +Copyright (c) 2007 - 2010, George Giorgidze and Henrik Nilsson All rights reserved. diff --git a/README b/README --- a/README +++ b/README @@ -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) diff --git a/YampaSynth.cabal b/YampaSynth.cabal --- a/YampaSynth.cabal +++ b/YampaSynth.cabal @@ -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 diff --git a/src/Main/Gtk.hs b/src/Main/Gtk.hs --- a/src/Main/Gtk.hs +++ b/src/Main/Gtk.hs @@ -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 diff --git a/src/Main/OpenAL.hs b/src/Main/OpenAL.hs --- a/src/Main/OpenAL.hs +++ b/src/Main/OpenAL.hs @@ -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." diff --git a/src/Player/Gtk.hs b/src/Player/Gtk.hs --- a/src/Player/Gtk.hs +++ b/src/Player/Gtk.hs @@ -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 diff --git a/src/Player/OpenAL.hs b/src/Player/OpenAL.hs --- a/src/Player/OpenAL.hs +++ b/src/Player/OpenAL.hs @@ -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