diff --git a/music-pitch-literal.cabal b/music-pitch-literal.cabal --- a/music-pitch-literal.cabal +++ b/music-pitch-literal.cabal @@ -1,6 +1,6 @@ name: music-pitch-literal -version: 1.2 +version: 1.3 cabal-version: >= 1.2 author: Hans Hoglund maintainer: Hans Hoglund @@ -15,7 +15,7 @@ This package allow you to write the pitches of standard notation as expressions overloaded on result type. This works exactly like numeric literals. - This library is part of the Haskell Music Suite, see . + This library is part of the Music Suite, see . library build-depends: diff --git a/src/Music/Pitch/Literal.hs b/src/Music/Pitch/Literal.hs --- a/src/Music/Pitch/Literal.hs +++ b/src/Music/Pitch/Literal.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + ------------------------------------------------------------------------------------- -- | -- Copyright : (c) Hans Hoglund 2012 @@ -17,7 +19,11 @@ PitchL(..), IsPitch(..), - + + cs'', ds'', es'', fs'', gs'', as'', bs'', + c'' , d'' , e'' , f'' , g'' , a'' , b'' , + cb'', db'', eb'', fb'', gb'', ab'', bb'', + cs' , ds' , es' , fs' , gs' , as' , bs' , c' , d' , e' , f' , g' , a' , b' , cb' , db' , eb' , fb' , gb' , ab' , bb' , @@ -28,21 +34,74 @@ cs_ , ds_ , es_ , fs_ , gs_ , as_ , bs_ , c_ , d_ , e_ , f_ , g_ , a_ , b_ , - cb_ , db_ , eb_ , fb_ , gb_ , ab_ , bb_ + cb_ , db_ , eb_ , fb_ , gb_ , ab_ , bb_ , + cs__, ds__, es__, fs__, gs__, as__, bs__, + c__ , d__ , e__ , f__ , g__ , a__ , b__ , + cb__, db__, eb__, fb__, gb__, ab__, bb__ ) where +-- | +-- The 'PitchL' types is used to encode a pitch literal. +-- +-- It is defined as /(class, alteration, octave)/, where +-- +-- * /class/ is a pitch class number in /[0,6]/, starting from C. +-- +-- * /alteration/ is the number of semitones, i.e. 0 is natural, 1 for sharp 2 for double sharp, -1 for flat and -2 for double flat. +-- Alteration is in 'Maybe' because some pitch representations differ between explicit and explicit accidentals, i.e. a diatonic +-- pitch type may assume @(0,Nothing,4)@ to mean C sharp rather than C. +-- +-- * /octave/ is octave number in scientific pitch notation. +-- +-- Middle C is represented by the pitch literal @(0, Nothing, 4)@. +-- newtype PitchL = PitchL { getPitchL :: (Int, Maybe Double, Int) } + deriving (Eq, Show, Ord) -- Like Num can be expressed using arabic numerals, instances --- of IsPitch can be expressed using Western pitch names (c, c sharp, c flat etc) +-- of IsPitch can be expressed using Western pitch names (c, c sharp, c flat etc) class IsPitch a where fromPitch :: PitchL -> a instance IsPitch PitchL where fromPitch = id +instance IsPitch a => IsPitch (Maybe a) where + fromPitch = Just . fromPitch +instance IsPitch Double where + fromPitch (PitchL (pc, sem, oct)) = fromIntegral $ semitones sem + diatonic pc + (oct+1) * 12 + where + semitones = maybe 0 round + diatonic pc = case pc of + 0 -> 0 + 1 -> 2 + 2 -> 4 + 3 -> 5 + 4 -> 7 + 5 -> 9 + 6 -> 11 + +instance IsPitch Integer where + fromPitch (PitchL (pc, sem, oct)) = fromIntegral $ semitones sem + diatonic pc + (oct+1) * 12 + where + semitones = maybe 0 round + diatonic pc = case pc of + 0 -> 0 + 1 -> 2 + 2 -> 4 + 3 -> 5 + 4 -> 7 + 5 -> 9 + 6 -> 11 + + +{- +cs'', ds'', es'', fs'', gs'', as'', bs'':: IsPitch a => a +c'' , d'' , e'' , f'' , g'' , a'' , b'' :: IsPitch a => a +cb'', db'', eb'', fb'', gb'', ab'', bb'':: IsPitch a => a + cs' , ds' , es' , fs' , gs' , as' , bs' :: IsPitch a => a c' , d' , e' , f' , g' , a' , b' :: IsPitch a => a cb' , db' , eb' , fb' , gb' , ab' , bb' :: IsPitch a => a @@ -54,8 +113,33 @@ cs_ , ds_ , es_ , fs_ , gs_ , as_ , bs_ :: IsPitch a => a c_ , d_ , e_ , f_ , g_ , a_ , b_ :: IsPitch a => a cb_ , db_ , eb_ , fb_ , gb_ , ab_ , bb_ :: IsPitch a => a +-} +cs'' = fromPitch $ PitchL (0, Just 1, 6) +ds'' = fromPitch $ PitchL (1, Just 1, 6) +es'' = fromPitch $ PitchL (2, Just 1, 6) +fs'' = fromPitch $ PitchL (3, Just 1, 6) +gs'' = fromPitch $ PitchL (4, Just 1, 6) +as'' = fromPitch $ PitchL (5, Just 1, 6) +bs'' = fromPitch $ PitchL (6, Just 1, 6) + +c'' = fromPitch $ PitchL (0, Nothing, 6) +d'' = fromPitch $ PitchL (1, Nothing, 6) +e'' = fromPitch $ PitchL (2, Nothing, 6) +f'' = fromPitch $ PitchL (3, Nothing, 6) +g'' = fromPitch $ PitchL (4, Nothing, 6) +a'' = fromPitch $ PitchL (5, Nothing, 6) +b'' = fromPitch $ PitchL (6, Nothing, 6) + +cb'' = fromPitch $ PitchL (0, Just (-1), 6) +db'' = fromPitch $ PitchL (1, Just (-1), 6) +eb'' = fromPitch $ PitchL (2, Just (-1), 6) +fb'' = fromPitch $ PitchL (3, Just (-1), 6) +gb'' = fromPitch $ PitchL (4, Just (-1), 6) +ab'' = fromPitch $ PitchL (5, Just (-1), 6) +bb'' = fromPitch $ PitchL (6, Just (-1), 6) + cs' = fromPitch $ PitchL (0, Just 1, 5) ds' = fromPitch $ PitchL (1, Just 1, 5) es' = fromPitch $ PitchL (2, Just 1, 5) @@ -127,4 +211,28 @@ gb_ = fromPitch $ PitchL (4, Just (-1), 3) ab_ = fromPitch $ PitchL (5, Just (-1), 3) bb_ = fromPitch $ PitchL (6, Just (-1), 3) + +cs__ = fromPitch $ PitchL (0, Just 1, 2) +ds__ = fromPitch $ PitchL (1, Just 1, 2) +es__ = fromPitch $ PitchL (2, Just 1, 2) +fs__ = fromPitch $ PitchL (3, Just 1, 2) +gs__ = fromPitch $ PitchL (4, Just 1, 2) +as__ = fromPitch $ PitchL (5, Just 1, 2) +bs__ = fromPitch $ PitchL (6, Just 1, 2) + +c__ = fromPitch $ PitchL (0, Nothing, 2) +d__ = fromPitch $ PitchL (1, Nothing, 2) +e__ = fromPitch $ PitchL (2, Nothing, 2) +f__ = fromPitch $ PitchL (3, Nothing, 2) +g__ = fromPitch $ PitchL (4, Nothing, 2) +a__ = fromPitch $ PitchL (5, Nothing, 2) +b__ = fromPitch $ PitchL (6, Nothing, 2) + +cb__ = fromPitch $ PitchL (0, Just (-1), 2) +db__ = fromPitch $ PitchL (1, Just (-1), 2) +eb__ = fromPitch $ PitchL (2, Just (-1), 2) +fb__ = fromPitch $ PitchL (3, Just (-1), 2) +gb__ = fromPitch $ PitchL (4, Just (-1), 2) +ab__ = fromPitch $ PitchL (5, Just (-1), 2) +bb__ = fromPitch $ PitchL (6, Just (-1), 2)