The Haskore Tutorial
top back next

4  Interpretation and Performance

 

> module Performance (module Performance, module Basics) -- module Players
>        where
>
> import Basics
> -- import Players

Now that we have defined the structure of musical objects, let us turn to the issue of performance, which we define as a temporally ordered sequence of musical events:  

> type Performance = [Event]
>
> data Event = Event Time IName AbsPitch DurT Volume
>      deriving (Eq,Ord,Show)
>
> type Time      = Float
> type DurT      = Float
> type Volume    = Float

An event is the lowest of our music representations not yet committed to Midi, csound, or the MusicKit. An event Event s i p d v captures the fact that at start time s, instrument i sounds pitch p with volume v for a duration d (where now duration is measured in seconds, rather than beats).

To generate a complete performance of, i.e. give an interpretation to, a musical object, we must know the time to begin the performance, and the proper volume, key and tempo. We must also know what players to use; that is, we need a mapping from the PNames in an abstract musical object to the actual players to be used. (We don't yet need a mapping from abstract INames to instruments, since this is handled in the translation from a performance into, say, Midi, such as defined in Section 6.)

We can thus model a performer as a function perform which maps all of this information and a musical object into a performance:  

> perform :: PMap -> Context -> Music -> Performance
>
> type PMap    = PName -> Player
> type Context = (Time,Player,IName,DurT,Key,Volume)
> type Key     = AbsPitch

  perform pmap c@(t,pl,i,dt,k,v) m =
    case m of
      Note p d nas -> playNote pl c p d nas
      Rest d       -> []
      m1 :+: m2    -> perform pmap c m1 ++ 
                      perform pmap (setTime  c (t+(dur m1)*dt)) m2
      m1 :=: m2    -> merge (perform pmap c m1) (perform pmap c m2)
      Tempo  a b m -> perform pmap (setTempo  c (dt * float b / float a)) m
      Trans  p   m -> perform pmap (setTrans  c     (k+p)) m
      Instr  nm  m -> perform pmap (setInstr  c       nm ) m
      Player nm  m -> perform pmap (setPlayer c (pmap nm)) m
      Phrase pas m -> interpPhrase pl pmap c pas m

 
setTime, setInstr, setTempo, setTrans, and setVolume
have type:  Context -> X -> Context, where X is obvious.

> setTime   (t,pl,i,dt,k,v) t'  = (t',pl,i,dt,k,v) 
> setPlayer (t,pl,i,dt,k,v) pl' = (t,pl',i,dt,k,v)
> setInstr  (t,pl,i,dt,k,v) i'  = (t,pl,i',dt,k,v)
> setTempo  (t,pl,i,dt,k,v) dt' = (t,pl,i,dt',k,v)
> setTrans  (t,pl,i,dt,k,v) k'  = (t,pl,i,dt,k',v)
> setVolume (t,pl,i,dt,k,v) v'  = (t,pl,i,dt,k,v')

getEventTime, getEventInst, getEventPitch, getEventDur, and getEventVol
have type:  Event -> X, where X is obvious 

> getEventTime  (Event t _ _ _ _) = t
> getEventInst  (Event _ i _ _ _) = i
> getEventPitch (Event _ _ p _ _) = p
> getEventDur   (Event _ _ _ d _) = d
> getEventVol   (Event _ _ _ _ v) = v

setEventTime, setEventInst, setEventPitch, setEventDur, and setEventVol
have type:  Event -> X -> Event, where X is obvious.

> setEventTime  (Event t i p d v) t' = Event t' i  p  d  v
> setEventInst  (Event t i p d v) i' = Event t  i' p  d  v
> setEventPitch (Event t i p d v) p' = Event t  i  p' d  v
> setEventDur   (Event t i p d v) d' = Event t  i  p  d' v
> setEventVol   (Event t i p d v) v' = Event t  i  p  d  v'

Figure 5: Selectors and mutators for contexts and events.

 

> perform pmap c m = fst (perf pmap c m)
>
> perf :: PMap -> Context -> Music -> (Performance, DurT)
> perf pmap c@(t,pl,i,dt,k,v) m =
>   case m of
>     Note p d nas -> (playNote pl c p d nas, d*dt)
>     Rest d       -> ([], d*dt)
>     m1 :+: m2    -> let (pf1,d1) = perf pmap c m1
>                         (pf2,d2) = perf pmap (setTime c (t+d1)) m2
>                     in (pf1++pf2, d1+d2)
>     m1 :=: m2    -> let (pf1,d1) = perf pmap c m1
>                         (pf2,d2) = perf pmap c m2
>                     in (merge pf1 pf2, max d1 d2)
>     Tempo  a b m -> perf pmap (setTempo  c (dt * float b / float a)) m
>     Trans  p m   -> perf pmap (setTrans  c     (k+p)) m
>     Instr  nm m  -> perf pmap (setInstr  c       nm ) m
>     Player nm m  -> perf pmap (setPlayer c (pmap nm)) m
>     Phrase pas m -> interpPhrase pl pmap c pas m

Figure 6: The "real" perform function.

Some things to note:

  1. The Context is the running "state" of the performance, and gets updated in several different ways. For example, the interpretation of the Tempo constructor involves scaling dt appropriately and updating the DurT field of the context. Figure 5 defines a convenient group of selectors and mutators for contexts and events.

  2. Interpretation of notes and phrases is player dependent. Ultimately a single note is played by the playNote function, which takes the player as an argument. Similarly, phrase interpretation is also player dependent, reflected in the use of interpPhrase. Precisely how these two functions work is described in Section 5.

  3. The DurT component of the context is the duration, in seconds, of one whole note. To make it easier to compute, we can define a "metronome" function that, given a standard metronome marking (in beats per minute) and the note type associated with one beat (quarter note, eighth note, etc.) generates the duration of one whole note:  

    > metro :: Float -> Dur -> DurT
    > metro setting dur = 60 / (setting*dur)

    Thus, for example, metro 96 qn creates a tempo of 96 quarter notes per minute.

  4. In the treatment of (:+:), note that the sub-sequences are appended together, with the start time of the second argument delayed by the duration of the first. The function dur (defined in Section 3.2) is used to compute this duration. Note that this results in a quadratic time complexity for perform. A more efficient solution is to have perform compute the duration directly, returning it as part of its result. This version of perform is shown in Figure 6.

  5. In contrast, the sub-sequences derived from the arguments to (:=:) are merged into a time-ordered stream. The definition of merge is given below.
 

> merge :: Performance -> Performance -> Performance

  merge a@(e1:es1) b@(e2:es2) = 
        if e1 < e2 then e1 : merge es1 b
                   else e2 : merge a es2
  merge [] es2 = es2
  merge es1 [] = es1

Note that merge compares entire events rather than just start times. This is to ensure that it is commutative, a desirable condition for some of the proofs used in Section 8. Here is a more efficient version that will work just as well in practice:  

> merge a@(e1@(Event t1 _ _ _ _) : es1) b@(e2@(Event t2 _ _ _ _) : es2) = 
>       if t1 < t2 then e1 : merge es1 b
>                  else e2 : merge a es2
> merge [] es2 = es2
> merge es1 [] = es1

5  Players

 

  module Players (module Players, module Music, module Performance)
         where

  import Music
  import Performance

In the last section we saw how a performance involved the notion of a player. The reason for this is the same as for real players and their instruments: many of the note and phrase attributes (see Section 3.3) are player and instrument dependent. For example, how should "legato" be interpreted in a performance? Or "diminuendo?" Different players interpret things in different ways, of course, but even more fundamental is the fact that a pianist, for example, realizes legato in a way fundamentally different from the way a violinist does, because of differences in their instruments. Similarly, diminuendo on a piano and a harpsichord are different concepts.

With a slight stretch of the imagination, we can even consider a "notator" of a score as a kind of player: exactly how the music is rendered on the written page may be a personal, stylized process. For example, how many, and which staves should be used to notate a particular instrument?

In any case, to handle these issues, Haskore has a notion of a player which "knows" about differences with respect to performance and notation. A Haskore player is a 4-tuple consisting of a name and 3 functions: one for interpreting notes, one for phrases, and one for producing a properly notated score.  

> data Player    = MkPlayer PName NoteFun PhraseFun NotateFun
>
> type NoteFun   = Context -> Pitch -> Dur -> [NoteAttribute] -> Performance
> type PhraseFun = PMap -> Context -> [PhraseAttribute] -> Music -> (Performance,Dur)
> type NotateFun = ()

The last line above is temporary for this executable version of Haskore, since notation only works on systems supporting CMN. The real definition should read:  
  type NotateFun = [Glyph] -> Staff

Note that both NoteFun and PhraseFun return a Performance (imported from module Perform), whereas NotateFun returns a Staff (imported from module Notation).

For convenience we define:  

> pName        ::  Player -> PName
> pName        (MkPlayer nm _ _ _) = nm
>
> playNote     ::  Player -> NoteFun
> playNote     (MkPlayer _ nf _ _) = nf
>
> interpPhrase ::  Player -> PhraseFun
> interpPhrase (MkPlayer _ _ pf _) = pf
>
> notatePlayer ::  Player -> NotateFun
> notatePlayer (MkPlayer _ _ _ nf) = nf

 

> defPlayer :: Player
> defPlayer  = MkPlayer "Default" (defPlayNote     defNasHandler)
>                                 (defInterpPhrase defPasHandler)
>                                 (defNotatePlayer ()           )
>
> defPlayNote :: (Context->NoteAttribute->Event->Event) -> NoteFun
> defPlayNote nasHandler c@(t,pl,i,dt,k,v) p d nas =
>        [ foldr (nasHandler c)
>                (Event t i (absPitch p + k) (d*dt) v)
>                nas ]
>
> defNasHandler :: Context-> NoteAttribute -> Event -> Event
> defNasHandler (_,_,_,_,_,v) (Volume v') ev = setEventVol ev (v*v'/100.0)
> defNasHandler _             _           ev = ev
>
> defInterpPhrase :: (PhraseAttribute->Performance->Performance) -> PhraseFun
> defInterpPhrase pasHandler pmap c@(t,pl,i,dt,k,v) pas m =
>        let (pf,dur) = perf pmap c m
>        in  (foldr pasHandler pf pas, dur)

> defPasHandler :: PhraseAttribute -> Performance -> Performance
> defPasHandler (Dyn (Accent x))     pf = 
>        map (\e -> setEventVol e (x * getEventVol e)) pf
> defPasHandler (Art (Staccato x))   pf = 
>        map (\e -> setEventDur e (x * getEventDur e)) pf
> defPasHandler (Art (Legato   x))   pf =
>        map (\e -> setEventDur e (x * getEventDur e)) pf
> defPasHandler  _                   pf = pf
>
> defNotatePlayer   :: () -> NotateFun
> defNotatePlayer _  =  ()

Figure 7: Definition of default Player defPlayer.

5.1  Examples of Player Construction

A "default player" called defPlayer (not to be confused with "deaf player"!) is defined for use when none other is specified in the score; it also functions as a base from which other players can be derived. defPlayer responds only to the Volume note attribute and to the Accent, Staccato, and Legato phrase attributes. It is defined in Figure 7. Before reading this code, recall how players are invoked by the perform function defined in the last section; in particular, note the calls to playNote and interpPhase defined above. Then note:

  1. defPlayNote is the only function (even in the definition of perform) that actually generates an event. It also modifies that event based on an interpretation of each note attribute by the function defHasHandler.

  2. defNasHandler only recognizes the Volume attribute, which it uses to set the event volume accordingly.

  3. defInterpPhrase calls (mutually recursively) perform to interpret a phrase, and then modifies the result based on an interpretation of each phrase attribute by the function defPasHandler.

  4. defPasHandler only recognizes the Accent, Staccato, and Legato phrase attributes. For each of these it uses the numeric argument as a "scaling" factor of the volume (for Accent) and duration (for Staccato and Lagato). Thus (Phrase [Legato 1.1] m) effectively increases the duration of each note in m by 10%(without changing the tempo).

It should be clear that much of the code in Figure 7 can be re-used in defining a new player. For example, to define a player weird that interprets note attributes just like defPlayer but behaves differently with respect to phrase attributes, we could write:  
  weird :: Player
  weird  = MkPlayer "Weirdo" (defPlayNote     defNasHandler)
                             (defInterpPhrase myPasHandler )
                             (defNotatePlayer ()           )
and then supply a suitable definition of myPasHandler. That definition could also re-use code, in the following sense: suppose we wish to add an interpretation for Crescendo, but otherwise have myPasHandler behave just like defPasHandler.  
  myPasHandler :: PhraseAttribute -> Performance -> Performance
  myPasHandler (Dyn (Crescendo x)) pf = ...
  myPasHandler  pa                 pf = defPasHandler pa pf

Exercise
Fill in the ... in the definition of myPasHandler according to the following strategy: Assume 0<x<1. Gradually scale the volume of each event by a factor of 1.0 through 1.0+x, using linear interpolation.

Exercise
Choose some of the other phrase attributes and provide interpretations of them, such as Diminuendo, Slurred, Trill, etc.

In a system that supports it, the default notation handler sets up a staff with a treble clef for the player and appends any glyphs to the end of the staff:  
  defNotatePlayer gs = Staff "Default" 1.0 5 (Clef Treble : gs)

Figure 8 defines a relatively sophisticated player called fancyPlayer that knows all that defPlayer knows, and much more. Note that Slurred is different from Legato in that it doesn't extend the duration of the last note(s). The behavior of (Ritardando x) can be explained as follows. We'd like to "stretch" the time of each event by a factor from 0 to x, linearly interpolated based on how far along the musical phrase the event occurs. I.e., given a start time t0 for the first event in the phrase, total phrase duration D, and event time t, the new event time t' is given by:

t' = (1 + D/(t-t0) x)(t-t0) + t0

Further, if d is the duration of the event, then the end of the event t+d gets stretched to a new time td' given by:

td' = (1 + D/(t+d-t0) x)(t+d-t0) + t0

The difference td' - t' gives us the new, stretched duration d', which after simplification is:

d' = (1 + D/(2(t-t0)+d) x)d

Accelerando behaves in exactly the same way, except that it shortens event times rather than lengthening them. And, a similar but simpler strategy explains the behaviors of Crescendo and Diminuendo.

 

> fancyPlayer :: Player
> fancyPlayer  = MkPlayer "Fancy" (defPlayNote     defNasHandler )
>                                 fancyInterpPhrase
>                                 (defNotatePlayer ()            )
>
> fancyInterpPhrase :: PhraseFun
> fancyInterpPhrase pmap c                  []      m = perf pmap c m
> fancyInterpPhrase pmap c@(t,pl,i,dt,k,v) (pa:pas) m =
>  let pfd@(pf,dur) = fancyInterpPhrase pmap c pas m
>      loud x       = fancyInterpPhrase pmap c (Dyn (Loudness x) : pas) m
>      stretch x = let t0 = getEventTime (head pf)
>                      r  = x/dur
>                      upd (Event t i p d v) = let dt = t-t0
>                                                  t' = (1+dt*r)*dt + t0
>                                                  d' = (1+(2*dt+d)*r)*d
>                                              in Event t' i p d' v
>                  in (map upd pf, (1+x)*dur)
>      inflate x = let t0 = getEventTime (head pf)
>                      r  = x/dur
>                      upd (Event t i p d v) = let dt = t-t0
>                                              in Event t i p d ((1+dt*r)*v)
>                  in (map upd pf, dur)
>  in case pa of
>     Dyn (Accent x)      -> (map (\e-> setEventVol e (x * getEventVol e)) pf, dur)
>     Dyn PPP -> loud  40  ;  Dyn  PP -> loud  50  ;  Dyn   P -> loud  60
>     Dyn  MP -> loud  70  ;  Dyn  SF -> loud  80  ;  Dyn  MF -> loud  90
>     Dyn  NF -> loud 100  ;  Dyn  FF -> loud 110  ;  Dyn FFF -> loud 120
>     Dyn (Loudness x)    -> fancyInterpPhrase pmap (t,pl,i,dt,k,v*x/100) pas m
>     Dyn (Crescendo x)   -> inflate   x
>     Dyn (Diminuendo x)  -> inflate (-x)
>     Dyn (Ritardando  x) -> stretch   x
>     Dyn (Accelerando x) -> stretch (-x)
>     Art (Staccato x)    -> (map (\e-> setEventDur e (x * getEventDur e)) pf, dur)
>     Art (Legato   x)    -> (map (\e-> setEventDur e (x * getEventDur e)) pf, dur)
>     Art (Slurred  x)    -> 
>         let lastStartTime = foldr (\e t -> max (getEventTime e) t) 0 pf
>             setDur e      = if getEventTime e < lastStartTime
>                             then setEventDur e (x * getEventDur e)
>                             else e
>         in (map setDur pf, dur)
>     Art _               -> pfd  -- Remaining articulations:
>                --   Tenuto | Marcato | Pedal | Fermata  | FermataDown
>                -- | Breath | DownBow | UpBow | Harmonic | Pizzicato
>                -- | LeftPizz | BartokPizz | Swell | Wedge | Thumb | Stopped
>     Orn _              -> pfd  -- Remaining ornamenations:
>                --   Trill | Mordent | InvMordent | DoubleMordent | Turn
>                -- | TrilledTurn | ShortTrill | Arpeggio | ArpeggioUp 
>                -- | ArpeggioDown | Instruction String | Head NoteHead
>     -- Design Bug: To do these right we need to keep the KEY SIGNATURE
>     -- around so that we can determine, for example, what the trill note is.
>     -- Alternatively, provide an argument to Trill to carry this info.

Figure 8: Definition of Player fancyPlayer.


The Haskore Tutorial
top back next