> {-#  LANGUAGE FlexibleInstances, TypeSynonymInstances  #-}

> module Euterpea.Music where

> infixr 5 :+:, :=:

> type AbsPitch = Int
> type Octave = Int
> type Pitch = (PitchClass, Octave)
> type Dur   = Rational
> data PitchClass  =  Cff | Cf | C | Dff | Cs | Df | Css | D | Eff | Ds
>                  |  Ef | Fff | Dss | E | Ff | Es | F | Gff | Ess | Fs
>                  |  Gf | Fss | G | Aff | Gs | Af | Gss | A | Bff | As
>                  |  Bf | Ass | B | Bs | Bss
>      deriving (Int -> PitchClass -> ShowS
[PitchClass] -> ShowS
PitchClass -> String
(Int -> PitchClass -> ShowS)
-> (PitchClass -> String)
-> ([PitchClass] -> ShowS)
-> Show PitchClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PitchClass -> ShowS
showsPrec :: Int -> PitchClass -> ShowS
$cshow :: PitchClass -> String
show :: PitchClass -> String
$cshowList :: [PitchClass] -> ShowS
showList :: [PitchClass] -> ShowS
Show, PitchClass -> PitchClass -> Bool
(PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool) -> Eq PitchClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PitchClass -> PitchClass -> Bool
== :: PitchClass -> PitchClass -> Bool
$c/= :: PitchClass -> PitchClass -> Bool
/= :: PitchClass -> PitchClass -> Bool
Eq, Eq PitchClass
Eq PitchClass =>
(PitchClass -> PitchClass -> Ordering)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> PitchClass)
-> (PitchClass -> PitchClass -> PitchClass)
-> Ord PitchClass
PitchClass -> PitchClass -> Bool
PitchClass -> PitchClass -> Ordering
PitchClass -> PitchClass -> PitchClass
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PitchClass -> PitchClass -> Ordering
compare :: PitchClass -> PitchClass -> Ordering
$c< :: PitchClass -> PitchClass -> Bool
< :: PitchClass -> PitchClass -> Bool
$c<= :: PitchClass -> PitchClass -> Bool
<= :: PitchClass -> PitchClass -> Bool
$c> :: PitchClass -> PitchClass -> Bool
> :: PitchClass -> PitchClass -> Bool
$c>= :: PitchClass -> PitchClass -> Bool
>= :: PitchClass -> PitchClass -> Bool
$cmax :: PitchClass -> PitchClass -> PitchClass
max :: PitchClass -> PitchClass -> PitchClass
$cmin :: PitchClass -> PitchClass -> PitchClass
min :: PitchClass -> PitchClass -> PitchClass
Ord, ReadPrec [PitchClass]
ReadPrec PitchClass
Int -> ReadS PitchClass
ReadS [PitchClass]
(Int -> ReadS PitchClass)
-> ReadS [PitchClass]
-> ReadPrec PitchClass
-> ReadPrec [PitchClass]
-> Read PitchClass
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PitchClass
readsPrec :: Int -> ReadS PitchClass
$creadList :: ReadS [PitchClass]
readList :: ReadS [PitchClass]
$creadPrec :: ReadPrec PitchClass
readPrec :: ReadPrec PitchClass
$creadListPrec :: ReadPrec [PitchClass]
readListPrec :: ReadPrec [PitchClass]
Read, Int -> PitchClass
PitchClass -> Int
PitchClass -> [PitchClass]
PitchClass -> PitchClass
PitchClass -> PitchClass -> [PitchClass]
PitchClass -> PitchClass -> PitchClass -> [PitchClass]
(PitchClass -> PitchClass)
-> (PitchClass -> PitchClass)
-> (Int -> PitchClass)
-> (PitchClass -> Int)
-> (PitchClass -> [PitchClass])
-> (PitchClass -> PitchClass -> [PitchClass])
-> (PitchClass -> PitchClass -> [PitchClass])
-> (PitchClass -> PitchClass -> PitchClass -> [PitchClass])
-> Enum PitchClass
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PitchClass -> PitchClass
succ :: PitchClass -> PitchClass
$cpred :: PitchClass -> PitchClass
pred :: PitchClass -> PitchClass
$ctoEnum :: Int -> PitchClass
toEnum :: Int -> PitchClass
$cfromEnum :: PitchClass -> Int
fromEnum :: PitchClass -> Int
$cenumFrom :: PitchClass -> [PitchClass]
enumFrom :: PitchClass -> [PitchClass]
$cenumFromThen :: PitchClass -> PitchClass -> [PitchClass]
enumFromThen :: PitchClass -> PitchClass -> [PitchClass]
$cenumFromTo :: PitchClass -> PitchClass -> [PitchClass]
enumFromTo :: PitchClass -> PitchClass -> [PitchClass]
$cenumFromThenTo :: PitchClass -> PitchClass -> PitchClass -> [PitchClass]
enumFromThenTo :: PitchClass -> PitchClass -> PitchClass -> [PitchClass]
Enum, PitchClass
PitchClass -> PitchClass -> Bounded PitchClass
forall a. a -> a -> Bounded a
$cminBound :: PitchClass
minBound :: PitchClass
$cmaxBound :: PitchClass
maxBound :: PitchClass
Bounded)

> data Primitive a  =  Note Dur a
>                   |  Rest Dur
>      deriving (Int -> Primitive a -> ShowS
[Primitive a] -> ShowS
Primitive a -> String
(Int -> Primitive a -> ShowS)
-> (Primitive a -> String)
-> ([Primitive a] -> ShowS)
-> Show (Primitive a)
forall a. Show a => Int -> Primitive a -> ShowS
forall a. Show a => [Primitive a] -> ShowS
forall a. Show a => Primitive a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Primitive a -> ShowS
showsPrec :: Int -> Primitive a -> ShowS
$cshow :: forall a. Show a => Primitive a -> String
show :: Primitive a -> String
$cshowList :: forall a. Show a => [Primitive a] -> ShowS
showList :: [Primitive a] -> ShowS
Show, Primitive a -> Primitive a -> Bool
(Primitive a -> Primitive a -> Bool)
-> (Primitive a -> Primitive a -> Bool) -> Eq (Primitive a)
forall a. Eq a => Primitive a -> Primitive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Primitive a -> Primitive a -> Bool
== :: Primitive a -> Primitive a -> Bool
$c/= :: forall a. Eq a => Primitive a -> Primitive a -> Bool
/= :: Primitive a -> Primitive a -> Bool
Eq, Eq (Primitive a)
Eq (Primitive a) =>
(Primitive a -> Primitive a -> Ordering)
-> (Primitive a -> Primitive a -> Bool)
-> (Primitive a -> Primitive a -> Bool)
-> (Primitive a -> Primitive a -> Bool)
-> (Primitive a -> Primitive a -> Bool)
-> (Primitive a -> Primitive a -> Primitive a)
-> (Primitive a -> Primitive a -> Primitive a)
-> Ord (Primitive a)
Primitive a -> Primitive a -> Bool
Primitive a -> Primitive a -> Ordering
Primitive a -> Primitive a -> Primitive a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Primitive a)
forall a. Ord a => Primitive a -> Primitive a -> Bool
forall a. Ord a => Primitive a -> Primitive a -> Ordering
forall a. Ord a => Primitive a -> Primitive a -> Primitive a
$ccompare :: forall a. Ord a => Primitive a -> Primitive a -> Ordering
compare :: Primitive a -> Primitive a -> Ordering
$c< :: forall a. Ord a => Primitive a -> Primitive a -> Bool
< :: Primitive a -> Primitive a -> Bool
$c<= :: forall a. Ord a => Primitive a -> Primitive a -> Bool
<= :: Primitive a -> Primitive a -> Bool
$c> :: forall a. Ord a => Primitive a -> Primitive a -> Bool
> :: Primitive a -> Primitive a -> Bool
$c>= :: forall a. Ord a => Primitive a -> Primitive a -> Bool
>= :: Primitive a -> Primitive a -> Bool
$cmax :: forall a. Ord a => Primitive a -> Primitive a -> Primitive a
max :: Primitive a -> Primitive a -> Primitive a
$cmin :: forall a. Ord a => Primitive a -> Primitive a -> Primitive a
min :: Primitive a -> Primitive a -> Primitive a
Ord)

> data Music a  =
>        Prim (Primitive a)               --  primitive value

>     |  Music a :+: Music a              --  sequential composition

>     |  Music a :=: Music a              --  parallel composition

>     |  Modify Control (Music a)         --  modifier

>   deriving (Int -> Music a -> ShowS
[Music a] -> ShowS
Music a -> String
(Int -> Music a -> ShowS)
-> (Music a -> String) -> ([Music a] -> ShowS) -> Show (Music a)
forall a. Show a => Int -> Music a -> ShowS
forall a. Show a => [Music a] -> ShowS
forall a. Show a => Music a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Music a -> ShowS
showsPrec :: Int -> Music a -> ShowS
$cshow :: forall a. Show a => Music a -> String
show :: Music a -> String
$cshowList :: forall a. Show a => [Music a] -> ShowS
showList :: [Music a] -> ShowS
Show, Music a -> Music a -> Bool
(Music a -> Music a -> Bool)
-> (Music a -> Music a -> Bool) -> Eq (Music a)
forall a. Eq a => Music a -> Music a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Music a -> Music a -> Bool
== :: Music a -> Music a -> Bool
$c/= :: forall a. Eq a => Music a -> Music a -> Bool
/= :: Music a -> Music a -> Bool
Eq, Eq (Music a)
Eq (Music a) =>
(Music a -> Music a -> Ordering)
-> (Music a -> Music a -> Bool)
-> (Music a -> Music a -> Bool)
-> (Music a -> Music a -> Bool)
-> (Music a -> Music a -> Bool)
-> (Music a -> Music a -> Music a)
-> (Music a -> Music a -> Music a)
-> Ord (Music a)
Music a -> Music a -> Bool
Music a -> Music a -> Ordering
Music a -> Music a -> Music a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Music a)
forall a. Ord a => Music a -> Music a -> Bool
forall a. Ord a => Music a -> Music a -> Ordering
forall a. Ord a => Music a -> Music a -> Music a
$ccompare :: forall a. Ord a => Music a -> Music a -> Ordering
compare :: Music a -> Music a -> Ordering
$c< :: forall a. Ord a => Music a -> Music a -> Bool
< :: Music a -> Music a -> Bool
$c<= :: forall a. Ord a => Music a -> Music a -> Bool
<= :: Music a -> Music a -> Bool
$c> :: forall a. Ord a => Music a -> Music a -> Bool
> :: Music a -> Music a -> Bool
$c>= :: forall a. Ord a => Music a -> Music a -> Bool
>= :: Music a -> Music a -> Bool
$cmax :: forall a. Ord a => Music a -> Music a -> Music a
max :: Music a -> Music a -> Music a
$cmin :: forall a. Ord a => Music a -> Music a -> Music a
min :: Music a -> Music a -> Music a
Ord)

> data Control =
>           Tempo       Rational           --  scale the tempo

>        |  Transpose   AbsPitch           --  transposition

>        |  Instrument  InstrumentName     --  instrument label

>        |  Phrase      [PhraseAttribute]  --  phrase attributes

>        |  KeySig      PitchClass Mode    --  key signature and mode

>        |  Custom      String			   --  for user-specified controls

>   deriving (Int -> Control -> ShowS
[Control] -> ShowS
Control -> String
(Int -> Control -> ShowS)
-> (Control -> String) -> ([Control] -> ShowS) -> Show Control
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Control -> ShowS
showsPrec :: Int -> Control -> ShowS
$cshow :: Control -> String
show :: Control -> String
$cshowList :: [Control] -> ShowS
showList :: [Control] -> ShowS
Show, Control -> Control -> Bool
(Control -> Control -> Bool)
-> (Control -> Control -> Bool) -> Eq Control
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Control -> Control -> Bool
== :: Control -> Control -> Bool
$c/= :: Control -> Control -> Bool
/= :: Control -> Control -> Bool
Eq, Eq Control
Eq Control =>
(Control -> Control -> Ordering)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Bool)
-> (Control -> Control -> Control)
-> (Control -> Control -> Control)
-> Ord Control
Control -> Control -> Bool
Control -> Control -> Ordering
Control -> Control -> Control
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Control -> Control -> Ordering
compare :: Control -> Control -> Ordering
$c< :: Control -> Control -> Bool
< :: Control -> Control -> Bool
$c<= :: Control -> Control -> Bool
<= :: Control -> Control -> Bool
$c> :: Control -> Control -> Bool
> :: Control -> Control -> Bool
$c>= :: Control -> Control -> Bool
>= :: Control -> Control -> Bool
$cmax :: Control -> Control -> Control
max :: Control -> Control -> Control
$cmin :: Control -> Control -> Control
min :: Control -> Control -> Control
Ord)

> data Mode = Major | Minor |
>             Ionian | Dorian | Phrygian | Lydian | Mixolydian | Aeolian | Locrian |
>             CustomMode String
>   deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> String
show :: Mode -> String
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show, Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, Eq Mode
Eq Mode =>
(Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Mode -> Mode -> Ordering
compare :: Mode -> Mode -> Ordering
$c< :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
>= :: Mode -> Mode -> Bool
$cmax :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
min :: Mode -> Mode -> Mode
Ord)

> data InstrumentName =
>      AcousticGrandPiano     | BrightAcousticPiano    | ElectricGrandPiano
>   |  HonkyTonkPiano         | RhodesPiano            | ChorusedPiano
>   |  Harpsichord            | Clavinet               | Celesta
>   |  Glockenspiel           | MusicBox               | Vibraphone
>   |  Marimba                | Xylophone              | TubularBells
>   |  Dulcimer               | HammondOrgan           | PercussiveOrgan
>   |  RockOrgan              | ChurchOrgan            | ReedOrgan
>   |  Accordion              | Harmonica              | TangoAccordion
>   |  AcousticGuitarNylon    | AcousticGuitarSteel    | ElectricGuitarJazz
>   |  ElectricGuitarClean    | ElectricGuitarMuted    | OverdrivenGuitar
>   |  DistortionGuitar       | GuitarHarmonics        | AcousticBass
>   |  ElectricBassFingered   | ElectricBassPicked     | FretlessBass
>   |  SlapBass1              | SlapBass2              | SynthBass1
>   |  SynthBass2             | Violin                 | Viola
>   |  Cello                  | Contrabass             | TremoloStrings
>   |  PizzicatoStrings       | OrchestralHarp         | Timpani
>   |  StringEnsemble1        | StringEnsemble2        | SynthStrings1
>   |  SynthStrings2          | ChoirAahs              | VoiceOohs
>   |  SynthVoice             | OrchestraHit           | Trumpet
>   |  Trombone               | Tuba                   | MutedTrumpet
>   |  FrenchHorn             | BrassSection           | SynthBrass1
>   |  SynthBrass2            | SopranoSax             | AltoSax
>   |  TenorSax               | BaritoneSax            | Oboe
>   |  Bassoon                | EnglishHorn            | Clarinet
>   |  Piccolo                | Flute                  | Recorder
>   |  PanFlute               | BlownBottle            | Shakuhachi
>   |  Whistle                | Ocarina                | Lead1Square
>   |  Lead2Sawtooth          | Lead3Calliope          | Lead4Chiff
>   |  Lead5Charang           | Lead6Voice             | Lead7Fifths
>   |  Lead8BassLead          | Pad1NewAge             | Pad2Warm
>   |  Pad3Polysynth          | Pad4Choir              | Pad5Bowed
>   |  Pad6Metallic           | Pad7Halo               | Pad8Sweep
>   |  FX1Train               | FX2Soundtrack          | FX3Crystal
>   |  FX4Atmosphere          | FX5Brightness          | FX6Goblins
>   |  FX7Echoes              | FX8SciFi               | Sitar
>   |  Banjo                  | Shamisen               | Koto
>   |  Kalimba                | Bagpipe                | Fiddle
>   |  Shanai                 | TinkleBell             | Agogo
>   |  SteelDrums             | Woodblock              | TaikoDrum
>   |  MelodicDrum            | SynthDrum              | ReverseCymbal
>   |  GuitarFretNoise        | BreathNoise            | Seashore
>   |  BirdTweet              | TelephoneRing          | Helicopter
>   |  Applause               | Gunshot                | Percussion
>   |  CustomInstrument String
>   deriving (Int -> InstrumentName -> ShowS
[InstrumentName] -> ShowS
InstrumentName -> String
(Int -> InstrumentName -> ShowS)
-> (InstrumentName -> String)
-> ([InstrumentName] -> ShowS)
-> Show InstrumentName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstrumentName -> ShowS
showsPrec :: Int -> InstrumentName -> ShowS
$cshow :: InstrumentName -> String
show :: InstrumentName -> String
$cshowList :: [InstrumentName] -> ShowS
showList :: [InstrumentName] -> ShowS
Show, InstrumentName -> InstrumentName -> Bool
(InstrumentName -> InstrumentName -> Bool)
-> (InstrumentName -> InstrumentName -> Bool) -> Eq InstrumentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstrumentName -> InstrumentName -> Bool
== :: InstrumentName -> InstrumentName -> Bool
$c/= :: InstrumentName -> InstrumentName -> Bool
/= :: InstrumentName -> InstrumentName -> Bool
Eq, Eq InstrumentName
Eq InstrumentName =>
(InstrumentName -> InstrumentName -> Ordering)
-> (InstrumentName -> InstrumentName -> Bool)
-> (InstrumentName -> InstrumentName -> Bool)
-> (InstrumentName -> InstrumentName -> Bool)
-> (InstrumentName -> InstrumentName -> Bool)
-> (InstrumentName -> InstrumentName -> InstrumentName)
-> (InstrumentName -> InstrumentName -> InstrumentName)
-> Ord InstrumentName
InstrumentName -> InstrumentName -> Bool
InstrumentName -> InstrumentName -> Ordering
InstrumentName -> InstrumentName -> InstrumentName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InstrumentName -> InstrumentName -> Ordering
compare :: InstrumentName -> InstrumentName -> Ordering
$c< :: InstrumentName -> InstrumentName -> Bool
< :: InstrumentName -> InstrumentName -> Bool
$c<= :: InstrumentName -> InstrumentName -> Bool
<= :: InstrumentName -> InstrumentName -> Bool
$c> :: InstrumentName -> InstrumentName -> Bool
> :: InstrumentName -> InstrumentName -> Bool
$c>= :: InstrumentName -> InstrumentName -> Bool
>= :: InstrumentName -> InstrumentName -> Bool
$cmax :: InstrumentName -> InstrumentName -> InstrumentName
max :: InstrumentName -> InstrumentName -> InstrumentName
$cmin :: InstrumentName -> InstrumentName -> InstrumentName
min :: InstrumentName -> InstrumentName -> InstrumentName
Ord)

> data PhraseAttribute  =  Dyn Dynamic
>                       |  Tmp Tempo
>                       |  Art Articulation
>                       |  Orn Ornament
>      deriving (Int -> PhraseAttribute -> ShowS
[PhraseAttribute] -> ShowS
PhraseAttribute -> String
(Int -> PhraseAttribute -> ShowS)
-> (PhraseAttribute -> String)
-> ([PhraseAttribute] -> ShowS)
-> Show PhraseAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PhraseAttribute -> ShowS
showsPrec :: Int -> PhraseAttribute -> ShowS
$cshow :: PhraseAttribute -> String
show :: PhraseAttribute -> String
$cshowList :: [PhraseAttribute] -> ShowS
showList :: [PhraseAttribute] -> ShowS
Show, PhraseAttribute -> PhraseAttribute -> Bool
(PhraseAttribute -> PhraseAttribute -> Bool)
-> (PhraseAttribute -> PhraseAttribute -> Bool)
-> Eq PhraseAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhraseAttribute -> PhraseAttribute -> Bool
== :: PhraseAttribute -> PhraseAttribute -> Bool
$c/= :: PhraseAttribute -> PhraseAttribute -> Bool
/= :: PhraseAttribute -> PhraseAttribute -> Bool
Eq, Eq PhraseAttribute
Eq PhraseAttribute =>
(PhraseAttribute -> PhraseAttribute -> Ordering)
-> (PhraseAttribute -> PhraseAttribute -> Bool)
-> (PhraseAttribute -> PhraseAttribute -> Bool)
-> (PhraseAttribute -> PhraseAttribute -> Bool)
-> (PhraseAttribute -> PhraseAttribute -> Bool)
-> (PhraseAttribute -> PhraseAttribute -> PhraseAttribute)
-> (PhraseAttribute -> PhraseAttribute -> PhraseAttribute)
-> Ord PhraseAttribute
PhraseAttribute -> PhraseAttribute -> Bool
PhraseAttribute -> PhraseAttribute -> Ordering
PhraseAttribute -> PhraseAttribute -> PhraseAttribute
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PhraseAttribute -> PhraseAttribute -> Ordering
compare :: PhraseAttribute -> PhraseAttribute -> Ordering
$c< :: PhraseAttribute -> PhraseAttribute -> Bool
< :: PhraseAttribute -> PhraseAttribute -> Bool
$c<= :: PhraseAttribute -> PhraseAttribute -> Bool
<= :: PhraseAttribute -> PhraseAttribute -> Bool
$c> :: PhraseAttribute -> PhraseAttribute -> Bool
> :: PhraseAttribute -> PhraseAttribute -> Bool
$c>= :: PhraseAttribute -> PhraseAttribute -> Bool
>= :: PhraseAttribute -> PhraseAttribute -> Bool
$cmax :: PhraseAttribute -> PhraseAttribute -> PhraseAttribute
max :: PhraseAttribute -> PhraseAttribute -> PhraseAttribute
$cmin :: PhraseAttribute -> PhraseAttribute -> PhraseAttribute
min :: PhraseAttribute -> PhraseAttribute -> PhraseAttribute
Ord)

> data Dynamic  =  Accent Rational | Crescendo Rational | Diminuendo Rational
>               |  StdLoudness StdLoudness | Loudness Rational
>      deriving (Int -> Dynamic -> ShowS
[Dynamic] -> ShowS
Dynamic -> String
(Int -> Dynamic -> ShowS)
-> (Dynamic -> String) -> ([Dynamic] -> ShowS) -> Show Dynamic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dynamic -> ShowS
showsPrec :: Int -> Dynamic -> ShowS
$cshow :: Dynamic -> String
show :: Dynamic -> String
$cshowList :: [Dynamic] -> ShowS
showList :: [Dynamic] -> ShowS
Show, Dynamic -> Dynamic -> Bool
(Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool) -> Eq Dynamic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dynamic -> Dynamic -> Bool
== :: Dynamic -> Dynamic -> Bool
$c/= :: Dynamic -> Dynamic -> Bool
/= :: Dynamic -> Dynamic -> Bool
Eq, Eq Dynamic
Eq Dynamic =>
(Dynamic -> Dynamic -> Ordering)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Dynamic)
-> (Dynamic -> Dynamic -> Dynamic)
-> Ord Dynamic
Dynamic -> Dynamic -> Bool
Dynamic -> Dynamic -> Ordering
Dynamic -> Dynamic -> Dynamic
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Dynamic -> Dynamic -> Ordering
compare :: Dynamic -> Dynamic -> Ordering
$c< :: Dynamic -> Dynamic -> Bool
< :: Dynamic -> Dynamic -> Bool
$c<= :: Dynamic -> Dynamic -> Bool
<= :: Dynamic -> Dynamic -> Bool
$c> :: Dynamic -> Dynamic -> Bool
> :: Dynamic -> Dynamic -> Bool
$c>= :: Dynamic -> Dynamic -> Bool
>= :: Dynamic -> Dynamic -> Bool
$cmax :: Dynamic -> Dynamic -> Dynamic
max :: Dynamic -> Dynamic -> Dynamic
$cmin :: Dynamic -> Dynamic -> Dynamic
min :: Dynamic -> Dynamic -> Dynamic
Ord)

> data StdLoudness = PPP | PP | P | MP | SF | MF | NF | FF | FFF
>      deriving (Int -> StdLoudness -> ShowS
[StdLoudness] -> ShowS
StdLoudness -> String
(Int -> StdLoudness -> ShowS)
-> (StdLoudness -> String)
-> ([StdLoudness] -> ShowS)
-> Show StdLoudness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StdLoudness -> ShowS
showsPrec :: Int -> StdLoudness -> ShowS
$cshow :: StdLoudness -> String
show :: StdLoudness -> String
$cshowList :: [StdLoudness] -> ShowS
showList :: [StdLoudness] -> ShowS
Show, StdLoudness -> StdLoudness -> Bool
(StdLoudness -> StdLoudness -> Bool)
-> (StdLoudness -> StdLoudness -> Bool) -> Eq StdLoudness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StdLoudness -> StdLoudness -> Bool
== :: StdLoudness -> StdLoudness -> Bool
$c/= :: StdLoudness -> StdLoudness -> Bool
/= :: StdLoudness -> StdLoudness -> Bool
Eq, Eq StdLoudness
Eq StdLoudness =>
(StdLoudness -> StdLoudness -> Ordering)
-> (StdLoudness -> StdLoudness -> Bool)
-> (StdLoudness -> StdLoudness -> Bool)
-> (StdLoudness -> StdLoudness -> Bool)
-> (StdLoudness -> StdLoudness -> Bool)
-> (StdLoudness -> StdLoudness -> StdLoudness)
-> (StdLoudness -> StdLoudness -> StdLoudness)
-> Ord StdLoudness
StdLoudness -> StdLoudness -> Bool
StdLoudness -> StdLoudness -> Ordering
StdLoudness -> StdLoudness -> StdLoudness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StdLoudness -> StdLoudness -> Ordering
compare :: StdLoudness -> StdLoudness -> Ordering
$c< :: StdLoudness -> StdLoudness -> Bool
< :: StdLoudness -> StdLoudness -> Bool
$c<= :: StdLoudness -> StdLoudness -> Bool
<= :: StdLoudness -> StdLoudness -> Bool
$c> :: StdLoudness -> StdLoudness -> Bool
> :: StdLoudness -> StdLoudness -> Bool
$c>= :: StdLoudness -> StdLoudness -> Bool
>= :: StdLoudness -> StdLoudness -> Bool
$cmax :: StdLoudness -> StdLoudness -> StdLoudness
max :: StdLoudness -> StdLoudness -> StdLoudness
$cmin :: StdLoudness -> StdLoudness -> StdLoudness
min :: StdLoudness -> StdLoudness -> StdLoudness
Ord, Int -> StdLoudness
StdLoudness -> Int
StdLoudness -> [StdLoudness]
StdLoudness -> StdLoudness
StdLoudness -> StdLoudness -> [StdLoudness]
StdLoudness -> StdLoudness -> StdLoudness -> [StdLoudness]
(StdLoudness -> StdLoudness)
-> (StdLoudness -> StdLoudness)
-> (Int -> StdLoudness)
-> (StdLoudness -> Int)
-> (StdLoudness -> [StdLoudness])
-> (StdLoudness -> StdLoudness -> [StdLoudness])
-> (StdLoudness -> StdLoudness -> [StdLoudness])
-> (StdLoudness -> StdLoudness -> StdLoudness -> [StdLoudness])
-> Enum StdLoudness
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: StdLoudness -> StdLoudness
succ :: StdLoudness -> StdLoudness
$cpred :: StdLoudness -> StdLoudness
pred :: StdLoudness -> StdLoudness
$ctoEnum :: Int -> StdLoudness
toEnum :: Int -> StdLoudness
$cfromEnum :: StdLoudness -> Int
fromEnum :: StdLoudness -> Int
$cenumFrom :: StdLoudness -> [StdLoudness]
enumFrom :: StdLoudness -> [StdLoudness]
$cenumFromThen :: StdLoudness -> StdLoudness -> [StdLoudness]
enumFromThen :: StdLoudness -> StdLoudness -> [StdLoudness]
$cenumFromTo :: StdLoudness -> StdLoudness -> [StdLoudness]
enumFromTo :: StdLoudness -> StdLoudness -> [StdLoudness]
$cenumFromThenTo :: StdLoudness -> StdLoudness -> StdLoudness -> [StdLoudness]
enumFromThenTo :: StdLoudness -> StdLoudness -> StdLoudness -> [StdLoudness]
Enum)

> data Tempo = Ritardando Rational | Accelerando Rational
>      deriving (Int -> Tempo -> ShowS
[Tempo] -> ShowS
Tempo -> String
(Int -> Tempo -> ShowS)
-> (Tempo -> String) -> ([Tempo] -> ShowS) -> Show Tempo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tempo -> ShowS
showsPrec :: Int -> Tempo -> ShowS
$cshow :: Tempo -> String
show :: Tempo -> String
$cshowList :: [Tempo] -> ShowS
showList :: [Tempo] -> ShowS
Show, Tempo -> Tempo -> Bool
(Tempo -> Tempo -> Bool) -> (Tempo -> Tempo -> Bool) -> Eq Tempo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tempo -> Tempo -> Bool
== :: Tempo -> Tempo -> Bool
$c/= :: Tempo -> Tempo -> Bool
/= :: Tempo -> Tempo -> Bool
Eq, Eq Tempo
Eq Tempo =>
(Tempo -> Tempo -> Ordering)
-> (Tempo -> Tempo -> Bool)
-> (Tempo -> Tempo -> Bool)
-> (Tempo -> Tempo -> Bool)
-> (Tempo -> Tempo -> Bool)
-> (Tempo -> Tempo -> Tempo)
-> (Tempo -> Tempo -> Tempo)
-> Ord Tempo
Tempo -> Tempo -> Bool
Tempo -> Tempo -> Ordering
Tempo -> Tempo -> Tempo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tempo -> Tempo -> Ordering
compare :: Tempo -> Tempo -> Ordering
$c< :: Tempo -> Tempo -> Bool
< :: Tempo -> Tempo -> Bool
$c<= :: Tempo -> Tempo -> Bool
<= :: Tempo -> Tempo -> Bool
$c> :: Tempo -> Tempo -> Bool
> :: Tempo -> Tempo -> Bool
$c>= :: Tempo -> Tempo -> Bool
>= :: Tempo -> Tempo -> Bool
$cmax :: Tempo -> Tempo -> Tempo
max :: Tempo -> Tempo -> Tempo
$cmin :: Tempo -> Tempo -> Tempo
min :: Tempo -> Tempo -> Tempo
Ord)

> data Articulation  =  Staccato Rational | Legato Rational | Slurred Rational
>                    |  Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath
>                    |  DownBow | UpBow | Harmonic | Pizzicato | LeftPizz
>                    |  BartokPizz | Swell | Wedge | Thumb | Stopped
>      deriving (Int -> Articulation -> ShowS
[Articulation] -> ShowS
Articulation -> String
(Int -> Articulation -> ShowS)
-> (Articulation -> String)
-> ([Articulation] -> ShowS)
-> Show Articulation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Articulation -> ShowS
showsPrec :: Int -> Articulation -> ShowS
$cshow :: Articulation -> String
show :: Articulation -> String
$cshowList :: [Articulation] -> ShowS
showList :: [Articulation] -> ShowS
Show, Articulation -> Articulation -> Bool
(Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool) -> Eq Articulation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Articulation -> Articulation -> Bool
== :: Articulation -> Articulation -> Bool
$c/= :: Articulation -> Articulation -> Bool
/= :: Articulation -> Articulation -> Bool
Eq, Eq Articulation
Eq Articulation =>
(Articulation -> Articulation -> Ordering)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Bool)
-> (Articulation -> Articulation -> Articulation)
-> (Articulation -> Articulation -> Articulation)
-> Ord Articulation
Articulation -> Articulation -> Bool
Articulation -> Articulation -> Ordering
Articulation -> Articulation -> Articulation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Articulation -> Articulation -> Ordering
compare :: Articulation -> Articulation -> Ordering
$c< :: Articulation -> Articulation -> Bool
< :: Articulation -> Articulation -> Bool
$c<= :: Articulation -> Articulation -> Bool
<= :: Articulation -> Articulation -> Bool
$c> :: Articulation -> Articulation -> Bool
> :: Articulation -> Articulation -> Bool
$c>= :: Articulation -> Articulation -> Bool
>= :: Articulation -> Articulation -> Bool
$cmax :: Articulation -> Articulation -> Articulation
max :: Articulation -> Articulation -> Articulation
$cmin :: Articulation -> Articulation -> Articulation
min :: Articulation -> Articulation -> Articulation
Ord)

> data Ornament  =  Trill | Mordent | InvMordent | DoubleMordent
>                |  Turn | TrilledTurn | ShortTrill
>                |  Arpeggio | ArpeggioUp | ArpeggioDown
>                |  Instruction String | Head NoteHead
>                |  DiatonicTrans Int
>      deriving (Int -> Ornament -> ShowS
[Ornament] -> ShowS
Ornament -> String
(Int -> Ornament -> ShowS)
-> (Ornament -> String) -> ([Ornament] -> ShowS) -> Show Ornament
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ornament -> ShowS
showsPrec :: Int -> Ornament -> ShowS
$cshow :: Ornament -> String
show :: Ornament -> String
$cshowList :: [Ornament] -> ShowS
showList :: [Ornament] -> ShowS
Show, Ornament -> Ornament -> Bool
(Ornament -> Ornament -> Bool)
-> (Ornament -> Ornament -> Bool) -> Eq Ornament
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ornament -> Ornament -> Bool
== :: Ornament -> Ornament -> Bool
$c/= :: Ornament -> Ornament -> Bool
/= :: Ornament -> Ornament -> Bool
Eq, Eq Ornament
Eq Ornament =>
(Ornament -> Ornament -> Ordering)
-> (Ornament -> Ornament -> Bool)
-> (Ornament -> Ornament -> Bool)
-> (Ornament -> Ornament -> Bool)
-> (Ornament -> Ornament -> Bool)
-> (Ornament -> Ornament -> Ornament)
-> (Ornament -> Ornament -> Ornament)
-> Ord Ornament
Ornament -> Ornament -> Bool
Ornament -> Ornament -> Ordering
Ornament -> Ornament -> Ornament
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ornament -> Ornament -> Ordering
compare :: Ornament -> Ornament -> Ordering
$c< :: Ornament -> Ornament -> Bool
< :: Ornament -> Ornament -> Bool
$c<= :: Ornament -> Ornament -> Bool
<= :: Ornament -> Ornament -> Bool
$c> :: Ornament -> Ornament -> Bool
> :: Ornament -> Ornament -> Bool
$c>= :: Ornament -> Ornament -> Bool
>= :: Ornament -> Ornament -> Bool
$cmax :: Ornament -> Ornament -> Ornament
max :: Ornament -> Ornament -> Ornament
$cmin :: Ornament -> Ornament -> Ornament
min :: Ornament -> Ornament -> Ornament
Ord)

> data NoteHead  =  DiamondHead | SquareHead | XHead | TriangleHead
>                |  TremoloHead | SlashHead | ArtHarmonic | NoHead
>      deriving (Int -> NoteHead -> ShowS
[NoteHead] -> ShowS
NoteHead -> String
(Int -> NoteHead -> ShowS)
-> (NoteHead -> String) -> ([NoteHead] -> ShowS) -> Show NoteHead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoteHead -> ShowS
showsPrec :: Int -> NoteHead -> ShowS
$cshow :: NoteHead -> String
show :: NoteHead -> String
$cshowList :: [NoteHead] -> ShowS
showList :: [NoteHead] -> ShowS
Show, NoteHead -> NoteHead -> Bool
(NoteHead -> NoteHead -> Bool)
-> (NoteHead -> NoteHead -> Bool) -> Eq NoteHead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoteHead -> NoteHead -> Bool
== :: NoteHead -> NoteHead -> Bool
$c/= :: NoteHead -> NoteHead -> Bool
/= :: NoteHead -> NoteHead -> Bool
Eq, Eq NoteHead
Eq NoteHead =>
(NoteHead -> NoteHead -> Ordering)
-> (NoteHead -> NoteHead -> Bool)
-> (NoteHead -> NoteHead -> Bool)
-> (NoteHead -> NoteHead -> Bool)
-> (NoteHead -> NoteHead -> Bool)
-> (NoteHead -> NoteHead -> NoteHead)
-> (NoteHead -> NoteHead -> NoteHead)
-> Ord NoteHead
NoteHead -> NoteHead -> Bool
NoteHead -> NoteHead -> Ordering
NoteHead -> NoteHead -> NoteHead
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NoteHead -> NoteHead -> Ordering
compare :: NoteHead -> NoteHead -> Ordering
$c< :: NoteHead -> NoteHead -> Bool
< :: NoteHead -> NoteHead -> Bool
$c<= :: NoteHead -> NoteHead -> Bool
<= :: NoteHead -> NoteHead -> Bool
$c> :: NoteHead -> NoteHead -> Bool
> :: NoteHead -> NoteHead -> Bool
$c>= :: NoteHead -> NoteHead -> Bool
>= :: NoteHead -> NoteHead -> Bool
$cmax :: NoteHead -> NoteHead -> NoteHead
max :: NoteHead -> NoteHead -> NoteHead
$cmin :: NoteHead -> NoteHead -> NoteHead
min :: NoteHead -> NoteHead -> NoteHead
Ord)

> type Volume = Int

> addVolume    :: Volume -> Music Pitch -> Music (Pitch,Volume)
> addVolume :: Int -> Music Pitch -> Music (Pitch, Int)
addVolume Int
v  = (Pitch -> (Pitch, Int)) -> Music Pitch -> Music (Pitch, Int)
forall a b. (a -> b) -> Music a -> Music b
mMap (\Pitch
p -> (Pitch
p,Int
v))

> data NoteAttribute =
>         Volume  Int   --  MIDI convention: 0=min, 127=max

>      |  Fingering Integer
>      |  Dynamics String
>      |  Params [Double]
>    deriving (NoteAttribute -> NoteAttribute -> Bool
(NoteAttribute -> NoteAttribute -> Bool)
-> (NoteAttribute -> NoteAttribute -> Bool) -> Eq NoteAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoteAttribute -> NoteAttribute -> Bool
== :: NoteAttribute -> NoteAttribute -> Bool
$c/= :: NoteAttribute -> NoteAttribute -> Bool
/= :: NoteAttribute -> NoteAttribute -> Bool
Eq, Int -> NoteAttribute -> ShowS
[NoteAttribute] -> ShowS
NoteAttribute -> String
(Int -> NoteAttribute -> ShowS)
-> (NoteAttribute -> String)
-> ([NoteAttribute] -> ShowS)
-> Show NoteAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoteAttribute -> ShowS
showsPrec :: Int -> NoteAttribute -> ShowS
$cshow :: NoteAttribute -> String
show :: NoteAttribute -> String
$cshowList :: [NoteAttribute] -> ShowS
showList :: [NoteAttribute] -> ShowS
Show)

> type Note1   = (Pitch, [NoteAttribute])
> type Music1  = Music Note1


A new type class to allow for musical polymorphism that ultimately
must be converted to Music1 to be converted to MIDI format through
the MEvent framework.

> class ToMusic1 a where
>     toMusic1 :: Music a -> Music1

> instance ToMusic1 Pitch where
>     toMusic1 :: Music Pitch -> Music1
toMusic1 = (Pitch -> Note1) -> Music Pitch -> Music1
forall a b. (a -> b) -> Music a -> Music b
mMap (\Pitch
p -> (Pitch
p, []))

> instance ToMusic1 (Pitch, Volume) where
>     toMusic1 :: Music (Pitch, Int) -> Music1
toMusic1  = ((Pitch, Int) -> Note1) -> Music (Pitch, Int) -> Music1
forall a b. (a -> b) -> Music a -> Music b
mMap (\(Pitch
p, Int
v) -> (Pitch
p, [Int -> NoteAttribute
Volume Int
v]))

> instance ToMusic1 (Note1) where
>     toMusic1 :: Music1 -> Music1
toMusic1 = Music1 -> Music1
forall a. a -> a
id

> instance ToMusic1 (AbsPitch) where
>     toMusic1 :: Music Int -> Music1
toMusic1 = (Int -> Note1) -> Music Int -> Music1
forall a b. (a -> b) -> Music a -> Music b
mMap (\Int
a -> (Int -> Pitch
pitch Int
a, []))

> instance ToMusic1 (AbsPitch, Volume) where
>     toMusic1 :: Music (Int, Int) -> Music1
toMusic1 = ((Int, Int) -> Note1) -> Music (Int, Int) -> Music1
forall a b. (a -> b) -> Music a -> Music b
mMap (\(Int
p,Int
v) -> (Int -> Pitch
pitch Int
p, [Int -> NoteAttribute
Volume Int
v]))

> note            :: Dur -> a -> Music a
> note :: forall a. Dur -> a -> Music a
note Dur
d a
p        = Primitive a -> Music a
forall a. Primitive a -> Music a
Prim (Dur -> a -> Primitive a
forall a. Dur -> a -> Primitive a
Note Dur
d a
p)

> rest            :: Dur -> Music a
> rest :: forall a. Dur -> Music a
rest Dur
d          = Primitive a -> Music a
forall a. Primitive a -> Music a
Prim (Dur -> Primitive a
forall a. Dur -> Primitive a
Rest Dur
d)

> tempo           :: Dur -> Music a -> Music a
> tempo :: forall a. Dur -> Music a -> Music a
tempo Dur
r Music a
m       = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify (Dur -> Control
Tempo Dur
r) Music a
m

> transpose       :: AbsPitch -> Music a -> Music a
> transpose :: forall a. Int -> Music a -> Music a
transpose Int
i Music a
m   = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify (Int -> Control
Transpose Int
i) Music a
m

> instrument      :: InstrumentName -> Music a -> Music a
> instrument :: forall a. InstrumentName -> Music a -> Music a
instrument InstrumentName
i Music a
m  = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify (InstrumentName -> Control
Instrument InstrumentName
i) Music a
m

> phrase          :: [PhraseAttribute] -> Music a -> Music a
> phrase :: forall a. [PhraseAttribute] -> Music a -> Music a
phrase [PhraseAttribute]
pa Music a
m     = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify ([PhraseAttribute] -> Control
Phrase [PhraseAttribute]
pa) Music a
m

> keysig          :: PitchClass -> Mode -> Music a -> Music a
> keysig :: forall a. PitchClass -> Mode -> Music a -> Music a
keysig PitchClass
pc Mode
mo Music a
m  = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify (PitchClass -> Mode -> Control
KeySig PitchClass
pc Mode
mo) Music a
m

> cff,cf,c,cs,css,dff,df,d,ds,dss,eff,ef,e,es,ess,fff,ff,f,
>   fs,fss,gff,gf,g,gs,gss,aff,af,a,as,ass,bff,bf,b,bs,bss ::
>     Octave -> Dur -> Music Pitch

> cff :: Int -> Dur -> Music Pitch
cff  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Cff,  Int
o);  cf :: Int -> Dur -> Music Pitch
cf   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Cf,   Int
o)
> c :: Int -> Dur -> Music Pitch
c    Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
C,    Int
o);  cs :: Int -> Dur -> Music Pitch
cs   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Cs,   Int
o)
> css :: Int -> Dur -> Music Pitch
css  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Css,  Int
o);  dff :: Int -> Dur -> Music Pitch
dff  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Dff,  Int
o)
> df :: Int -> Dur -> Music Pitch
df   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Df,   Int
o);  d :: Int -> Dur -> Music Pitch
d    Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
D,    Int
o)
> ds :: Int -> Dur -> Music Pitch
ds   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Ds,   Int
o);  dss :: Int -> Dur -> Music Pitch
dss  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Dss,  Int
o)
> eff :: Int -> Dur -> Music Pitch
eff  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Eff,  Int
o);  ef :: Int -> Dur -> Music Pitch
ef   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Ef,   Int
o)
> e :: Int -> Dur -> Music Pitch
e    Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
E,    Int
o);  es :: Int -> Dur -> Music Pitch
es   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Es,   Int
o)
> ess :: Int -> Dur -> Music Pitch
ess  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Ess,  Int
o);  fff :: Int -> Dur -> Music Pitch
fff  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Fff,  Int
o)
> ff :: Int -> Dur -> Music Pitch
ff   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Ff,   Int
o);  f :: Int -> Dur -> Music Pitch
f    Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
F,    Int
o)
> fs :: Int -> Dur -> Music Pitch
fs   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Fs,   Int
o);  fss :: Int -> Dur -> Music Pitch
fss  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Fss,  Int
o)
> gff :: Int -> Dur -> Music Pitch
gff  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Gff,  Int
o);  gf :: Int -> Dur -> Music Pitch
gf   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Gf,   Int
o)
> g :: Int -> Dur -> Music Pitch
g    Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
G,    Int
o);  gs :: Int -> Dur -> Music Pitch
gs   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Gs,   Int
o)
> gss :: Int -> Dur -> Music Pitch
gss  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Gss,  Int
o);  aff :: Int -> Dur -> Music Pitch
aff  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Aff,  Int
o)
> af :: Int -> Dur -> Music Pitch
af   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Af,   Int
o);  a :: Int -> Dur -> Music Pitch
a    Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
A,    Int
o)
> as :: Int -> Dur -> Music Pitch
as   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
As,   Int
o);  ass :: Int -> Dur -> Music Pitch
ass  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Ass,  Int
o)
> bff :: Int -> Dur -> Music Pitch
bff  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Bff,  Int
o);  bf :: Int -> Dur -> Music Pitch
bf   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Bf,   Int
o)
> b :: Int -> Dur -> Music Pitch
b    Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
B,    Int
o);  bs :: Int -> Dur -> Music Pitch
bs   Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Bs,   Int
o)
> bss :: Int -> Dur -> Music Pitch
bss  Int
o Dur
d = Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
d (PitchClass
Bss,  Int
o)


> bn, wn, hn, qn, en, sn, tn, sfn, dwn, dhn,
>     dqn, den, dsn, dtn, ddhn, ddqn, dden :: Dur

> bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr, dwnr, dhnr,
>      dqnr, denr, dsnr, dtnr, ddhnr, ddqnr, ddenr :: Music Pitch

> bn :: Dur
bn    = Dur
2;     bnr :: Music Pitch
bnr    = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
bn    --  brevis rest

> wn :: Dur
wn    = Dur
1;     wnr :: Music Pitch
wnr    = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
wn    --  whole note rest

> hn :: Dur
hn    = Dur
1Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
2;   hnr :: Music Pitch
hnr    = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
hn    --  half note rest

> qn :: Dur
qn    = Dur
1Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
4;   qnr :: Music Pitch
qnr    = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
qn    --  quarter note rest

> en :: Dur
en    = Dur
1Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
8;   enr :: Music Pitch
enr    = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
en    --  eighth note rest

> sn :: Dur
sn    = Dur
1Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
16;  snr :: Music Pitch
snr    = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
sn    --  sixteenth note rest

> tn :: Dur
tn    = Dur
1Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
32;  tnr :: Music Pitch
tnr    = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
tn    --  thirty-second note rest

> sfn :: Dur
sfn   = Dur
1Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
64;  sfnr :: Music Pitch
sfnr   = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
sfn   --  sixty-fourth note rest


> dwn :: Dur
dwn   = Dur
3Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
2;   dwnr :: Music Pitch
dwnr   = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
dwn   --  dotted whole note rest

> dhn :: Dur
dhn   = Dur
3Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
4;   dhnr :: Music Pitch
dhnr   = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
dhn   --  dotted half note rest

> dqn :: Dur
dqn   = Dur
3Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
8;   dqnr :: Music Pitch
dqnr   = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
dqn   --  dotted quarter note rest

> den :: Dur
den   = Dur
3Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
16;  denr :: Music Pitch
denr   = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
den   --  dotted eighth note rest

> dsn :: Dur
dsn   = Dur
3Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
32;  dsnr :: Music Pitch
dsnr   = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
dsn   --  dotted sixteenth note rest

> dtn :: Dur
dtn   = Dur
3Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
64;  dtnr :: Music Pitch
dtnr   = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
dtn   --  dotted thirty-second note rest


> ddhn :: Dur
ddhn  = Dur
7Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
8;   ddhnr :: Music Pitch
ddhnr  = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
ddhn  --  double-dotted half note rest

> ddqn :: Dur
ddqn  = Dur
7Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
16;  ddqnr :: Music Pitch
ddqnr  = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
ddqn  --  double-dotted quarter note rest

> dden :: Dur
dden  = Dur
7Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
32;  ddenr :: Music Pitch
ddenr  = Dur -> Music Pitch
forall a. Dur -> Music a
rest Dur
dden  --  double-dotted eighth note rest


The conversion for Pitch and AbsPitch differs from previous versions
of Euterpea. In Euterpea 1.x, (C,5) was pitch number 60, which is not
the most common interpretation. While there is no universal standard
for which octave should be octave 0, it is far more common to have the
pitch number relationship that (C,4) = 60. Since this change has been
requested many times in previous versions of Euterpea, the following
standard is now in place as of version 2.0.0:

pitch 0 = (C,-1)
pitch 60 = (C,4)
pitch 127 = (G,9)

> absPitch           :: Pitch -> AbsPitch
> absPitch :: Pitch -> Int
absPitch (PitchClass
pc,Int
oct)  = Int
12Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
octInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PitchClass -> Int
pcToInt PitchClass
pc

> pcToInt     :: PitchClass -> Int
> pcToInt :: PitchClass -> Int
pcToInt PitchClass
pc  = case PitchClass
pc of
>   PitchClass
Cff  -> -Int
2;  PitchClass
Cf  -> -Int
1;  PitchClass
C  -> Int
0;   PitchClass
Cs  -> Int
1;   PitchClass
Css  -> Int
2;
>   PitchClass
Dff  -> Int
0;   PitchClass
Df  -> Int
1;   PitchClass
D  -> Int
2;   PitchClass
Ds  -> Int
3;   PitchClass
Dss  -> Int
4;
>   PitchClass
Eff  -> Int
2;   PitchClass
Ef  -> Int
3;   PitchClass
E  -> Int
4;   PitchClass
Es  -> Int
5;   PitchClass
Ess  -> Int
6;
>   PitchClass
Fff  -> Int
3;   PitchClass
Ff  -> Int
4;   PitchClass
F  -> Int
5;   PitchClass
Fs  -> Int
6;   PitchClass
Fss  -> Int
7;
>   PitchClass
Gff  -> Int
5;   PitchClass
Gf  -> Int
6;   PitchClass
G  -> Int
7;   PitchClass
Gs  -> Int
8;   PitchClass
Gss  -> Int
9;
>   PitchClass
Aff  -> Int
7;   PitchClass
Af  -> Int
8;   PitchClass
A  -> Int
9;   PitchClass
As  -> Int
10;  PitchClass
Ass  -> Int
11;
>   PitchClass
Bff  -> Int
9;   PitchClass
Bf  -> Int
10;  PitchClass
B  -> Int
11;  PitchClass
Bs  -> Int
12;  PitchClass
Bss  -> Int
13

> pitch     :: AbsPitch -> Pitch
> pitch :: Int -> Pitch
pitch Int
ap  =
>     let (Int
oct, Int
n) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
ap Int
12
>     in  ([PitchClass
C,PitchClass
Cs,PitchClass
D,PitchClass
Ds,PitchClass
E,PitchClass
F,PitchClass
Fs,PitchClass
G,PitchClass
Gs,PitchClass
A,PitchClass
As,PitchClass
B] [PitchClass] -> Int -> PitchClass
forall a. HasCallStack => [a] -> Int -> a
!! Int
n, Int
octInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

> trans      :: Int -> Pitch -> Pitch
> trans :: Int -> Pitch -> Pitch
trans Int
i Pitch
p  = Int -> Pitch
pitch (Pitch -> Int
absPitch Pitch
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)






-- =================================================================================

-- From MoreMusic.hs


> line, chord :: [Music a] -> Music a
> line :: forall a. [Music a] -> Music a
line   = (Music a -> Music a -> Music a) -> Music a -> [Music a] -> Music a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
(:+:) (Dur -> Music a
forall a. Dur -> Music a
rest Dur
0)
> chord :: forall a. [Music a] -> Music a
chord  = (Music a -> Music a -> Music a) -> Music a -> [Music a] -> Music a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
(:=:) (Dur -> Music a
forall a. Dur -> Music a
rest Dur
0)

> line1, chord1 :: [Music a] -> Music a
> line1 :: forall a. [Music a] -> Music a
line1  = (Music a -> Music a -> Music a) -> [Music a] -> Music a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
(:+:)
> chord1 :: forall a. [Music a] -> Music a
chord1 = (Music a -> Music a -> Music a) -> [Music a] -> Music a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
(:=:)

> offset      :: Dur -> Music a -> Music a
> offset :: forall a. Dur -> Music a -> Music a
offset Dur
d Music a
m  = Dur -> Music a
forall a. Dur -> Music a
rest Dur
d Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a
m

> times      :: Int -> Music a -> Music a
> times :: forall a. Int -> Music a -> Music a
times Int
0 Music a
m  = Dur -> Music a
forall a. Dur -> Music a
rest Dur
0
> times Int
n Music a
m  = Music a
m Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Int -> Music a -> Music a
forall a. Int -> Music a -> Music a
times (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Music a
m

> forever    :: Music a -> Music a
> forever :: forall a. Music a -> Music a
forever Music a
m  = Music a
m Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a -> Music a
forall a. Music a -> Music a
forever Music a
m

> lineToList                    :: Music a -> [Music a]
> lineToList :: forall a. Music a -> [Music a]
lineToList (Prim (Rest Dur
0))    = []
> lineToList (Music a
n :+: Music a
ns)         = Music a
n Music a -> [Music a] -> [Music a]
forall a. a -> [a] -> [a]
: Music a -> [Music a]
forall a. Music a -> [Music a]
lineToList Music a
ns
> lineToList Music a
_                  =
>     String -> [Music a]
forall a. HasCallStack => String -> a
error String
"lineToList: argument not created by function line"

> invertAt :: Pitch -> Music Pitch -> Music Pitch
> invertAt :: Pitch -> Music Pitch -> Music Pitch
invertAt Pitch
pRef = (Pitch -> Pitch) -> Music Pitch -> Music Pitch
forall a b. (a -> b) -> Music a -> Music b
mMap (\Pitch
p -> Int -> Pitch
pitch (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Pitch -> Int
absPitch Pitch
pRef Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pitch -> Int
absPitch Pitch
p))

> invertAt1 :: Pitch -> Music (Pitch, a) -> Music (Pitch, a)
> invertAt1 :: forall a. Pitch -> Music (Pitch, a) -> Music (Pitch, a)
invertAt1 Pitch
pRef = ((Pitch, a) -> (Pitch, a)) -> Music (Pitch, a) -> Music (Pitch, a)
forall a b. (a -> b) -> Music a -> Music b
mMap (\(Pitch
p,a
x) -> (Int -> Pitch
pitch (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Pitch -> Int
absPitch Pitch
pRef Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pitch -> Int
absPitch Pitch
p),a
x))

> invert :: Music Pitch -> Music Pitch
> invert :: Music Pitch -> Music Pitch
invert Music Pitch
m =
>     let pRef :: [Pitch]
pRef = (Primitive Pitch -> [Pitch])
-> ([Pitch] -> [Pitch] -> [Pitch])
-> ([Pitch] -> [Pitch] -> [Pitch])
-> (Control -> [Pitch] -> [Pitch])
-> Music Pitch
-> [Pitch]
forall a b.
(Primitive a -> b)
-> (b -> b -> b)
-> (b -> b -> b)
-> (Control -> b -> b)
-> Music a
-> b
mFold Primitive Pitch -> [Pitch]
forall {a}. Primitive a -> [a]
pFun [Pitch] -> [Pitch] -> [Pitch]
forall a. [a] -> [a] -> [a]
(++) [Pitch] -> [Pitch] -> [Pitch]
forall a. [a] -> [a] -> [a]
(++) (([Pitch] -> Control -> [Pitch]) -> Control -> [Pitch] -> [Pitch]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Pitch] -> Control -> [Pitch]
forall a b. a -> b -> a
const) Music Pitch
m
>     in  if [Pitch] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pitch]
pRef then Music Pitch
m -- no pitches in the structure!

>         else Pitch -> Music Pitch -> Music Pitch
invertAt ([Pitch] -> Pitch
forall a. HasCallStack => [a] -> a
head [Pitch]
pRef) Music Pitch
m
>     where pFun :: Primitive a -> [a]
pFun (Note Dur
d a
p) = [a
p]
>           pFun Primitive a
_ = []

> invert1 :: Music (Pitch,a) -> Music (Pitch,a)
> invert1 :: forall a. Music (Pitch, a) -> Music (Pitch, a)
invert1 Music (Pitch, a)
m =
>     let pRef :: [Pitch]
pRef = (Primitive (Pitch, a) -> [Pitch])
-> ([Pitch] -> [Pitch] -> [Pitch])
-> ([Pitch] -> [Pitch] -> [Pitch])
-> (Control -> [Pitch] -> [Pitch])
-> Music (Pitch, a)
-> [Pitch]
forall a b.
(Primitive a -> b)
-> (b -> b -> b)
-> (b -> b -> b)
-> (Control -> b -> b)
-> Music a
-> b
mFold Primitive (Pitch, a) -> [Pitch]
forall {a} {b}. Primitive (a, b) -> [a]
pFun [Pitch] -> [Pitch] -> [Pitch]
forall a. [a] -> [a] -> [a]
(++) [Pitch] -> [Pitch] -> [Pitch]
forall a. [a] -> [a] -> [a]
(++) (([Pitch] -> Control -> [Pitch]) -> Control -> [Pitch] -> [Pitch]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Pitch] -> Control -> [Pitch]
forall a b. a -> b -> a
const) Music (Pitch, a)
m
>     in  if [Pitch] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pitch]
pRef then Music (Pitch, a)
m -- no pitches!

>         else Pitch -> Music (Pitch, a) -> Music (Pitch, a)
forall a. Pitch -> Music (Pitch, a) -> Music (Pitch, a)
invertAt1 ([Pitch] -> Pitch
forall a. HasCallStack => [a] -> a
head [Pitch]
pRef) Music (Pitch, a)
m
>     where pFun :: Primitive (a, b) -> [a]
pFun (Note Dur
d (a
p,b
x)) = [a
p]
>           pFun Primitive (a, b)
_ = []

> retro               :: Music a -> Music a
> retro :: forall a. Music a -> Music a
retro n :: Music a
n@(Prim Primitive a
_)    = Music a
n
> retro (Modify Control
c Music a
m)  = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify Control
c (Music a -> Music a
forall a. Music a -> Music a
retro Music a
m)
> retro (Music a
m1 :+: Music a
m2)   = Music a -> Music a
forall a. Music a -> Music a
retro Music a
m2 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a -> Music a
forall a. Music a -> Music a
retro Music a
m1
> retro (Music a
m1 :=: Music a
m2)   =
>    let  d1 :: Dur
d1 = Music a -> Dur
forall a. Music a -> Dur
dur Music a
m1
>         d2 :: Dur
d2 = Music a -> Dur
forall a. Music a -> Dur
dur Music a
m2
>    in if Dur
d1Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
>Dur
d2  then Music a -> Music a
forall a. Music a -> Music a
retro Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: (Dur -> Music a
forall a. Dur -> Music a
rest (Dur
d1Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
-Dur
d2) Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a -> Music a
forall a. Music a -> Music a
retro Music a
m2)
>                 else (Dur -> Music a
forall a. Dur -> Music a
rest (Dur
d2Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
-Dur
d1) Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a -> Music a
forall a. Music a -> Music a
retro Music a
m1) Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: Music a -> Music a
forall a. Music a -> Music a
retro Music a
m2

> retroInvert, invertRetro :: Music Pitch -> Music Pitch
> retroInvert :: Music Pitch -> Music Pitch
retroInvert  = Music Pitch -> Music Pitch
forall a. Music a -> Music a
retro  (Music Pitch -> Music Pitch)
-> (Music Pitch -> Music Pitch) -> Music Pitch -> Music Pitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Music Pitch -> Music Pitch
invert
> invertRetro :: Music Pitch -> Music Pitch
invertRetro  = Music Pitch -> Music Pitch
invert (Music Pitch -> Music Pitch)
-> (Music Pitch -> Music Pitch) -> Music Pitch -> Music Pitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Music Pitch -> Music Pitch
forall a. Music a -> Music a
retro

> dur                       :: Music a -> Dur
> dur :: forall a. Music a -> Dur
dur (Prim (Note Dur
d a
_))     = Dur
d
> dur (Prim (Rest Dur
d))       = Dur
d
> dur (Music a
m1 :+: Music a
m2)           = Music a -> Dur
forall a. Music a -> Dur
dur Music a
m1   Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
+   Music a -> Dur
forall a. Music a -> Dur
dur Music a
m2
> dur (Music a
m1 :=: Music a
m2)           = Music a -> Dur
forall a. Music a -> Dur
dur Music a
m1 Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
`max` Music a -> Dur
forall a. Music a -> Dur
dur Music a
m2
> dur (Modify (Tempo Dur
r) Music a
m)  = Music a -> Dur
forall a. Music a -> Dur
dur Music a
m Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/ Dur
r
> dur (Modify Control
_ Music a
m)          = Music a -> Dur
forall a. Music a -> Dur
dur Music a
m

Update as of Euterpea 2.0.7: the cut and remove functions 
previously used to permit zero-duration notes. This can cause
some bad behavior with some synthesizers. The Note cases have
been re-written to turn zero-duration notes into rests.
These functions will still introduce zero-duration rests. 
To remove all zero duration values, use removeZeros.

> cut :: Dur -> Music a -> Music a
> cut :: forall a. Dur -> Music a -> Music a
cut Dur
d Music a
m | Dur
d Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<= Dur
0            = Dur -> Music a
forall a. Dur -> Music a
rest Dur
0
> cut Dur
d (Prim (Note Dur
oldD a
p))  =  let d' :: Dur
d' = Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
max (Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
min Dur
oldD Dur
d) Dur
0
>                                in if Dur
d'Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
>Dur
0 then Dur -> a -> Music a
forall a. Dur -> a -> Music a
note Dur
d' a
p else Dur -> Music a
forall a. Dur -> Music a
rest Dur
0
> cut Dur
d (Prim (Rest Dur
oldD))    = Dur -> Music a
forall a. Dur -> Music a
rest (Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
max (Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
min Dur
oldD Dur
d) Dur
0)
> cut Dur
d (Music a
m1 :=: Music a
m2)           = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
cut Dur
d Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
cut Dur
d Music a
m2
> cut Dur
d (Music a
m1 :+: Music a
m2)           =  let  m'1 :: Music a
m'1  = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
cut Dur
d Music a
m1
>                                     m'2 :: Music a
m'2  = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
cut (Dur
d Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
- Music a -> Dur
forall a. Music a -> Dur
dur Music a
m'1) Music a
m2
>                                in   Music a
m'1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a
m'2
> cut Dur
d (Modify (Tempo Dur
r) Music a
m)  = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
tempo Dur
r (Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
cut (Dur
dDur -> Dur -> Dur
forall a. Num a => a -> a -> a
*Dur
r) Music a
m)
> cut Dur
d (Modify Control
c Music a
m)          = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify Control
c (Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
cut Dur
d Music a
m)

> remove :: Dur -> Music a -> Music a
> remove :: forall a. Dur -> Music a -> Music a
remove Dur
d Music a
m | Dur
d Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<= Dur
0            = Music a
m
> remove Dur
d (Prim (Note Dur
oldD a
p))  =  let d' :: Dur
d' = Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
max (Dur
oldDDur -> Dur -> Dur
forall a. Num a => a -> a -> a
-Dur
d) Dur
0
>                                   in  if Dur
d'Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
>Dur
0 then Dur -> a -> Music a
forall a. Dur -> a -> Music a
note Dur
d' a
p else Dur -> Music a
forall a. Dur -> Music a
rest Dur
0
> remove Dur
d (Prim (Rest Dur
oldD))    = Dur -> Music a
forall a. Dur -> Music a
rest (Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
max (Dur
oldDDur -> Dur -> Dur
forall a. Num a => a -> a -> a
-Dur
d) Dur
0)
> remove Dur
d (Music a
m1 :=: Music a
m2)           = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
remove Dur
d Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
remove Dur
d Music a
m2
> remove Dur
d (Music a
m1 :+: Music a
m2)           =  let  m'1 :: Music a
m'1  = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
remove Dur
d Music a
m1
>                                        m'2 :: Music a
m'2  = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
remove (Dur
d Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
- Music a -> Dur
forall a. Music a -> Dur
dur Music a
m1) Music a
m2
>                                   in   Music a
m'1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a
m'2
> remove Dur
d (Modify (Tempo Dur
r) Music a
m)  = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
tempo Dur
r (Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
remove (Dur
dDur -> Dur -> Dur
forall a. Num a => a -> a -> a
*Dur
r) Music a
m)
> remove Dur
d (Modify Control
c Music a
m)          = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify Control
c (Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
remove Dur
d Music a
m)

> removeZeros :: Music a -> Music a
> removeZeros :: forall a. Music a -> Music a
removeZeros (Prim Primitive a
p)      = Primitive a -> Music a
forall a. Primitive a -> Music a
Prim Primitive a
p
> removeZeros (Music a
m1 :+: Music a
m2)   =
>   let  m'1 :: Music a
m'1  = Music a -> Music a
forall a. Music a -> Music a
removeZeros Music a
m1
>        m'2 :: Music a
m'2  = Music a -> Music a
forall a. Music a -> Music a
removeZeros Music a
m2
>   in case (Music a
m'1,Music a
m'2) of
>        (Prim (Note Dur
0 a
p), Music a
m)  -> Music a
m
>        (Prim (Rest Dur
0  ), Music a
m)  -> Music a
m
>        (Music a
m, Prim (Note Dur
0 a
p))  -> Music a
m
>        (Music a
m, Prim (Rest Dur
0  ))  -> Music a
m
>        (Music a
m1, Music a
m2)              -> Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a
m2
> removeZeros (Music a
m1 :=: Music a
m2)   =
>   let  m'1 :: Music a
m'1  = Music a -> Music a
forall a. Music a -> Music a
removeZeros Music a
m1
>        m'2 :: Music a
m'2  = Music a -> Music a
forall a. Music a -> Music a
removeZeros Music a
m2
>   in case (Music a
m'1,Music a
m'2) of
>        (Prim (Note Dur
0 a
p), Music a
m)  -> Music a
m
>        (Prim (Rest Dur
0  ), Music a
m)  -> Music a
m
>        (Music a
m, Prim (Note Dur
0 a
p))  -> Music a
m
>        (Music a
m, Prim (Rest Dur
0  ))  -> Music a
m
>        (Music a
m1, Music a
m2)              -> Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: Music a
m2
> removeZeros (Modify Control
c Music a
m)  = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify Control
c (Music a -> Music a
forall a. Music a -> Music a
removeZeros Music a
m)


> type LazyDur = [Dur]
> durL :: Music a -> LazyDur
> durL :: forall a. Music a -> LazyDur
durL m :: Music a
m@(Prim Primitive a
_)            =  [Music a -> Dur
forall a. Music a -> Dur
dur Music a
m]
> durL (Music a
m1 :+: Music a
m2)           =  let d1 :: LazyDur
d1 = Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m1
>                               in LazyDur
d1 LazyDur -> LazyDur -> LazyDur
forall a. [a] -> [a] -> [a]
++ (Dur -> Dur) -> LazyDur -> LazyDur
forall a b. (a -> b) -> [a] -> [b]
map (Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
+(LazyDur -> Dur
forall a. HasCallStack => [a] -> a
last LazyDur
d1)) (Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m2)
> durL (Music a
m1 :=: Music a
m2)           =  LazyDur -> LazyDur -> LazyDur
mergeLD (Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m1) (Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m2)
> durL (Modify (Tempo Dur
r) Music a
m)  =  (Dur -> Dur) -> LazyDur -> LazyDur
forall a b. (a -> b) -> [a] -> [b]
map (Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
r) (Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m)
> durL (Modify Control
_ Music a
m)          =  Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m

> mergeLD :: LazyDur -> LazyDur -> LazyDur
> mergeLD :: LazyDur -> LazyDur -> LazyDur
mergeLD [] LazyDur
ld = LazyDur
ld
> mergeLD LazyDur
ld [] = LazyDur
ld
> mergeLD ld1 :: LazyDur
ld1@(Dur
d1:LazyDur
ds1) ld2 :: LazyDur
ld2@(Dur
d2:LazyDur
ds2) =
>   if Dur
d1Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<Dur
d2  then  Dur
d1 Dur -> LazyDur -> LazyDur
forall a. a -> [a] -> [a]
: LazyDur -> LazyDur -> LazyDur
mergeLD LazyDur
ds1 LazyDur
ld2
>             else  Dur
d2 Dur -> LazyDur -> LazyDur
forall a. a -> [a] -> [a]
: LazyDur -> LazyDur -> LazyDur
mergeLD LazyDur
ld1 LazyDur
ds2

> minL :: LazyDur -> Dur -> Dur
> minL :: LazyDur -> Dur -> Dur
minL []      Dur
d' = Dur
d'
> minL [Dur
d]     Dur
d' = Dur -> Dur -> Dur
forall a. Ord a => a -> a -> a
min Dur
d Dur
d'
> minL (Dur
d:LazyDur
ds)  Dur
d' = if Dur
d Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
< Dur
d' then LazyDur -> Dur -> Dur
minL LazyDur
ds Dur
d' else Dur
d'

> cutL :: LazyDur -> Music a -> Music a
> cutL :: forall a. LazyDur -> Music a -> Music a
cutL [] Music a
m                     = Dur -> Music a
forall a. Dur -> Music a
rest Dur
0
> cutL (Dur
d:LazyDur
ds) Music a
m | Dur
d Dur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<= Dur
0        = LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL LazyDur
ds Music a
m
> cutL LazyDur
ld (Prim (Note Dur
oldD a
p))  = Dur -> a -> Music a
forall a. Dur -> a -> Music a
note (LazyDur -> Dur -> Dur
minL LazyDur
ld Dur
oldD) a
p
> cutL LazyDur
ld (Prim (Rest Dur
oldD))    = Dur -> Music a
forall a. Dur -> Music a
rest (LazyDur -> Dur -> Dur
minL LazyDur
ld Dur
oldD)
> cutL LazyDur
ld (Music a
m1 :=: Music a
m2)           = LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL LazyDur
ld Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL LazyDur
ld Music a
m2
> cutL LazyDur
ld (Music a
m1 :+: Music a
m2)           =
>    let  m'1 :: Music a
m'1 = LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL LazyDur
ld Music a
m1
>         m'2 :: Music a
m'2 = LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL ((Dur -> Dur) -> LazyDur -> LazyDur
forall a b. (a -> b) -> [a] -> [b]
map (\Dur
d -> Dur
d Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
- Music a -> Dur
forall a. Music a -> Dur
dur Music a
m'1) LazyDur
ld) Music a
m2
>    in Music a
m'1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a
m'2
> cutL LazyDur
ld (Modify (Tempo Dur
r) Music a
m)  = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
tempo Dur
r (LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL ((Dur -> Dur) -> LazyDur -> LazyDur
forall a b. (a -> b) -> [a] -> [b]
map (Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
*Dur
r) LazyDur
ld) Music a
m)
> cutL LazyDur
ld (Modify Control
c Music a
m)          = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify Control
c (LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL LazyDur
ld Music a
m)

> (/=:)      :: Music a -> Music a -> Music a
> Music a
m1 /=: :: forall a. Music a -> Music a -> Music a
/=: Music a
m2  = LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL (Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m2) Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: LazyDur -> Music a -> Music a
forall a. LazyDur -> Music a -> Music a
cutL (Music a -> LazyDur
forall a. Music a -> LazyDur
durL Music a
m1) Music a
m2

> data PercussionSound =
>         AcousticBassDrum  --  MIDI Key 35

>      |  BassDrum1         --  MIDI Key 36

>      |  SideStick         --  ...

>      |  AcousticSnare  | HandClap      | ElectricSnare  | LowFloorTom
>      |  ClosedHiHat    | HighFloorTom  | PedalHiHat     | LowTom
>      |  OpenHiHat      | LowMidTom     | HiMidTom       | CrashCymbal1
>      |  HighTom        | RideCymbal1   | ChineseCymbal  | RideBell
>      |  Tambourine     | SplashCymbal  | Cowbell        | CrashCymbal2
>      |  Vibraslap      | RideCymbal2   | HiBongo        | LowBongo
>      |  MuteHiConga    | OpenHiConga   | LowConga       | HighTimbale
>      |  LowTimbale     | HighAgogo     | LowAgogo       | Cabasa
>      |  Maracas        | ShortWhistle  | LongWhistle    | ShortGuiro
>      |  LongGuiro      | Claves        | HiWoodBlock    | LowWoodBlock
>      |  MuteCuica      | OpenCuica     | MuteTriangle
>      |  OpenTriangle      --  MIDI Key 82

>    deriving (Int -> PercussionSound -> ShowS
[PercussionSound] -> ShowS
PercussionSound -> String
(Int -> PercussionSound -> ShowS)
-> (PercussionSound -> String)
-> ([PercussionSound] -> ShowS)
-> Show PercussionSound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PercussionSound -> ShowS
showsPrec :: Int -> PercussionSound -> ShowS
$cshow :: PercussionSound -> String
show :: PercussionSound -> String
$cshowList :: [PercussionSound] -> ShowS
showList :: [PercussionSound] -> ShowS
Show,PercussionSound -> PercussionSound -> Bool
(PercussionSound -> PercussionSound -> Bool)
-> (PercussionSound -> PercussionSound -> Bool)
-> Eq PercussionSound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PercussionSound -> PercussionSound -> Bool
== :: PercussionSound -> PercussionSound -> Bool
$c/= :: PercussionSound -> PercussionSound -> Bool
/= :: PercussionSound -> PercussionSound -> Bool
Eq,Eq PercussionSound
Eq PercussionSound =>
(PercussionSound -> PercussionSound -> Ordering)
-> (PercussionSound -> PercussionSound -> Bool)
-> (PercussionSound -> PercussionSound -> Bool)
-> (PercussionSound -> PercussionSound -> Bool)
-> (PercussionSound -> PercussionSound -> Bool)
-> (PercussionSound -> PercussionSound -> PercussionSound)
-> (PercussionSound -> PercussionSound -> PercussionSound)
-> Ord PercussionSound
PercussionSound -> PercussionSound -> Bool
PercussionSound -> PercussionSound -> Ordering
PercussionSound -> PercussionSound -> PercussionSound
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PercussionSound -> PercussionSound -> Ordering
compare :: PercussionSound -> PercussionSound -> Ordering
$c< :: PercussionSound -> PercussionSound -> Bool
< :: PercussionSound -> PercussionSound -> Bool
$c<= :: PercussionSound -> PercussionSound -> Bool
<= :: PercussionSound -> PercussionSound -> Bool
$c> :: PercussionSound -> PercussionSound -> Bool
> :: PercussionSound -> PercussionSound -> Bool
$c>= :: PercussionSound -> PercussionSound -> Bool
>= :: PercussionSound -> PercussionSound -> Bool
$cmax :: PercussionSound -> PercussionSound -> PercussionSound
max :: PercussionSound -> PercussionSound -> PercussionSound
$cmin :: PercussionSound -> PercussionSound -> PercussionSound
min :: PercussionSound -> PercussionSound -> PercussionSound
Ord,Int -> PercussionSound
PercussionSound -> Int
PercussionSound -> [PercussionSound]
PercussionSound -> PercussionSound
PercussionSound -> PercussionSound -> [PercussionSound]
PercussionSound
-> PercussionSound -> PercussionSound -> [PercussionSound]
(PercussionSound -> PercussionSound)
-> (PercussionSound -> PercussionSound)
-> (Int -> PercussionSound)
-> (PercussionSound -> Int)
-> (PercussionSound -> [PercussionSound])
-> (PercussionSound -> PercussionSound -> [PercussionSound])
-> (PercussionSound -> PercussionSound -> [PercussionSound])
-> (PercussionSound
    -> PercussionSound -> PercussionSound -> [PercussionSound])
-> Enum PercussionSound
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PercussionSound -> PercussionSound
succ :: PercussionSound -> PercussionSound
$cpred :: PercussionSound -> PercussionSound
pred :: PercussionSound -> PercussionSound
$ctoEnum :: Int -> PercussionSound
toEnum :: Int -> PercussionSound
$cfromEnum :: PercussionSound -> Int
fromEnum :: PercussionSound -> Int
$cenumFrom :: PercussionSound -> [PercussionSound]
enumFrom :: PercussionSound -> [PercussionSound]
$cenumFromThen :: PercussionSound -> PercussionSound -> [PercussionSound]
enumFromThen :: PercussionSound -> PercussionSound -> [PercussionSound]
$cenumFromTo :: PercussionSound -> PercussionSound -> [PercussionSound]
enumFromTo :: PercussionSound -> PercussionSound -> [PercussionSound]
$cenumFromThenTo :: PercussionSound
-> PercussionSound -> PercussionSound -> [PercussionSound]
enumFromThenTo :: PercussionSound
-> PercussionSound -> PercussionSound -> [PercussionSound]
Enum)

> perc :: PercussionSound -> Dur -> Music Pitch
> perc :: PercussionSound -> Dur -> Music Pitch
perc PercussionSound
ps Dur
dur = InstrumentName -> Music Pitch -> Music Pitch
forall a. InstrumentName -> Music a -> Music a
instrument InstrumentName
Percussion (Music Pitch -> Music Pitch) -> Music Pitch -> Music Pitch
forall a b. (a -> b) -> a -> b
$ Dur -> Pitch -> Music Pitch
forall a. Dur -> a -> Music a
note Dur
dur (Int -> Pitch
pitch (PercussionSound -> Int
forall a. Enum a => a -> Int
fromEnum PercussionSound
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
35))


> pMap               :: (a -> b) -> Primitive a -> Primitive b
> pMap :: forall a b. (a -> b) -> Primitive a -> Primitive b
pMap a -> b
f (Note Dur
d a
x)  = Dur -> b -> Primitive b
forall a. Dur -> a -> Primitive a
Note Dur
d (a -> b
f a
x)
> pMap a -> b
f (Rest Dur
d)    = Dur -> Primitive b
forall a. Dur -> Primitive a
Rest Dur
d

> mMap                 :: (a -> b) -> Music a -> Music b
> mMap :: forall a b. (a -> b) -> Music a -> Music b
mMap a -> b
f (Prim Primitive a
p)      = Primitive b -> Music b
forall a. Primitive a -> Music a
Prim ((a -> b) -> Primitive a -> Primitive b
forall a b. (a -> b) -> Primitive a -> Primitive b
pMap a -> b
f Primitive a
p)
> mMap a -> b
f (Music a
m1 :+: Music a
m2)   = (a -> b) -> Music a -> Music b
forall a b. (a -> b) -> Music a -> Music b
mMap a -> b
f Music a
m1 Music b -> Music b -> Music b
forall a. Music a -> Music a -> Music a
:+: (a -> b) -> Music a -> Music b
forall a b. (a -> b) -> Music a -> Music b
mMap a -> b
f Music a
m2
> mMap a -> b
f (Music a
m1 :=: Music a
m2)   = (a -> b) -> Music a -> Music b
forall a b. (a -> b) -> Music a -> Music b
mMap a -> b
f Music a
m1 Music b -> Music b -> Music b
forall a. Music a -> Music a -> Music a
:=: (a -> b) -> Music a -> Music b
forall a b. (a -> b) -> Music a -> Music b
mMap a -> b
f Music a
m2
> mMap a -> b
f (Modify Control
c Music a
m)  = Control -> Music b -> Music b
forall a. Control -> Music a -> Music a
Modify Control
c ((a -> b) -> Music a -> Music b
forall a b. (a -> b) -> Music a -> Music b
mMap a -> b
f Music a
m)

> instance Functor Primitive where
>     fmap :: forall a b. (a -> b) -> Primitive a -> Primitive b
fmap = (a -> b) -> Primitive a -> Primitive b
forall a b. (a -> b) -> Primitive a -> Primitive b
pMap

> instance Functor Music where
>     fmap :: forall a b. (a -> b) -> Music a -> Music b
fmap = (a -> b) -> Music a -> Music b
forall a b. (a -> b) -> Music a -> Music b
mMap


> mFold ::  (Primitive a -> b) -> (b->b->b) -> (b->b->b) ->
>           (Control -> b -> b) -> Music a -> b
> mFold :: forall a b.
(Primitive a -> b)
-> (b -> b -> b)
-> (b -> b -> b)
-> (Control -> b -> b)
-> Music a
-> b
mFold Primitive a -> b
f b -> b -> b
(+:) b -> b -> b
(=:) Control -> b -> b
g Music a
m =
>   let rec :: Music a -> b
rec = (Primitive a -> b)
-> (b -> b -> b)
-> (b -> b -> b)
-> (Control -> b -> b)
-> Music a
-> b
forall a b.
(Primitive a -> b)
-> (b -> b -> b)
-> (b -> b -> b)
-> (Control -> b -> b)
-> Music a
-> b
mFold Primitive a -> b
f b -> b -> b
(+:) b -> b -> b
(=:) Control -> b -> b
g
>   in case Music a
m of
>        Prim Primitive a
p      -> Primitive a -> b
f Primitive a
p
>        Music a
m1 :+: Music a
m2   -> Music a -> b
rec Music a
m1 b -> b -> b
+: Music a -> b
rec Music a
m2
>        Music a
m1 :=: Music a
m2   -> Music a -> b
rec Music a
m1 b -> b -> b
=: Music a -> b
rec Music a
m2
>        Modify Control
c Music a
m  -> Control -> b -> b
g Control
c (Music a -> b
rec Music a
m)


-- =========================================================================================


Sometimes we may wish to alter the internal structure of a Music value
rather than wrapping it with Modify. The following functions allow this.

> shiftPitches :: AbsPitch -> Music Pitch -> Music Pitch
> shiftPitches :: Int -> Music Pitch -> Music Pitch
shiftPitches Int
k = (Pitch -> Pitch) -> Music Pitch -> Music Pitch
forall a b. (a -> b) -> Music a -> Music b
mMap (Int -> Pitch -> Pitch
trans Int
k)

> shiftPitches1 :: AbsPitch -> Music (Pitch, b) -> Music (Pitch, b)
> shiftPitches1 :: forall b. Int -> Music (Pitch, b) -> Music (Pitch, b)
shiftPitches1 Int
k = ((Pitch, b) -> (Pitch, b)) -> Music (Pitch, b) -> Music (Pitch, b)
forall a b. (a -> b) -> Music a -> Music b
mMap (\(Pitch
p,b
xs) -> (Int -> Pitch -> Pitch
trans Int
k Pitch
p, b
xs))

> scaleDurations :: Rational -> Music a -> Music a
> scaleDurations :: forall a. Dur -> Music a -> Music a
scaleDurations Dur
r (Prim (Note Dur
d a
p)) = Dur -> a -> Music a
forall a. Dur -> a -> Music a
note (Dur
dDur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
r) a
p
> scaleDurations Dur
r (Prim (Rest Dur
d)) = Dur -> Music a
forall a. Dur -> Music a
rest (Dur
dDur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/Dur
r)
> scaleDurations Dur
r (Music a
m1 :+: Music a
m2) = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
scaleDurations Dur
r Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
scaleDurations Dur
r Music a
m2
> scaleDurations Dur
r (Music a
m1 :=: Music a
m2) = Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
scaleDurations Dur
r Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
scaleDurations Dur
r Music a
m2
> scaleDurations Dur
r (Modify Control
c Music a
m) = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify Control
c (Dur -> Music a -> Music a
forall a. Dur -> Music a -> Music a
scaleDurations Dur
r Music a
m)

> changeInstrument :: InstrumentName -> Music a -> Music a
> changeInstrument :: forall a. InstrumentName -> Music a -> Music a
changeInstrument InstrumentName
i Music a
m = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify (InstrumentName -> Control
Instrument InstrumentName
i) (Music a -> Music a) -> Music a -> Music a
forall a b. (a -> b) -> a -> b
$ Music a -> Music a
forall a. Music a -> Music a
removeInstruments Music a
m

> removeInstruments :: Music a -> Music a
> removeInstruments :: forall a. Music a -> Music a
removeInstruments (Modify (Instrument InstrumentName
i) Music a
m) = Music a -> Music a
forall a. Music a -> Music a
removeInstruments Music a
m
> removeInstruments (Modify Control
c Music a
m) = Control -> Music a -> Music a
forall a. Control -> Music a -> Music a
Modify Control
c (Music a -> Music a) -> Music a -> Music a
forall a b. (a -> b) -> a -> b
$ Music a -> Music a
forall a. Music a -> Music a
removeInstruments Music a
m
> removeInstruments (Music a
m1 :+: Music a
m2) = Music a -> Music a
forall a. Music a -> Music a
removeInstruments Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:+: Music a -> Music a
forall a. Music a -> Music a
removeInstruments Music a
m2
> removeInstruments (Music a
m1 :=: Music a
m2) = Music a -> Music a
forall a. Music a -> Music a
removeInstruments Music a
m1 Music a -> Music a -> Music a
forall a. Music a -> Music a -> Music a
:=: Music a -> Music a
forall a. Music a -> Music a
removeInstruments Music a
m2
> removeInstruments Music a
m = Music a
m