{-# LANGUAGE DeriveDataTypeable #-}
module Perform.Pitch (
Note(..), note_text
, Pitch(..), pitch, Degree(..)
, Octave, PitchClass, Accidentals, Semi, FSemi, Step
, pitch_accidentals, pitch_pc
, add_octave, add_pc, diff_pc
, middle_octave, middle_c
, Input(..), KbdType(..), Frac
, NoteNumber(..), nn, nn_to_double
, Cent, nn_to_cents
, nns_equal, nns_close
, Hz, add_hz, modify_hz, nn_to_hz, hz_to_nn, middle_c_hz
, 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
newtype Note = Note Text
deriving (Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
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
Eq Note
-> (Note -> Note -> Ordering)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Note)
-> (Note -> Note -> Note)
-> Ord 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
(Cent -> Note -> ShowS)
-> (Note -> String) -> ([Note] -> ShowS) -> Show Note
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
(String -> Note) -> IsString Note
forall a. (String -> a) -> IsString a
fromString :: String -> Note
$cfromString :: String -> Note
String.IsString, Get Note
Putter Note
Putter Note -> Get Note -> Serialize 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
data Pitch = Pitch {
Pitch -> Cent
pitch_octave :: !Octave
, Pitch -> Degree
pitch_degree :: !Degree
} deriving (Pitch -> Pitch -> Bool
(Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Bool) -> Eq Pitch
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
Eq Pitch
-> (Pitch -> Pitch -> Ordering)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Pitch)
-> (Pitch -> Pitch -> Pitch)
-> Ord 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]
(Cent -> ReadS Pitch)
-> ReadS [Pitch]
-> ReadPrec Pitch
-> ReadPrec [Pitch]
-> Read 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
(Cent -> Pitch -> ShowS)
-> (Pitch -> String) -> ([Pitch] -> ShowS) -> Show Pitch
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 (pc -> Cent
forall a. Enum a => a -> Cent
fromEnum pc
pc) Cent
0)
instance Pretty Pitch where
pretty :: Pitch -> Text
pretty (Pitch Cent
oct Degree
degree) = Cent -> Text
forall a. Show a => a -> Text
showt Cent
oct Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Degree -> Text
forall a. Pretty a => a -> Text
pretty Degree
degree
instance ShowVal.ShowVal Pitch where
show_val :: Pitch -> Text
show_val (Pitch Cent
oct (Degree Cent
pc Cent
accs)) =
Text
"(pitch " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unwords [Text]
args Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
where args :: [Text]
args = (Cent -> Text) -> [Cent] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Cent -> Text
forall a. Show a => a -> Text
showt ([Cent] -> [Text]) -> [Cent] -> [Text]
forall a b. (a -> b) -> a -> b
$ Cent
oct Cent -> [Cent] -> [Cent]
forall a. a -> [a] -> [a]
: Cent
pc Cent -> [Cent] -> [Cent]
forall a. a -> [a] -> [a]
: if Cent
accs Cent -> Cent -> Bool
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) = Putter Cent
forall a. Serialize a => Putter a
Serialize.put Cent
a PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Degree
forall a. Serialize a => Putter a
Serialize.put Degree
b
get :: Get Pitch
get = Cent -> Degree -> Pitch
Pitch (Cent -> Degree -> Pitch) -> Get Cent -> Get (Degree -> Pitch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Cent
forall a. Serialize a => Get a
Serialize.get Get (Degree -> Pitch) -> Get Degree -> Get Pitch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Degree
forall a. Serialize a => Get a
Serialize.get
data Degree = Degree {
Degree -> Cent
degree_pc :: !PitchClass
, Degree -> Cent
degree_accidentals :: !Accidentals
} deriving (Degree -> Degree -> Bool
(Degree -> Degree -> Bool)
-> (Degree -> Degree -> Bool) -> Eq Degree
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
Eq Degree
-> (Degree -> Degree -> Ordering)
-> (Degree -> Degree -> Bool)
-> (Degree -> Degree -> Bool)
-> (Degree -> Degree -> Bool)
-> (Degree -> Degree -> Bool)
-> (Degree -> Degree -> Degree)
-> (Degree -> Degree -> Degree)
-> Ord 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]
(Cent -> ReadS Degree)
-> ReadS [Degree]
-> ReadPrec Degree
-> ReadPrec [Degree]
-> Read 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
(Cent -> Degree -> ShowS)
-> (Degree -> String) -> ([Degree] -> ShowS) -> Show Degree
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) = Cent -> Text
forall a. Show a => a -> Text
showt Cent
pc
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Cent
acc Cent -> Cent -> Bool
forall a. Ord a => a -> a -> Bool
< Cent
0 then Cent -> Text -> Text
Text.replicate (Cent -> Cent
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) = Putter Cent
forall a. Serialize a => Putter a
Serialize.put Cent
a PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Cent
forall a. Serialize a => Putter a
Serialize.put Cent
b
get :: Get Degree
get = Cent -> Cent -> Degree
Degree (Cent -> Cent -> Degree) -> Get Cent -> Get (Cent -> Degree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Cent
forall a. Serialize a => Get a
Serialize.get Get (Cent -> Degree) -> Get Cent -> Get Degree
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Cent
forall a. Serialize a => Get a
Serialize.get
type Octave = Int
type PitchClass = Int
type Accidentals = Int
type Semi = Int
type FSemi = Double
type Step = Int
pitch_accidentals :: Pitch -> Accidentals
pitch_accidentals :: Pitch -> Cent
pitch_accidentals = Degree -> Cent
degree_accidentals (Degree -> Cent) -> (Pitch -> Degree) -> Pitch -> Cent
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 (Degree -> Cent) -> (Pitch -> Degree) -> Pitch -> Cent
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 Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
+ Cent
octave) Degree
degree
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 Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
+ Cent
octave) (Cent -> Cent -> Degree
Degree Cent
pc2 Cent
accs)
where (Cent
oct, Cent
pc2) = (Cent
pc Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
+ Cent
steps) Cent -> Cent -> (Cent, Cent)
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 Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
+ Cent
pc1 Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
- Cent
pc2
where oct_diff :: Cent
oct_diff = Cent
per_octave Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
* (Cent
oct1 Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
- Cent
oct2)
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)
data Input = Input !KbdType !Pitch !Frac
deriving (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
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
(Cent -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
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 =
PianoKbd
| AsciiKbd
deriving (KbdType -> KbdType -> Bool
(KbdType -> KbdType -> Bool)
-> (KbdType -> KbdType -> Bool) -> Eq KbdType
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
(Cent -> KbdType -> ShowS)
-> (KbdType -> String) -> ([KbdType] -> ShowS) -> Show KbdType
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)
type Frac = Double
instance Pretty Input where
pretty :: Input -> Text
pretty (Input KbdType
kbd Pitch
pitch Double
frac) = KbdType -> Text
forall a. Show a => a -> Text
showt KbdType
kbd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Pitch -> Text
forall a. Pretty a => a -> Text
pretty Pitch
pitch
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Double
frac Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Text
"" else Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a. Pretty a => a -> Text
pretty Double
frac
newtype NoteNumber = NoteNumber Double
deriving (Double -> NoteNumber -> NoteNumber -> Bool
(Double -> NoteNumber -> NoteNumber -> Bool) -> ApproxEq NoteNumber
forall a. (Double -> a -> a -> Bool) -> ApproxEq a
eq :: Double -> NoteNumber -> NoteNumber -> Bool
$ceq :: Double -> NoteNumber -> NoteNumber -> Bool
ApproxEq.ApproxEq, NoteNumber -> NoteNumber -> Bool
(NoteNumber -> NoteNumber -> Bool)
-> (NoteNumber -> NoteNumber -> Bool) -> Eq NoteNumber
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
Eq NoteNumber
-> (NoteNumber -> NoteNumber -> Ordering)
-> (NoteNumber -> NoteNumber -> Bool)
-> (NoteNumber -> NoteNumber -> Bool)
-> (NoteNumber -> NoteNumber -> Bool)
-> (NoteNumber -> NoteNumber -> Bool)
-> (NoteNumber -> NoteNumber -> NoteNumber)
-> (NoteNumber -> NoteNumber -> NoteNumber)
-> Ord 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
Num NoteNumber
-> (NoteNumber -> NoteNumber -> NoteNumber)
-> (NoteNumber -> NoteNumber)
-> (Rational -> NoteNumber)
-> Fractional 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
Num NoteNumber
-> Ord NoteNumber -> (NoteNumber -> Rational) -> Real NoteNumber
NoteNumber -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: NoteNumber -> Rational
$ctoRational :: NoteNumber -> Rational
Real, Fractional NoteNumber
Real NoteNumber
Real NoteNumber
-> Fractional NoteNumber
-> (forall b. Integral b => NoteNumber -> (b, NoteNumber))
-> (forall b. Integral b => NoteNumber -> b)
-> (forall b. Integral b => NoteNumber -> b)
-> (forall b. Integral b => NoteNumber -> b)
-> (forall b. Integral b => NoteNumber -> b)
-> RealFrac 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
(NoteNumber -> NoteNumber -> NoteNumber)
-> (NoteNumber -> NoteNumber -> NoteNumber)
-> (NoteNumber -> NoteNumber -> NoteNumber)
-> (NoteNumber -> NoteNumber)
-> (NoteNumber -> NoteNumber)
-> (NoteNumber -> NoteNumber)
-> (Integer -> NoteNumber)
-> Num 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
Putter NoteNumber -> Get NoteNumber -> Serialize 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) = Double -> String
forall a. Show a => a -> String
show Double
nn String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"nn"
instance Read NoteNumber where
readPrec :: ReadPrec NoteNumber
readPrec = do
Double
n <- ReadPrec Double
forall a. Read a => ReadPrec a
Read.readPrec
ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
Read.lift (ReadP String -> ReadPrec String)
-> ReadP String -> ReadPrec String
forall a b. (a -> b) -> a -> b
$ ReadP ()
ReadP.skipSpaces ReadP () -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ReadP String
ReadP.string String
"nn"
NoteNumber -> ReadPrec NoteNumber
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) = Double -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Double
nn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"nn"
instance Pretty NoteNumber where
pretty :: NoteNumber -> Text
pretty (NoteNumber Double
nn) = Maybe Cent -> Double -> Text
forall a. RealFloat a => Maybe Cent -> a -> Text
Num.showFloat0 (Cent -> Maybe Cent
forall a. a -> Maybe a
Just Cent
3) Double
nn Text -> Text -> Text
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 (Double -> NoteNumber) -> (a -> Double) -> a -> NoteNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Double
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 = NoteNumber -> Cent
forall a b. (RealFrac a, Integral b) => a -> b
round (NoteNumber -> Cent)
-> (NoteNumber -> NoteNumber) -> NoteNumber -> Cent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoteNumber -> NoteNumber -> NoteNumber
forall a. Num a => a -> a -> a
*NoteNumber
100)
nns_equal :: NoteNumber -> NoteNumber -> Bool
nns_equal :: NoteNumber -> NoteNumber -> Bool
nns_equal = Cent -> NoteNumber -> NoteNumber -> Bool
nns_close Cent
3
nns_close :: Cent -> NoteNumber -> NoteNumber -> Bool
nns_close :: Cent -> NoteNumber -> NoteNumber -> Bool
nns_close Cent
cents NoteNumber
nn1 NoteNumber
nn2 = Cent -> Cent
forall a. Num a => a -> a
abs (NoteNumber -> Cent
nn_to_cents NoteNumber
nn1 Cent -> Cent -> Cent
forall a. Num a => a -> a -> a
- NoteNumber -> Cent
nn_to_cents NoteNumber
nn2) Cent -> Cent -> Bool
forall a. Ord a => a -> a -> Bool
<= Cent
cents
type Hz = Double
add_hz :: Hz -> NoteNumber -> NoteNumber
add_hz :: Double -> NoteNumber -> NoteNumber
add_hz Double
0 NoteNumber
nn = NoteNumber
nn
add_hz Double
hz NoteNumber
nn = Double -> NoteNumber
hz_to_nn (Double
hz Double -> Double -> Double
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 (Double -> NoteNumber)
-> (NoteNumber -> Double) -> NoteNumber -> NoteNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
f (Double -> Double)
-> (NoteNumber -> Double) -> NoteNumber -> Double
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) = Double -> Double
forall a. Floating a => a -> a
exp (Double
nn Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_hz_scale Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
_hz_offset)
hz_to_nn :: Hz -> NoteNumber
hz_to_nn :: Double -> NoteNumber
hz_to_nn Double
hz = Double -> NoteNumber
NoteNumber (Double -> NoteNumber) -> Double -> NoteNumber
forall a b. (a -> b) -> a -> b
$ (Double -> Double
forall a. Floating a => a -> a
log Double
hz Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
_hz_offset) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
_hz_scale
_hz_scale, _hz_offset :: Hz
_hz_scale :: Double
_hz_scale = Double -> Double
forall a. Floating a => a -> a
log Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
12
_hz_offset :: Double
_hz_offset = Double -> Double
forall a. Floating a => a -> a
log Double
a_hz Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
a_nn Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_hz_scale)
where
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
newtype ScaleId = ScaleId Text
deriving (ScaleId -> ScaleId -> Bool
(ScaleId -> ScaleId -> Bool)
-> (ScaleId -> ScaleId -> Bool) -> Eq ScaleId
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
Eq ScaleId
-> (ScaleId -> ScaleId -> Ordering)
-> (ScaleId -> ScaleId -> Bool)
-> (ScaleId -> ScaleId -> Bool)
-> (ScaleId -> ScaleId -> Bool)
-> (ScaleId -> ScaleId -> Bool)
-> (ScaleId -> ScaleId -> ScaleId)
-> (ScaleId -> ScaleId -> ScaleId)
-> Ord 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]
(Cent -> ReadS ScaleId)
-> ReadS [ScaleId]
-> ReadPrec ScaleId
-> ReadPrec [ScaleId]
-> Read 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
(Cent -> ScaleId -> ShowS)
-> (ScaleId -> String) -> ([ScaleId] -> ShowS) -> Show ScaleId
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
(String -> ScaleId) -> IsString ScaleId
forall a. (String -> a) -> IsString a
fromString :: String -> ScaleId
$cfromString :: String -> ScaleId
String.IsString, Get ScaleId
Putter ScaleId
Putter ScaleId -> Get ScaleId -> Serialize 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
empty_scale :: ScaleId
empty_scale :: ScaleId
empty_scale = ScaleId
""
twelve :: ScaleId
twelve :: ScaleId
twelve = ScaleId
"twelve"
data Transpose = Chromatic Double | Diatonic Double
| Nn Double
deriving (Transpose -> Transpose -> Bool
(Transpose -> Transpose -> Bool)
-> (Transpose -> Transpose -> Bool) -> Eq Transpose
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
Eq Transpose
-> (Transpose -> Transpose -> Ordering)
-> (Transpose -> Transpose -> Bool)
-> (Transpose -> Transpose -> Bool)
-> (Transpose -> Transpose -> Bool)
-> (Transpose -> Transpose -> Bool)
-> (Transpose -> Transpose -> Transpose)
-> (Transpose -> Transpose -> Transpose)
-> Ord 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
(Cent -> Transpose -> ShowS)
-> (Transpose -> String)
-> ([Transpose] -> ShowS)
-> Show Transpose
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 = Transpose -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val
instance ShowVal.ShowVal Transpose where
show_val :: Transpose -> Text
show_val (Chromatic Double
d) = Double -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Double
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"c"
show_val (Diatonic Double
d) = Double -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Double
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"d"
show_val (Nn Double
d) = Double -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Double
d Text -> Text -> Text
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 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
Diatonic Double
d -> Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
Nn Double
d -> Double
d Double -> Double -> Bool
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)
newtype Key = Key Text
deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
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
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord 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]
(Cent -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read 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
(Cent -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
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
(Key -> Text) -> ShowVal Key
forall a. (a -> Text) -> ShowVal a
show_val :: Key -> Text
$cshow_val :: Key -> Text
ShowVal.ShowVal, Get Key
Putter Key
Putter Key -> Get Key -> Serialize 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