{-# LANGUAGE RecordWildCards, NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- Module : Mezzo.Render.Score -- Description : Score building -- Copyright : (c) Dima Szamozvancev -- License : MIT -- -- Maintainer : ds709@cam.ac.uk -- Stability : experimental -- Portability : portable -- -- Combinators for building scores: 'Music' values with global composition -- attributes such as tempo or key signature. -- ----------------------------------------------------------------------------- module Mezzo.Render.Score ( -- * Scores and attributes Attributes (..) , defAttributes , getTimeSig , getKeySig -- * Score builders , score , section , setTempo , setTimeSig , setKeySig , setRuleSet -- * Rule sets , free , classical , strict ) where import Mezzo.Model import Mezzo.Compose.Harmony import Mezzo.Compose.Builder import Codec.Midi hiding (key, Key) import qualified Codec.Midi as CM (key, Key) import qualified GHC.TypeLits as GT import Prelude hiding (min) ------------------------------------------------------------------------------- -- Attributes ------------------------------------------------------------------------------- -- | Datatype containing MIDI attributes of a Mezzo composition. data Attributes t k r = (Primitive t, Primitive k, ScoreAtt t, ScoreAtt k) => Attributes { title :: String -- ^ The title of the composition. , tempo :: Tempo -- ^ The tempo of the composition in BPM. , timeSignature :: TimeSig t -- ^ The time signature of the composition. , keySignature :: KeyS k -- ^ The key signature of the composition. , ruleSet :: r } -- | Default attributes: "Composition" in C major in common time, with tempo 120 BPM. defAttributes :: Attributes 4 (Key C Natural MajorMode) Classical defAttributes = Attributes { title = "Composition" , tempo = 120 , timeSignature = quadruple , keySignature = c_maj , ruleSet = classical } ------------------------------------------------------------------------------- -- Builders ------------------------------------------------------------------------------- -- Score attribute specifier: uses the default attributes. score :: Spec (Attributes 4 (Key C Natural MajorMode) Classical) score = spec defAttributes -- | Sets the title of the composition. section :: AMut String (Attributes t k r) section atts titl = spec (atts {title = titl}) -- | Sets the tempo of the composition. setTempo :: AMut Tempo (Attributes t k r) setTempo atts temp = spec (atts {tempo = temp}) -- | Sets the time signature of the composition. setTimeSig :: (Primitive t', ScoreAtt t') => AConv (TimeSig t') (Attributes t k r) (Attributes t' k r) setTimeSig Attributes{..} ts = spec (Attributes title tempo ts keySignature ruleSet) -- | Sets the key signature of the composition. setKeySig :: (Primitive k', ScoreAtt k') => AConv (KeyS k') (Attributes t k r) (Attributes t k' r) setKeySig Attributes{..} ks = spec (Attributes title tempo timeSignature ks ruleSet) -- | Sets the key signature of the composition. setRuleSet :: AConv r' (Attributes t k r) (Attributes t k r') setRuleSet Attributes{..} rs = spec (Attributes title tempo timeSignature keySignature rs) -- | Get the time signature MIDI message. getTimeSig :: Attributes t k r -> Message getTimeSig Attributes{timeSignature = t} = getAtt t -- | Get the key signature MIDI message. getKeySig :: Attributes t k r -> Message getKeySig Attributes{keySignature = k} = getAtt k ------------------------------------------------------------------------------- -- Rule sets ------------------------------------------------------------------------------- -- | No enforced rules. free :: Free free = Free -- | Classical rules. classical :: Classical classical = Classical -- | Strict rules strict :: Strict strict = Strict -- | Class for types that can be converted into score attribute MIDI messages. class ScoreAtt a where -- | Get the MIDI message corresponding to a type-level attribute. getAtt :: proxy a -> Message instance ScoreAtt 2 where getAtt t = TimeSignature 2 2 24 8 instance ScoreAtt 3 where getAtt t = TimeSignature 3 2 24 8 instance ScoreAtt 4 where getAtt t = TimeSignature 4 2 24 8 instance ScoreAtt (Key C Flat MajorMode) where getAtt k = KeySignature (-7) 0 instance ScoreAtt (Key G Flat MajorMode) where getAtt k = KeySignature (-6) 0 instance ScoreAtt (Key D Flat MajorMode) where getAtt k = KeySignature (-5) 0 instance ScoreAtt (Key A Flat MajorMode) where getAtt k = KeySignature (-4) 0 instance ScoreAtt (Key E Flat MajorMode) where getAtt k = KeySignature (-3) 0 instance ScoreAtt (Key B Flat MajorMode) where getAtt k = KeySignature (-2) 0 instance ScoreAtt (Key F Natural MajorMode) where getAtt k = KeySignature (-1) 0 instance ScoreAtt (Key C Natural MajorMode) where getAtt k = KeySignature 0 0 instance ScoreAtt (Key G Natural MajorMode) where getAtt k = KeySignature 1 0 instance ScoreAtt (Key D Natural MajorMode) where getAtt k = KeySignature 2 0 instance ScoreAtt (Key A Natural MajorMode) where getAtt k = KeySignature 3 0 instance ScoreAtt (Key E Natural MajorMode) where getAtt k = KeySignature 4 0 instance ScoreAtt (Key B Natural MajorMode) where getAtt k = KeySignature 5 0 instance ScoreAtt (Key F Sharp MajorMode) where getAtt k = KeySignature 6 0 instance ScoreAtt (Key C Sharp MajorMode) where getAtt k = KeySignature 7 0 instance ScoreAtt (Key A Flat MinorMode) where getAtt k = KeySignature (-7) 1 instance ScoreAtt (Key E Flat MinorMode) where getAtt k = KeySignature (-6) 1 instance ScoreAtt (Key B Flat MinorMode) where getAtt k = KeySignature (-5) 1 instance ScoreAtt (Key F Natural MinorMode) where getAtt k = KeySignature (-4) 1 instance ScoreAtt (Key C Natural MinorMode) where getAtt k = KeySignature (-3) 1 instance ScoreAtt (Key G Natural MinorMode) where getAtt k = KeySignature (-2) 1 instance ScoreAtt (Key D Natural MinorMode) where getAtt k = KeySignature (-1) 1 instance ScoreAtt (Key A Natural MinorMode) where getAtt k = KeySignature 0 1 instance ScoreAtt (Key E Natural MinorMode) where getAtt k = KeySignature 1 1 instance ScoreAtt (Key B Natural MinorMode) where getAtt k = KeySignature 2 1 instance ScoreAtt (Key F Sharp MinorMode) where getAtt k = KeySignature 3 1 instance ScoreAtt (Key C Sharp MinorMode) where getAtt k = KeySignature 4 1 instance ScoreAtt (Key G Sharp MinorMode) where getAtt k = KeySignature 5 1 instance ScoreAtt (Key D Sharp MinorMode) where getAtt k = KeySignature 6 1 instance ScoreAtt (Key A Sharp MinorMode) where getAtt k = KeySignature 7 1 instance {-# OVERLAPPABLE #-} GT.TypeError (GT.Text "The key signature is invalid.") => ScoreAtt (Key pc acc mode) where getAtt = undefined