-- | Gamelan instruments and pitch structures.
module Music.Theory.Gamelan where

import Data.Char {- base -}
import Data.Function {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ratio {- base -}
import Text.Printf {- base -}

import qualified Music.Theory.Enum as T {- hmt-base -}

import qualified Music.Theory.Clef as T {- hmt -}
import qualified Music.Theory.Pitch as T {- hmt -}
import qualified Music.Theory.Tuning as T {- hmt -}
import qualified Music.Theory.Tuning.Et as T {- hmt-diagrams -}

-- | 'fromJust' with error message.
fromJust_err :: String -> Maybe a -> a
fromJust_err :: forall a. String -> Maybe a -> a
fromJust_err String
err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
err)

-- | 'approxRational' of 0.01.
near_rat :: Double -> Rational
near_rat :: Double -> Rational
near_rat = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. RealFrac a => a -> a -> Rational
approxRational Double
0.01

-- * Gamelan

-- | Enumeration of gamelan instrument families.
data Instrument_Family
    = Bonang
    | Gambang
    | Gender
    | Gong
    | Saron
      deriving (Int -> Instrument_Family
Instrument_Family -> Int
Instrument_Family -> [Instrument_Family]
Instrument_Family -> Instrument_Family
Instrument_Family -> Instrument_Family -> [Instrument_Family]
Instrument_Family
-> Instrument_Family -> Instrument_Family -> [Instrument_Family]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Instrument_Family
-> Instrument_Family -> Instrument_Family -> [Instrument_Family]
$cenumFromThenTo :: Instrument_Family
-> Instrument_Family -> Instrument_Family -> [Instrument_Family]
enumFromTo :: Instrument_Family -> Instrument_Family -> [Instrument_Family]
$cenumFromTo :: Instrument_Family -> Instrument_Family -> [Instrument_Family]
enumFromThen :: Instrument_Family -> Instrument_Family -> [Instrument_Family]
$cenumFromThen :: Instrument_Family -> Instrument_Family -> [Instrument_Family]
enumFrom :: Instrument_Family -> [Instrument_Family]
$cenumFrom :: Instrument_Family -> [Instrument_Family]
fromEnum :: Instrument_Family -> Int
$cfromEnum :: Instrument_Family -> Int
toEnum :: Int -> Instrument_Family
$ctoEnum :: Int -> Instrument_Family
pred :: Instrument_Family -> Instrument_Family
$cpred :: Instrument_Family -> Instrument_Family
succ :: Instrument_Family -> Instrument_Family
$csucc :: Instrument_Family -> Instrument_Family
Enum,Instrument_Family
forall a. a -> a -> Bounded a
maxBound :: Instrument_Family
$cmaxBound :: Instrument_Family
minBound :: Instrument_Family
$cminBound :: Instrument_Family
Bounded,Instrument_Family -> Instrument_Family -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument_Family -> Instrument_Family -> Bool
$c/= :: Instrument_Family -> Instrument_Family -> Bool
== :: Instrument_Family -> Instrument_Family -> Bool
$c== :: Instrument_Family -> Instrument_Family -> Bool
Eq,Eq Instrument_Family
Instrument_Family -> Instrument_Family -> Bool
Instrument_Family -> Instrument_Family -> Ordering
Instrument_Family -> Instrument_Family -> Instrument_Family
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 :: Instrument_Family -> Instrument_Family -> Instrument_Family
$cmin :: Instrument_Family -> Instrument_Family -> Instrument_Family
max :: Instrument_Family -> Instrument_Family -> Instrument_Family
$cmax :: Instrument_Family -> Instrument_Family -> Instrument_Family
>= :: Instrument_Family -> Instrument_Family -> Bool
$c>= :: Instrument_Family -> Instrument_Family -> Bool
> :: Instrument_Family -> Instrument_Family -> Bool
$c> :: Instrument_Family -> Instrument_Family -> Bool
<= :: Instrument_Family -> Instrument_Family -> Bool
$c<= :: Instrument_Family -> Instrument_Family -> Bool
< :: Instrument_Family -> Instrument_Family -> Bool
$c< :: Instrument_Family -> Instrument_Family -> Bool
compare :: Instrument_Family -> Instrument_Family -> Ordering
$ccompare :: Instrument_Family -> Instrument_Family -> Ordering
Ord,Int -> Instrument_Family -> ShowS
[Instrument_Family] -> ShowS
Instrument_Family -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument_Family] -> ShowS
$cshowList :: [Instrument_Family] -> ShowS
show :: Instrument_Family -> String
$cshow :: Instrument_Family -> String
showsPrec :: Int -> Instrument_Family -> ShowS
$cshowsPrec :: Int -> Instrument_Family -> ShowS
Show,ReadPrec [Instrument_Family]
ReadPrec Instrument_Family
Int -> ReadS Instrument_Family
ReadS [Instrument_Family]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Instrument_Family]
$creadListPrec :: ReadPrec [Instrument_Family]
readPrec :: ReadPrec Instrument_Family
$creadPrec :: ReadPrec Instrument_Family
readList :: ReadS [Instrument_Family]
$creadList :: ReadS [Instrument_Family]
readsPrec :: Int -> ReadS Instrument_Family
$creadsPrec :: Int -> ReadS Instrument_Family
Read)

-- | Universe
instrument_family_set :: [Instrument_Family]
instrument_family_set :: [Instrument_Family]
instrument_family_set = forall t. (Bounded t, Enum t) => [t]
T.enum_univ

-- | Enumeration of Gamelan instruments.
data Instrument_Name
    = Bonang_Barung -- ^ Bonang Barung (horizontal gong, middle)
    | Bonang_Panerus -- ^ Bonang Panerus (horizontal gong, high)
    | Gambang_Kayu -- ^ Gambang Kayu (wooden key&resonator)
    | Gender_Barung -- ^ Gender Barung (key&resonator, middle)
    | Gender_Panerus -- ^ Gender Panembung (key&resonator, high)
    | Gender_Panembung -- ^ Gender Panembung, Slenthem (key&resonator, low)
    | Gong_Ageng -- ^ Gong Ageng (hanging gong, low)
    | Gong_Suwukan -- ^ Gong Suwukan (hanging gong, middle)
    | Kempul -- ^ Kempul (hanging gong, middle)
    | Kempyang -- ^ Kempyang (horizontal gong, high)
    | Kenong -- ^ Kenong (horizontal gong, low)
    | Ketuk -- ^ Ketuk, Kethuk (horizontal gong, middle)
    | Saron_Barung -- ^ Saron Barung, Saron (key, middle)
    | Saron_Demung -- ^ Saron Demung, Demung (key, low)
    | Saron_Panerus -- ^ Saron Panerus, Peking (key, high)
      deriving (Int -> Instrument_Name
Instrument_Name -> Int
Instrument_Name -> [Instrument_Name]
Instrument_Name -> Instrument_Name
Instrument_Name -> Instrument_Name -> [Instrument_Name]
Instrument_Name
-> Instrument_Name -> Instrument_Name -> [Instrument_Name]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Instrument_Name
-> Instrument_Name -> Instrument_Name -> [Instrument_Name]
$cenumFromThenTo :: Instrument_Name
-> Instrument_Name -> Instrument_Name -> [Instrument_Name]
enumFromTo :: Instrument_Name -> Instrument_Name -> [Instrument_Name]
$cenumFromTo :: Instrument_Name -> Instrument_Name -> [Instrument_Name]
enumFromThen :: Instrument_Name -> Instrument_Name -> [Instrument_Name]
$cenumFromThen :: Instrument_Name -> Instrument_Name -> [Instrument_Name]
enumFrom :: Instrument_Name -> [Instrument_Name]
$cenumFrom :: Instrument_Name -> [Instrument_Name]
fromEnum :: Instrument_Name -> Int
$cfromEnum :: Instrument_Name -> Int
toEnum :: Int -> Instrument_Name
$ctoEnum :: Int -> Instrument_Name
pred :: Instrument_Name -> Instrument_Name
$cpred :: Instrument_Name -> Instrument_Name
succ :: Instrument_Name -> Instrument_Name
$csucc :: Instrument_Name -> Instrument_Name
Enum,Instrument_Name
forall a. a -> a -> Bounded a
maxBound :: Instrument_Name
$cmaxBound :: Instrument_Name
minBound :: Instrument_Name
$cminBound :: Instrument_Name
Bounded,Instrument_Name -> Instrument_Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument_Name -> Instrument_Name -> Bool
$c/= :: Instrument_Name -> Instrument_Name -> Bool
== :: Instrument_Name -> Instrument_Name -> Bool
$c== :: Instrument_Name -> Instrument_Name -> Bool
Eq,Eq Instrument_Name
Instrument_Name -> Instrument_Name -> Bool
Instrument_Name -> Instrument_Name -> Ordering
Instrument_Name -> Instrument_Name -> Instrument_Name
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 :: Instrument_Name -> Instrument_Name -> Instrument_Name
$cmin :: Instrument_Name -> Instrument_Name -> Instrument_Name
max :: Instrument_Name -> Instrument_Name -> Instrument_Name
$cmax :: Instrument_Name -> Instrument_Name -> Instrument_Name
>= :: Instrument_Name -> Instrument_Name -> Bool
$c>= :: Instrument_Name -> Instrument_Name -> Bool
> :: Instrument_Name -> Instrument_Name -> Bool
$c> :: Instrument_Name -> Instrument_Name -> Bool
<= :: Instrument_Name -> Instrument_Name -> Bool
$c<= :: Instrument_Name -> Instrument_Name -> Bool
< :: Instrument_Name -> Instrument_Name -> Bool
$c< :: Instrument_Name -> Instrument_Name -> Bool
compare :: Instrument_Name -> Instrument_Name -> Ordering
$ccompare :: Instrument_Name -> Instrument_Name -> Ordering
Ord,Int -> Instrument_Name -> ShowS
[Instrument_Name] -> ShowS
Instrument_Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument_Name] -> ShowS
$cshowList :: [Instrument_Name] -> ShowS
show :: Instrument_Name -> String
$cshow :: Instrument_Name -> String
showsPrec :: Int -> Instrument_Name -> ShowS
$cshowsPrec :: Int -> Instrument_Name -> ShowS
Show,ReadPrec [Instrument_Name]
ReadPrec Instrument_Name
Int -> ReadS Instrument_Name
ReadS [Instrument_Name]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Instrument_Name]
$creadListPrec :: ReadPrec [Instrument_Name]
readPrec :: ReadPrec Instrument_Name
$creadPrec :: ReadPrec Instrument_Name
readList :: ReadS [Instrument_Name]
$creadList :: ReadS [Instrument_Name]
readsPrec :: Int -> ReadS Instrument_Name
$creadsPrec :: Int -> ReadS Instrument_Name
Read)

instrument_family :: Instrument_Name -> Instrument_Family
instrument_family :: Instrument_Name -> Instrument_Family
instrument_family Instrument_Name
nm =
    case Instrument_Name
nm of
      Instrument_Name
Bonang_Barung -> Instrument_Family
Bonang
      Instrument_Name
Bonang_Panerus -> Instrument_Family
Bonang
      Instrument_Name
Gambang_Kayu -> Instrument_Family
Gambang
      Instrument_Name
Gender_Barung -> Instrument_Family
Gender
      Instrument_Name
Gender_Panerus -> Instrument_Family
Gender
      Instrument_Name
Gender_Panembung -> Instrument_Family
Gender
      Instrument_Name
Gong_Ageng -> Instrument_Family
Gong
      Instrument_Name
Gong_Suwukan -> Instrument_Family
Gong
      Instrument_Name
Kempul -> Instrument_Family
Gong
      Instrument_Name
Kempyang -> Instrument_Family
Gong
      Instrument_Name
Kenong -> Instrument_Family
Gong
      Instrument_Name
Ketuk -> Instrument_Family
Gong
      Instrument_Name
Saron_Barung -> Instrument_Family
Saron
      Instrument_Name
Saron_Demung -> Instrument_Family
Saron
      Instrument_Name
Saron_Panerus -> Instrument_Family
Saron

instrument_name_pp :: Instrument_Name -> String
instrument_name_pp :: Instrument_Name -> String
instrument_name_pp =
    let f :: Char -> Char
f Char
c = if Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' then Char
' ' else Char
c
    in forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | 'Clef' appropriate for 'Instrument_Name'.
instrument_name_clef :: Integral i => Instrument_Name -> T.Clef i
instrument_name_clef :: forall i. Integral i => Instrument_Name -> Clef i
instrument_name_clef Instrument_Name
nm =
    case Instrument_Name
nm of
      Instrument_Name
Bonang_Barung -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0
      Instrument_Name
Bonang_Panerus -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
1
      Instrument_Name
Gambang_Kayu -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0
      Instrument_Name
Gender_Barung -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0
      Instrument_Name
Gender_Panerus -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
1
      Instrument_Name
Gender_Panembung -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Bass i
0
      Instrument_Name
Gong_Ageng -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Bass i
0
      Instrument_Name
Gong_Suwukan -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Bass i
0
      Instrument_Name
Kempul -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Bass i
0
      Instrument_Name
Kempyang -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
1
      Instrument_Name
Kenong -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0
      Instrument_Name
Ketuk -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Alto i
0
      Instrument_Name
Saron_Barung -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0
      Instrument_Name
Saron_Demung -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0
      Instrument_Name
Saron_Panerus -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
1

instrument_name_clef_plain :: Integral i => Instrument_Name -> T.Clef i
instrument_name_clef_plain :: forall i. Integral i => Instrument_Name -> Clef i
instrument_name_clef_plain = forall i. Integral i => Clef i -> Clef i
T.clef_zero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Instrument_Name -> Clef i
instrument_name_clef

-- | Enumeration of Gamelan scales.
data Scale = Pelog | Slendro deriving (Int -> Scale
Scale -> Int
Scale -> [Scale]
Scale -> Scale
Scale -> Scale -> [Scale]
Scale -> Scale -> Scale -> [Scale]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Scale -> Scale -> Scale -> [Scale]
$cenumFromThenTo :: Scale -> Scale -> Scale -> [Scale]
enumFromTo :: Scale -> Scale -> [Scale]
$cenumFromTo :: Scale -> Scale -> [Scale]
enumFromThen :: Scale -> Scale -> [Scale]
$cenumFromThen :: Scale -> Scale -> [Scale]
enumFrom :: Scale -> [Scale]
$cenumFrom :: Scale -> [Scale]
fromEnum :: Scale -> Int
$cfromEnum :: Scale -> Int
toEnum :: Int -> Scale
$ctoEnum :: Int -> Scale
pred :: Scale -> Scale
$cpred :: Scale -> Scale
succ :: Scale -> Scale
$csucc :: Scale -> Scale
Enum,Scale -> Scale -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scale -> Scale -> Bool
$c/= :: Scale -> Scale -> Bool
== :: Scale -> Scale -> Bool
$c== :: Scale -> Scale -> Bool
Eq,Eq Scale
Scale -> Scale -> Bool
Scale -> Scale -> Ordering
Scale -> Scale -> Scale
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 :: Scale -> Scale -> Scale
$cmin :: Scale -> Scale -> Scale
max :: Scale -> Scale -> Scale
$cmax :: Scale -> Scale -> Scale
>= :: Scale -> Scale -> Bool
$c>= :: Scale -> Scale -> Bool
> :: Scale -> Scale -> Bool
$c> :: Scale -> Scale -> Bool
<= :: Scale -> Scale -> Bool
$c<= :: Scale -> Scale -> Bool
< :: Scale -> Scale -> Bool
$c< :: Scale -> Scale -> Bool
compare :: Scale -> Scale -> Ordering
$ccompare :: Scale -> Scale -> Ordering
Ord,Int -> Scale -> ShowS
[Scale] -> ShowS
Scale -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scale] -> ShowS
$cshowList :: [Scale] -> ShowS
show :: Scale -> String
$cshow :: Scale -> String
showsPrec :: Int -> Scale -> ShowS
$cshowsPrec :: Int -> Scale -> ShowS
Show,ReadPrec [Scale]
ReadPrec Scale
Int -> ReadS Scale
ReadS [Scale]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Scale]
$creadListPrec :: ReadPrec [Scale]
readPrec :: ReadPrec Scale
$creadPrec :: ReadPrec Scale
readList :: ReadS [Scale]
$creadList :: ReadS [Scale]
readsPrec :: Int -> ReadS Scale
$creadsPrec :: Int -> ReadS Scale
Read)

-- | Octaves are zero-indexed and may be negative.
type Octave = Integer

-- | Degrees are one-indexed.
type Degree = Integer

-- | Frequency in hertz.
type Frequency = Double

-- | A text annotation.
type Annotation = String

-- | 'Octave' and 'Degree'.
data Pitch = Pitch {Pitch -> Degree
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,Int -> Pitch -> ShowS
[Pitch] -> ShowS
Pitch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pitch] -> ShowS
$cshowList :: [Pitch] -> ShowS
show :: Pitch -> String
$cshow :: Pitch -> String
showsPrec :: Int -> Pitch -> ShowS
$cshowsPrec :: Int -> Pitch -> ShowS
Show)

-- | Octaves are written as repeated @-@ or @+@, degrees are printed ordinarily.
--
-- > map pitch_pp_ascii (zipWith Pitch [-2 .. 2] [1 .. 5]) == ["--1","-2","3","+4","++5"]
pitch_pp_ascii :: Pitch -> String
pitch_pp_ascii :: Pitch -> String
pitch_pp_ascii (Pitch Degree
o Degree
d) =
    let d' :: Char
d' = Int -> Char
intToDigit (forall a b. (Integral a, Num b) => a -> b
fromIntegral Degree
d)
        o' :: String
o' = if Degree
o forall a. Ord a => a -> a -> Bool
< Degree
0
             then forall i a. Integral i => i -> a -> [a]
genericReplicate (forall a. Num a => a -> a
abs Degree
o) Char
'-'
             else forall i a. Integral i => i -> a -> [a]
genericReplicate Degree
o Char
'+'
    in String
o' forall a. [a] -> [a] -> [a]
++ [Char
d']

pitch_pp_duple :: Pitch -> String
pitch_pp_duple :: Pitch -> String
pitch_pp_duple (Pitch Degree
o Degree
d) = forall r. PrintfType r => String -> r
printf String
"(%d,%d)" Degree
o Degree
d

-- | 'Scale' and 'Pitch'.
data Note = Note {Note -> Scale
note_scale :: Scale
                 ,Note -> Pitch
note_pitch :: Pitch}
             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,Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show)

-- | 'pitch_degree' of 'note_pitch'.
note_degree :: Note -> Degree
note_degree :: Note -> Degree
note_degree = Pitch -> Degree
pitch_degree forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Pitch
note_pitch

-- | It is an error to compare notes from different scales.
note_compare :: Note -> Note -> Ordering
note_compare :: Note -> Note -> Ordering
note_compare (Note Scale
s1 Pitch
p1) (Note Scale
s2 Pitch
p2) =
  if Scale
s1 forall a. Eq a => a -> a -> Bool
/= Scale
s2
  then forall a. HasCallStack => String -> a
error String
"note_compare?"
  else forall a. Ord a => a -> a -> Ordering
compare Pitch
p1 Pitch
p2

-- | Orderable if scales are equal.
instance Ord Note where compare :: Note -> Note -> Ordering
compare = Note -> Note -> Ordering
note_compare

-- | Ascending sequence of 'Note' for 'Scale' from /p1/ to /p2/ inclusive.
note_range_elem :: Scale -> Pitch -> Pitch -> [Note]
note_range_elem :: Scale -> Pitch -> Pitch -> [Note]
note_range_elem Scale
scl p1 :: Pitch
p1@(Pitch Degree
o1 Degree
_d1) p2 :: Pitch
p2@(Pitch Degree
o2 Degree
_d2) =
  let univ :: [Note]
univ = [Scale -> Pitch -> Note
Note Scale
scl (Degree -> Degree -> Pitch
Pitch Degree
o Degree
d) | Degree
o <- [Degree
o1 .. Degree
o2], Degree
d <- Scale -> [Degree]
scale_degrees Scale
scl]
  in forall a. (a -> Bool) -> [a] -> [a]
filter (\Note
n -> Note -> Pitch
note_pitch Note
n forall a. Ord a => a -> a -> Bool
>= Pitch
p1 Bool -> Bool -> Bool
&& Note -> Pitch
note_pitch Note
n forall a. Ord a => a -> a -> Bool
<= Pitch
p2) [Note]
univ

-- | Ascending sequence of 'Note' from /n1/ to /n2/ inclusive.
--
-- > note_gamut_elem (Note Slendro (Pitch 0 5)) (Note Slendro (Pitch 1 2))
note_gamut_elem :: Note -> Note -> [Note]
note_gamut_elem :: Note -> Note -> [Note]
note_gamut_elem (Note Scale
s1 Pitch
p1) (Note Scale
s2 Pitch
p2) =
  if Scale
s1 forall a. Eq a => a -> a -> Bool
/= Scale
s2
  then forall a. HasCallStack => String -> a
error String
"note_gamut_elem?"
  else Scale -> Pitch -> Pitch -> [Note]
note_range_elem Scale
s1 Pitch
p1 Pitch
p2

data Tone t = Tone {forall t. Tone t -> Instrument_Name
tone_instrument_name :: Instrument_Name
                   ,forall t. Tone t -> Maybe Note
tone_note :: Maybe Note
                   ,forall t. Tone t -> Maybe Double
tone_frequency :: Maybe Frequency
                   ,forall t. Tone t -> Maybe t
tone_annotation :: Maybe t}
              deriving (Tone t -> Tone t -> Bool
forall t. Eq t => Tone t -> Tone t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tone t -> Tone t -> Bool
$c/= :: forall t. Eq t => Tone t -> Tone t -> Bool
== :: Tone t -> Tone t -> Bool
$c== :: forall t. Eq t => Tone t -> Tone t -> Bool
Eq,Int -> Tone t -> ShowS
forall t. Show t => Int -> Tone t -> ShowS
forall t. Show t => [Tone t] -> ShowS
forall t. Show t => Tone t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tone t] -> ShowS
$cshowList :: forall t. Show t => [Tone t] -> ShowS
show :: Tone t -> String
$cshow :: forall t. Show t => Tone t -> String
showsPrec :: Int -> Tone t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Tone t -> ShowS
Show)

tone_frequency_err :: Tone t -> Frequency
tone_frequency_err :: forall t. Tone t -> Double
tone_frequency_err = forall a. String -> Maybe a -> a
fromJust_err String
"tone_frequency" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Double
tone_frequency

-- | Orderable if frequency is given.
instance Eq t => Ord (Tone t) where compare :: Tone t -> Tone t -> Ordering
compare = forall t. Tone t -> Tone t -> Ordering
tone_compare_frequency

-- | Constructor for 'Tone' without /frequency/ or /annotation/.
plain_tone :: Instrument_Name -> Scale -> Octave -> Degree -> Tone t
plain_tone :: forall t. Instrument_Name -> Scale -> Degree -> Degree -> Tone t
plain_tone Instrument_Name
nm Scale
sc Degree
o Degree
d = forall t.
Instrument_Name -> Maybe Note -> Maybe Double -> Maybe t -> Tone t
Tone Instrument_Name
nm (forall a. a -> Maybe a
Just (Scale -> Pitch -> Note
Note Scale
sc (Degree -> Degree -> Pitch
Pitch Degree
o Degree
d))) forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Tones are considered /equivalent/ if they have the same
-- 'Instrument_Name' and 'Note'.
tone_equivalent :: Tone t -> Tone t -> Bool
tone_equivalent :: forall t. Tone t -> Tone t -> Bool
tone_equivalent Tone t
p Tone t
q =
    let Tone Instrument_Name
nm Maybe Note
nt Maybe Double
_ Maybe t
_ = Tone t
p
        Tone Instrument_Name
nm' Maybe Note
nt' Maybe Double
_ Maybe t
_ = Tone t
q
    in Instrument_Name
nm forall a. Eq a => a -> a -> Bool
== Instrument_Name
nm' Bool -> Bool -> Bool
&& Maybe Note
nt forall a. Eq a => a -> a -> Bool
== Maybe Note
nt'

tone_24et_pitch :: Tone t -> Maybe T.Pitch
tone_24et_pitch :: forall t. Tone t -> Maybe Pitch
tone_24et_pitch =
    let f :: Double -> Pitch
f Double
i = let (Double
_,Pitch
pt,Double
_,Double
_,Double
_) = (Double, Double)
-> Double -> (Double, Pitch, Double, Double, Double)
T.nearest_24et_tone_k0 (Double
69,Double
440) Double
i in Pitch
pt
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Pitch
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Double
tone_frequency

tone_24et_pitch' :: Tone t -> T.Pitch
tone_24et_pitch' :: forall t. Tone t -> Pitch
tone_24et_pitch' = forall a. String -> Maybe a -> a
fromJust_err String
"tone_24et_pitch" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Pitch
tone_24et_pitch

tone_24et_pitch_detune :: Tone t -> Maybe T.Pitch_Detune
tone_24et_pitch_detune :: forall t. Tone t -> Maybe Pitch_Detune
tone_24et_pitch_detune = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double, Double) -> Double -> Pitch_Detune
T.nearest_pitch_detune_24et_k0 (Double
69,Double
440)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Double
tone_frequency

tone_24et_pitch_detune' :: Tone t -> T.Pitch_Detune
tone_24et_pitch_detune' :: forall t. Tone t -> Pitch_Detune
tone_24et_pitch_detune' = forall a. String -> Maybe a -> a
fromJust_err String
"tone_24et_pitch_detune" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Pitch_Detune
tone_24et_pitch_detune

tone_fmidi :: Tone t -> Double
tone_fmidi :: forall t. Tone t -> Double
tone_fmidi = forall a. Floating a => a -> a
T.cps_to_fmidi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Double
tone_frequency_err

-- | Fractional (rational) 24-et midi note number of 'Tone'.
tone_24et_fmidi :: Tone t -> Rational
tone_24et_fmidi :: forall t. Tone t -> Rational
tone_24et_fmidi = Double -> Rational
near_rat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Fractional n => Pitch -> n
T.pitch_to_fmidi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Pitch
tone_24et_pitch'

tone_12et_pitch :: Tone t -> Maybe T.Pitch
tone_12et_pitch :: forall t. Tone t -> Maybe Pitch
tone_12et_pitch =
    let f :: Double -> Pitch
f Double
i = let (Double
_,Pitch
pt,Double
_,Double
_,Double
_) = (Double, Double)
-> Double -> (Double, Pitch, Double, Double, Double)
T.nearest_12et_tone_k0 (Double
69,Double
440) Double
i in Pitch
pt
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Pitch
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Double
tone_frequency

tone_12et_pitch' :: Tone t -> T.Pitch
tone_12et_pitch' :: forall t. Tone t -> Pitch
tone_12et_pitch' = forall a. String -> Maybe a -> a
fromJust_err String
"tone_12et_pitch" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Pitch
tone_12et_pitch

tone_12et_pitch_detune :: Tone t -> Maybe T.Pitch_Detune
tone_12et_pitch_detune :: forall t. Tone t -> Maybe Pitch_Detune
tone_12et_pitch_detune = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double, Double) -> Double -> Pitch_Detune
T.nearest_pitch_detune_12et_k0 (Double
69,Double
440)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Double
tone_frequency

tone_12et_pitch_detune' :: Tone t -> T.Pitch_Detune
tone_12et_pitch_detune' :: forall t. Tone t -> Pitch_Detune
tone_12et_pitch_detune' = forall a. String -> Maybe a -> a
fromJust_err String
"tone_12et_pitch_detune" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Pitch_Detune
tone_12et_pitch_detune

-- | Fractional (rational) 24-et midi note number of 'Tone'.
tone_12et_fmidi :: Tone t -> Rational
tone_12et_fmidi :: forall t. Tone t -> Rational
tone_12et_fmidi = Double -> Rational
near_rat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Fractional n => Pitch -> n
T.pitch_to_fmidi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Pitch
tone_12et_pitch'

tone_family :: Tone t -> Instrument_Family
tone_family :: forall t. Tone t -> Instrument_Family
tone_family = Instrument_Name -> Instrument_Family
instrument_family forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Instrument_Name
tone_instrument_name

tone_in_family :: Instrument_Family -> Tone t -> Bool
tone_in_family :: forall t. Instrument_Family -> Tone t -> Bool
tone_in_family Instrument_Family
c Tone t
t = forall t. Tone t -> Instrument_Family
tone_family Tone t
t forall a. Eq a => a -> a -> Bool
== Instrument_Family
c

select_tones :: Instrument_Family -> [Tone t] -> [Maybe (Tone t)]
select_tones :: forall t. Instrument_Family -> [Tone t] -> [Maybe (Tone t)]
select_tones Instrument_Family
c =
    let f :: Tone t -> Maybe (Tone t)
f Tone t
t = if forall t. Tone t -> Instrument_Family
tone_family Tone t
t forall a. Eq a => a -> a -> Bool
== Instrument_Family
c then forall a. a -> Maybe a
Just Tone t
t else forall a. Maybe a
Nothing
    in forall a b. (a -> b) -> [a] -> [b]
map forall {t}. Tone t -> Maybe (Tone t)
f

-- | Specify subset as list of families and scales.
type Tone_Subset = ([Instrument_Family],[Scale])

-- | Extract subset of 'Tone_Set'.
tone_subset :: Tone_Subset -> Tone_Set t -> Tone_Set t
tone_subset :: forall t. Tone_Subset -> Tone_Set t -> Tone_Set t
tone_subset ([Instrument_Family]
fm,[Scale]
sc) =
    let f :: Tone t -> Bool
f Tone t
t = forall t. Tone t -> Instrument_Family
tone_family Tone t
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Instrument_Family]
fm Bool -> Bool -> Bool
&&
              forall a. String -> Maybe a -> a
fromJust_err String
"tone_subset" (forall t. Tone t -> Maybe Scale
tone_scale Tone t
t) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Scale]
sc
    in forall a. (a -> Bool) -> [a] -> [a]
filter forall {t}. Tone t -> Bool
f

data Instrument = Instrument {Instrument -> Instrument_Name
instrument_name :: Instrument_Name
                             ,Instrument -> Maybe Scale
instrument_scale :: Maybe Scale
                             ,Instrument -> Maybe [Pitch]
instrument_pitches :: Maybe [Pitch]
                             ,Instrument -> Maybe [Double]
instrument_frequencies :: Maybe [Frequency]}
                  deriving (Instrument -> Instrument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument -> Instrument -> Bool
$c/= :: Instrument -> Instrument -> Bool
== :: Instrument -> Instrument -> Bool
$c== :: Instrument -> Instrument -> Bool
Eq,Int -> Instrument -> ShowS
[Instrument] -> ShowS
Instrument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument] -> ShowS
$cshowList :: [Instrument] -> ShowS
show :: Instrument -> String
$cshow :: Instrument -> String
showsPrec :: Int -> Instrument -> ShowS
$cshowsPrec :: Int -> Instrument -> ShowS
Show)

type Tone_Set t = [Tone t]
type Tone_Group t = [Tone_Set t]
type Gamelan = [Instrument]

tone_scale :: Tone t -> Maybe Scale
tone_scale :: forall t. Tone t -> Maybe Scale
tone_scale = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Note -> Scale
note_scale forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Note
tone_note

tone_pitch :: Tone t -> Maybe Pitch
tone_pitch :: forall t. Tone t -> Maybe Pitch
tone_pitch = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Note -> Pitch
note_pitch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Note
tone_note

tone_degree :: Tone t -> Maybe Degree
tone_degree :: forall t. Tone t -> Maybe Degree
tone_degree = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pitch -> Degree
pitch_degree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Pitch
tone_pitch

tone_degree' :: Tone t -> Degree
tone_degree' :: forall t. Tone t -> Degree
tone_degree' = forall a. String -> Maybe a -> a
fromJust_err String
"tone_degree" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Degree
tone_degree

tone_octave :: Tone t -> Maybe Octave
tone_octave :: forall t. Tone t -> Maybe Degree
tone_octave = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pitch -> Degree
pitch_octave forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Pitch
tone_pitch

tone_class :: Tone t -> (Instrument_Name,Maybe Scale)
tone_class :: forall t. Tone t -> (Instrument_Name, Maybe Scale)
tone_class Tone t
t = (forall t. Tone t -> Instrument_Name
tone_instrument_name Tone t
t,forall t. Tone t -> Maybe Scale
tone_scale Tone t
t)

instrument_class :: Instrument -> (Instrument_Name,Maybe Scale)
instrument_class :: Instrument -> (Instrument_Name, Maybe Scale)
instrument_class Instrument
i = (Instrument -> Instrument_Name
instrument_name Instrument
i,Instrument -> Maybe Scale
instrument_scale Instrument
i)

tone_class_p :: (Instrument_Name, Scale) -> Tone t -> Bool
tone_class_p :: forall t. (Instrument_Name, Scale) -> Tone t -> Bool
tone_class_p (Instrument_Name
nm,Scale
sc) Tone t
t =
    forall t. Tone t -> Instrument_Name
tone_instrument_name Tone t
t forall a. Eq a => a -> a -> Bool
== Instrument_Name
nm Bool -> Bool -> Bool
&&
    forall t. Tone t -> Maybe Scale
tone_scale Tone t
t forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Scale
sc

tone_family_class_p :: (Instrument_Family,Scale) -> Tone t -> Bool
tone_family_class_p :: forall t. (Instrument_Family, Scale) -> Tone t -> Bool
tone_family_class_p (Instrument_Family
fm,Scale
sc) Tone t
t =
    Instrument_Name -> Instrument_Family
instrument_family (forall t. Tone t -> Instrument_Name
tone_instrument_name Tone t
t) forall a. Eq a => a -> a -> Bool
== Instrument_Family
fm Bool -> Bool -> Bool
&&
    forall t. Tone t -> Maybe Scale
tone_scale Tone t
t forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Scale
sc

-- | Given a 'Tone_Set', find those 'Tone's that are within 'T.Cents' of 'Frequency'.
tone_set_near_frequency :: Tone_Set t -> T.Cents -> Frequency -> Tone_Set t
tone_set_near_frequency :: forall t. Tone_Set t -> Double -> Double -> Tone_Set t
tone_set_near_frequency Tone_Set t
t Double
k Double
n =
    let near :: Double -> Bool
near Double
i = forall a. Num a => a -> a
abs (forall r n. (Real r, Fractional r, Floating n) => r -> r -> n
T.cps_difference_cents Double
i Double
n) forall a. Ord a => a -> a -> Bool
<= Double
k
        near_t :: Tone t -> Bool
near_t Tone t
i = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
near (forall t. Tone t -> Maybe Double
tone_frequency Tone t
i)
    in forall a. (a -> Bool) -> [a] -> [a]
filter forall {t}. Tone t -> Bool
near_t Tone_Set t
t

-- | Compare 'Tone's by frequency.  'Tone's without frequency compare
-- as if at frequency @0@.
tone_compare_frequency :: Tone t -> Tone t -> Ordering
tone_compare_frequency :: forall t. Tone t -> Tone t -> Ordering
tone_compare_frequency = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a. a -> Maybe a -> a
fromMaybe Double
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Double
tone_frequency)

-- | If all /f/ of /a/ are 'Just' /b/, then 'Just' /[b]/, else
-- 'Nothing'.
map_maybe_uniform :: (a -> Maybe b) -> [a] -> Maybe [b]
map_maybe_uniform :: forall a b. (a -> Maybe b) -> [a] -> Maybe [b]
map_maybe_uniform a -> Maybe b
f [a]
x =
    let x' :: [Maybe b]
x' = forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe b
f [a]
x
    in if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isNothing [Maybe b]
x' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. [Maybe a] -> [a]
catMaybes [Maybe b]
x')

instrument :: Tone_Set t -> Instrument
instrument :: forall t. Tone_Set t -> Instrument
instrument Tone_Set t
c =
    let sf :: Tone t -> Maybe Scale
sf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Note -> Scale
note_scale forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Note
tone_note
        pf :: Tone t -> Maybe Pitch
pf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Note -> Pitch
note_pitch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Note
tone_note
        pm :: Maybe [Pitch]
pm = forall a b. (a -> Maybe b) -> [a] -> Maybe [b]
map_maybe_uniform forall t. Tone t -> Maybe Pitch
pf Tone_Set t
c
        fm :: Maybe [Double]
fm = forall a b. (a -> Maybe b) -> [a] -> Maybe [b]
map_maybe_uniform forall t. Tone t -> Maybe Double
tone_frequency Tone_Set t
c
        (Maybe [Pitch]
p,Maybe [Double]
f) = case (Maybe [Pitch]
pm,Maybe [Double]
fm) of
                  (Just [Pitch]
i,Just [Double]
j) -> let ([Pitch]
i',[Double]
j') = forall a b. [(a, b)] -> ([a], [b])
unzip (forall a. Ord a => [a] -> [a]
sort (forall a b. [a] -> [b] -> [(a, b)]
zip [Pitch]
i [Double]
j))
                                     in (forall a. a -> Maybe a
Just [Pitch]
i',forall a. a -> Maybe a
Just [Double]
j')
                  (Maybe [Pitch], Maybe [Double])
_ -> (Maybe [Pitch]
pm,Maybe [Double]
fm)
    in case Tone_Set t
c of
         Tone t
t:Tone_Set t
_ -> Instrument_Name
-> Maybe Scale -> Maybe [Pitch] -> Maybe [Double] -> Instrument
Instrument (forall t. Tone t -> Instrument_Name
tone_instrument_name Tone t
t) (forall t. Tone t -> Maybe Scale
sf Tone t
t) Maybe [Pitch]
p Maybe [Double]
f
         [] -> forall a. HasCallStack => a
undefined

instruments :: Tone_Set t -> [Instrument]
instruments :: forall t. Tone_Set t -> [Instrument]
instruments Tone_Set t
c =
    let c' :: Tone_Set t
c' = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall t. Tone t -> Instrument_Name
tone_instrument_name) Tone_Set t
c
        c'' :: [Tone_Set t]
c'' = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall t. Tone t -> (Instrument_Name, Maybe Scale)
tone_class) Tone_Set t
c'
    in forall a b. (a -> b) -> [a] -> [b]
map forall t. Tone_Set t -> Instrument
instrument [Tone_Set t]
c''

instrument_gamut :: Instrument -> Maybe (Pitch,Pitch)
instrument_gamut :: Instrument -> Maybe (Pitch, Pitch)
instrument_gamut =
    let f :: [b] -> (b, b)
f [b]
p = (forall a. [a] -> a
head [b]
p,forall a. [a] -> a
last [b]
p)
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b}. [b] -> (b, b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instrument -> Maybe [Pitch]
instrument_pitches

-- | Pelog has seven degrees, numbered one to seven.
--   Slendro has five degrees, numbered one to six excluding four.
--
-- > map scale_degrees [Pelog,Slendro] == [[1,2,3,4,5,6,7],[1,2,3,5,6]]
scale_degrees :: Scale -> [Degree]
scale_degrees :: Scale -> [Degree]
scale_degrees Scale
s =
    case Scale
s of
      Scale
Pelog -> [Degree
1..Degree
7]
      Scale
Slendro -> [Degree
1,Degree
2,Degree
3,Degree
5,Degree
6]

-- | Zero based index of scale degree, or Nothing.
--
-- > degree_index Slendro 4 == Nothing
-- > degree_index Pelog 4 == Just 3
degree_index :: Scale -> Degree -> Maybe Int
degree_index :: Scale -> Degree -> Maybe Int
degree_index Scale
s Degree
d = forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Degree
d (Scale -> [Degree]
scale_degrees Scale
s)

-- * Tone set

tone_set_gamut :: Tone_Set t -> Maybe (Pitch,Pitch)
tone_set_gamut :: forall t. Tone_Set t -> Maybe (Pitch, Pitch)
tone_set_gamut Tone_Set t
g =
    case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Note -> Pitch
note_pitch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Tone t -> Maybe Note
tone_note) Tone_Set t
g of
      [] -> forall a. Maybe a
Nothing
      [Pitch]
p -> forall a. a -> Maybe a
Just (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Pitch]
p,forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Pitch]
p)

tone_set_instrument :: Tone_Set t -> (Instrument_Name,Maybe Scale) -> Tone_Set t
tone_set_instrument :: forall t.
Tone_Set t -> (Instrument_Name, Maybe Scale) -> Tone_Set t
tone_set_instrument Tone_Set t
db (Instrument_Name
i,Maybe Scale
s) =
    let f :: Tone t -> Bool
f Tone t
t = forall t. Tone t -> (Instrument_Name, Maybe Scale)
tone_class Tone t
t forall a. Eq a => a -> a -> Bool
== (Instrument_Name
i,Maybe Scale
s)
    in forall a. (a -> Bool) -> [a] -> [a]
filter forall {t}. Tone t -> Bool
f Tone_Set t
db