diff --git a/haskore-realtime.cabal b/haskore-realtime.cabal --- a/haskore-realtime.cabal +++ b/haskore-realtime.cabal @@ -1,5 +1,5 @@ Name: haskore-realtime -Version: 0.1.1 +Version: 0.2 License: GPL License-File: LICENSE Author: Henning Thielemann @@ -25,7 +25,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/haskore/revised/realtime/ - tag: 0.1.1 + tag: 0.2 Flag splitBase description: Choose the new smaller, split-up base package. @@ -33,20 +33,21 @@ Library Build-Depends: haskore >=0.1 && <0.3, - midi >=0.1.1 && <0.2, - bytestring >=0.9 && <1.0, + midi >=0.2 && <0.3, + bytestring >=0.9 && <0.11, -- dependency on non-negative for Haddock non-negative >=0.0.1 && <0.2, event-list >=0.0.6 && <0.2, data-accessor >=0.2 && <0.3, unix >= 2.0 && <3, - transformers >=0.2 && <0.3 + transformers >=0.2 && <0.5, + utility-ht >=0.0.8 && <0.1 If flag(splitBase) Build-Depends: - directory >=1.0 && <1.1, - old-time >=1.0 && <1.1, - process >=1.0 && <1.1, + directory >=1.0 && <1.3, + old-time >=1.0 && <1.2, + process >=1.0 && <1.3, base >=3 && <5 Else Build-Depends: @@ -55,13 +56,15 @@ GHC-Options: -Wall Hs-source-dirs: src Exposed-modules: - Haskore.RealTime.Timer, - Haskore.RealTime.Timer.Immediate, - Haskore.RealTime.Timer.Thread, + Haskore.RealTime.Timer + Haskore.RealTime.Timer.Immediate + Haskore.RealTime.Timer.Thread -- needs 'unix' package Haskore.RealTime.Timer.Posix - Haskore.RealTime.EventList.TimeBody, - Haskore.RealTime.EventList.TimeTime, - Haskore.RealTime.ShellPipe, - Haskore.Interface.CSound.Play, + Haskore.RealTime.EventList.TimeBody + Haskore.RealTime.EventList.TimeTime + Haskore.RealTime.ShellPipe + Haskore.Interface.CSound.Play Haskore.Interface.MIDI.Play + Other-Modules: + Haskore.RealTime.Utility diff --git a/src/Haskore/Interface/CSound/Play.hs b/src/Haskore/Interface/CSound/Play.hs --- a/src/Haskore/Interface/CSound/Play.hs +++ b/src/Haskore/Interface/CSound/Play.hs @@ -9,16 +9,19 @@ module Haskore.Interface.CSound.Play where import Haskore.RealTime.ShellPipe (launch) -import System.IO (IO) +import Haskore.RealTime.Utility (catchCtrlC, ) + import qualified System.IO as IO -import qualified System.Posix.Signals as Signals -import System.Cmd (system, ) +import System.Process (rawSystem, system, ) import System.Directory(doesFileExist, removeFile, ) import Haskore.Interface.CSound (Name, ) import qualified Haskore.Interface.CSound.Orchestra as Orchestra import qualified Haskore.Interface.CSound.Score as Score +import Control.Functor.HT (void, ) + + play :: Orchestra.Output out => Orchestra.T out -> Score.T -> IO () play orc sco = playV4 "/tmp" ("tmp", orc, sco) @@ -53,9 +56,9 @@ exists <- doesFileExist scorePipe if exists then putStrLn (scorePipe ++ " already exists") - else system ("mkfifo " ++ scorePipe) >> return () + else void $ rawSystem "mkfifo" [scorePipe] writeFile orchName (Orchestra.toString o) - system (fst cmd ++ orchName ++ " " ++ scorePipe ++ snd cmd) + void $ system (fst cmd ++ orchName ++ " " ++ scorePipe ++ snd cmd) -- how can I reliably wait for CSound to open the pipe? writeFile scorePipe (Score.toString s) removeFile scorePipe @@ -69,11 +72,7 @@ let orchName = dir ++ "/" ++ name ++ ".orc" -- ((rate, _, channels), _) = o in do - -- Disable sigPIPE. This means that the whole program - -- won't crash when the tool exits. Unfortunately there - -- doesn't seem to be another way of doing this. - Signals.installHandler Signals.sigPIPE - Signals.Ignore Nothing + catchCtrlC -- system ("mkfifo "++scorePipe) writeFile orchName (Orchestra.toString o) -- system ("csound -d -odac "++orchName++" "++scorePipe++" &") @@ -94,11 +93,7 @@ let orchName = dir ++ "/" ++ name ++ ".orc" Orchestra.Cons (rate, _) _ = o in do - -- Disable sigPIPE. This means that the whole program - -- won't crash when the tool exits. Unfortunately there - -- doesn't seem to be another way of doing this. - Signals.installHandler Signals.sigPIPE - Signals.Ignore Nothing + catchCtrlC writeFile orchName (Orchestra.toString o) (input,_,_) <- launch "play" ["play", "-r", show rate, @@ -118,11 +113,7 @@ let orchName = dir ++ "/" ++ name ++ ".orc" -- ((rate, _, channels), _) = o in do - -- Disable sigPIPE. This means that the whole program - -- won't crash when the tool exits. Unfortunately there - -- doesn't seem to be another way of doing this. - Signals.installHandler Signals.sigPIPE - Signals.Ignore Nothing + catchCtrlC writeFile orchName (Orchestra.toString o) (input,_,_) <- launch "csound32" ["csound32", "-d", "-o", tmpWave, "-W", diff --git a/src/Haskore/Interface/MIDI/Play.hs b/src/Haskore/Interface/MIDI/Play.hs --- a/src/Haskore/Interface/MIDI/Play.hs +++ b/src/Haskore/Interface/MIDI/Play.hs @@ -27,12 +27,10 @@ via the MIDI file format! For better realtime support on Linux look at the @alsa-midi@ package. -} -module Haskore.Interface.MIDI.Play where +module Haskore.Interface.MIDI.Play (play, playSimple, ) where import Haskore.RealTime.ShellPipe (launch) -import System.IO (IO) -import qualified System.IO as IO -import qualified System.Posix.Signals as Signals +import Haskore.RealTime.Utility (catchCtrlC, ) import qualified Haskore.Music.GeneralMIDI as MidiMusic import qualified Haskore.Music.Rhythmic as RhyMusic @@ -43,13 +41,12 @@ import qualified Haskore.Interface.MIDI.Render as Render import qualified Sound.MIDI.File.Save as SaveMidi +import qualified Data.ByteString.Lazy as B +import qualified System.IO as IO import qualified Numeric.NonNegative.Class as NonNeg -import Data.Char (chr, ) -import Data.Word (Word8, ) - play :: (Ord instr, Ord drum, NonNeg.C time, RealFrac time, Fractional time, RealFrac dyn) => @@ -58,19 +55,15 @@ Context.T time dyn (RhyMusic.Note drum instr), RhyMusic.T drum instr) -> IO () -play = playRaw [] . SaveMidi.toByteList . WriteMidi.fromRhythmicMusicMixed +play = playRaw [] . SaveMidi.toByteString . WriteMidi.fromRhythmicMusicMixed playSimple :: MidiMusic.T -> IO () -playSimple = playRaw [] . SaveMidi.toByteList . Render.mixedGeneralMidi +playSimple = playRaw [] . SaveMidi.toByteString . Render.mixedGeneralMidi -playRaw :: [String] -> ByteList -> IO () +playRaw :: [String] -> B.ByteString -> IO () playRaw args stream = do - -- Disable sigPIPE. This means that the whole program - -- won't crash when the tool exits. Unfortunately there - -- doesn't seem to be another way of doing this. - Signals.installHandler Signals.sigPIPE - Signals.Ignore Nothing + catchCtrlC -- (input,_,_) <- launch "play" -- (["play", "-r","11025","-t","sw","-"]) @@ -78,11 +71,5 @@ -- (["od", "-t", "x4z"]) (input,_,_) <- launch "timidity" (["timidity", "-B", "8,9"] ++ args ++ ["-"]) - IO.hPutStr input (stringCharFromByte stream) + B.hPutStr input stream IO.hClose input - - -type ByteList = [Word8] - -stringCharFromByte :: ByteList -> String -stringCharFromByte = map (chr . fromIntegral) diff --git a/src/Haskore/RealTime/Utility.hs b/src/Haskore/RealTime/Utility.hs new file mode 100644 --- /dev/null +++ b/src/Haskore/RealTime/Utility.hs @@ -0,0 +1,17 @@ +module Haskore.RealTime.Utility where + +import qualified System.Posix.Signals as Signals + +import Control.Functor.HT (void, ) + + +{- | +Disable sigPIPE. This means that the whole program +won't crash when the tool exits. Unfortunately there +doesn't seem to be another way of doing this. +-} +catchCtrlC :: IO () +catchCtrlC = + void $ + Signals.installHandler Signals.sigPIPE + Signals.Ignore Nothing