diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2010, Henning Thielemann + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of contributors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#! /usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/midi-alsa.cabal b/midi-alsa.cabal new file mode 100644 --- /dev/null +++ b/midi-alsa.cabal @@ -0,0 +1,52 @@ +Name: midi-alsa +Version: 0.1 +License: BSD3 +License-File: LICENSE +Author: Henning Thielemann +Maintainer: Henning Thielemann +Homepage: http://www.haskell.org/haskellwiki/MIDI +Category: Sound, Music +Build-Type: Simple +Synopsis: Convert between datatypes of the midi and the alsa packages +Description: + MIDI is the Musical Instrument Digital Interface, + ALSA is the Advanced Linux Sound Architecture. + This package provides accessors to data structures + of the ALSA sequencer interface + via the more specific types from the @midi@ package. +Tested-With: GHC==6.10.4 +Cabal-Version: >=1.6 +Build-Type: Simple +Source-Repository head + type: darcs + location: http://code.haskell.org/~thielema/midi-alsa/ + +Source-Repository this + type: darcs + location: http://code.haskell.org/~thielema/midi-alsa/ + tag: 0.1 + +Flag splitBase + description: Choose the new smaller, split-up base package. + +Flag buildExamples + description: Build example executables + default: False + +Library + Build-Depends: + midi >=0.1.5 && <0.2, + alsa-seq >=0.5 && <0.6, + data-accessor >=0.2.1 && <0.3, + utility-ht >=0.0.5 && <0.1 + If flag(splitBase) + Build-Depends: + base >= 2 && <6 + Else + Build-Depends: + base >= 1.0 && < 2 + + GHC-Options: -Wall + Hs-Source-Dirs: src + Exposed-Modules: + Sound.MIDI.ALSA diff --git a/src/Sound/MIDI/ALSA.hs b/src/Sound/MIDI/ALSA.hs new file mode 100644 --- /dev/null +++ b/src/Sound/MIDI/ALSA.hs @@ -0,0 +1,154 @@ +module Sound.MIDI.ALSA where + +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 Mode + +import Sound.MIDI.Message.Channel (Channel, ) +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, ) + + +toChannel :: Word8 -> Channel +toChannel = ChannelMsg.toChannel . fromIntegral + +fromChannel :: Channel -> Word8 +fromChannel = fromIntegral . ChannelMsg.fromChannel + + +toPitch :: Word8 -> Pitch +toPitch = ChannelMsg.toPitch . fromIntegral + +fromPitch :: Pitch -> Word8 +fromPitch = fromIntegral . ChannelMsg.fromPitch + + +toVelocity :: Word8 -> Velocity +toVelocity = ChannelMsg.toVelocity . fromIntegral + +fromVelocity :: Velocity -> Word8 +fromVelocity = fromIntegral . ChannelMsg.fromVelocity + + +{- | +Return a 'NoteOff' if input is a 'NoteOn' with velocity zero. +This is a trick of the MIDI standard +in order to allow compression of a series of note events. +After normalization you can safely match on 'NoteOn' and 'NoteOff'. +-} +normalizeNote :: (Event.NoteEv, Velocity) -> (Event.NoteEv, Velocity) +normalizeNote nv@(notePart,velocity) = + case notePart of + Event.NoteOn -> + if velocity == VoiceMsg.toVelocity 0 + then (Event.NoteOff, VoiceMsg.toVelocity VoiceMsg.normalVelocity) + else (Event.NoteOn, velocity) + _ -> nv + +normalNoteFromEvent :: Event.NoteEv -> Event.Note -> (Event.NoteEv, Velocity) +normalNoteFromEvent notePart note = + normalizeNote (notePart, note ^. noteVelocity) + + +{- | +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 + +fromController :: Controller -> Word32 +fromController = fromIntegral . ChannelMsg.fromController + + +toProgram :: Int32 -> Program +toProgram = ChannelMsg.toProgram . fromIntegral + +fromProgram :: Program -> Int32 +fromProgram = fromIntegral . ChannelMsg.fromProgram + + + +noteChannel :: Acc.T Event.Note Channel +noteChannel = + Acc.fromSetGet + (\c note -> note{Event.noteChannel = fromChannel c}) + (toChannel . Event.noteChannel) + +notePitch :: Acc.T Event.Note Pitch +notePitch = + Acc.fromSetGet + (\p note -> note{Event.noteNote = fromPitch p}) + (toPitch . Event.noteNote) + +{- | +This may not yield what you expect. +See 'normalizeNote'. +-} +noteVelocity :: Acc.T Event.Note Velocity +noteVelocity = + Acc.fromSetGet + (\v note -> note{Event.noteVelocity = fromVelocity v}) + (toVelocity . Event.noteVelocity) + + +ctrlChannel :: Acc.T Event.Ctrl Channel +ctrlChannel = + Acc.fromSetGet + (\c ctrl -> ctrl{Event.ctrlChannel = fromChannel c}) + (toChannel . Event.ctrlChannel) + +{- | +This is undefined, if the controller is no regular controller +but a channel mode message. +Better use 'ctrlControllerMode'. +-} +ctrlController :: Acc.T Event.Ctrl Controller +ctrlController = + Acc.fromSetGet + (\c ctrl -> ctrl{Event.ctrlParam = fromController c}) + (toController . Event.ctrlParam) + +data ControllerMode = + Controller Controller Int + | Mode Mode.T + deriving (Show, Eq) + +ctrlControllerMode :: Acc.T Event.Ctrl ControllerMode +ctrlControllerMode = + Acc.fromSetGet + (\cm ctrl -> + let (p,v) = + case cm of + Controller c x -> + (fromController c, fromIntegral x) + Mode m -> + mapSnd fromIntegral $ Mode.toControllerValue m + in ctrl{Event.ctrlParam = p, + Event.ctrlValue = v}) + (\ctrl -> + let c = Event.ctrlParam ctrl + in if c<0x78 + then Controller (ctrl ^. ctrlController) (ctrl ^. ctrlValue) + else Mode $ snd $ Mode.fromControllerValue + (fromIntegral $ Event.ctrlParam ctrl, + Event.ctrlValue ctrl)) + +ctrlValue :: Acc.T Event.Ctrl Int +ctrlValue = + Acc.fromSetGet + (\x ctrl -> ctrl{Event.ctrlValue = fromIntegral x}) + (fromIntegral . Event.ctrlValue) + +ctrlProgram :: Acc.T Event.Ctrl Program +ctrlProgram = + Acc.fromSetGet + (\p ctrl -> ctrl{Event.ctrlValue = fromProgram p}) + (toProgram . Event.ctrlValue)