module Music.Prelude.Instances () where
import Data.Default
import Data.Typeable
import Data.AffineSpace.Point
import Music.Pitch
import Music.Dynamics
import Music.Parts
import Music.Score hiding (Pitch, Interval, Fifths, Note)
import qualified Music.Score as Score
import qualified Music.Lilypond as Lilypond
import qualified Music.MusicXml.Simple as Xml
deriving instance Typeable Music.Parts.Part
type instance Music.Score.Part BasicPart = BasicPart
instance HasPart BasicPart where
getPart = id
modifyPart = id
instance Delayable Pitch
instance Stretchable Pitch
type instance Score.Pitch Pitch = Pitch
instance HasGetPitch Pitch where
__getPitch = id
instance (a ~ Score.Pitch a) => HasSetPitch Pitch a where
type SetPitch a Pitch = a
__mapPitch = id
instance Tiable Pitch where
beginTie = id
endTie = id
instance HasMidi Semitones where
getMidi a = getMidi $ (60 + fromIntegral a :: Integer)
instance HasMidi Pitch where
getMidi p = getMidi $ semitones (p .-. c)
instance HasMusicXml Pitch where
getMusicXml (realToFrac -> d) = (`Xml.note` d) . snd3 Just . spellPitch
getMusicXmlChord (realToFrac -> d) = (`Xml.chord` (realToFrac d)) . fmap (snd3 Just . spellPitch)
instance HasLilypond Pitch where
getLilypond d = (^*realToFrac (d*4)) . Lilypond.note . pitchLilypond . Lilypond.Pitch . spellPitch . (.+^ perfect octave)
getLilypondChord d = (^*realToFrac (d*4)) . Lilypond.chord . fmap (pitchLilypond . Lilypond.Pitch . spellPitch . (.+^ perfect octave))
snd3 f (a, b, c) = (a, f b, c)
pitchLilypond a = Lilypond.NotePitch a Nothing
spellPitch :: (Enum p, Num a, Num o) => Pitch -> (p, a, o)
spellPitch p = (pitchName, pitchAccidental, octave)
where
pitchName = toEnum $ fromEnum $ name p
pitchAccidental = fromIntegral $ accidental p
octave = fromIntegral $ (+ 4) $ octaves (p .-. c)
instance Alterable a => Alterable (Score a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (ChordT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (DynamicT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (SlideT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (TieT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (HarmonicT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (ArticulationT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (TextT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (TremoloT a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Alterable a => Alterable (PartT n a) where
sharpen = fmap sharpen
flatten = fmap flatten
instance Augmentable a => Augmentable (Score a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (ChordT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (DynamicT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (SlideT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (TieT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (HarmonicT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (ArticulationT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (TextT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (TremoloT a) where
augment = fmap augment
diminish = fmap diminish
instance Augmentable a => Augmentable (PartT n a) where
augment = fmap augment
diminish = fmap diminish
instance HasMidiProgram BasicPart where
getMidiChannel _ = 0
getMidiProgram _ = 0
instance HasMidiProgram Music.Parts.Part where
getMidiChannel = defaultMidiChannel
getMidiProgram = fixStrings . defaultMidiProgram
where
fixStrings x = case x of
40 -> 48
41 -> 48
42 -> 48
x -> x