> 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:
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.
|
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:
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.
|