packages feed

midi-alsa 0.1.3 → 0.2

raw patch · 4 files changed

+185/−82 lines, 4 filesdep ~alsa-seqdep ~midi

Dependency ranges changed: alsa-seq, midi

Files

midi-alsa.cabal view
@@ -1,5 +1,5 @@ Name:             midi-alsa-Version:          0.1.3+Version:          0.2 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -14,13 +14,14 @@   This package provides accessors to data structures   of the ALSA sequencer interface   via the more specific types from the @midi@ package.-  The package also contains an orphan instance-  for the @alsa-seq:Event@ type of the @midi:Message.Class.Check@ class.-Tested-With:      GHC==6.10.4+  The package also contains a orphan instances+  for the @alsa-seq:Event@ type+  of the @midi:Message.Class.Check@ and @midi:Message.Class.Query@ classes.+Tested-With:      GHC==6.10.4, GHC==6.12.3, GHC==7.4.1 Cabal-Version:    >=1.6 Build-Type:       Simple Source-Repository this-  Tag:         0.1.3+  Tag:         0.2   Type:        darcs   Location:    http://code.haskell.org/alsa/midi/ @@ -37,8 +38,8 @@  Library   Build-Depends:-    midi >=0.1.7 && <0.2,-    alsa-seq >=0.5 && <0.6,+    midi >=0.2 && <0.3,+    alsa-seq >=0.6 && <0.7,     data-accessor >=0.2.1 && <0.3,     utility-ht >=0.0.5 && <0.1   If flag(splitBase)@@ -53,3 +54,4 @@   Exposed-Modules:     Sound.MIDI.ALSA     Sound.MIDI.ALSA.Check+    Sound.MIDI.ALSA.Query
src/Sound/MIDI/ALSA.hs view
@@ -14,35 +14,33 @@ import Sound.MIDI.Message.Channel.Voice (Velocity, Pitch, Controller, Program, )  import qualified Sound.ALSA.Sequencer.Event as Event-import Data.Word (Word8, Word32, )-import Data.Int (Int32, )  import qualified Data.Accessor.Basic as Acc import Data.Accessor.Basic ((^.), )-import Data.Tuple.HT (mapSnd, )+import Data.Tuple.HT (mapPair, )   -- * value conversions -toChannel :: Word8 -> Channel-toChannel  =  ChannelMsg.toChannel . fromIntegral+toChannel :: Event.Channel -> Channel+toChannel  =  ChannelMsg.toChannel . fromIntegral . Event.unChannel -fromChannel :: Channel -> Word8-fromChannel  =  fromIntegral . ChannelMsg.fromChannel+fromChannel :: Channel -> Event.Channel+fromChannel  =  Event.Channel . fromIntegral . ChannelMsg.fromChannel  -toPitch :: Word8 -> Pitch-toPitch  =  ChannelMsg.toPitch . fromIntegral+toPitch :: Event.Pitch -> Pitch+toPitch  =  ChannelMsg.toPitch . fromIntegral . Event.unPitch -fromPitch :: Pitch -> Word8-fromPitch  =  fromIntegral . ChannelMsg.fromPitch+fromPitch :: Pitch -> Event.Pitch+fromPitch  =  Event.Pitch . fromIntegral . ChannelMsg.fromPitch  -toVelocity :: Word8 -> Velocity-toVelocity  =  ChannelMsg.toVelocity . fromIntegral+toVelocity :: Event.Velocity -> Velocity+toVelocity  =  ChannelMsg.toVelocity . fromIntegral . Event.unVelocity -fromVelocity :: Velocity -> Word8-fromVelocity  =  fromIntegral . ChannelMsg.fromVelocity+fromVelocity :: Velocity -> Event.Velocity+fromVelocity  =  Event.Velocity . fromIntegral . ChannelMsg.fromVelocity   {- |@@ -56,7 +54,7 @@    case notePart of       Event.NoteOn ->          if velocity == VoiceMsg.toVelocity 0-           then (Event.NoteOff, VoiceMsg.toVelocity VoiceMsg.normalVelocity)+           then (Event.NoteOff, VoiceMsg.normalVelocity)            else (Event.NoteOn, velocity)       _ -> nv @@ -69,24 +67,24 @@ Controllers from @0x78@ to @0x7F@ are special, you must assert that the controller number is in the range @0@ to @0x77@. -}-toController :: Word32 -> Controller-toController  =  ChannelMsg.toController . fromIntegral+toController :: Event.Parameter -> Controller+toController  =  ChannelMsg.toController . fromIntegral . Event.unParameter -fromController :: Controller -> Word32-fromController  =  fromIntegral . ChannelMsg.fromController+fromController :: Controller -> Event.Parameter+fromController  =  Event.Parameter . fromIntegral . ChannelMsg.fromController  -toProgram :: Int32 -> Program-toProgram  =  ChannelMsg.toProgram . fromIntegral+toProgram :: Event.Value -> Program+toProgram  =  ChannelMsg.toProgram . fromIntegral . Event.unValue -fromProgram :: Program -> Int32-fromProgram  =  fromIntegral . ChannelMsg.fromProgram+fromProgram :: Program -> Event.Value+fromProgram  =  Event.Value . fromIntegral . ChannelMsg.fromProgram   -- * construction of event data records  noteEvent ::-   Channel -> Pitch -> Velocity -> Velocity -> Word32 ->+   Channel -> Pitch -> Velocity -> Velocity -> Int ->    Event.Note noteEvent chan pitch velOn velOff dur =    Event.Note@@ -94,16 +92,16 @@       (fromPitch pitch)       (fromVelocity velOn)       (fromVelocity velOff)-      dur+      (Event.Duration $ fromIntegral dur)  controllerEvent ::-   Channel -> Controller -> Int32 ->+   Channel -> Controller -> Int ->    Event.Ctrl controllerEvent chan ctrl value =    Event.Ctrl       (fromChannel chan)       (fromController ctrl)-      value+      (Event.Value $ fromIntegral value)  programChangeEvent ::    Channel -> Program ->@@ -111,7 +109,7 @@ programChangeEvent chan pgm =    Event.Ctrl       (fromChannel chan)-      0+      (Event.Parameter 0)       (fromProgram pgm)  modeEvent ::@@ -122,8 +120,8 @@       (param,value) ->          Event.Ctrl             (fromChannel chan)-            param-            (fromIntegral value)+            (Event.Parameter $ fromIntegral param)+            (Event.Value value)   -- * accessors to event data fields@@ -182,22 +180,23 @@                    Controller c x ->                       (fromController c, fromIntegral x)                    Mode m ->-                      mapSnd fromIntegral $ Mode.toControllerValue m+                      mapPair (Event.Parameter, fromIntegral) $+                      Mode.toControllerValue m          in  ctrl{Event.ctrlParam = p,-                  Event.ctrlValue = v})+                  Event.ctrlValue = Event.Value v})       (\ctrl ->          let c = Event.ctrlParam ctrl-         in  if c<0x78+         in  if c < Event.Parameter 0x78                then Controller (ctrl ^. ctrlController) (ctrl ^. ctrlValue)-               else Mode $ snd  $ Mode.fromControllerValue-                       (fromIntegral $ Event.ctrlParam ctrl,-                        Event.ctrlValue ctrl))+               else Mode $ snd $ Mode.fromControllerValue+                       (Event.unParameter $ Event.ctrlParam ctrl,+                        fromIntegral $ Event.unValue $ Event.ctrlValue ctrl))  ctrlValue :: Acc.T Event.Ctrl Int ctrlValue =    Acc.fromSetGet-      (\x ctrl -> ctrl{Event.ctrlValue = fromIntegral x})-      (fromIntegral . Event.ctrlValue)+      (\x ctrl -> ctrl{Event.ctrlValue = Event.Value $ fromIntegral x})+      (fromIntegral . Event.unValue . Event.ctrlValue)  ctrlProgram :: Acc.T Event.Ctrl Program ctrlProgram =
src/Sound/MIDI/ALSA/Check.hs view
@@ -1,10 +1,19 @@ {--The instance Class.C Event.T is orphan.+The instances Class.C Event.T and Class.C Event.Data are orphan. I could put it in package 'midi' or 'alsa-seq'-but in both them it imposes a lot of new dependencies.+but in both of them it imposes a lot of new dependencies. -} {-# OPTIONS_GHC -fno-warn-orphans #-}-module Sound.MIDI.ALSA.Check where+module Sound.MIDI.ALSA.Check (+   Class.C,+   Class.note,+   Class.program,+   Class.anyController,+   Class.controller,+   Class.mode,+   Class.pitchBend,+   Class.channelPressure,+   ) where  import qualified Sound.MIDI.Message.Class.Check as Class import qualified Sound.MIDI.Message.Channel.Mode as Mode@@ -22,18 +31,26 @@   instance Class.C Event.T where-   note = note-   program = program-   anyController = anyController-   mode = mode-   pitchBend = pitchBend-   channelPressure = channelPressure+   note chan = noteData chan . Event.body+   program chan = programData chan . Event.body+   anyController chan = anyControllerData chan . Event.body+   mode chan = modeData chan . Event.body+   pitchBend chan = pitchBendData chan . Event.body+   channelPressure chan = channelPressureData chan . Event.body +instance Class.C Event.Data where+   note = noteData+   program = programData+   anyController = anyControllerData+   mode = modeData+   pitchBend = pitchBendData+   channelPressure = channelPressureData -note ::-   Channel -> Event.T -> Maybe (Velocity, Pitch, Bool)-note chan e = do-   Event.NoteEv n c <- Just $ Event.body e++noteData ::+   Channel -> Event.Data -> Maybe (Velocity, Pitch, Bool)+noteData chan e = do+   Event.NoteEv n c <- Just e    guard (c ^. MALSA.noteChannel  ==  chan)    let pitch    = c ^. MALSA.notePitch        velocity = c ^. MALSA.noteVelocity@@ -42,47 +59,41 @@       Event.NoteOff -> Just (velocity, pitch, False)       _ -> Nothing -program ::-   Channel -> Event.T -> Maybe Program-program chan e = do-   Event.CtrlEv Event.PgmChange c <- Just $ Event.body e+programData ::+   Channel -> Event.Data -> Maybe Program+programData chan e = do+   Event.CtrlEv Event.PgmChange c <- Just e    guard (c ^. MALSA.ctrlChannel  ==  chan)    return $ c ^. MALSA.ctrlProgram -anyController ::-   Channel -> Event.T -> Maybe (Controller, Int)-anyController chan e = do+anyControllerData ::+   Channel -> Event.Data -> Maybe (Controller, Int)+anyControllerData chan e = do    -- let Event.TickTime n = Event.timestamp e-   Event.CtrlEv Event.Controller c <- Just $ Event.body e+   Event.CtrlEv Event.Controller c <- Just e    guard (c ^. MALSA.ctrlChannel  ==  chan)    MALSA.Controller cn cv <- Just $ c ^. MALSA.ctrlControllerMode    return (cn, cv) -controller :: Channel -> Controller -> Event.T -> Maybe Int-controller chan ctrl e = do-   (c,n) <- anyController chan e-   guard (ctrl==c)-   return n--mode :: Channel -> Event.T -> Maybe Mode.T-mode chan e = do-   Event.CtrlEv Event.Controller c <- Just $ Event.body e+modeData :: Channel -> Event.Data -> Maybe Mode.T+modeData chan e = do+   Event.CtrlEv Event.Controller c <- Just e    guard (c ^. MALSA.ctrlChannel  ==  chan)    MALSA.Mode m <- Just $ c ^. MALSA.ctrlControllerMode    return m -pitchBend :: Channel -> Event.T -> Maybe Int-pitchBend chan e =-   case Event.body e of+pitchBendData :: Channel -> Event.Data -> Maybe Int+pitchBendData chan e =+   case e of       Event.CtrlEv Event.PitchBend c ->          toMaybe             (c ^. MALSA.ctrlChannel == chan)             (c ^. MALSA.ctrlValue)       _ -> Nothing -channelPressure :: Channel -> Event.T -> Maybe Int-channelPressure chan e =-   case Event.body e of+channelPressureData :: Channel -> Event.Data -> Maybe Int+channelPressureData chan e =+   case e of       Event.CtrlEv Event.ChanPress c ->          toMaybe             (c ^. MALSA.ctrlChannel == chan)
+ src/Sound/MIDI/ALSA/Query.hs view
@@ -0,0 +1,91 @@+{-+The instances Class.C Event.T and Class.C Event.Data are orphan.+I could put it in package 'midi' or 'alsa-seq'+but in both of them it imposes a lot of new dependencies.+-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Sound.MIDI.ALSA.Query (+   Class.C,+   Class.note,+   Class.program,+   Class.anyController,+   Class.mode,+   Class.pitchBend,+   Class.channelPressure,+   ) where++import qualified Sound.MIDI.Message.Class.Query as Class+import qualified Sound.MIDI.Message.Channel.Mode as Mode++import qualified Sound.MIDI.ALSA as MALSA++import qualified Sound.ALSA.Sequencer.Event as Event++import Sound.MIDI.Message.Channel (Channel, )+import Sound.MIDI.Message.Channel.Voice (Pitch, Velocity, Controller, Program, )++import Data.Accessor.Basic ((^.), )+++instance Class.C Event.T where+   note = noteData . Event.body+   program = programData . Event.body+   anyController = anyControllerData . Event.body+   mode = modeData . Event.body+   pitchBend = pitchBendData . Event.body+   channelPressure = channelPressureData . Event.body++instance Class.C Event.Data where+   note = noteData+   program = programData+   anyController = anyControllerData+   mode = modeData+   pitchBend = pitchBendData+   channelPressure = channelPressureData+++noteData ::+   Event.Data -> Maybe (Channel, (Velocity, Pitch, Bool))+noteData e = do+   Event.NoteEv n c <- Just e+   let pitch    = c ^. MALSA.notePitch+       velocity = c ^. MALSA.noteVelocity+   fmap ((,) (c ^. MALSA.noteChannel)) $+      case n of+         Event.NoteOn  -> Just (velocity, pitch, True)+         Event.NoteOff -> Just (velocity, pitch, False)+         _ -> Nothing++programData ::+   Event.Data -> Maybe (Channel, Program)+programData e = do+   Event.CtrlEv Event.PgmChange c <- Just e+   return (c ^. MALSA.ctrlChannel, c ^. MALSA.ctrlProgram)++anyControllerData ::+   Event.Data -> Maybe (Channel, (Controller, Int))+anyControllerData e = do+   -- let Event.TickTime n = Event.timestamp e+   Event.CtrlEv Event.Controller c <- Just e+   MALSA.Controller cn cv <- Just $ c ^. MALSA.ctrlControllerMode+   return (c ^. MALSA.ctrlChannel, (cn, cv))++modeData :: Event.Data -> Maybe (Channel, Mode.T)+modeData e = do+   Event.CtrlEv Event.Controller c <- Just e+   MALSA.Mode m <- Just $ c ^. MALSA.ctrlControllerMode+   return (c ^. MALSA.ctrlChannel, m)++pitchBendData :: Event.Data -> Maybe (Channel, Int)+pitchBendData e =+   case e of+      Event.CtrlEv Event.PitchBend c ->+         Just (c ^. MALSA.ctrlChannel, c ^. MALSA.ctrlValue)+      _ -> Nothing++channelPressureData :: Event.Data -> Maybe (Channel, Int)+channelPressureData e =+   case e of+      Event.CtrlEv Event.ChanPress c ->+         Just (c ^. MALSA.ctrlChannel, c ^. MALSA.ctrlValue)+      _ -> Nothing