{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------------- -- | -- Copyright : (c) Hans Hoglund 2012-2014 -- -- License : BSD-style -- -- Maintainer : hans@hanshoglund.se -- Stability : experimental -- Portability : non-portable (TF,GNTD) -- -- Provides MIDI import. -- -- /Warning/ Experimental module. -- ------------------------------------------------------------------------------------- module Music.Score.Import.Midi ( IsMidi(..), fromMidi, readMidi, readMidiMaybe, readMidiEither ) where import Music.Pitch.Literal (IsPitch) import Codec.Midi (Midi) import Control.Applicative import Control.Lens import Control.Monad.Plus -- import Control.Reactive hiding (Event) -- import qualified Control.Reactive as R -- import Control.Reactive.Midi import Music.Dynamics.Literal import Music.Pitch.Literal import Music.Score.Articulation import Music.Score.Dynamics import Music.Score.Internal.Export import Music.Score.Harmonics import Music.Score.Part import Music.Score.Pitch import Music.Score.Slide import Music.Score.Text import Music.Score.Ties import Music.Score.Tremolo import Music.Time import qualified Data.Maybe import Data.Map (Map) import qualified Data.Map as Map import qualified Codec.Midi as Midi import qualified Data.List as List import qualified Data.Map as Map import qualified Text.Pretty as Pretty import Data.Monoid import qualified Music.Pitch.Literal as Pitch -- import qualified Data.ByteString.Lazy as ByteString -- | -- This constraint includes all note types that can be constructed from a Midi representation. -- type IsMidi a = ( -- TODO IsPitch a, HasPart' a, Ord (Part a), Enum (Part a), -- HasPitch a, Num (Pitch a), HasTremolo a, HasArticulation a a, Tiable a ) -- -- type SimpleMidi = [[(Time, Bool, Int, Int)]] -- outer: track, inner: channel, time, on/off, pitch, vel -- -- -- Ignore offset velocities (can't represent them) -- -- type SimpleMidi2 = [[(Span, Int, Int)]] -- outer: track, inner: channel, time, pitch, vel -- -- -- -- foo :: SimpleMidi2 -- -- foo = undefined -- -- mapWithIndex :: (Int -> a -> b) -> [a] -> [b] -- mapWithIndex f = zipWith f [0..] -- -- mapWithIndex2 :: (Int -> Int -> a -> b) -> [[a]] -> [b] -- mapWithIndex2 f xss = concat $ zipWith (\m -> zipWith (f m) [0..]) [0..] xss -- -- -- Last time the given key was pressed but not released (non-existant means it is not pressed) -- type ChanMap = Map Int Time -- -- -- | -- -- Convert a score from a Midi representation. -- -- fromMidi :: IsMidi a => Midi -> Score a fromMidi m = undefined -- where -- -- toAspects :: [[Event (Midi.Channel,Midi.Key,Midi.Velocity)]] -> [Event (Part,Int,Int)] -- toAspects = mapWithIndex (\trackN events -> over (mapped.event) (\(s,(ch,key,vel)) -> undefined)) -- -- getMidi :: Midi.Midi -> [[Event (Midi.Channel,Midi.Key,Midi.Velocity)]] -- getMidi (Midi.Midi fileType timeDiv tracks) = id -- $ compress (ticksp timeDiv) -- $ fmap mcatMaybes -- $ fmap snd -- $ fmap (List.mapAccumL g mempty) -- $ fmap mcatMaybes $ over (mapped.mapped) getMsg tracks -- where -- g keyStatus (t,onOff,c,p,v) = -- ( updateKeys onOff p (fromIntegral t) keyStatus -- , (if onOff then Nothing else Just ( -- (Data.Maybe.fromMaybe 0 (Map.lookup (fromIntegral t) keyStatus)<->fromIntegral t,(c,p,60))^.event)) -- ) -- -- TODO also store dynamics in pitch map (to use onset value rather than offset value) -- -- For now just assume 60 -- updateKeys True p t = Map.insert p t -- updateKeys False p _ = Map.delete p -- -- -- Amount to compress time (after initially treating each tick as duration 1) -- ticksp (Midi.TicksPerBeat n) = 1 / fromIntegral n -- ticksp (Midi.TicksPerSecond _ _) = error "fromMidi: Can not parse TickePerSecond-based files" -- -- getMsg (t, Midi.NoteOff c p v) = Just (t,False,c,p,v) -- getMsg (t, Midi.NoteOn c p 0) = Just (t,False,c,p,0) -- getMsg (t, Midi.NoteOn c p v) = Just (t,True,c,p,v) -- -- TODO key pressure -- -- control change -- -- program change -- -- channel pressure -- -- pitch wheel -- -- etc. -- getMsg _ = Nothing -- -- Map each track to a part (scanning for ProgramChange, name etc) -- Subdivide parts based on channels -- Set channel 10 tracks to "percussion" -- Remove all non-used messages (KeyPressure, ChannelPressure, ProgramChange) -- Create reactives from variable values -- Create notes -- Superimpose variable values -- Compose -- Add meta-information -- TODO -- | -- Read a Midi score from a file. Fails if the file could not be read or if a parsing -- error occurs. -- readMidi :: IsMidi a => FilePath -> IO (Score a) readMidi path = fmap (either (\x -> error $ "Could not read MIDI file" ++ x) id) $ readMidiEither path -- | -- Read a Midi score from a file. Fails if the file could not be read, and returns -- @Nothing@ if a parsing error occurs. -- readMidiMaybe :: IsMidi a => FilePath -> IO (Maybe (Score a)) readMidiMaybe path = fmap (either (const Nothing) Just) $ readMidiEither path -- | -- Read a Midi score from a file. Fails if the file could not be read, and returns -- @Left m@ if a parsing error occurs. -- readMidiEither :: IsMidi a => FilePath -> IO (Either String (Score a)) readMidiEither path = fmap (fmap fromMidi) $ Midi.importFile path