midi-util 0.1 → 0.1.1
raw patch · 2 files changed
+34/−5 lines, 2 files
Files
- midi-util.cabal +2/−2
- src/Sound/MIDI/Util.hs +32/−3
midi-util.cabal view
@@ -1,5 +1,5 @@ name: midi-util-version: 0.1+version: 0.1.1 synopsis: Utility functions for processing MIDI files description: Common high-level tasks when processing MIDI files.@@ -18,7 +18,7 @@ license-file: LICENSE homepage: http://github.com/mtolly/midi-util bug-reports: http://github.com/mtolly/midi-util/issues-stability: Unstable; not thoroughly tested yet!+stability: Seems to work, passes a few tests library exposed-modules:
src/Sound/MIDI/Util.hs view
@@ -14,10 +14,11 @@ -- * Tempos , readTempo, showTempo , makeTempo, applyTempo, unapplyTempo, applyTempoTrack, unapplyTempoTrack-, TempoMap, makeTempoMap, applyTempoMap, unapplyTempoMap+, TempoMap, makeTempoMap, tempoMapFromBPS, tempoMapToBPS, applyTempoMap, unapplyTempoMap -- * Measures and time signatures , readSignature, showSignature , MeasureMap, MeasureBeats, MeasureMode(..), measures, makeMeasureMap+, measureMapFromLengths, measureMapToLengths , applyMeasureMap, unapplyMeasureMap -- * Track names , trackName, setTrackName, readTrackName, showTrackName@@ -180,14 +181,28 @@ -- | Converts between positions in musical time and real time. newtype TempoMap = TempoMap (Map.Map (DoubleKey Beats Seconds) BPS)+ deriving (Eq, Ord) +instance Show TempoMap where+ showsPrec p = showsPrec p . tempoMapToBPS+ makeTempoMap :: RTB.T Beats E.T -> TempoMap-makeTempoMap = TempoMap . Map.fromAscList . go 0 0 2 . RTB.mapMaybe readTempo where+makeTempoMap = tempoMapFromBPS . RTB.mapMaybe readTempo++tempoMapFromBPS :: RTB.T Beats BPS -> TempoMap+tempoMapFromBPS = TempoMap . Map.fromAscList . go 0 0 2 where go :: Beats -> Seconds -> BPS -> RTB.T Beats BPS -> [(DoubleKey Beats Seconds, BPS)] go b s bps rtb = (DoubleKey b s, bps) : case RTB.viewL rtb of Nothing -> [] Just ((db, bps'), rtb') -> go (b + db) (s + applyTempo bps db) bps' rtb' +tempoMapToBPS :: TempoMap -> RTB.T Beats BPS+tempoMapToBPS (TempoMap m) = let+ f (DoubleKey bts _, bps) = (bts, bps)+ f _ = error+ "Sound.MIDI.Util.tempoMapToBPS: internal error! TempoMap key wasn't DoubleKey"+ in RTB.fromAbsoluteEventList $ ATB.fromPairList $ map f $ Map.toAscList m+ applyTempoMap :: TempoMap -> Beats -> Seconds applyTempoMap (TempoMap tm) bts = case Map.lookupLE (LookupA bts) tm of Just (DoubleKey b s, bps) -> s + applyTempo bps (bts - b)@@ -213,7 +228,11 @@ -- | Converts between a simple beat position, -- and a measure offset plus a beat position. newtype MeasureMap = MeasureMap (Map.Map (DoubleKey Beats Int) Beats)+ deriving (Eq, Ord) +instance Show MeasureMap where+ showsPrec p = showsPrec p . measureMapToLengths+ -- | A number of measures (starting from 0), and an offset within that measure -- (also starting from 0). type MeasureBeats = (Int, Beats)@@ -231,7 +250,10 @@ -- | Computes the measure map, given the tempo track from the MIDI. makeMeasureMap :: MeasureMode -> RTB.T Beats E.T -> MeasureMap-makeMeasureMap mm = MeasureMap . Map.fromAscList . go 0 0 4 . RTB.mapMaybe readSignature where+makeMeasureMap mm = measureMapFromLengths mm . RTB.mapMaybe readSignature++measureMapFromLengths :: MeasureMode -> RTB.T Beats Beats -> MeasureMap+measureMapFromLengths mm = MeasureMap . Map.fromAscList . go 0 0 4 where go :: Beats -> Int -> Beats -> RTB.T Beats Beats -> [(DoubleKey Beats Int, Beats)] go b m tsig rtb = (DoubleKey b m, tsig) : case RTB.viewL rtb of Nothing -> []@@ -250,6 +272,13 @@ leftoverBeats = leftoverMsrs * tsig truncated = (DoubleKey (b + measures dm tsig) (m + dm), leftoverBeats) in truncated : go (b + db) (m + dm + 1) tsig' rtb'++measureMapToLengths :: MeasureMap -> RTB.T Beats Beats+measureMapToLengths (MeasureMap m) = let+ f (DoubleKey bts _, len) = (bts, len)+ f _ = error+ "Sound.MIDI.Util.measureMapToLengths: internal error! MeasureMap key wasn't DoubleKey"+ in RTB.fromAbsoluteEventList $ ATB.fromPairList $ map f $ Map.toAscList m -- | Uses the measure map to compute which measure a beat position is in. applyMeasureMap :: MeasureMap -> Beats -> MeasureBeats