-- Copyright 2013 Evan Laforge -- This program is distributed under the terms of the GNU General Public -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt {-# LANGUAGE DeriveDataTypeable #-} {- | Representation for scales, pitches, and frequencies (note numbers). There are many representations for a pitch, at many different levels of abstraction. -} module Perform.Pitch ( -- * Note Note(..), note_text -- * Pitch , Pitch(..), pitch, Degree(..) , Octave, PitchClass, Accidentals, Semi, FSemi, Step , pitch_accidentals, pitch_pc , add_octave, add_pc, diff_pc , middle_octave, middle_c -- * Input , Input(..), KbdType(..), Frac -- * NoteNumber , NoteNumber(..), nn, nn_to_double , Cent, nn_to_cents , nns_equal, nns_close -- * Hz , Hz, add_hz, modify_hz, nn_to_hz, hz_to_nn, middle_c_hz -- * Scale , ScaleId(..), empty_scale, twelve , Transpose(..), zero_transpose, modify_transpose , Key(Key), key_text ) where import qualified Data.String as String import qualified Data.Text as Text import qualified Data.Typeable as Typeable import qualified Text.ParserCombinators.ReadP as ReadP import qualified Text.Read as Read import qualified Util.Num as Num import qualified Util.Pretty as Pretty import qualified Util.Serialize as Serialize import qualified Util.Test.ApproxEq as ApproxEq import qualified Derive.ShowVal as ShowVal import Global -- * Note -- | A Note is the most abstract representation of pitch, in that it's simply -- an unparsed bit of text representing that pitch. Given a Scale, it's -- expected to name a val call exported by that scale. newtype Note = Note Text deriving (Note -> Note -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Note -> Note -> Bool $c/= :: Note -> Note -> Bool == :: Note -> Note -> Bool $c== :: Note -> Note -> Bool Eq, Eq Note Note -> Note -> Bool Note -> Note -> Ordering Note -> Note -> Note 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 min :: Note -> Note -> Note $cmin :: Note -> Note -> Note max :: Note -> Note -> Note $cmax :: Note -> Note -> Note >= :: Note -> Note -> Bool $c>= :: Note -> Note -> Bool > :: Note -> Note -> Bool $c> :: Note -> Note -> Bool <= :: Note -> Note -> Bool $c<= :: Note -> Note -> Bool < :: Note -> Note -> Bool $c< :: Note -> Note -> Bool compare :: Note -> Note -> Ordering $ccompare :: Note -> Note -> Ordering Ord, Cent -> Note -> ShowS [Note] -> ShowS Note -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Note] -> ShowS $cshowList :: [Note] -> ShowS show :: Note -> String $cshow :: Note -> String showsPrec :: Cent -> Note -> ShowS $cshowsPrec :: Cent -> Note -> ShowS Show, String -> Note forall a. (String -> a) -> IsString a fromString :: String -> Note $cfromString :: String -> Note String.IsString, Get Note Putter Note forall a. Putter a -> Get a -> Serialize a get :: Get Note $cget :: Get Note put :: Putter Note $cput :: Putter Note Serialize.Serialize) note_text :: Note -> Text note_text :: Note -> Text note_text (Note Text s) = Text s instance Pretty Note where pretty :: Note -> Text pretty (Note Text n) = Text n -- * pitch -- | A Pitch is a parsed 'Note'. Functions that want to manipulate notes -- in a scale-independent way can ask the scale to convert to and from a Note. -- Not all scales use all the fields. data Pitch = Pitch { Pitch -> Cent pitch_octave :: !Octave , Pitch -> Degree pitch_degree :: !Degree } deriving (Pitch -> Pitch -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Pitch -> Pitch -> Bool $c/= :: Pitch -> Pitch -> Bool == :: Pitch -> Pitch -> Bool $c== :: Pitch -> Pitch -> Bool Eq, Eq Pitch Pitch -> Pitch -> Bool Pitch -> Pitch -> Ordering Pitch -> Pitch -> Pitch 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 min :: Pitch -> Pitch -> Pitch $cmin :: Pitch -> Pitch -> Pitch max :: Pitch -> Pitch -> Pitch $cmax :: Pitch -> Pitch -> Pitch >= :: Pitch -> Pitch -> Bool $c>= :: Pitch -> Pitch -> Bool > :: Pitch -> Pitch -> Bool $c> :: Pitch -> Pitch -> Bool <= :: Pitch -> Pitch -> Bool $c<= :: Pitch -> Pitch -> Bool < :: Pitch -> Pitch -> Bool $c< :: Pitch -> Pitch -> Bool compare :: Pitch -> Pitch -> Ordering $ccompare :: Pitch -> Pitch -> Ordering Ord, ReadPrec [Pitch] ReadPrec Pitch Cent -> ReadS Pitch ReadS [Pitch] forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Pitch] $creadListPrec :: ReadPrec [Pitch] readPrec :: ReadPrec Pitch $creadPrec :: ReadPrec Pitch readList :: ReadS [Pitch] $creadList :: ReadS [Pitch] readsPrec :: Cent -> ReadS Pitch $creadsPrec :: Cent -> ReadS Pitch Read, Cent -> Pitch -> ShowS [Pitch] -> ShowS Pitch -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Pitch] -> ShowS $cshowList :: [Pitch] -> ShowS show :: Pitch -> String $cshow :: Pitch -> String showsPrec :: Cent -> Pitch -> ShowS $cshowsPrec :: Cent -> Pitch -> ShowS Show) pitch :: Enum pc => Octave -> pc -> Pitch pitch :: forall pc. Enum pc => Cent -> pc -> Pitch pitch Cent oct pc pc = Cent -> Degree -> Pitch Pitch Cent oct (Cent -> Cent -> Degree Degree (forall a. Enum a => a -> Cent fromEnum pc pc) Cent 0) instance Pretty Pitch where pretty :: Pitch -> Text pretty (Pitch Cent oct Degree degree) = forall a. Show a => a -> Text showt Cent oct forall a. Semigroup a => a -> a -> a <> Text "-" forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Degree degree -- | This relies on the presence of a @pitch@ val call. instance ShowVal.ShowVal Pitch where show_val :: Pitch -> Text show_val (Pitch Cent oct (Degree Cent pc Cent accs)) = Text "(pitch " forall a. Semigroup a => a -> a -> a <> [Text] -> Text Text.unwords [Text] args forall a. Semigroup a => a -> a -> a <> Text ")" where args :: [Text] args = forall a b. (a -> b) -> [a] -> [b] map forall a. Show a => a -> Text showt forall a b. (a -> b) -> a -> b $ Cent oct forall a. a -> [a] -> [a] : Cent pc forall a. a -> [a] -> [a] : if Cent accs forall a. Eq a => a -> a -> Bool == Cent 0 then [] else [Cent accs] instance Serialize.Serialize Pitch where put :: Putter Pitch put (Pitch Cent a Degree b) = forall a. Serialize a => Putter a Serialize.put Cent a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall a. Serialize a => Putter a Serialize.put Degree b get :: Get Pitch get = Cent -> Degree -> Pitch Pitch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Serialize a => Get a Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Serialize a => Get a Serialize.get -- | A scale degree, without reference to an octave. data Degree = Degree { Degree -> Cent degree_pc :: !PitchClass -- | Ignored for diatonic scales. , Degree -> Cent degree_accidentals :: !Accidentals } deriving (Degree -> Degree -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Degree -> Degree -> Bool $c/= :: Degree -> Degree -> Bool == :: Degree -> Degree -> Bool $c== :: Degree -> Degree -> Bool Eq, Eq Degree Degree -> Degree -> Bool Degree -> Degree -> Ordering Degree -> Degree -> Degree 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 min :: Degree -> Degree -> Degree $cmin :: Degree -> Degree -> Degree max :: Degree -> Degree -> Degree $cmax :: Degree -> Degree -> Degree >= :: Degree -> Degree -> Bool $c>= :: Degree -> Degree -> Bool > :: Degree -> Degree -> Bool $c> :: Degree -> Degree -> Bool <= :: Degree -> Degree -> Bool $c<= :: Degree -> Degree -> Bool < :: Degree -> Degree -> Bool $c< :: Degree -> Degree -> Bool compare :: Degree -> Degree -> Ordering $ccompare :: Degree -> Degree -> Ordering Ord, ReadPrec [Degree] ReadPrec Degree Cent -> ReadS Degree ReadS [Degree] forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Degree] $creadListPrec :: ReadPrec [Degree] readPrec :: ReadPrec Degree $creadPrec :: ReadPrec Degree readList :: ReadS [Degree] $creadList :: ReadS [Degree] readsPrec :: Cent -> ReadS Degree $creadsPrec :: Cent -> ReadS Degree Read, Cent -> Degree -> ShowS [Degree] -> ShowS Degree -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Degree] -> ShowS $cshowList :: [Degree] -> ShowS show :: Degree -> String $cshow :: Degree -> String showsPrec :: Cent -> Degree -> ShowS $cshowsPrec :: Cent -> Degree -> ShowS Show) instance Pretty Degree where pretty :: Degree -> Text pretty (Degree Cent pc Cent acc) = forall a. Show a => a -> Text showt Cent pc forall a. Semigroup a => a -> a -> a <> if Cent acc forall a. Ord a => a -> a -> Bool < Cent 0 then Cent -> Text -> Text Text.replicate (forall a. Num a => a -> a abs Cent acc) Text "b" else Cent -> Text -> Text Text.replicate Cent acc Text "#" instance Serialize.Serialize Degree where put :: Putter Degree put (Degree Cent a Cent b) = forall a. Serialize a => Putter a Serialize.put Cent a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall a. Serialize a => Putter a Serialize.put Cent b get :: Get Degree get = Cent -> Cent -> Degree Degree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Serialize a => Get a Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Serialize a => Get a Serialize.get -- | Just a way to label an octave, either relative or absolute. type Octave = Int -- | A PitchClass maps directly to a scale degree, which is a letter in -- traditional Western notation, though this PitchClass may have fewer or -- greater than 7 notes. The PitchClass is absolute in that it doesn't depend -- on the tonic of a key. -- -- These numbers are expected to wrap around at the octave, so they usually use -- modular arithmetic, but if an octave is not handy (i.e. they're not in -- a 'Pitch'), then steps exceeding an octave will be wrapped into an octave -- when one is available. type PitchClass = Int -- | Positive for sharps, negative for flats. type Accidentals = Int -- | Number of semitones. This is an absolute measure from octave 0, -- regardless of whether the scale has notes at octave 0. This is so you can -- convert between Semis and the similarly absolute 'Pitch' in the same way for -- all scales. type Semi = Int -- | This is like 'Semi', but floating point. type FSemi = Double -- | This is a relative amount of transposition. It could be either chromatic -- or diatonic. type Step = Int pitch_accidentals :: Pitch -> Accidentals pitch_accidentals :: Pitch -> Cent pitch_accidentals = Degree -> Cent degree_accidentals forall b c a. (b -> c) -> (a -> b) -> a -> c . Pitch -> Degree pitch_degree pitch_pc :: Pitch -> PitchClass pitch_pc :: Pitch -> Cent pitch_pc = Degree -> Cent degree_pc forall b c a. (b -> c) -> (a -> b) -> a -> c . Pitch -> Degree pitch_degree add_octave :: Octave -> Pitch -> Pitch add_octave :: Cent -> Pitch -> Pitch add_octave Cent oct (Pitch Cent octave Degree degree) = Cent -> Degree -> Pitch Pitch (Cent oct forall a. Num a => a -> a -> a + Cent octave) Degree degree -- | Add diatonic steps. This doesn't deal with key signatures or non-diatonic -- scales. add_pc :: PitchClass -> PitchClass -> Pitch -> Pitch add_pc :: Cent -> Cent -> Pitch -> Pitch add_pc Cent per_octave Cent steps (Pitch Cent octave (Degree Cent pc Cent accs)) = Cent -> Degree -> Pitch Pitch (Cent oct forall a. Num a => a -> a -> a + Cent octave) (Cent -> Cent -> Degree Degree Cent pc2 Cent accs) where (Cent oct, Cent pc2) = (Cent pc forall a. Num a => a -> a -> a + Cent steps) forall a. Integral a => a -> a -> (a, a) `divMod` Cent per_octave diff_pc :: PitchClass -> Pitch -> Pitch -> PitchClass diff_pc :: Cent -> Pitch -> Pitch -> Cent diff_pc Cent per_octave (Pitch Cent oct1 (Degree Cent pc1 Cent _)) (Pitch Cent oct2 (Degree Cent pc2 Cent _)) = Cent oct_diff forall a. Num a => a -> a -> a + Cent pc1 forall a. Num a => a -> a -> a - Cent pc2 where oct_diff :: Cent oct_diff = Cent per_octave forall a. Num a => a -> a -> a * (Cent oct1 forall a. Num a => a -> a -> a - Cent oct2) -- | The middle octave. The \"center\" of a scale should be oriented around -- this. middle_octave :: Octave middle_octave :: Cent middle_octave = Cent 4 middle_c :: Pitch middle_c :: Pitch middle_c = Cent -> Degree -> Pitch Pitch Cent middle_octave (Cent -> Cent -> Degree Degree Cent 0 Cent 0) -- * Input -- | A physically played note on some input device. This hasn't been mapped to -- a scale yet, so the Pitch is in the context of the device's layout. -- -- I have 3 kinds of kbds: -- -- ASCII has 10 white keys, and black keys between each one. It should be -- relative, so that C or sa is always on Q and Z, and if the octave is <10 -- then it will wrap on the same row. -- -- MIDI has the usual piano layout. It's absolute, so that a relative scale -- can start at keys other than C, if that would be convenient for the layout. -- The octave is rounded up to the nearest multiple of 7, and the extra keys -- are unused, so the octave always starts at C. -- -- Continuum has no keys, just NNs. So it gets the scale degree that's -- closest to the given NN. That's different from the MIDI kbd because the -- MIDI kbd never wants a key to emit something between notes. TODO not -- supported yet data Input = Input !KbdType !Pitch !Frac deriving (Input -> Input -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Input -> Input -> Bool $c/= :: Input -> Input -> Bool == :: Input -> Input -> Bool $c== :: Input -> Input -> Bool Eq, Cent -> Input -> ShowS [Input] -> ShowS Input -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Input] -> ShowS $cshowList :: [Input] -> ShowS show :: Input -> String $cshow :: Input -> String showsPrec :: Cent -> Input -> ShowS $cshowsPrec :: Cent -> Input -> ShowS Show) data KbdType = -- | An absolute kbd maps the same key to the same absolute pitch, -- regardless of the key. This is the case for a piano style kbd. -- This is consistent with convention, but also the piano kbd has a fixed -- layout of white and black keys. So if you e.g. transpose A-major to -- start on C, then you have a mysterious black key in between B and C, and -- no way to play C#. PianoKbd -- | A relative kbd always maps the same key to the same relative pitch. -- This is appropriate for the ASCII kbd, because it has \"black keys\" -- between every white key, so scales can be transposed freely. | AsciiKbd deriving (KbdType -> KbdType -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: KbdType -> KbdType -> Bool $c/= :: KbdType -> KbdType -> Bool == :: KbdType -> KbdType -> Bool $c== :: KbdType -> KbdType -> Bool Eq, Cent -> KbdType -> ShowS [KbdType] -> ShowS KbdType -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [KbdType] -> ShowS $cshowList :: [KbdType] -> ShowS show :: KbdType -> String $cshow :: KbdType -> String showsPrec :: Cent -> KbdType -> ShowS $cshowsPrec :: Cent -> KbdType -> ShowS Show) -- | A number between -1 and 1 exclusive, representing the portion of the way -- between two scale degrees. I could have used \"Cents\" for this, but that -- implies equal temperedness. type Frac = Double instance Pretty Input where pretty :: Input -> Text pretty (Input KbdType kbd Pitch pitch Double frac) = forall a. Show a => a -> Text showt KbdType kbd forall a. Semigroup a => a -> a -> a <> Text ":" forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Pitch pitch forall a. Semigroup a => a -> a -> a <> if Double frac forall a. Eq a => a -> a -> Bool == Double 0 then Text "" else Text "+" forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Double frac -- * NoteNumber -- | This is equal tempered scale notes with the same definition as MIDI, so -- MIDI note 0 is NoteNumber 0, at 8.176 Hz, and is -1c. Middle C (4c) is -- NoteNumber 60. -- -- 'Derive.PSignal.PSignal's are converted into this before performance -- since performance doesn't understand scales. newtype NoteNumber = NoteNumber Double deriving (Double -> NoteNumber -> NoteNumber -> Bool forall a. (Double -> a -> a -> Bool) -> ApproxEq a eq :: Double -> NoteNumber -> NoteNumber -> Bool $ceq :: Double -> NoteNumber -> NoteNumber -> Bool ApproxEq.ApproxEq, NoteNumber -> NoteNumber -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: NoteNumber -> NoteNumber -> Bool $c/= :: NoteNumber -> NoteNumber -> Bool == :: NoteNumber -> NoteNumber -> Bool $c== :: NoteNumber -> NoteNumber -> Bool Eq, Eq NoteNumber NoteNumber -> NoteNumber -> Bool NoteNumber -> NoteNumber -> Ordering NoteNumber -> NoteNumber -> NoteNumber 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 min :: NoteNumber -> NoteNumber -> NoteNumber $cmin :: NoteNumber -> NoteNumber -> NoteNumber max :: NoteNumber -> NoteNumber -> NoteNumber $cmax :: NoteNumber -> NoteNumber -> NoteNumber >= :: NoteNumber -> NoteNumber -> Bool $c>= :: NoteNumber -> NoteNumber -> Bool > :: NoteNumber -> NoteNumber -> Bool $c> :: NoteNumber -> NoteNumber -> Bool <= :: NoteNumber -> NoteNumber -> Bool $c<= :: NoteNumber -> NoteNumber -> Bool < :: NoteNumber -> NoteNumber -> Bool $c< :: NoteNumber -> NoteNumber -> Bool compare :: NoteNumber -> NoteNumber -> Ordering $ccompare :: NoteNumber -> NoteNumber -> Ordering Ord, Num NoteNumber Rational -> NoteNumber NoteNumber -> NoteNumber NoteNumber -> NoteNumber -> NoteNumber forall a. Num a -> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a fromRational :: Rational -> NoteNumber $cfromRational :: Rational -> NoteNumber recip :: NoteNumber -> NoteNumber $crecip :: NoteNumber -> NoteNumber / :: NoteNumber -> NoteNumber -> NoteNumber $c/ :: NoteNumber -> NoteNumber -> NoteNumber Fractional, Num NoteNumber Ord NoteNumber NoteNumber -> Rational forall a. Num a -> Ord a -> (a -> Rational) -> Real a toRational :: NoteNumber -> Rational $ctoRational :: NoteNumber -> Rational Real, Fractional NoteNumber Real NoteNumber forall b. Integral b => NoteNumber -> b forall b. Integral b => NoteNumber -> (b, NoteNumber) forall a. Real a -> Fractional a -> (forall b. Integral b => a -> (b, a)) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> RealFrac a floor :: forall b. Integral b => NoteNumber -> b $cfloor :: forall b. Integral b => NoteNumber -> b ceiling :: forall b. Integral b => NoteNumber -> b $cceiling :: forall b. Integral b => NoteNumber -> b round :: forall b. Integral b => NoteNumber -> b $cround :: forall b. Integral b => NoteNumber -> b truncate :: forall b. Integral b => NoteNumber -> b $ctruncate :: forall b. Integral b => NoteNumber -> b properFraction :: forall b. Integral b => NoteNumber -> (b, NoteNumber) $cproperFraction :: forall b. Integral b => NoteNumber -> (b, NoteNumber) RealFrac, Integer -> NoteNumber NoteNumber -> NoteNumber NoteNumber -> NoteNumber -> NoteNumber forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a fromInteger :: Integer -> NoteNumber $cfromInteger :: Integer -> NoteNumber signum :: NoteNumber -> NoteNumber $csignum :: NoteNumber -> NoteNumber abs :: NoteNumber -> NoteNumber $cabs :: NoteNumber -> NoteNumber negate :: NoteNumber -> NoteNumber $cnegate :: NoteNumber -> NoteNumber * :: NoteNumber -> NoteNumber -> NoteNumber $c* :: NoteNumber -> NoteNumber -> NoteNumber - :: NoteNumber -> NoteNumber -> NoteNumber $c- :: NoteNumber -> NoteNumber -> NoteNumber + :: NoteNumber -> NoteNumber -> NoteNumber $c+ :: NoteNumber -> NoteNumber -> NoteNumber Num, Get NoteNumber Putter NoteNumber forall a. Putter a -> Get a -> Serialize a get :: Get NoteNumber $cget :: Get NoteNumber put :: Putter NoteNumber $cput :: Putter NoteNumber Serialize.Serialize, Typeable.Typeable) instance Show NoteNumber where show :: NoteNumber -> String show (NoteNumber Double nn) = forall a. Show a => a -> String show Double nn forall a. Semigroup a => a -> a -> a <> String "nn" instance Read NoteNumber where readPrec :: ReadPrec NoteNumber readPrec = do Double n <- forall a. Read a => ReadPrec a Read.readPrec forall a. ReadP a -> ReadPrec a Read.lift forall a b. (a -> b) -> a -> b $ ReadP () ReadP.skipSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> String -> ReadP String ReadP.string String "nn" forall (m :: * -> *) a. Monad m => a -> m a return (Double -> NoteNumber NoteNumber Double n) instance ShowVal.ShowVal NoteNumber where show_val :: NoteNumber -> Text show_val (NoteNumber Double nn) = forall a. ShowVal a => a -> Text ShowVal.show_val Double nn forall a. Semigroup a => a -> a -> a <> Text "nn" -- The suffix should be the same as DeriveT.type_to_code Nn instance Pretty NoteNumber where pretty :: NoteNumber -> Text pretty (NoteNumber Double nn) = forall a. RealFloat a => Maybe Cent -> a -> Text Num.showFloat0 (forall a. a -> Maybe a Just Cent 3) Double nn forall a. Semigroup a => a -> a -> a <> Text "nn" nn :: Real a => a -> NoteNumber nn :: forall a. Real a => a -> NoteNumber nn = Double -> NoteNumber NoteNumber forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Real a, Fractional b) => a -> b realToFrac nn_to_double :: NoteNumber -> Double nn_to_double :: NoteNumber -> Double nn_to_double (NoteNumber Double nn) = Double nn type Cent = Int nn_to_cents :: NoteNumber -> Cent nn_to_cents :: NoteNumber -> Cent nn_to_cents = forall a b. (RealFrac a, Integral b) => a -> b round forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a. Num a => a -> a -> a *NoteNumber 100) -- | True if the NoteNumbers are close enough that they sound the same. nns_equal :: NoteNumber -> NoteNumber -> Bool nns_equal :: NoteNumber -> NoteNumber -> Bool nns_equal = Cent -> NoteNumber -> NoteNumber -> Bool nns_close Cent 3 -- almost certainly less than JND nns_close :: Cent -> NoteNumber -> NoteNumber -> Bool nns_close :: Cent -> NoteNumber -> NoteNumber -> Bool nns_close Cent cents NoteNumber nn1 NoteNumber nn2 = forall a. Num a => a -> a abs (NoteNumber -> Cent nn_to_cents NoteNumber nn1 forall a. Num a => a -> a -> a - NoteNumber -> Cent nn_to_cents NoteNumber nn2) forall a. Ord a => a -> a -> Bool <= Cent cents -- * Hz -- | This is absolute non-logarithmic frequency. type Hz = Double add_hz :: Hz -> NoteNumber -> NoteNumber add_hz :: Double -> NoteNumber -> NoteNumber add_hz Double 0 NoteNumber nn = NoteNumber nn -- hz_to_nn . nn_to_hz adds a tiny bit of inaccuracy add_hz Double hz NoteNumber nn = Double -> NoteNumber hz_to_nn (Double hz forall a. Num a => a -> a -> a + NoteNumber -> Double nn_to_hz NoteNumber nn) modify_hz :: (Hz -> Hz) -> NoteNumber -> NoteNumber modify_hz :: (Double -> Double) -> NoteNumber -> NoteNumber modify_hz Double -> Double f = Double -> NoteNumber hz_to_nn forall b c a. (b -> c) -> (a -> b) -> a -> c . Double -> Double f forall b c a. (b -> c) -> (a -> b) -> a -> c . NoteNumber -> Double nn_to_hz nn_to_hz :: NoteNumber -> Hz nn_to_hz :: NoteNumber -> Double nn_to_hz (NoteNumber Double nn) = forall a. Floating a => a -> a exp (Double nn forall a. Num a => a -> a -> a * Double _hz_scale forall a. Num a => a -> a -> a + Double _hz_offset) -- | Negative hz will result in NaN. TODO take an abs or throw an error, or -- let the NaN propagate? hz_to_nn :: Hz -> NoteNumber hz_to_nn :: Double -> NoteNumber hz_to_nn Double hz = Double -> NoteNumber NoteNumber forall a b. (a -> b) -> a -> b $ (forall a. Floating a => a -> a log Double hz forall a. Num a => a -> a -> a - Double _hz_offset) forall a. Fractional a => a -> a -> a / Double _hz_scale -- | Constants to calculate equal tempered conversions. _hz_scale, _hz_offset :: Hz _hz_scale :: Double _hz_scale = forall a. Floating a => a -> a log Double 2 forall a. Fractional a => a -> a -> a / Double 12 _hz_offset :: Double _hz_offset = forall a. Floating a => a -> a log Double a_hz forall a. Num a => a -> a -> a - (Double a_nn forall a. Num a => a -> a -> a * Double _hz_scale) where -- NoteNumber is defined with these values. Ultimately it's because midi -- synthesizers are by default defined with these values. a_hz :: Double a_hz = Double 440 a_nn :: Double a_nn = Double 69 middle_c_hz :: Hz middle_c_hz :: Double middle_c_hz = NoteNumber -> Double nn_to_hz NoteNumber 60 -- Alternate implementation that also introduces a bit of imprecision. Seems -- to be about the same as the one above. -- -- nn_to_hz :: NoteNumber -> Hz -- nn_to_hz (NoteNumber nn) = a_hz * rt12 ** (nn - a_nn) -- where rt12 = 2**(1/12) -- -- hz_to_nn :: Hz -> NoteNumber -- hz_to_nn hz = NoteNumber $ logBase rt12 (hz / a_hz * (rt12**a_nn)) -- where rt12 = 2**(1/12) -- -- a_hz, a_nn :: Double -- a_hz = 440 -- a_nn = 69 -- * scale newtype ScaleId = ScaleId Text deriving (ScaleId -> ScaleId -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ScaleId -> ScaleId -> Bool $c/= :: ScaleId -> ScaleId -> Bool == :: ScaleId -> ScaleId -> Bool $c== :: ScaleId -> ScaleId -> Bool Eq, Eq ScaleId ScaleId -> ScaleId -> Bool ScaleId -> ScaleId -> Ordering ScaleId -> ScaleId -> ScaleId 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 min :: ScaleId -> ScaleId -> ScaleId $cmin :: ScaleId -> ScaleId -> ScaleId max :: ScaleId -> ScaleId -> ScaleId $cmax :: ScaleId -> ScaleId -> ScaleId >= :: ScaleId -> ScaleId -> Bool $c>= :: ScaleId -> ScaleId -> Bool > :: ScaleId -> ScaleId -> Bool $c> :: ScaleId -> ScaleId -> Bool <= :: ScaleId -> ScaleId -> Bool $c<= :: ScaleId -> ScaleId -> Bool < :: ScaleId -> ScaleId -> Bool $c< :: ScaleId -> ScaleId -> Bool compare :: ScaleId -> ScaleId -> Ordering $ccompare :: ScaleId -> ScaleId -> Ordering Ord, ReadPrec [ScaleId] ReadPrec ScaleId Cent -> ReadS ScaleId ReadS [ScaleId] forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [ScaleId] $creadListPrec :: ReadPrec [ScaleId] readPrec :: ReadPrec ScaleId $creadPrec :: ReadPrec ScaleId readList :: ReadS [ScaleId] $creadList :: ReadS [ScaleId] readsPrec :: Cent -> ReadS ScaleId $creadsPrec :: Cent -> ReadS ScaleId Read, Cent -> ScaleId -> ShowS [ScaleId] -> ShowS ScaleId -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ScaleId] -> ShowS $cshowList :: [ScaleId] -> ShowS show :: ScaleId -> String $cshow :: ScaleId -> String showsPrec :: Cent -> ScaleId -> ShowS $cshowsPrec :: Cent -> ScaleId -> ShowS Show, String -> ScaleId forall a. (String -> a) -> IsString a fromString :: String -> ScaleId $cfromString :: String -> ScaleId String.IsString, Get ScaleId Putter ScaleId forall a. Putter a -> Get a -> Serialize a get :: Get ScaleId $cget :: Get ScaleId put :: Putter ScaleId $cput :: Putter ScaleId Serialize.Serialize) instance Pretty ScaleId where pretty :: ScaleId -> Text pretty (ScaleId Text s) = Text s -- | Usually this means to use the scale currently in scope. empty_scale :: ScaleId empty_scale :: ScaleId empty_scale = ScaleId "" twelve :: ScaleId twelve :: ScaleId twelve = ScaleId "twelve" -- | A generic transposition, for operations that can transpose diatonically, -- chromatically, or by absolute NoteNumber. data Transpose = Chromatic Double | Diatonic Double -- | Nn is scale-independent, so it's not suitable for symbolic -- transposition, but it's still useful for pitch transposition. | Nn Double deriving (Transpose -> Transpose -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Transpose -> Transpose -> Bool $c/= :: Transpose -> Transpose -> Bool == :: Transpose -> Transpose -> Bool $c== :: Transpose -> Transpose -> Bool Eq, Eq Transpose Transpose -> Transpose -> Bool Transpose -> Transpose -> Ordering Transpose -> Transpose -> Transpose 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 min :: Transpose -> Transpose -> Transpose $cmin :: Transpose -> Transpose -> Transpose max :: Transpose -> Transpose -> Transpose $cmax :: Transpose -> Transpose -> Transpose >= :: Transpose -> Transpose -> Bool $c>= :: Transpose -> Transpose -> Bool > :: Transpose -> Transpose -> Bool $c> :: Transpose -> Transpose -> Bool <= :: Transpose -> Transpose -> Bool $c<= :: Transpose -> Transpose -> Bool < :: Transpose -> Transpose -> Bool $c< :: Transpose -> Transpose -> Bool compare :: Transpose -> Transpose -> Ordering $ccompare :: Transpose -> Transpose -> Ordering Ord, Cent -> Transpose -> ShowS [Transpose] -> ShowS Transpose -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Transpose] -> ShowS $cshowList :: [Transpose] -> ShowS show :: Transpose -> String $cshow :: Transpose -> String showsPrec :: Cent -> Transpose -> ShowS $cshowsPrec :: Cent -> Transpose -> ShowS Show) instance Pretty Transpose where pretty :: Transpose -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val instance ShowVal.ShowVal Transpose where -- TODO convert to a ScoreT.Typed Signal.Y and use its ShowVal show_val :: Transpose -> Text show_val (Chromatic Double d) = forall a. ShowVal a => a -> Text ShowVal.show_val Double d forall a. Semigroup a => a -> a -> a <> Text "c" show_val (Diatonic Double d) = forall a. ShowVal a => a -> Text ShowVal.show_val Double d forall a. Semigroup a => a -> a -> a <> Text "d" show_val (Nn Double d) = forall a. ShowVal a => a -> Text ShowVal.show_val Double d forall a. Semigroup a => a -> a -> a <> Text "nn" zero_transpose :: Transpose -> Bool zero_transpose :: Transpose -> Bool zero_transpose Transpose t = case Transpose t of Chromatic Double d -> Double d forall a. Eq a => a -> a -> Bool == Double 0 Diatonic Double d -> Double d forall a. Eq a => a -> a -> Bool == Double 0 Nn Double d -> Double d forall a. Eq a => a -> a -> Bool == Double 0 modify_transpose :: (Double -> Double) -> Transpose -> Transpose modify_transpose :: (Double -> Double) -> Transpose -> Transpose modify_transpose Double -> Double f Transpose t = case Transpose t of Chromatic Double d -> Double -> Transpose Chromatic (Double -> Double f Double d) Diatonic Double d -> Double -> Transpose Diatonic (Double -> Double f Double d) Nn Double d -> Double -> Transpose Nn (Double -> Double f Double d) -- | Diatonic transposition often requires a Key for context. -- -- This is not very strongly typed, because it's intended to be scale -- independent, and not every scale will have the same values for key and -- mode. newtype Key = Key Text deriving (Key -> Key -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Key -> Key -> Bool $c/= :: Key -> Key -> Bool == :: Key -> Key -> Bool $c== :: Key -> Key -> Bool Eq, Eq Key Key -> Key -> Bool Key -> Key -> Ordering Key -> Key -> Key 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 min :: Key -> Key -> Key $cmin :: Key -> Key -> Key max :: Key -> Key -> Key $cmax :: Key -> Key -> Key >= :: Key -> Key -> Bool $c>= :: Key -> Key -> Bool > :: Key -> Key -> Bool $c> :: Key -> Key -> Bool <= :: Key -> Key -> Bool $c<= :: Key -> Key -> Bool < :: Key -> Key -> Bool $c< :: Key -> Key -> Bool compare :: Key -> Key -> Ordering $ccompare :: Key -> Key -> Ordering Ord, ReadPrec [Key] ReadPrec Key Cent -> ReadS Key ReadS [Key] forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Key] $creadListPrec :: ReadPrec [Key] readPrec :: ReadPrec Key $creadPrec :: ReadPrec Key readList :: ReadS [Key] $creadList :: ReadS [Key] readsPrec :: Cent -> ReadS Key $creadsPrec :: Cent -> ReadS Key Read, Cent -> Key -> ShowS [Key] -> ShowS Key -> String forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Key] -> ShowS $cshowList :: [Key] -> ShowS show :: Key -> String $cshow :: Key -> String showsPrec :: Cent -> Key -> ShowS $cshowsPrec :: Cent -> Key -> ShowS Show, Key -> Text forall a. (a -> Text) -> ShowVal a show_val :: Key -> Text $cshow_val :: Key -> Text ShowVal.ShowVal, Get Key Putter Key forall a. Putter a -> Get a -> Serialize a get :: Get Key $cget :: Get Key put :: Putter Key $cput :: Putter Key Serialize.Serialize) key_text :: Key -> Text key_text :: Key -> Text key_text (Key Text t) = Text t instance Pretty Key where format :: Key -> Doc format (Key Text s) = Text -> Doc Pretty.text Text s