PlayK.lhs

Special playback functions
Donya Quick
Last modified: 01-July-2015

Kulitta-specific playback functions.

Most of these functions are slight modifications of Euterpea's
functions in ExperimentalPlay and MidiIO.

> module PlayK where
> import Euterpea
> import Codec.Midi
> import Sound.PortMidi
> import System.IO.Unsafe (unsafePerformIO)
> import Euterpea.IO.MIDI.MidiIO
> import System.Directory


Play a MIDI file to a user-specified device. Unlike the regular play function,
this version also checks whether the file exists to avoid crashing the calling
program. If the file doesn't exist, an error message will be printed.

> play' fp devID = do
>   x <- tryImportFile fp 
>   seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return ()
>                     Right m -> playM' devID m

> playX fp devID chanOffset vol = do
>   x <- tryImportFile fp 
>   seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return ()
>                     Right m -> playM' devID (trackMod chanOffset vol m)

> playXS fp devID chanOffset vol speed = do
>   x <- tryImportFile fp 
>   seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return ()
>                     Right m -> do 
>                         let mx = fromMidi m
>                         putStrLn ("Playback speed:  "++show speed)
>                         putStrLn ("Playback volume: "++show vol)
>                         playM' devID (trackMod chanOffset vol $ toMidi $ perform $ tempo (toRational speed) mx)

> writeX fp m chanOffset = 
>   let x = trackMod 0 (-1) $ toMidi m 
>   in  exportMidiFile fp x


The trackMod function takes a channel offset, x, and a list of tick-stamped messages
and offsets the track numbers by x amount. The purpose of this was really a single 
use case: running the Kulitta GUI alongside other programs that used tracks 1 through
(x-1) so that Kulitta's playback would not "step on the toes" of the other programs'
playback. 

> trackMod x vol m = 
>     let t = tracks m
>         t' = map (map (trackMod' x vol)) t 
>     in  m{tracks = t'} 

> trackMod' :: Channel -> Double -> (Ticks, Message) -> (Ticks, Message)
> trackMod' x vol (a, NoteOff c k v) = (a, NoteOff (c+x) k (if vol <0 then v else volMod v vol))
> trackMod' x vol (a, NoteOn c k v) = (a, NoteOn (c+x) k (if vol <0 then v else volMod v vol))
> trackMod' x vol (a, ProgramChange c p) = (a, ProgramChange (c+x) p)
> trackMod' x vol (a, ControlChange c v1 v2) = (a, ControlChange (c+x) v1 v2)
> trackMod' x vol (a,v) = (a,v)

> volMod v vol = floor(fromIntegral v * vol)

> playF fp fmid devID = do
>   x <- tryImportFile fp 
>   seq x $ case x of Left err -> putStrLn ("Error: "++err) >> return ()
>                     Right m -> playM' devID (fmid m)

Code to check whether the file exists:

> tryImportFile fp = do
>     let theDir = getDir fp
>         theFile = getFile fp
>     files <- getDirectoryContents theDir
>     if elem theFile files then importFile fp >>= return 
>         else return $ Left ("File "++fp ++ " does not exist, so it cannot be played!") where
>         getDir fp = reverse $ dropWhile (not.(`elem` "/\\")) $ reverse fp
>         getFile fp = drop (length $ getDir fp) fp

=====================

DATA MANIPULATION FUNCTIONS

For playback, it's useful to be able to set the volume on some systems.

> setVol :: Int -> Music Pitch -> Music1
> setVol v = mMap (\p -> (p, [Volume v])) 

> setVol1 :: Int -> Music1 -> Music1
> setVol1 v = mMap (\(p,nas) -> (p, Volume v : filter f nas)) where
>     f (Volume v) = False
>     f _ = True

Sometimes it is also useful to play to devices with instrument
information stripped (i.e. sending to a single synth such that 
only one channel can be used).

> stripInstrs :: Music a -> Music a
> stripInstrs (a :+: b) = stripInstrs a :+: stripInstrs b
> stripInstrs (a :=: b) = stripInstrs a :=: stripInstrs b
> stripInstrs (Prim p) = Prim p
> stripInstrs (Modify (Instrument i) m) = stripInstrs m
> stripInstrs (Modify c m) = Modify c $ stripInstrs m

> m2m :: (Music1 -> Music1) -> Midi -> Midi
> m2m fm1 midi = 
>     let  m1 = fromMidi midi
>     in   toMidi $ perform $ fm1 m1

> ch1 :: Int -> Midi -> Midi
> ch1 v = if v <=0 then m2m stripInstrs
>         else m2m (setVol1 v . stripInstrs)