diff --git a/haskore.cabal b/haskore.cabal --- a/haskore.cabal +++ b/haskore.cabal @@ -1,5 +1,5 @@ Name: haskore -Version: 0.2.0.2 +Version: 0.2.0.3 License: GPL License-File: LICENSE Author: Paul Hudak , Henning Thielemann @@ -39,7 +39,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/haskore/revised/core - tag: 0.2.0.2 + tag: 0.2.0.3 Flag splitBase description: Choose the new smaller, split-up base package. @@ -51,13 +51,13 @@ Library Build-Depends: markov-chain >=0.0.1 && <0.1, - midi >=0.1.1 && <0.2, + midi >=0.2 && <0.3, event-list >=0.1 && <0.2, non-negative >=0.1 && <0.2, data-accessor >=0.2 && <0.3, utility-ht >=0.0.3 && <0.1, - transformers >=0.0.1 && <0.3, - bytestring >=0.9 && <0.10, + transformers >=0.0.1 && <0.4, + bytestring >=0.9 && <0.11, haskell-src >=1.0 && <1.1, parsec >=2.1 && <3.2 @@ -67,7 +67,7 @@ array >=0.1 && <1.0, containers >=0.1 && <1.0, random >=1.0 && <2.0, - process >=1.0 && <1.1 + process >=1.0 && <1.2 Else Build-Depends: base >= 1.0 && < 2, diff --git a/src/Haskore/Example/SelfSim.lhs b/src/Haskore/Example/SelfSim.lhs --- a/src/Haskore/Example/SelfSim.lhs +++ b/src/Haskore/Example/SelfSim.lhs @@ -31,10 +31,10 @@ > addmult pds iss = zipWith addmult' pds iss > where addmult' (p,d) (i,s) = (p+i,d*s) > -> simFringe :: (Num a) => a -> Pat -> [SNote] +> simFringe :: (Num a, Eq a) => a -> Pat -> [SNote] > simFringe n pat = fringe n (Cl [(0,0)] (sim pat)) > -> fringe :: (Num a) => a -> Cluster -> [SNote] +> fringe :: (Num a, Eq a) => a -> Cluster -> [SNote] > fringe 0 (Cl n _) = [n] > fringe m (Cl _ cls) = concatMap (fringe (m-1)) cls > diff --git a/src/Haskore/Interface/MIDI/Note.lhs b/src/Haskore/Interface/MIDI/Note.lhs --- a/src/Haskore/Interface/MIDI/Note.lhs +++ b/src/Haskore/Interface/MIDI/Note.lhs @@ -92,8 +92,9 @@ > dyn -> Rational -> Voice.Velocity > velocityFromStd dyn vel = > Voice.toVelocity $ -> round (limit (0, Voice.maximumVelocity) -> (dyn * fromRational vel * Voice.normalVelocity)) +> round (limit (0, fromIntegral (Voice.fromVelocity Voice.maximumVelocity)) +> (dyn * fromRational vel * +> fromIntegral (Voice.fromVelocity Voice.normalVelocity))) > pitchFromStd :: Pitch.Relative -> Pitch.T -> Voice.Pitch > pitchFromStd trans p = @@ -146,7 +147,8 @@ > velocityToStd :: Fractional a => Voice.Velocity -> a > velocityToStd x = -> fromIntegral (Voice.fromVelocity x) / Voice.normalVelocity +> fromIntegral (Voice.fromVelocity x) / +> fromIntegral (Voice.fromVelocity Voice.normalVelocity) > pitchToStd :: Voice.Pitch -> Pitch.T > pitchToStd p = Pitch.fromInt (Voice.subtractPitch Voice.zeroKey p) diff --git a/src/Haskore/Interface/MIDI/Read.lhs b/src/Haskore/Interface/MIDI/Read.lhs --- a/src/Haskore/Interface/MIDI/Read.lhs +++ b/src/Haskore/Interface/MIDI/Read.lhs @@ -18,7 +18,7 @@ > import qualified Sound.MIDI.Message.Channel.Voice as Voice > import qualified Sound.MIDI.General as GeneralMidi > import Sound.MIDI.File.Event (T(MIDIEvent, MetaEvent), ) -> import Sound.MIDI.File.Event.Meta (T(SetTempo), defltST, defltDurT, ) +> import Sound.MIDI.File.Event.Meta (T(SetTempo), defltTempo, ) > import Sound.MIDI.Message.Channel (Body(Voice), Channel, ) > import Sound.MIDI.Message.Channel.Voice (Program, ) > @@ -86,14 +86,14 @@ > Context.T time dyn note > context = > Context.setPlayer DefltPf.player $ -> Context.setDur 1 $ +> Context.setDur 2 $ > DefltPf.context > retrieveTracks :: MidiFile.T -> [[MidiMusic.T]] > retrieveTracks (MidiFile.Cons _ d trks) = > let cpm = makeCPM trks > in map (map (Music.mapNote MidiNote.toGMNote -> . readTrack (tDiv d) cpm . fst) +> . readTrack (MidiFile.ticksPerQuarterNote d) cpm . fst) > . prepareTrack) trks > type ChannelProgramMap = Map ChannelMsg.Channel Voice.Program @@ -102,13 +102,13 @@ > Division -> ChannelProgramMap -> Track -> Music.T MidiNote.T > readFullTrack dv cpm = > let readTempoTrack (t,r) = -> changeTempo r (readTrack (tDiv dv) cpm t) +> changeTempo r (readTrack (MidiFile.ticksPerQuarterNote dv) cpm t) > in Optimization.all . line . map readTempoTrack . prepareTrack > prepareTrack :: Track -> [(RichTrack, DurRatio)] > prepareTrack = -> map (extractTempo defltST) . segmentBeforeSetTempo . -> mergeNotes defltST . moveTempoToHead +> map (extractTempo defltTempo) . segmentBeforeSetTempo . +> mergeNotes defltTempo . moveTempoToHead \end{haskelllisting} @@ -145,15 +145,6 @@ \end{haskelllisting} -Translate \code{Divisions} into the number of ticks per quarter note. -\begin{haskelllisting} - -> tDiv :: Division -> Tempo -> tDiv (Ticks x) = x -> tDiv (SMPTE _ _) = error "Sorry, SMPTE not yet implemented." - -\end{haskelllisting} - \code{moveTempoToHead} gets the information that occurs at the beginning of the piece: the default tempo and the default key signature. A \code{SetTempo} in the middle of the piece @@ -177,7 +168,7 @@ > getHeadTempo :: Track -> (Tempo, Track) > getHeadTempo es = > maybe -> (defltST, es) +> (defltTempo, es) > (\ ~(me,rest) -> > case me of > MetaEvent (SetTempo tempo) -> (tempo, rest) @@ -244,28 +235,31 @@ > readTrack :: Tempo -> ChannelProgramMap -> > RichTrack -> Music.T MidiNote.T -> readTrack ticks cpm = -> PfBE.toMusic . trackTimeToStd ticks +> readTrack ticksPerQN cpm = +> PfBE.toMusic . trackTimeToStd ticksPerQN > . richTrackToBE . applyProgChanges cpm \end{haskelllisting} -Take the division in ticks and a duration value and +Take the division in ticks per quarterNote and +a duration value in number of ticks and converts that to a common note duration (such as quarter note, eighth note, etc.). \begin{haskelllisting} > fromTicks :: Tempo -> ElapsedTime -> Dur -> fromTicks ticks d = -> toInteger d %+ (toInteger ticks * toInteger defltDurT) +> fromTicks ticksPerQN d = +> toInteger d %+ (toInteger ticksPerQN * quarter) - d %+ (fromIntegral ticks * defltDurT)) +> quarter :: Integer +> quarter = 4 > trackTimeToStd :: Tempo -> > PfBE.T ElapsedTime note -> PfBE.T Dur note -> trackTimeToStd ticks = -> TimeList.mapBody (\(PfBE.Event d n) -> PfBE.Event (fromTicks ticks d) n) -> . TimeList.mapTime (fromTicks ticks) +> trackTimeToStd ticksPerQN = +> TimeList.mapBody +> (\(PfBE.Event d n) -> PfBE.Event (fromTicks ticksPerQN d) n) +> . TimeList.mapTime (fromTicks ticksPerQN) \end{haskelllisting} diff --git a/src/Haskore/Interface/MIDI/Write.lhs b/src/Haskore/Interface/MIDI/Write.lhs --- a/src/Haskore/Interface/MIDI/Write.lhs +++ b/src/Haskore/Interface/MIDI/Write.lhs @@ -309,7 +309,13 @@ with this order of execution it may be that notes with equal duration can have slightly different durations in the MIDI file. On the other hand -small rests between notes or small overlappings are avoided. +small rests between notes or small overlappings are avoided.% +\footnote{It would be better to define \code{rate = 4*division}, +since this would map a quarter note to \code{division} ticks, +as stated by the MIDI File specification. +For compensation \code{SetTempo} could be set to 250000, +meaning a quarter second per quarter note, +or one second per whole note.} We manage a \module{Map} which stores the active program number of each MIDI channel. @@ -335,7 +341,7 @@ > setTempo :: (MidiFile.ElapsedTime, MidiFileEvent.T) > setTempo = > (0, MidiFileEvent.MetaEvent -> (MetaEvent.SetTempo MetaEvent.defltST)) +> (MetaEvent.SetTempo MetaEvent.defltTempo)) > > getChanProg :: MidiNote.T -> (ChannelMsg.Channel, Voice.Program) > getChanProg note = (MidiNote.channel note, MidiNote.program note) @@ -364,7 +370,7 @@ > > rate :: (Num a) => a > rate = 2 * fromIntegral division -> -- ^ compensate defltDurT +> -- ^ would be correctly 4 and the setTempo should be 250000 \end{haskelllisting} diff --git a/src/Test/Suite.lhs b/src/Test/Suite.lhs --- a/src/Test/Suite.lhs +++ b/src/Test/Suite.lhs @@ -61,8 +61,11 @@ > import qualified Sound.MIDI.File as MidiFile > import qualified Sound.MIDI.File.Save as SaveMidi > import qualified Sound.MIDI.File.Load as LoadMidi -> import qualified Sound.MIDI.General as GeneralMidi > import qualified Sound.MIDI.Parser.Report as MidiReport +> import qualified Sound.MIDI.File.Event as MidiEvent +> import qualified Sound.MIDI.File.Event.Meta as MetaEvent +> import qualified Sound.MIDI.Message.Channel as ChannelMsg +> import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg > import qualified Haskore.Interface.CSound.Orchestra as CSOrchestra > import qualified Haskore.Interface.CSound.Score as CSScore @@ -83,11 +86,11 @@ > import qualified Test.QuickCheck.Batch as QCB > import qualified Test.HUnit as HUnit > import qualified Test.HUnit.Text as HUnitText -> import System.Random (Random, ) > import qualified Data.Accessor.Basic as Accessor > import System.Cmd (system, ) +> import qualified System.Exit as Exit > import qualified Data.ByteString.Lazy as B import Debug.Trace (trace) @@ -255,7 +258,8 @@ > testReadMidiPure :: MidiFile.T -> HUnit.Assertion > testReadMidiPure midiFile = > do -> diffIA (MidiFile.showLines (MidiFile.sortEvents midiFile)) +> _ <- diffIA +> (MidiFile.showLines (MidiFile.sortEvents midiFile)) > (MidiFile.showLines (MidiFile.sortEvents > (writeMusic (ReadMidi.toGMMusic midiFile)))) > HUnit.assertEqual @@ -264,10 +268,60 @@ > (MidiFile.sortEvents (writeMusic (ReadMidi.toGMMusic midiFile))) > setInstrMidi :: MidiFile.T -> setInstrMidi = (Render.generalMidi -> (MidiMusic.fromMelodyNullAttr MidiMusic.Marimba (c 0 qn ()) +:+ -> MidiMusic.fromMelodyNullAttr MidiMusic.Xylophone (e 0 qn ()))) +> setInstrMidi = +> Render.generalMidi $ +> MidiMusic.fromMelodyNullAttr MidiMusic.Marimba (c 0 qn ()) +:+ +> MidiMusic.fromMelodyNullAttr MidiMusic.Xylophone (e 0 qn ()) +> midiPitch :: Int -> VoiceMsg.Pitch +> midiPitch = VoiceMsg.toPitch + +> channel :: Int -> ChannelMsg.Channel +> channel = ChannelMsg.toChannel + +> vel :: VoiceMsg.Velocity +> vel = VoiceMsg.normalVelocity + +> voiceMsg :: VoiceMsg.T -> MidiEvent.T +> voiceMsg msg = +> MidiEvent.MIDIEvent $ ChannelMsg.Cons (channel 0) $ +> ChannelMsg.Voice $ msg + +> noteOn :: VoiceMsg.Pitch -> MidiEvent.T +> noteOn p = +> voiceMsg $ VoiceMsg.NoteOn p vel + +> noteOff :: VoiceMsg.Pitch -> MidiEvent.T +> noteOff p = +> voiceMsg $ VoiceMsg.NoteOff p vel + +> program :: VoiceMsg.Program -> MidiEvent.T +> program pgm = +> voiceMsg $ VoiceMsg.ProgramChange pgm + +> setTempo :: NonNegW.Int -> MidiEvent.T +> setTempo = MidiEvent.MetaEvent . MetaEvent.SetTempo + +> setTempoMidi :: MidiFile.T +> setTempoMidi = +> MidiFile.Cons MidiFile.Mixed (MidiFile.Ticks 12) +> [TimeList.cons 0 (program (VoiceMsg.toProgram 0)) $ +> TimeList.cons 0 (setTempo 1000000) $ +> TimeList.cons 0 (noteOn (midiPitch 60)) $ +> TimeList.cons 12 (noteOff (midiPitch 60)) $ +> TimeList.cons 0 (setTempo 500000) $ +> TimeList.cons 0 (noteOn (midiPitch 60)) $ +> TimeList.cons 24 (noteOff (midiPitch 60)) $ +> TimeList.cons 0 (setTempo 2000000) $ +> TimeList.cons 0 (noteOn (midiPitch 60)) $ +> TimeList.cons 12 (noteOff (midiPitch 60)) $ +> TimeList.empty] + +> setTempoMusic :: +> (InstrMap.ChannelTable MidiMusic.Instrument, +> Context.T NonNegW.Float Float MidiMusic.Note, MidiMusic.T) +> setTempoMusic = ReadMidi.toGMMusic setTempoMidi + The velocities of the original tests were too strong. MIDI spec says that a non-velocity-sensitive instrument gets velocity value 64. @@ -408,11 +462,11 @@ > scoName = csoundDir++name++".sco" > in do > origOrchestra <- readFile orcName -> diffIA (sortLines origOrchestra) -> (sortLines $ CSOrchestra.toString newOrchestra) +> _ <- diffIA (sortLines origOrchestra) +> (sortLines $ CSOrchestra.toString newOrchestra) > origScore <- readFile scoName -> diffIA (sortLines origScore) -> (sortLines $ CSScore.toString newScore) +> _ <- diffIA (sortLines origScore) +> (sortLines $ CSScore.toString newScore) > return () Compare with several files former versions have produced. @@ -947,9 +1001,14 @@ > "song = MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano $ " ++ > MusicFormat.prettyMelody > (StdMelody.fromMelodyNullAttr ctrlMusic)]) -> if False -> then system ("echo 'main\n:q' | hugs -98 -P"++hugsPath++" GeneratedTest") -> else system ("ghc -e main -i"++hugsPath++" GeneratedTest") +> exitCode <- +> if False +> then system ("echo 'main\n:q' | hugs -98 -P"++hugsPath++" GeneratedTest") +> else system ("ghc -e main -i"++hugsPath++" GeneratedTest") +> HUnit.assertEqual +> "running Haskell interpreter" +> exitCode +> Exit.ExitSuccess > midi <- B.readFile "test.mid" > let expectedMidi = > SaveMidi.toByteString (Render.generalMidi (withPiano ctrlMusic))