supercollider-midi 0.1.3 → 0.2
raw patch · 4 files changed
+225/−101 lines, 4 filesdep +alsa-seqdep +midi-alsadep +utility-htdep −alsa-mididep ~data-accessordep ~midi
Dependencies added: alsa-seq, midi-alsa, utility-ht
Dependencies removed: alsa-midi
Dependency ranges changed: data-accessor, midi
Files
- src/Sound/SC3/MIDI/Keyboard.hs +128/−56
- src/Sound/SC3/MIDI/Utility.hs +38/−0
- src/Sound/SC3/MIDI/Wind.hs +31/−24
- supercollider-midi.cabal +28/−21
src/Sound/SC3/MIDI/Keyboard.hs view
@@ -1,20 +1,23 @@ {- |-Play incoming MIDI messages from ALSA as sounds via SuperCollider-with one instrument.+Play incoming MIDI messages from ALSA as sounds via SuperCollider. -} -- module Sound.SC3.MIDI.Keyboard where module Main where --- import Sound.OpenSoundControl-import Sound.SC3 as SC3 hiding (pitch)+import Sound.SC3.MIDI.Utility (withEvents, startMessage, ) -import qualified Sound.OpenSoundControl.Transport.Monad as Trans+import Sound.SC3 as SC3 hiding (pitch, )+ import qualified Sound.SC3.Server.PlayEasy as SCPlay+import qualified Sound.OpenSoundControl.Transport.Monad as Trans -import qualified Sound.ALSA.Sequencer as AlsaMidi+import qualified Sound.MIDI.ALSA as MALSA import qualified Sound.MIDI.Message.Channel as ChannelMsg import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg+import qualified Sound.MIDI.Message.Channel.Mode as ModeMsg +import qualified Sound.ALSA.Sequencer.Event as Event+ import Data.Array (Array, array, listArray, (!), ) import Data.Map (Map, ) @@ -29,10 +32,14 @@ import qualified Data.Accessor.Monad.Trans.State as AccState import qualified Data.Accessor.Container as AccCntn import qualified Data.Accessor.Basic as Accessor-import Data.Accessor.Basic ((.>))+import Data.Accessor.Basic ((.>), (^.), (^:), (^=), ) +import Control.Monad.HT ((<=<), )+import Control.Monad (MonadPlus, mplus, liftM, )+-- import Control.Applicative ((<$), )+import Data.Monoid (Monoid, mempty, ) import Data.List (genericLength, )-import Data.Maybe (mapMaybe, fromMaybe, )+import Data.Maybe (fromMaybe, ) frequency :: UGen@@ -45,7 +52,7 @@ soundPing = sinOsc AR (2*frequency) 0 * xLine KR 1 0.1 1 PauseSynth *- 0.25 * 4 ** control KR "Velocity" 0+ 0.15 * 4 ** control KR "Velocity" 0 programPing :: ProgramSound programPing = ProgramSound "Ping" soundPing 2@@ -59,7 +66,7 @@ soundString :: UGen soundString = let n = 5- volume = 0.25 * 4 ** control KR "Velocity" 0 / sqrt (fromIntegral n)+ volume = 0.2 * 4 ** control KR "Velocity" 0 / sqrt (fromIntegral n) detunes = normalizeLevel 1 $ take (2*n) $ randomRs (0,0.03) $ mkStdGen 912@@ -112,7 +119,7 @@ StateT MIDIState IO () playNote chan velocity pitch = do sid <- AccState.getAndModify stateSID succ- AccState.set (stateNoteSID .> AccCntn.mapMaybe (chan, pitch)) (Just sid)+ AccState.set (stateChannelNotes .> AccCntn.mapMaybe chan .>> AccCntn.mapMaybe pitch) (Just sid) lift $ print (pitch, velocity) program <- AccState.get (stateChannelProgram .> AccCntn.array chan) params <- AccState.get (stateChannelParameter .> AccCntn.array chan)@@ -129,17 +136,32 @@ VoiceMsg.Pitch -> StateT MIDIState IO () stopNote chan pitch =- do sid <- AccState.get (stateNoteSID .> AccCntn.mapMaybe (chan, pitch))+ do sid <-+ AccState.getAndModify+ (stateChannelNotes .> AccCntn.mapMaybe chan .>> AccCntn.mapMaybe pitch)+ (const Nothing) lift $ maybe- (putStrLn $ "released key " ++ show (chan,pitch) ++ " which was not pressed")+ (putStrLn $ "released key " ++ show (chan,pitch) ++ " that was not pressed") (\s -> SCPlay.withSC3 $ Trans.send $ n_free [s]) sid +stopAllNotes ::+ ChannelMsg.Channel ->+ StateT MIDIState IO ()+stopAllNotes chan =+ do notes <-+ AccState.getAndModify+ (stateChannelNotes .> AccCntn.mapMaybe chan)+ (const Nothing)+ lift $ SCPlay.withSC3 $+ mapM_ (\s -> Trans.send $ n_free [s]) (maybe [] Map.elems notes)++ data MIDIState = MIDIState { stateSID_ :: SCPlay.NodeId,- stateNoteSID_ :: Map (ChannelMsg.Channel, VoiceMsg.Pitch) SCPlay.NodeId,+ stateChannelNotes_ :: Map ChannelMsg.Channel (Map VoiceMsg.Pitch SCPlay.NodeId), stateChannelProgram_ :: Array ChannelMsg.Channel VoiceMsg.Program, stateChannelParameter_ :: Array ChannelMsg.Channel (Map String Double) }@@ -151,12 +173,49 @@ (\x r -> r{stateSID_ = x}) stateSID_ -stateNoteSID :: Accessor.T MIDIState (Map (ChannelMsg.Channel, VoiceMsg.Pitch) SCPlay.NodeId)-stateNoteSID =++{- |+This combines two accessors+in the case that a null value of type @m b@+can represented both by @mzero@ and @pure mempty@.+Reasonable choices for @m@ are 'Maybe' and 'Either'.+The type @b@ might be a 'Map'.++Maybe move that function to data-accessor.+Monoid is only needed for 'mempty'.+Maybe it is not a good choice.+-}+(.>>) ::+ (Monoid b, MonadPlus m) =>+ Accessor.T a (m b) ->+ Accessor.T b (m c) ->+ Accessor.T a (m c)+(.>>) ab bc = Accessor.fromSetGet- (\x r -> r{stateNoteSID_ = x})- stateNoteSID_+ (\mc -> ab ^: (\mb ->+ liftM (bc ^= mc) $+ mplus mb (liftM (const mempty) mc)))+ -- (mempty <$ mc)+ (Accessor.get bc <=< Accessor.get ab) +composeMapAccessor ::+ Accessor.T a (Maybe (Map b c)) ->+ Accessor.T (Map b c) (Maybe c) ->+ Accessor.T a (Maybe c)+composeMapAccessor ab bc =+ Accessor.fromSetGet+ (\mc -> ab ^: (\mb -> case (mb,mc) of+ (Nothing, Nothing) -> Nothing+ _ -> Just $ (bc ^= mc) (fromMaybe Map.empty mb)))+ (\a -> (a ^. ab) >>= \b -> b ^. bc)+++stateChannelNotes :: Accessor.T MIDIState (Map ChannelMsg.Channel (Map VoiceMsg.Pitch SCPlay.NodeId))+stateChannelNotes =+ Accessor.fromSetGet+ (\x r -> r{stateChannelNotes_ = x})+ stateChannelNotes_+ stateChannelProgram :: Accessor.T MIDIState (Array ChannelMsg.Channel VoiceMsg.Program) stateChannelProgram =@@ -198,11 +257,12 @@ toneInitId = channelInitId + numberMIDIChannels numberMIDIChannels :: Int-numberMIDIChannels = 16+numberMIDIChannels =+ ChannelMsg.fromChannel maxBound -+ ChannelMsg.fromChannel minBound + 1 boundMIDIChannels :: (ChannelMsg.Channel, ChannelMsg.Channel)-boundMIDIChannels =- (ChannelMsg.toChannel 0, ChannelMsg.toChannel (pred numberMIDIChannels))+boundMIDIChannels = (minBound, maxBound) @@ -270,42 +330,54 @@ main = do SCPlay.withSC3 $ SCPlay.reset >> initEffect - putStrLn "use 'aconnect -i' to find out the ports from where note messages can be received"- putStrLn "and connect the source with this program using 'aconnect' or 'patchage' or 'alsa-patch-bay'"+ putStr startMessage - AlsaMidi.withEvents "supercollider-midi" "supercollider-midi-listen" $ \ ll ->+ withEvents "Haskell-SuperCollider" "in-0" $ \ evs -> flip evalStateT (MIDIState toneInitId Map.empty (listArray boundMIDIChannels (repeat (VoiceMsg.toProgram 0)))- (listArray boundMIDIChannels (repeat Map.empty)))- (mapM_ (\mev -> case mev of- ChannelMsg.Cons chan (ChannelMsg.Voice ev) ->- case ev of- VoiceMsg.Control ctrl value ->- fromMaybe (return ()) $- lookup ctrl $- (VoiceMsg.mainVolumeMSB,- controlChange chan "Volume" id value) :- (VoiceMsg.modulationMSB,- controlChange chan "Modulation" (*0.03) value) :- []- VoiceMsg.PitchBend value ->- controlChange chan "PitchBend" (/64) value- VoiceMsg.MonoAftertouch value ->- controlChange chan "Aftertouch" (*0.03) value- VoiceMsg.NoteOn pitch velocity ->-{--NoteOn with velocity 0 is now handled by alsa-midi package- when (VoiceMsg.fromVelocity velocity > 0) $--}- playNote chan velocity pitch- VoiceMsg.NoteOff pitch _velocity ->- stopNote chan pitch- VoiceMsg.ProgramChange program ->- lift (print ev) >>- if Array.inRange (Array.bounds programSounds) program- then AccState.set (stateChannelProgram .> AccCntn.array chan) program- else lift $ putStrLn "program unavailable"- _ -> return ()- _ -> return ())- (mapMaybe AlsaMidi.eventToChannelMsg ll))+ (listArray boundMIDIChannels (repeat Map.empty))) $+ flip mapM_ (map Event.body evs) $ \ev -> case ev of+ Event.CtrlEv ctrlPart param ->+ let chan = param ^. MALSA.ctrlChannel+ ctrlMode = param ^. MALSA.ctrlControllerMode+ valueX = param ^. MALSA.ctrlValue+ program = param ^. MALSA.ctrlProgram+ in case ctrlPart of+ Event.Controller ->+ case ctrlMode of+ MALSA.Controller ctrl value ->+ fromMaybe (return ()) $+ lookup ctrl $+ (VoiceMsg.mainVolume,+ controlChange chan "Volume" id value) :+ (VoiceMsg.modulation,+ controlChange chan "Modulation" (*0.03) value) :+ []+ MALSA.Mode ModeMsg.AllNotesOff ->+ stopAllNotes chan+ MALSA.Mode ModeMsg.AllSoundOff ->+ stopAllNotes chan+ {- this would clear all channels+ SCPlay.withSC3 (SCPlay.reset >> initEffect)+ -}+ _ ->+ return ()+ Event.PitchBend ->+ controlChange chan "PitchBend" (/64) valueX+ Event.ChanPress ->+ controlChange chan "Aftertouch" (*0.03) valueX+ Event.PgmChange ->+ lift (print ev) >>+ if Array.inRange (Array.bounds programSounds) program+ then AccState.set (stateChannelProgram .> AccCntn.array chan) program+ else lift $ putStrLn "program unavailable"+ _ -> return ()+ Event.NoteEv notePart note ->+ let chan = note ^. MALSA.noteChannel+ pitch = note ^. MALSA.notePitch+ in case MALSA.normalNoteFromEvent notePart note of+ (Event.NoteOn, velocity) -> playNote chan velocity pitch+ (Event.NoteOff, _velocity) -> stopNote chan pitch+ _ -> return ()+ _ -> return ()
+ src/Sound/SC3/MIDI/Utility.hs view
@@ -0,0 +1,38 @@+module Sound.SC3.MIDI.Utility where++import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer as SndSeq++import Control.Monad (liftM2, )++import System.IO.Unsafe (unsafeInterleaveIO, )+++withInPort ::+ String -> String -> SndSeq.BlockMode ->+ (SndSeq.T SndSeq.InputMode -> Port.T -> IO a) -> IO a+withInPort sequName portName blockMode act =+ SndSeq.with SndSeq.defaultName blockMode $ \h ->+ Client.setName h sequName >>+ Port.withSimple h portName+ (Port.caps [Port.capWrite, Port.capSubsWrite])+ Port.typeMidiGeneric+ (act h)++ioToLazyList :: IO a -> IO [a]+ioToLazyList m =+ let go = unsafeInterleaveIO $ liftM2 (:) m go+ in go++withEvents :: String -> String -> ([Event.T] -> IO a) -> IO a+withEvents sequName portName act =+ withInPort sequName portName SndSeq.Block $ \sequ _p ->+ ioToLazyList (Event.input sequ) >>= act+++startMessage :: String+startMessage =+ "use 'aconnect -i' to find out the ports from where note messages can be received\n" +++ "and connect the source with this program using 'aconnect' or 'patchage' or 'alsa-patch-bay'\n"
src/Sound/SC3/MIDI/Wind.hs view
@@ -1,24 +1,30 @@ module Main where--- module SuperColliderMIDI where+-- module Sound.SC3.MIDI.Wind where -import Sound.OpenSoundControl+import Sound.SC3.MIDI.Utility (withEvents, startMessage, )+ import Sound.SC3 as SC3 import Sound.SC3.UGen.Noise.ID as Noise -import qualified Sound.ALSA.Sequencer as AlsaMidi-import qualified Sound.MIDI.Message.Channel as ChannelMsg+import qualified Sound.MIDI.ALSA as MALSA import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg -import Data.Maybe (mapMaybe, fromMaybe, )+import qualified Sound.ALSA.Sequencer.Event as Event +import Data.Accessor.Basic ((^.), ) +import Data.Maybe (fromMaybe, )++ sound :: UGen-sound = out 0- (delayN (0.2 * rlpf- (Noise.whiteNoise (0::Int) AR * control KR "Volume" 1)- (control KR "Frequency" 400)- (control KR "Resonance" 0.005))- 0 (MCE [0, control KR "Phase" 0]))+sound =+ let noise =+ delayN (0.1 * rlpf+ (Noise.whiteNoise (0::Int) AR * control KR "Volume" 1)+ (control KR "Frequency" 400)+ (control KR "Resonance" 0.005))+ 0 (MCE [0, control KR "Phase" 0])+ in out 0 (noise + 0.5 * combN noise 0.5 0.5 2) controlChange :: String -> (Double -> Double) -> Int -> IO () controlChange ctrlName f value =@@ -34,24 +40,25 @@ audition sound putStrLn "turn the wheels ..."- AlsaMidi.withEvents "midinoise" "midinoise-listen" $ \ ll ->- putStrLn "use 'pmidi -l' to find out the ports from where controller values can be received" >>- putStrLn "and connect the source with this program using 'aconnect'" >>- mapM_ (\mev -> case mev of- ChannelMsg.Cons _chan (ChannelMsg.Voice ev) ->- case ev of- VoiceMsg.Control ctrl value ->+ withEvents "Haskell-Wind" "in-0" $ \ evs -> do+ putStr startMessage+ flip mapM_ (map Event.body evs) $ \ev -> case ev of+ Event.CtrlEv Event.Controller param ->+ case param ^. MALSA.ctrlControllerMode of+ MALSA.Controller ctrl value -> fromMaybe (return ()) $ lookup ctrl $- (VoiceMsg.mainVolumeMSB,+ (VoiceMsg.mainVolume, controlChange "Volume" id value) :- (VoiceMsg.footControlMSB,+ (VoiceMsg.footControl, controlChange "Frequency" (\x -> 200 * 4 ** x) value) :- (VoiceMsg.breathControlMSB,+ (VoiceMsg.breathControl, controlChange "Resonance" (\x -> 1 / 1000 ** x) value) :- (VoiceMsg.modulationMSB,+ (VoiceMsg.modulation, controlChange "Phase" (0.002*) value) : [] _ -> return ()- _ -> return ())- (mapMaybe AlsaMidi.eventToChannelMsg ll)+ Event.CtrlEv Event.PitchBend param ->+ controlChange "Frequency"+ (\x -> 400 * 2 ** (x / 64)) (param ^. MALSA.ctrlValue)+ _ -> return ()
supercollider-midi.cabal view
@@ -1,5 +1,5 @@ Name: supercollider-midi-Version: 0.1.3+Version: 0.2 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -26,47 +26,54 @@ description: Choose the new smaller, split-up base package. Executable sc-keyboard- If flag(splitBase)- Build-Depends:- array >=0.1 && <0.4,- containers >=0.1 && <0.5,- random >=1.0 && <2.0,- base >=2 && <5- Else- Build-Depends:- base >=1.0 && <2- Build-Depends: supercollider-ht >=0.1 && <0.2, opensoundcontrol-ht >=0.1 && <0.2, hsc3 >=0.8 && <0.9, hosc >=0.8 && <0.9,- alsa-midi >=0.4 && <0.5,- midi >=0.1.3 && <0.2,+ alsa-seq >=0.5 && <0.6,+ data-accessor >=0.2.1 && <0.3,+ midi-alsa >=0.1.1 && <0.2,+ midi >=0.1.4 && <0.2, event-list >=0.0.6 && <0.2, non-negative >=0.0.1 && <0.2, data-accessor-transformers >=0.2 && <0.3, data-accessor >=0.2 && <0.3,- transformers >=0.2 && <0.3+ transformers >=0.2 && <0.3,+ utility-ht >=0.0.5 && <0.1 + If flag(splitBase)+ Build-Depends:+ array >=0.1 && <0.4,+ containers >=0.1 && <0.5,+ random >=1.0 && <2.0,+ base >=2 && <5+ Else+ Build-Depends:+ base >=1.0 && <2+ Hs-source-dirs: src GHC-Options: -Wall -threaded Main-Is: Sound/SC3/MIDI/Keyboard.hs+ Other-Modules: Sound.SC3.MIDI.Utility Executable sc-wind- If flag(splitBase)- Build-Depends: base >=2- Else- Build-Depends: base >=1.0 && <2- Build-Depends: hsc3 >=0.8 && <0.9, hosc >=0.8 && <0.9,- alsa-midi >=0.4 && <0.5,- midi >=0.1.3 && <0.2,+ alsa-seq >=0.5 && <0.6,+ data-accessor >=0.2.1 && <0.3,+ midi-alsa >=0.1.1 && <0.2,+ midi >=0.1.4 && <0.2, event-list >=0.0.6 && <0.2, non-negative >=0.0.1 && <0.2 + If flag(splitBase)+ Build-Depends: base >=2+ Else+ Build-Depends: base >=1.0 && <2+ Hs-source-dirs: src GHC-Options: -Wall -threaded Main-Is: Sound/SC3/MIDI/Wind.hs+ Other-Modules: Sound.SC3.MIDI.Utility