summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xEuterpea.cabal10
-rwxr-xr-xEuterpea/IO/MIDI/MidiIO.lhs65
-rwxr-xr-xEuterpea/Music.lhs17
-rwxr-xr-xReadMe.txt4
4 files changed, 50 insertions, 46 deletions
diff --git a/Euterpea.cabal b/Euterpea.cabal
index 51d7405..080c2b1 100755
--- a/Euterpea.cabal
+++ b/Euterpea.cabal
@@ -1,9 +1,9 @@
name: Euterpea
-version: 2.0.6
+version: 2.0.7
Cabal-Version: >= 1.8
license: BSD3
license-file: License
-copyright: Copyright (c) 2008-2017 Euterpea authors
+copyright: Copyright (c) 2008-2019 Euterpea authors
category: Sound, Music
stability: experimental
build-type: Custom
@@ -62,10 +62,10 @@ Library
array>=0.5.0.0 && <=0.6,
deepseq>=1.3.0.2 && <=1.5,
random>=1.0.1.1 && <=1.2,
- PortMidi==0.1.6.1,
+ PortMidi==0.2.0.0,
HCodecs == 0.5.1,
- stm >= 2.4 && <2.5,
- containers>=0.5.5.1 && <0.6,
+ stm >= 2.4 && <2.6,
+ containers>=0.5.5.1 && <0.7,
bytestring>=0.10.4.0 && <= 0.10.9,
heap >= 1.0 && < 2.0,
ghc-prim
diff --git a/Euterpea/IO/MIDI/MidiIO.lhs b/Euterpea/IO/MIDI/MidiIO.lhs
index f76d909..8b815f7 100755
--- a/Euterpea/IO/MIDI/MidiIO.lhs
+++ b/Euterpea/IO/MIDI/MidiIO.lhs
@@ -20,9 +20,10 @@
> getDefaultOutputDeviceID, getDefaultInputDeviceID,
> openInput, openOutput, readEvents,
> close, writeShort, getErrorText, terminate, initialize,
-> PMError (NoError, BufferOverflow), PMStream,
+> PMStream, PMError (..),
> PMEvent (..), PMMsg (PMMsg),
-> encodeMsg, decodeMsg)
+> encodeMsg, decodeMsg,
+> PMSuccess (..))
> import Control.Exception (finally)
> import Control.Concurrent
> import Control.Concurrent.STM.TChan
@@ -206,9 +207,9 @@ initializeMidi just initializes PortMidi
> initializeMidi :: IO ()
> initializeMidi = do
> e <- initialize
-> if e == NoError
-> then return ()
-> else reportError "initializeMidi" e
+> case e of
+> Right _ -> return ()
+> Left e' -> reportError "initializeMidi" e'
terminateMidi calls the stop function on all elements of outDevMap
and clears the mapping entirely. It also clears outPort and inPort.
@@ -260,18 +261,16 @@ DWC NOTE: Why is the time even used? All messages get the same time?
> Nothing -> do
> r <- openInput devId
> case r of
-> Right e -> reportError "pollMidiCB" e
-> Left s -> addPort inPort (idid, s) >> input s
+> Left e -> reportError "pollMidiCB" e
+> Right s -> addPort inPort (idid, s) >> input s
> Just s -> input s
> where
> input :: PMStream -> IO ()
> input s = do
> e <- readEvents s
> case e of
-> Right e -> if e == NoError
-> then return ()
-> else reportError "pollMidiCB" e
-> Left l -> do
+> Left e -> reportError "pollMidiCB" e
+> Right l -> do
> now <- getTimeNow
> case mapMaybe (msgToMidi . decodeMsg . message) l of
> [] -> return ()
@@ -284,18 +283,16 @@ DWC NOTE: Why is the time even used? All messages get the same time?
> Nothing -> do
> r <- openInput devId
> case r of
-> Right e -> reportError "pollMIDI" e >> return Nothing
-> Left s -> addPort inPort (idid, s) >> input s
+> Left e -> reportError "pollMIDI" e >> return Nothing
+> Right s -> addPort inPort (idid, s) >> input s
> Just s -> input s
> where
> input :: PMStream -> IO (Maybe (Time, [Message]))
> input s = do
> e <- readEvents s
> case e of
-> Right e -> if e == NoError
-> then return Nothing
-> else reportError "pollMIDI" e >> return Nothing
-> Left l -> do
+> Left e -> reportError "pollMIDI" e >> return Nothing
+> Right l -> do
> now <- getTimeNow
> case mapMaybe (msgToMidi . decodeMsg . message) l of
> [] -> return Nothing
@@ -409,8 +406,8 @@ use one and when to use the other.
> midiOutRealTime' odid@(OutputDeviceID devId) = do
> s <- openOutput devId 1
> case s of
-> Right e -> reportError "Unable to open output device in midiOutRealTime'" e >> return Nothing
-> Left s -> do
+> Left e -> reportError "Unable to open output device in midiOutRealTime'" e >> return Nothing
+> Right s -> do
> addPort outPort (odid, s)
> return $ Just (process odid, finalize odid)
> where
@@ -427,22 +424,22 @@ use one and when to use the other.
> writeMsg s t m = do
> e <- writeShort s (PMEvent m (round (t * 1e3)))
> case e of
-> NoError -> return ()
-> _ -> reportError "midiOutRealTime'" e
+> Left e' -> reportError "midiOutRealTime'" e'
+> Right _ -> return ()
> finalize odid = do
> s <- lookupPort outPort odid
-> e <- maybe (return NoError) close s
+> e <- maybe (return (Right NoError'NoData)) close s
> case e of
-> NoError -> return ()
-> _ -> reportError "midiOutRealTime'" e
+> Left e' -> reportError "midiOutRealTime'" e'
+> Right _ -> return ()
> midiOutRealTime :: OutputDeviceID -> IO (Maybe ((Time, Message) -> IO (), IO ()))
> midiOutRealTime odid@(OutputDeviceID devId) = do
> s <- openOutput devId 1
> case s of
-> Right e -> reportError "outputMidi" e >> return Nothing
-> Left s -> do
+> Left e -> reportError "outputMidi" e >> return Nothing
+> Right s -> do
> ch <- atomically newTChan
> wait <- newEmptyMVar
> fin <- newEmptyMVar
@@ -492,9 +489,9 @@ use one and when to use the other.
> writeMsg t m = do
> e <- writeShort s (PMEvent m (round (t * 1e3)))
> case e of
-> NoError -> return False
-> BufferOverflow -> putStrLn "overflow" >> threadDelay 10000 >> writeMsg t m
-> _ -> reportError "outputMidi" e >> return True
+> Left BufferOverflow -> putStrLn "overflow" >> threadDelay 10000 >> writeMsg t m
+> Left e' -> reportError "outputMidi" e' >> return True
+> Right _ -> return False
---------------------
@@ -624,8 +621,8 @@ A conversion function from PortMidi PMMsgs to Codec.Midi Messages.
> midiInRealTime device callback = do
> r <- openInput device
> case r of
-> Right e -> reportError "midiInRealTime" e >> return Nothing
-> Left s -> do
+> Left e -> reportError "midiInRealTime" e >> return Nothing
+> Right s -> do
> fin <- newEmptyMVar
> forkIO (loop Nothing s fin)
> return (Just (putMVar fin () >> putMVar fin ()))
@@ -638,13 +635,11 @@ A conversion function from PortMidi PMMsgs to Codec.Midi Messages.
> Nothing -> do
> e <- readEvents s
> case e of
-> Right e -> if e == NoError
-> then threadDelay 1000 >> loop start s fin
-> else do
+> Left e -> do
> reportError "midiInRealTime" e
> callback (t, TrackEnd)
> return ()
-> Left l -> do
+> Right l -> do
> t <- getTimeNow
> sendEvts start t l
> where
diff --git a/Euterpea/Music.lhs b/Euterpea/Music.lhs
index b31e33f..3dd0fa7 100755
--- a/Euterpea/Music.lhs
+++ b/Euterpea/Music.lhs
@@ -338,10 +338,18 @@ pitch 127 = (G,9)
> dur (Modify (Tempo r) m) = dur m / r
> dur (Modify _ m) = dur m
+Update as of Euterpea 2.0.7: the cut and remove functions
+previously used to permit zero-duration notes. This can cause
+some bad behavior with some synthesizers. The Note cases have
+been re-written to turn zero-duration notes into rests.
+These functions will still introduce zero-duration rests.
+To remove all zero duration values, use removeZeros.
+
> cut :: Dur -> Music a -> Music a
> cut d m | d <= 0 = rest 0
-> cut d (Prim (Note oldD p)) = note (min oldD d) p
-> cut d (Prim (Rest oldD)) = rest (min oldD d)
+> cut d (Prim (Note oldD p)) = let d' = max (min oldD d) 0
+> in if d'>0 then note d' p else rest 0
+> cut d (Prim (Rest oldD)) = rest (max (min oldD d) 0)
> cut d (m1 :=: m2) = cut d m1 :=: cut d m2
> cut d (m1 :+: m2) = let m'1 = cut d m1
> m'2 = cut (d - dur m'1) m2
@@ -349,10 +357,10 @@ pitch 127 = (G,9)
> cut d (Modify (Tempo r) m) = tempo r (cut (d*r) m)
> cut d (Modify c m) = Modify c (cut d m)
-
> remove :: Dur -> Music a -> Music a
> remove d m | d <= 0 = m
-> remove d (Prim (Note oldD p)) = note (max (oldD-d) 0) p
+> remove d (Prim (Note oldD p)) = let d' = max (oldD-d) 0
+> in if d'>0 then note d' p else rest 0
> remove d (Prim (Rest oldD)) = rest (max (oldD-d) 0)
> remove d (m1 :=: m2) = remove d m1 :=: remove d m2
> remove d (m1 :+: m2) = let m'1 = remove d m1
@@ -383,6 +391,7 @@ pitch 127 = (G,9)
> (m1, m2) -> m1 :=: m2
> removeZeros (Modify c m) = Modify c (removeZeros m)
+
> type LazyDur = [Dur]
> durL :: Music a -> LazyDur
> durL m@(Prim _) = [dur m]
diff --git a/ReadMe.txt b/ReadMe.txt
index af2a7d5..0848f11 100755
--- a/ReadMe.txt
+++ b/ReadMe.txt
@@ -1,5 +1,5 @@
-Version 2.0.5
-Last modified: 26-June-2018
+Version 2.0.7
+Last modified: 14-May-2019
Website: http://www.euterpea.com
_____ _
| ___| | |