\subsection{Conversion functions with default settings}
\seclabel{fancy-performance}
{\small
\begin{haskelllisting}
> module Haskore.Performance.Fancy where
> import qualified Haskore.Music as Music
> import qualified Haskore.Performance as Performance
> import qualified Haskore.Performance.Context as Context
> import qualified Haskore.Performance.Player as Player
> import qualified Haskore.Performance.Default as DefltPf
> import Haskore.Performance (eventDur, )
>
>
> import qualified Data.EventList.Relative.MixedTime as TimeListPad
> import qualified Data.EventList.Relative.BodyTime as BodyTimeList
> import Control.Monad.Trans.State (state, evalState, )
> import Control.Monad.Trans.Reader (local, )
>
> import qualified Numeric.NonNegative.Class as NonNeg
> import qualified Numeric.NonNegative.Wrapper as NonNegW
> import Prelude hiding (map)
\end{haskelllisting}
}
\begin{figure}
{\small
\begin{haskelllisting}
> player :: (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
> Player.T time dyn note
> player = map "Fancy"
>
>
> map ::
> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
> String -> Player.T time dyn note
> map pname =
> Performance.PlayerCons {
> Performance.name = pname,
> Performance.playNote = DefltPf.playNote,
> Performance.interpretPhrase = fancyInterpretPhrase,
> Performance.notatePlayer = DefltPf.notatePlayer ()
> }
>
> processPerformance :: (Num time) =>
> (time ->
> (time -> time -> time,
> time -> Performance.Event time dyn note -> Performance.Event time dyn note,
> time)) ->
> (Performance.PaddedWithRests time dyn note, time) ->
> (Performance.PaddedWithRests time dyn note, time)
> processPerformance f (pf, dur) =
> let (fTime, fEvent, newDur) = f dur
> procPf =
> flip evalState 0 .
> BodyTimeList.mapM
> (\dt -> state $ \t -> (fTime t dt, t+dt))
> (\ev -> state $ \t -> (fmap (fEvent t) ev, t))
> in (TimeListPad.mapTimeTail procPf pf, newDur)
>
> fancyInterpretDynamic ::
> (Fractional time, Real time, Fractional dyn) =>
> Music.Dynamic -> Performance.Monad time dyn note -> Performance.Monad time dyn note
> fancyInterpretDynamic dyn =
> let loud x = local (Performance.updateDynamics (fromRational x *))
> inflate add x dur =
> let r = fromRational x / realToFrac dur
> in (const id,
> \t -> Player.changeVelocity (add (realToFrac t * r)),
> dur)
> in case dyn of
> Music.Accent x -> Player.accent x
> Music.Loudness x -> loud x
> Music.Crescendo x -> fmap (processPerformance (inflate (+) x))
> Music.Diminuendo x -> fmap (processPerformance (inflate subtract x))
>
>
>
> fancyInterpretTempo :: (Fractional time, Real time) =>
> Music.Tempo -> Performance.Monad time dyn note -> Performance.Monad time dyn note
> fancyInterpretTempo tmp =
> let stretch add x dur =
> let x' = fromRational x
> r = x' / dur
> fac t dt = add 1 (r * (2*t + dt))
> in (\t dt -> dt * fac t dt,
> \t (e@Performance.Event {eventDur = d}) ->
> e{eventDur = d * fac t d },
> dur * add 1 x')
> in case tmp of
> Music.Ritardando x -> fmap (processPerformance (stretch (+) x))
> Music.Accelerando x -> fmap (processPerformance (stretch () x))
>
> fancyInterpretArticulation :: (NonNeg.C time, Fractional time) =>
> Music.Articulation -> Performance.Monad time dyn note -> Performance.Monad time dyn note
> fancyInterpretArticulation art =
> case art of
> Music.Staccato x -> Player.staccatoAbs x
> Music.Legato x -> Player.legatoAbs x
> Music.Slurred x -> Player.slurredAbs x
> _ -> id
>
> fancyInterpretOrnament :: (Fractional time, Real time) =>
> Music.Ornament -> Performance.Monad time dyn note -> Performance.Monad time dyn note
> fancyInterpretOrnament _orn = id
>
>
> fancyInterpretPhrase ::
> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
> Performance.PhraseFun time dyn note
> fancyInterpretPhrase pa =
> case pa of
> Music.Dyn dyn -> fancyInterpretDynamic dyn
> Music.Tmp tmp -> fancyInterpretTempo tmp
> Music.Art art -> fancyInterpretArticulation art
> Music.Orn orn -> fancyInterpretOrnament orn
> context ::
> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
> Context.T time dyn note
> context = DefltPf.context {Performance.contextPlayer = player}
\end{haskelllisting}
}
\caption{Definition of Player \function{Fancy.player}.}
\figlabel{fancy-Player}
\end{figure}
{\small
\begin{haskelllisting}
> fromMusic ::
> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
> Music.T note -> Performance.T time dyn note
> fromMusic =
> Performance.fromMusic map context
>
> fromMusicModifyContext ::
> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
> (Context.T time dyn note -> Context.T time dyn note) ->
> Music.T note ->
> Performance.T time dyn note
> fromMusicModifyContext update =
> Performance.fromMusic
> map
> (update context)
>
> floatFromMusic :: (Ord note) =>
> Music.T note -> Performance.T NonNegW.Float Float note
> floatFromMusic = fromMusic
>
> paddedFromMusic ::
> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
> Music.T note -> Performance.Padded time dyn note
> paddedFromMusic =
> Performance.paddedFromMusic map context
>
> doublePaddedFromMusic ::
> (Ord note) =>
> Music.T note -> Performance.Padded NonNegW.Double Double note
> doublePaddedFromMusic =
> Performance.paddedFromMusic map context
>
> paddedFromMusicModifyContext ::
> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
> (Context.T time dyn note -> Context.T time dyn note) ->
> Music.T note ->
> Performance.T time dyn note
> paddedFromMusicModifyContext update =
> Performance.fromMusic
> map
> (update context)
\end{haskelllisting}
}
% fromRhythmicMusic :: (Ord drum, Ord instr, RealFrac time) =>
% RhyMusic.T drum instr -> Performance.T time (RhyMusic.Note drum instr)
% fromRhythmicMusic =
% Performance.fromMusic map context
%
% floatFromRhythmicMusic :: (Ord drum, Ord instr) =>
% RhyMusic.T drum instr -> Performance.T Float (RhyMusic.Note drum instr)
% floatFromRhythmicMusic = fromRhythmicMusic
%
% stateFromRhythmicMusic ::
% (Ord drum, Ord instr, Fractional time, Real time) =>
% (RhyMusic.T drum instr) ->
% ((Performance.T time (RhyMusic.Note drum instr), time),
% Context.T time (RhyMusic.Note drum instr))
% stateFromRhythmicMusic m =
% runState (Performance.monadFromMusic map m) context
% monadFromMusic ::
% (Ord note, RealFrac time) =>
% Music.T note ->
% ((Performance.T time dyn note, time),
% Context.T time dyn note)
% monadFromMusic m =
% runReader (Performance.monadFromMusic map m) context