-- 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 CPP #-}
{- | Functions to manipulate pitches in scales according to the rules of
    standard western music theory.

    Pitches are represented as 'Pitch.Pitch'es and 'Pitch.Degree's.  They're
    generalized to work with any number of 'Pitch.PitchClass'es, but since each
    scale carries an implied key 'Layout' it can only handle pitch classes in
    a certain range.  Internally there are no checks that the pitch class is in
    range, so the range has to be checked on parse or show.  Parsing and
    showing is handled in "Derive.Scale.TheoryFormat".

    @
        db      eb  fb      gb      ab      bb  cb
        c#      d#      e#  f#      g#      a#      b#
    c       d       e   f       g       a       b   c
    |   |   |   |   |   |   |   |   |   |   |   |   |
    @
-}
module Derive.Scale.Theory (
    -- * constants
    piano_intervals, piano_layout, diatonic_layout
    -- * NoteNumber diatonic transposition
    , diatonic_to_chromatic
    -- * symbolic transposition
    , transpose_diatonic, transpose_chromatic
    -- * input
    , enharmonics_of
    , pitch_to_semis, degree_to_semis
    , semis_to_pitch, pick_enharmonic, semis_to_pitch_sharps
    , semis_to_nn, fsemis_to_nn, nn_to_semis
    -- ** key
    , Key(key_tonic, key_name, key_intervals, key_signature, key_layout), key
    , accidentals_at_pc
    , Signature, Intervals
    , layout
    , layout_pc_per_octave, layout_semis_per_octave
    , contains_degree
#ifndef TESTING
    , Layout(layout_intervals)
#else
    , Layout(..)
    , calculate_signature, step_of
#endif
) where
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Vector as Boxed
import qualified Data.Vector.Unboxed as Vector

import qualified Util.Num as Num
import qualified Util.Pretty as Pretty
import qualified Util.Seq as Seq
import qualified Util.Vector as Vector

import qualified Perform.Pitch as Pitch

import           Global


-- * constants

piano_intervals :: [Pitch.Semi]
piano_intervals :: [Accidentals]
piano_intervals = [Accidentals
2, Accidentals
2, Accidentals
1, Accidentals
2, Accidentals
2, Accidentals
2, Accidentals
1]

-- | The layout of keys on everyone's favorite boxed harp.
piano_layout :: Layout
piano_layout :: Layout
piano_layout = [Accidentals] -> Layout
layout [Accidentals]
piano_intervals

diatonic_layout :: Pitch.PitchClass -> Layout
diatonic_layout :: Accidentals -> Layout
diatonic_layout Accidentals
per_oct = [Accidentals] -> Layout
layout ([Accidentals] -> Layout) -> [Accidentals] -> Layout
forall a b. (a -> b) -> a -> b
$ Accidentals -> Accidentals -> [Accidentals]
forall a. Accidentals -> a -> [a]
replicate Accidentals
per_oct Accidentals
1


-- * NoteNumber diatonic transposition

-- | Convert a fractional number of diatonic steps to chromatic steps.
diatonic_to_chromatic :: Key -> Pitch.Degree -> Double -> Double
diatonic_to_chromatic :: Key -> Degree -> FSemi -> FSemi
diatonic_to_chromatic Key
key Degree
degree FSemi
steps
    | FSemi
steps FSemi -> FSemi -> Bool
forall a. Eq a => a -> a -> Bool
== FSemi
0 = FSemi
0
    | FSemi
steps FSemi -> FSemi -> Bool
forall a. Ord a => a -> a -> Bool
> FSemi
0 = FSemi -> FSemi -> FSemi -> FSemi
forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale (Accidentals -> FSemi
transpose Accidentals
isteps) (Accidentals -> FSemi
transpose (Accidentals
istepsAccidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+Accidentals
1)) FSemi
frac
    | Bool
otherwise =
        FSemi -> FSemi -> FSemi -> FSemi
forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale (Accidentals -> FSemi
transpose (Accidentals
istepsAccidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
-Accidentals
1)) (Accidentals -> FSemi
transpose Accidentals
isteps) (FSemi
1 FSemi -> FSemi -> FSemi
forall a. Num a => a -> a -> a
- FSemi -> FSemi
forall a. Num a => a -> a
abs FSemi
frac)
    where
    (Accidentals
isteps, FSemi
frac) = FSemi -> (Accidentals, FSemi)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction FSemi
steps
    transpose :: Accidentals -> FSemi
transpose = Accidentals -> FSemi
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Accidentals -> FSemi)
-> (Accidentals -> Accidentals) -> Accidentals -> FSemi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Degree -> Accidentals -> Accidentals
chromatic_steps Key
key Degree
degree

-- | Convert diatonic steps to chromatic steps.
chromatic_steps :: Key -> Pitch.Degree -> Int -> Pitch.Semi
chromatic_steps :: Key -> Degree -> Accidentals -> Accidentals
chromatic_steps Key
key Degree
degree Accidentals
steps =
    case Intervals
table Intervals -> Accidentals -> Maybe Accidentals
forall a. Unbox a => Vector a -> Accidentals -> Maybe a
Vector.!? (Accidentals
middle Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
step Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
steps2) of
        Just Accidentals
val -> Accidentals
oct_semis Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
val Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
- Intervals
table Intervals -> Accidentals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals -> a
Vector.! (Accidentals
middle Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
step)
        -- 'make_table' should build a table big enough that this can't happen.
        Maybe Accidentals
Nothing -> [Char] -> Accidentals
forall a. HasCallStack => [Char] -> a
error ([Char] -> Accidentals) -> [Char] -> Accidentals
forall a b. (a -> b) -> a -> b
$ [Char]
"ran out of transpose table for "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Accidentals, Accidentals, Accidentals) -> [Char]
forall a. Show a => a -> [Char]
show (Accidentals
middle, Accidentals
step, Accidentals
steps2) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Intervals -> [Char]
forall a. Show a => a -> [Char]
show Intervals
table
    where
    step :: Accidentals
step = Key -> Degree -> Accidentals
step_of Key
key Degree
degree
    (Accidentals
octaves, Accidentals
steps2) = Accidentals
steps Accidentals -> Accidentals -> (Accidentals, Accidentals)
forall a. Integral a => a -> a -> (a, a)
`divMod` Key -> Accidentals
key_steps_per_octave Key
key
    oct_semis :: Accidentals
oct_semis = if Accidentals
octaves Accidentals -> Accidentals -> Bool
forall a. Eq a => a -> a -> Bool
== Accidentals
0 then Accidentals
0
        else Accidentals
octaves Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
* Layout -> Accidentals
layout_semis_per_octave (Key -> Layout
key_layout Key
key)
    middle :: Accidentals
middle = Intervals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length Intervals
table Accidentals -> Accidentals -> Accidentals
forall a. Integral a => a -> a -> a
`div` Accidentals
2
    table :: Intervals
table = Key -> Intervals
key_transpose_table Key
key

-- * symbolic transposition

-- | Transpose a pitch diatonically.  If the key is diatonic (i.e. there is
-- a 1:1 relationship between note letters and scale degrees), then this will
-- increment or decrement the note letters by the number of steps and adjust
-- the accidentals based on the key signature.  Otherwise (i.e. for scales like
-- whole-tone or octatonic), it will figure out the number of chromatic steps
-- to transpose and act like 'transpose_chromatic'.
transpose_diatonic :: Key -> Step -> Pitch.Pitch -> Pitch.Pitch
transpose_diatonic :: Key -> Accidentals -> Pitch -> Pitch
transpose_diatonic Key
key Accidentals
steps
        pitch :: Pitch
pitch@(Pitch.Pitch Accidentals
oct degree :: Degree
degree@(Pitch.Degree Accidentals
pc Accidentals
accs))
    | Accidentals
steps Accidentals -> Accidentals -> Bool
forall a. Eq a => a -> a -> Bool
== Accidentals
0 = Pitch
pitch
    | Bool
otherwise = case Key -> Maybe Intervals
key_signature Key
key of
        Just Intervals
_ -> Accidentals -> Degree -> Pitch
Pitch.Pitch (Accidentals
oct Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
oct2) (Degree -> Pitch) -> Degree -> Pitch
forall a b. (a -> b) -> a -> b
$ Accidentals -> Accidentals -> Degree
Pitch.Degree Accidentals
pc2 (Accidentals -> Degree) -> Accidentals -> Degree
forall a b. (a -> b) -> a -> b
$
            Accidentals
accs Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
- Key -> Accidentals -> Accidentals
accidentals_at_pc Key
key Accidentals
pc Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Key -> Accidentals -> Accidentals
accidentals_at_pc Key
key Accidentals
pc2
        Maybe Intervals
Nothing -> Key -> Accidentals -> Pitch -> Pitch
transpose_chromatic
            Key
key (Key -> Degree -> Accidentals -> Accidentals
chromatic_steps Key
key Degree
degree Accidentals
steps) Pitch
pitch
    where
    (Accidentals
oct2, Accidentals
pc2) = (Accidentals
pc Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
steps) Accidentals -> Accidentals -> (Accidentals, Accidentals)
forall a. Integral a => a -> a -> (a, a)
`divMod` Key -> Accidentals
key_steps_per_octave Key
key

-- | Chromatic transposition.  Try to pick a spelling that makes sense for the
-- given key.
transpose_chromatic :: Key -> Pitch.Semi -> Pitch.Pitch -> Pitch.Pitch
transpose_chromatic :: Key -> Accidentals -> Pitch -> Pitch
transpose_chromatic Key
key Accidentals
steps Pitch
pitch
    | Accidentals
steps Accidentals -> Accidentals -> Bool
forall a. Eq a => a -> a -> Bool
== Accidentals
0 = Pitch
pitch
    | Bool
otherwise = Key -> Accidentals -> Pitch
semis_to_pitch Key
key (Accidentals -> Pitch) -> Accidentals -> Pitch
forall a b. (a -> b) -> a -> b
$ Layout -> Pitch -> Accidentals
pitch_to_semis Layout
layout Pitch
pitch Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
steps
    where layout :: Layout
layout = Key -> Layout
key_layout Key
key

pitch_to_semis :: Layout -> Pitch.Pitch -> Pitch.Semi
pitch_to_semis :: Layout -> Pitch -> Accidentals
pitch_to_semis Layout
layout (Pitch.Pitch Accidentals
oct Degree
note) =
    Accidentals
oct Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
* Layout -> Accidentals
layout_semis_per_octave Layout
layout Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Layout -> Degree -> Accidentals
degree_to_semis Layout
layout Degree
note

degree_to_semis :: Layout -> Pitch.Degree -> Pitch.Semi
degree_to_semis :: Layout -> Degree -> Accidentals
degree_to_semis Layout
layout (Pitch.Degree Accidentals
pc_ Accidentals
accs) =
    Intervals -> Accidentals
forall a. (Unbox a, Num a) => Vector a -> a
Vector.sum (Accidentals -> Intervals -> Intervals
forall a. Unbox a => Accidentals -> Vector a -> Vector a
Vector.take Accidentals
pc (Layout -> Intervals
layout_intervals Layout
layout)) Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
accs
        Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
oct Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
* Layout -> Accidentals
layout_semis_per_octave Layout
layout
    where (Accidentals
oct, Accidentals
pc) = Accidentals
pc_ Accidentals -> Accidentals -> (Accidentals, Accidentals)
forall a. Integral a => a -> a -> (a, a)
`divMod` Layout -> Accidentals
layout_pc_per_octave Layout
layout

-- | Pick the most sensible enharmonic for the given pitch.
--
-- TODO I reduce to semis and then pick an enharmonic, so 5b# becomes 6c.  But
-- if they asked for 5b# they should get it.
pick_enharmonic :: Key -> Pitch.Pitch -> Pitch.Pitch
pick_enharmonic :: Key -> Pitch -> Pitch
pick_enharmonic Key
key = Key -> Accidentals -> Pitch
semis_to_pitch Key
key (Accidentals -> Pitch) -> (Pitch -> Accidentals) -> Pitch -> Pitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Pitch -> Accidentals
pitch_to_semis (Key -> Layout
key_layout Key
key)

-- | Convert an absolute semitones value to a pitch.  This is a bit
-- complicated because it wants to find the best spelling for the given key.
semis_to_pitch :: Key -> Pitch.Semi -> Pitch.Pitch
semis_to_pitch :: Key -> Accidentals -> Pitch
semis_to_pitch Key
key Accidentals
semis = (Accidentals, Degree) -> Pitch
mkpitch ((Accidentals, Degree) -> Pitch) -> (Accidentals, Degree) -> Pitch
forall a b. (a -> b) -> a -> b
$ case Key -> Maybe Intervals
key_signature Key
key of
    Just Intervals
sig -> case ((Accidentals, Degree) -> Bool)
-> [(Accidentals, Degree)] -> Maybe (Accidentals, Degree)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Intervals -> (Accidentals, Degree) -> Bool
forall {a}. Intervals -> (a, Degree) -> Bool
in_scale Intervals
sig) [(Accidentals, Degree)]
enharmonics of
        Maybe (Accidentals, Degree)
Nothing -> Bool -> [(Accidentals, Degree)] -> (Accidentals, Degree)
forall {a}. Num a => Bool -> [(a, Degree)] -> (a, Degree)
pick_enharmonic (Intervals -> Bool
forall {v :: * -> *} {a}. (Vector v a, Ord a, Num a) => v a -> Bool
sharp_signature Intervals
sig) [(Accidentals, Degree)]
enharmonics
        Just (Accidentals, Degree)
note -> (Accidentals, Degree)
note
    Maybe Intervals
Nothing -> Bool -> [(Accidentals, Degree)] -> (Accidentals, Degree)
forall {a}. Num a => Bool -> [(a, Degree)] -> (a, Degree)
pick_enharmonic (Key -> Bool
sharp_tonic Key
key) [(Accidentals, Degree)]
enharmonics
    where
    mkpitch :: (Accidentals, Degree) -> Pitch
mkpitch (Accidentals
oct, Degree
note) = Accidentals -> Degree -> Pitch
Pitch.Pitch (Accidentals
octave Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
oct) Degree
note
    -- The (Pitch.Degree (-1) 0) error value is icky, but here's why it should
    -- never happen: It happens when enharmonics is empty.  Since the values of
    -- layout_enharmonics are never [] as per the definition of 'layout', it
    -- means the mod of semis is out of range for the array, which means the
    -- sum of the intervals is larger than the length of layout_enharmonics.
    -- That shouldn't happen because layout_enharmonics is initialized to
    -- [..  | i <- intervals, a <- [0..i-1]].
    pick_enharmonic :: Bool -> [(a, Degree)] -> (a, Degree)
pick_enharmonic Bool
use_sharps [(a, Degree)]
notes = (a, Degree) -> Maybe (a, Degree) -> (a, Degree)
forall a. a -> Maybe a -> a
fromMaybe (a
0, Accidentals -> Accidentals -> Degree
Pitch.Degree (-Accidentals
1) Accidentals
0) (Maybe (a, Degree) -> (a, Degree))
-> Maybe (a, Degree) -> (a, Degree)
forall a b. (a -> b) -> a -> b
$
        ((a, Degree) -> (Bool, Accidentals))
-> [(a, Degree)] -> Maybe (a, Degree)
forall k a. Ord k => (a -> k) -> [a] -> Maybe a
Seq.minimum_on (Accidentals -> (Bool, Accidentals)
forall {b}. (Ord b, Num b) => b -> (Bool, b)
key (Accidentals -> (Bool, Accidentals))
-> ((a, Degree) -> Accidentals)
-> (a, Degree)
-> (Bool, Accidentals)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Degree -> Accidentals
Pitch.degree_accidentals (Degree -> Accidentals)
-> ((a, Degree) -> Degree) -> (a, Degree) -> Accidentals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Degree) -> Degree
forall a b. (a, b) -> b
snd) [(a, Degree)]
notes
        where key :: b -> (Bool, b)
key b
accs = (if Bool
use_sharps then b
accs b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0 else b
accs b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0, b -> b
forall a. Num a => a -> a
abs b
accs)
    in_scale :: Intervals -> (a, Degree) -> Bool
in_scale Intervals
sig (a
_, Degree
note) =
        Intervals
sig Intervals -> Accidentals -> Maybe Accidentals
forall a. Unbox a => Vector a -> Accidentals -> Maybe a
Vector.!? Key -> Degree -> Accidentals
step_of Key
key Degree
note Maybe Accidentals -> Maybe Accidentals -> Bool
forall a. Eq a => a -> a -> Bool
== Accidentals -> Maybe Accidentals
forall a. a -> Maybe a
Just (Degree -> Accidentals
Pitch.degree_accidentals Degree
note)
    enharmonics :: [(Accidentals, Degree)]
enharmonics = [(Accidentals, Degree)]
-> Maybe [(Accidentals, Degree)] -> [(Accidentals, Degree)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(Accidentals, Degree)] -> [(Accidentals, Degree)])
-> Maybe [(Accidentals, Degree)] -> [(Accidentals, Degree)]
forall a b. (a -> b) -> a -> b
$ Layout -> Vector [(Accidentals, Degree)]
layout_enharmonics Layout
layout Vector [(Accidentals, Degree)]
-> Accidentals -> Maybe [(Accidentals, Degree)]
forall a. Vector a -> Accidentals -> Maybe a
Boxed.!? Accidentals
steps
    (Accidentals
octave, Accidentals
steps) = Accidentals
semis Accidentals -> Accidentals -> (Accidentals, Accidentals)
forall a. Integral a => a -> a -> (a, a)
`divMod` Layout -> Accidentals
layout_semis_per_octave Layout
layout
    layout :: Layout
layout = Key -> Layout
key_layout Key
key
    -- Sharpish looking key signatures favor sharps.
    sharp_signature :: v a -> Bool
sharp_signature v a
sig = (a -> Bool) -> v a -> Accidentals
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> Accidentals
Vector.count (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
0) v a
sig Accidentals -> Accidentals -> Bool
forall a. Ord a => a -> a -> Bool
>= (a -> Bool) -> v a -> Accidentals
forall (v :: * -> *) a.
Vector v a =>
(a -> Bool) -> v a -> Accidentals
Vector.count (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
0) v a
sig
    sharp_tonic :: Key -> Bool
sharp_tonic = (Accidentals -> Accidentals -> Bool
forall a. Ord a => a -> a -> Bool
>=Accidentals
0) (Accidentals -> Bool) -> (Key -> Accidentals) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Degree -> Accidentals
Pitch.degree_accidentals (Degree -> Accidentals) -> (Key -> Degree) -> Key -> Accidentals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Degree
key_tonic

-- | Like 'semis_to_pitch', but only emits sharps, so it doesn't require a key.
semis_to_pitch_sharps :: Layout -> Pitch.Semi -> Pitch.Pitch
semis_to_pitch_sharps :: Layout -> Accidentals -> Pitch
semis_to_pitch_sharps Layout
layout Accidentals
semis = Accidentals -> Degree -> Pitch
Pitch.Pitch (Accidentals
octave Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
oct) Degree
degree
    where
    (Accidentals
octave, Accidentals
steps) = Accidentals
semis Accidentals -> Accidentals -> (Accidentals, Accidentals)
forall a. Integral a => a -> a -> (a, a)
`divMod` Layout -> Accidentals
layout_semis_per_octave Layout
layout
    (Accidentals
oct, Degree
degree) = [(Accidentals, Degree)] -> (Accidentals, Degree)
forall a. [a] -> a
head ([(Accidentals, Degree)] -> (Accidentals, Degree))
-> [(Accidentals, Degree)] -> (Accidentals, Degree)
forall a b. (a -> b) -> a -> b
$ Vector [(Accidentals, Degree)]
enharmonics Vector [(Accidentals, Degree)]
-> Accidentals -> [(Accidentals, Degree)]
forall a. Vector a -> Accidentals -> a
Boxed.! Accidentals
steps
    enharmonics :: Vector [(Accidentals, Degree)]
enharmonics = Layout -> Vector [(Accidentals, Degree)]
layout_enharmonics Layout
layout

-- | Convert Semis to integral NNs.  This is only valid for 12TET, which is the
-- only scale where Semis correspond directly to NNs.
--
-- It doesn't return 'Pitch.NoteNumber' because these values are specifically
-- integral.
--
-- NOTE [middle-c] Middle C is 5 octaves above NN 0, but is conventially called
-- 4c.  Therefore, a 'Pitch' with octave 0 actually starts at NN 12 (in 12TET),
-- and I have to add an octave when converting from NNs and subtract an octave
-- when converting from NNs.
--
-- Previously I considered the octave offset a part of formatting, and added
-- an octave in 'TheoryFormat.p_octave' and subtracted an octave in
-- 'TheoryFormat.show_octave'.  But I was unsatisfied because it applied to
-- all scales, and it seemed confusing to ask for a Pitch with octave 4 and get
-- a note with octave 3.  TODO maybe the add/subtract octave should just go in
-- TheoryFormat.absolute_c?
semis_to_nn :: Pitch.Semi -> Int
semis_to_nn :: Accidentals -> Accidentals
semis_to_nn = (Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+Accidentals
12)

fsemis_to_nn :: Pitch.FSemi -> Pitch.NoteNumber
fsemis_to_nn :: FSemi -> NoteNumber
fsemis_to_nn = FSemi -> NoteNumber
Pitch.NoteNumber (FSemi -> NoteNumber) -> (FSemi -> FSemi) -> FSemi -> NoteNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FSemi -> FSemi -> FSemi
forall a. Num a => a -> a -> a
+FSemi
12)

nn_to_semis :: Int -> Pitch.Semi
nn_to_semis :: Accidentals -> Accidentals
nn_to_semis = Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
subtract Accidentals
12

-- * input

-- | Enharmonics of a pitch.
--
-- This choses the next highest enharmonic until it wraps around, so if you
-- repeatedly pick the first one you'll cycle through them all.
enharmonics_of :: Layout -> Pitch.Pitch -> [Pitch.Pitch]
enharmonics_of :: Layout -> Pitch -> [Pitch]
enharmonics_of Layout
layout Pitch
pitch =
    [ Accidentals -> Degree -> Pitch
Pitch.Pitch (Pitch -> Accidentals
Pitch.pitch_octave Pitch
pitch Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
oct) Degree
n
    | (Accidentals
oct, Degree
n) <-
        Intervals -> Degree -> [(Accidentals, Degree)]
get_enharmonics (Layout -> Intervals
layout_intervals Layout
layout) (Pitch -> Degree
Pitch.pitch_degree Pitch
pitch)
    ]

-- * step

{- | A degree is one step of a scale.  Unlike 'Pitch.PitchClass' it's relative
    to the tonic of the key, but also may have a different range.  This is
    because some scales, such as whole-tone or octatonic, have fewer or more
    degrees than 7, even though the underlying notation system uses only
    7 letters.  This means that not every Degree will map to a PitchClass.

    Another approach is to change the number of PitchClasses, which would
    result in a--h for octatonic, but it would not admit easy modulation from
    an octatonic scale to a septatonic one.

    'Key' has more documentation about the PitchClass and Step distinction.
-}
type Step = Int

-- * Key

{- | A Key is a scale along with a tonic Pitch.

    There's a distinction between \"diatonic\" and \"chromatic\" keys.  It's
    not really standard terminology, but within this module I call scales with
    a 1:1 'Pitch.PitchClass' to 'Degree' mapping \"diatonic\", and the ones
    without \"chromatic\".  That's because diatonic transposition for the
    former kind of scale is defined in terms of pitch classes, regardless of
    what accidentals the 'Pitch.Degree' may have, but the latter kind of scale
    must resort to chromatic transposition, losing the spelling of the original
    note.  Ultimately there is a tension between diatonic and chromatic
    systems.
-}
data Key = Key {
    Key -> Degree
key_tonic :: !Pitch.Degree
    -- | This is the name of the key without reference to its tonic, e.g.
    -- \"dorian\" or \"major\".
    , Key -> Text
key_name :: !Text
    -- | Semitones between each scale degree.  This should have at least two
    -- octaves of intervals, as needed by 'chromatic_steps'.  If this is a
    -- diatonic key, each interval is one pitch class.
    , Key -> Intervals
key_intervals :: Intervals
    -- | Nothing for a chromatic key.
    , Key -> Maybe Intervals
key_signature :: Maybe Signature
    -- | Table to speed up diatonic transposition, see 'make_table'.
    , Key -> Intervals
key_transpose_table :: Intervals
    , Key -> Layout
key_layout :: Layout
    } 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, Accidentals -> Key -> [Char] -> [Char]
[Key] -> [Char] -> [Char]
Key -> [Char]
(Accidentals -> Key -> [Char] -> [Char])
-> (Key -> [Char]) -> ([Key] -> [Char] -> [Char]) -> Show Key
forall a.
(Accidentals -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Key] -> [Char] -> [Char]
$cshowList :: [Key] -> [Char] -> [Char]
show :: Key -> [Char]
$cshow :: Key -> [Char]
showsPrec :: Accidentals -> Key -> [Char] -> [Char]
$cshowsPrec :: Accidentals -> Key -> [Char] -> [Char]
Show)

-- | Map from a Step to the number of sharps or flats at that Step.
type Signature = Vector.Vector Pitch.Accidentals
-- | Semitones between each scale degree.
type Intervals = Vector.Vector Pitch.Semi

-- | Make a Key given intervals and a layout.  If the number of intervals are
-- equal to the number of intervals in the layout, the scale is considered
-- diatonic and will get a 'Signature'.
key :: Pitch.Degree -> Text -> [Pitch.Semi] -> Layout -> Key
key :: Degree -> Text -> [Accidentals] -> Layout -> Key
key Degree
tonic Text
name [Accidentals]
intervals Layout
layout = Key
    { key_tonic :: Degree
key_tonic = Degree
tonic
    , key_name :: Text
key_name = Text
name
    , key_intervals :: Intervals
key_intervals = Intervals
ints
    , key_signature :: Maybe Intervals
key_signature = Degree -> Layout -> Intervals -> Maybe Intervals
generate_signature Degree
tonic Layout
layout Intervals
ints
    , key_transpose_table :: Intervals
key_transpose_table = [Accidentals] -> Intervals
make_table [Accidentals]
intervals
    , key_layout :: Layout
key_layout = Layout
layout
    }
    where ints :: Intervals
ints = [Accidentals] -> Intervals
forall a. Unbox a => [a] -> Vector a
Vector.fromList [Accidentals]
intervals

-- | Precalculated transpositions so I can figure out a transposition with
-- a single table lookup.  This goes out to two octaves on either direction
-- so I can start at any degree and go up to an octave of transposition.
-- Everything past an octave is chopped off by divMod and transposed with
-- multiplication.
make_table :: [Pitch.Semi] -> Intervals
make_table :: [Accidentals] -> Intervals
make_table [Accidentals]
intervals = [Accidentals] -> Intervals
forall a. Unbox a => [a] -> Vector a
Vector.fromList ([Accidentals] -> Intervals) -> [Accidentals] -> Intervals
forall a b. (a -> b) -> a -> b
$
    [Accidentals] -> [Accidentals]
forall a. [a] -> [a]
reverse (Accidentals -> [Accidentals] -> [Accidentals]
forall a. Accidentals -> [a] -> [a]
drop Accidentals
1 ((Accidentals -> Accidentals -> Accidentals)
-> [Accidentals] -> [Accidentals]
forall {a} {a}. Num a => (a -> a -> a) -> [a] -> [a]
make (-) ([Accidentals] -> [Accidentals]
forall a. [a] -> [a]
reverse [Accidentals]
intervals))) [Accidentals] -> [Accidentals] -> [Accidentals]
forall a. [a] -> [a] -> [a]
++ (Accidentals -> Accidentals -> Accidentals)
-> [Accidentals] -> [Accidentals]
forall {a} {a}. Num a => (a -> a -> a) -> [a] -> [a]
make Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
(+) [Accidentals]
intervals
    where make :: (a -> a -> a) -> [a] -> [a]
make a -> a -> a
f = Accidentals -> [a] -> [a]
forall a. Accidentals -> [a] -> [a]
take ([Accidentals] -> Accidentals
forall (t :: * -> *) a. Foldable t => t a -> Accidentals
length [Accidentals]
intervals Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
* Accidentals
2) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> a -> [a] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl a -> a -> a
f a
0 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
cycle

generate_signature :: Pitch.Degree -> Layout -> Intervals -> Maybe Signature
generate_signature :: Degree -> Layout -> Intervals -> Maybe Intervals
generate_signature Degree
tonic Layout
layout Intervals
intervals
    | Intervals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length (Layout -> Intervals
layout_intervals Layout
layout) Accidentals -> Accidentals -> Bool
forall a. Eq a => a -> a -> Bool
/= Intervals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length Intervals
intervals =
        Maybe Intervals
forall a. Maybe a
Nothing
    | Bool
otherwise = Intervals -> Maybe Intervals
forall a. a -> Maybe a
Just (Intervals -> Maybe Intervals) -> Intervals -> Maybe Intervals
forall a b. (a -> b) -> a -> b
$
        Degree -> Intervals -> Intervals -> Intervals
calculate_signature Degree
tonic (Layout -> Intervals
layout_intervals Layout
layout) Intervals
intervals

calculate_signature :: Pitch.Degree -> Intervals -> Intervals -> Intervals
calculate_signature :: Degree -> Intervals -> Intervals -> Intervals
calculate_signature (Pitch.Degree Accidentals
pc Accidentals
accs) Intervals
layout Intervals
intervals =
    Accidentals -> Intervals -> Intervals
forall a. Unbox a => Accidentals -> Vector a -> Vector a
Vector.take (Intervals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length Intervals
intervals) (Intervals -> Intervals) -> Intervals -> Intervals
forall a b. (a -> b) -> a -> b
$
        (Accidentals -> Accidentals -> Accidentals)
-> Intervals -> Intervals -> Intervals
forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWith Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
subtract ((Accidentals -> Accidentals -> Accidentals)
-> Accidentals -> Intervals -> Intervals
forall a b.
(Unbox a, Unbox b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
Vector.scanl Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
(+) Accidentals
0 (Accidentals -> Intervals -> Intervals
forall a. Unbox a => Accidentals -> Vector a -> Vector a
rotate Accidentals
pc Intervals
layout))
            ((Accidentals -> Accidentals -> Accidentals)
-> Accidentals -> Intervals -> Intervals
forall a b.
(Unbox a, Unbox b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
Vector.scanl Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
(+) Accidentals
accs Intervals
intervals)
    where
    rotate :: Accidentals -> Vector a -> Vector a
rotate Accidentals
n Vector a
xs = Vector a
post Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
pre
        where (Vector a
pre, Vector a
post) = Accidentals -> Vector a -> (Vector a, Vector a)
forall a.
Unbox a =>
Accidentals -> Vector a -> (Vector a, Vector a)
Vector.splitAt Accidentals
n Vector a
xs

key_is_diatonic :: Key -> Bool
key_is_diatonic :: Key -> Bool
key_is_diatonic = Maybe Intervals -> Bool
forall a. Maybe a -> Bool
Maybe.isJust (Maybe Intervals -> Bool)
-> (Key -> Maybe Intervals) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Intervals
key_signature

instance Pretty Key where
    format :: Key -> Doc
format key :: Key
key@(Key Degree
tonic Text
name Intervals
ints Maybe Intervals
sig Intervals
_table Layout
_layout) = Doc -> [(Text, Doc)] -> Doc
Pretty.record Doc
title
        [ (Text
"intervals",
            Intervals -> Doc
forall a. Pretty a => a -> Doc
Pretty.format (Accidentals -> Intervals -> Intervals
forall a. Unbox a => Accidentals -> Vector a -> Vector a
Vector.take (Key -> Accidentals
key_steps_per_octave Key
key) Intervals
ints))
        , (Text
"signature", Maybe Intervals -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Maybe Intervals
sig)
        ]
        where
        title :: Doc
title = Text -> Doc
Pretty.text Text
"Key" Doc -> Doc -> Doc
Pretty.<+> Degree -> Doc
forall a. Pretty a => a -> Doc
Pretty.format Degree
tonic
            Doc -> Doc -> Doc
Pretty.<+> Text -> Doc
Pretty.text Text
name

-- | The number of accidentals in the key signature at the given pitch class.
accidentals_at_pc :: Key -> Pitch.PitchClass -> Pitch.Accidentals
accidentals_at_pc :: Key -> Accidentals -> Accidentals
accidentals_at_pc Key
key Accidentals
pc = Accidentals -> Maybe Accidentals -> Accidentals
forall a. a -> Maybe a -> a
fromMaybe Accidentals
0 (Maybe Accidentals -> Accidentals)
-> Maybe Accidentals -> Accidentals
forall a b. (a -> b) -> a -> b
$ do
    Intervals
sig <- Key -> Maybe Intervals
key_signature Key
key
    Intervals
sig Intervals -> Accidentals -> Maybe Accidentals
forall a. Unbox a => Vector a -> Accidentals -> Maybe a
Vector.!? Key -> Accidentals -> Accidentals
diatonic_step_of Key
key Accidentals
pc

-- | Number of degrees in an octave for this scale.
--
-- This is different from the number of PCs per octave, because scales like
-- octatonic or whole tone don't have a mapping from PCs to scale degrees.
key_steps_per_octave :: Key -> Step
key_steps_per_octave :: Key -> Accidentals
key_steps_per_octave = Intervals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length (Intervals -> Accidentals)
-> (Key -> Intervals) -> Key -> Accidentals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Intervals
key_intervals

-- | Figure out the relative scale step of a note in the given key.
step_of :: Key -> Pitch.Degree -> Step
step_of :: Key -> Degree -> Accidentals
step_of Key
key Degree
note
    | Key -> Bool
key_is_diatonic Key
key = Key -> Accidentals -> Accidentals
diatonic_step_of Key
key (Degree -> Accidentals
Pitch.degree_pc Degree
note)
    | Bool
otherwise = Accidentals -> Intervals -> Accidentals
forall (v :: * -> *).
Vector v Accidentals =>
Accidentals -> v Accidentals -> Accidentals
Vector.find_before Accidentals
semis (Key -> Intervals
key_intervals Key
key)
    where semis :: Accidentals
semis = Layout -> Degree -> Accidentals
degree_to_semis (Key -> Layout
key_layout Key
key) Degree
note

-- | Figure out the (relative) scale step of an absolute PitchClass in
-- a diatonic key.  In a diatonic key, the step and pitch class are relative
-- and absolute versions of the same thing.
diatonic_step_of :: Key -> Pitch.PitchClass -> Step
diatonic_step_of :: Key -> Accidentals -> Accidentals
diatonic_step_of Key
key Accidentals
pc =
    (Accidentals
pc Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
- Degree -> Accidentals
Pitch.degree_pc (Key -> Degree
key_tonic Key
key)) Accidentals -> Accidentals -> Accidentals
forall a. Integral a => a -> a -> a
`mod` Key -> Accidentals
key_steps_per_octave Key
key

-- ** Layout

-- | A Layout represents the configuration of white and black keys.
data Layout = Layout {
    -- | Map PitchClass to the number of sharps above it.
    Layout -> Intervals
layout_intervals :: !Intervals
    -- | Map Pitch.Semis to the enharmonic Notes at that PitchClass.
    , Layout -> Vector [(Accidentals, Degree)]
layout_enharmonics :: !(Boxed.Vector [(Pitch.Octave, Pitch.Degree)])
    } deriving (Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
Eq, Accidentals -> Layout -> [Char] -> [Char]
[Layout] -> [Char] -> [Char]
Layout -> [Char]
(Accidentals -> Layout -> [Char] -> [Char])
-> (Layout -> [Char])
-> ([Layout] -> [Char] -> [Char])
-> Show Layout
forall a.
(Accidentals -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Layout] -> [Char] -> [Char]
$cshowList :: [Layout] -> [Char] -> [Char]
show :: Layout -> [Char]
$cshow :: Layout -> [Char]
showsPrec :: Accidentals -> Layout -> [Char] -> [Char]
$cshowsPrec :: Accidentals -> Layout -> [Char] -> [Char]
Show)

layout_semis_per_octave :: Layout -> Pitch.Semi
layout_semis_per_octave :: Layout -> Accidentals
layout_semis_per_octave = Intervals -> Accidentals
forall a. (Unbox a, Num a) => Vector a -> a
Vector.sum (Intervals -> Accidentals)
-> (Layout -> Intervals) -> Layout -> Accidentals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Intervals
layout_intervals

layout_pc_per_octave :: Layout -> Pitch.PitchClass
layout_pc_per_octave :: Layout -> Accidentals
layout_pc_per_octave = Intervals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length (Intervals -> Accidentals)
-> (Layout -> Intervals) -> Layout -> Accidentals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Intervals
layout_intervals

layout :: [Pitch.Semi] -> Layout
layout :: [Accidentals] -> Layout
layout [Accidentals]
intervals = Layout
    { layout_intervals :: Intervals
layout_intervals = Intervals
vec
    , layout_enharmonics :: Vector [(Accidentals, Degree)]
layout_enharmonics = [[(Accidentals, Degree)]] -> Vector [(Accidentals, Degree)]
forall a. [a] -> Vector a
Boxed.fromList ([[(Accidentals, Degree)]] -> Vector [(Accidentals, Degree)])
-> [[(Accidentals, Degree)]] -> Vector [(Accidentals, Degree)]
forall a b. (a -> b) -> a -> b
$
        (Degree -> [(Accidentals, Degree)])
-> [Degree] -> [[(Accidentals, Degree)]]
forall a b. (a -> b) -> [a] -> [b]
map (\Degree
n -> (Accidentals
0, Degree
n) (Accidentals, Degree)
-> [(Accidentals, Degree)] -> [(Accidentals, Degree)]
forall a. a -> [a] -> [a]
: Intervals -> Degree -> [(Accidentals, Degree)]
get_enharmonics Intervals
vec Degree
n) [Degree]
notes
    }
    where
    vec :: Intervals
vec = [Accidentals] -> Intervals
forall a. Unbox a => [a] -> Vector a
Vector.fromList [Accidentals]
intervals
    notes :: [Degree]
notes =
        [ Accidentals -> Accidentals -> Degree
Pitch.Degree Accidentals
pc Accidentals
accs
        | (Accidentals
pc, Accidentals
int) <- [Accidentals] -> [Accidentals] -> [(Accidentals, Accidentals)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Accidentals
0..] [Accidentals]
intervals, Accidentals
accs <- [Accidentals
0..Accidentals
intAccidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
-Accidentals
1]
        ]

-- | Enharmonics of a note, along with an octave offset if the enharmonic
-- wrapped an octave boundary.
--
-- This choses the next highest enharmonic until it wraps around, so if you
-- repeatedly pick the first one you'll cycle through them all.
get_enharmonics :: Intervals -> Pitch.Degree -> [(Pitch.Octave, Pitch.Degree)]
get_enharmonics :: Intervals -> Degree -> [(Accidentals, Degree)]
get_enharmonics Intervals
intervals (Pitch.Degree Accidentals
note_pc Accidentals
note_accs) =
    [ Intervals -> Accidentals -> Accidentals -> (Accidentals, Degree)
forall {a}.
Unbox a =>
Vector a -> Accidentals -> Accidentals -> (Accidentals, Degree)
mknote Intervals
intervals (Accidentals
note_pc Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
pc) (Accidentals
note_accs Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
accs)
    | (Accidentals
pc, Accidentals
accs) <- [(Accidentals, Accidentals)]
pcs, Accidentals -> Accidentals
forall a. Num a => a -> a
abs (Accidentals
note_accs Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
accs) Accidentals -> Accidentals -> Bool
forall a. Ord a => a -> a -> Bool
< Accidentals
3
    ]
    where
    -- Find the distance in semitones from neighbor pcs.
    pcs :: [(Accidentals, Accidentals)]
pcs =
        [ (Accidentals
1, -[Accidentals] -> Accidentals
diffs [Accidentals
0])
        , (Accidentals
2, -[Accidentals] -> Accidentals
diffs [Accidentals
0, Accidentals
1])
        , (-Accidentals
2, [Accidentals] -> Accidentals
diffs [-Accidentals
2, -Accidentals
1])
        , (-Accidentals
1, [Accidentals] -> Accidentals
diffs [-Accidentals
1])
        ]
    diffs :: [Accidentals] -> Accidentals
diffs = [Accidentals] -> Accidentals
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum ([Accidentals] -> Accidentals)
-> ([Accidentals] -> [Accidentals]) -> [Accidentals] -> Accidentals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accidentals -> Accidentals) -> [Accidentals] -> [Accidentals]
forall a b. (a -> b) -> [a] -> [b]
map (Intervals -> Accidentals -> Accidentals
layout_at Intervals
intervals (Accidentals -> Accidentals)
-> (Accidentals -> Accidentals) -> Accidentals -> Accidentals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accidentals
note_pc+))
    mknote :: Vector a -> Accidentals -> Accidentals -> (Accidentals, Degree)
mknote Vector a
intervals Accidentals
pc Accidentals
accs = (Accidentals
oct, Accidentals -> Accidentals -> Degree
Pitch.Degree Accidentals
pc2 Accidentals
accs)
        where (Accidentals
oct, Accidentals
pc2) = Accidentals
pc Accidentals -> Accidentals -> (Accidentals, Accidentals)
forall a. Integral a => a -> a -> (a, a)
`divMod` Vector a -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length Vector a
intervals

layout_at :: Intervals -> Pitch.PitchClass -> Pitch.Accidentals
layout_at :: Intervals -> Accidentals -> Accidentals
layout_at Intervals
intervals Accidentals
pc =
    Accidentals -> Maybe Accidentals -> Accidentals
forall a. a -> Maybe a -> a
fromMaybe Accidentals
0 (Maybe Accidentals -> Accidentals)
-> Maybe Accidentals -> Accidentals
forall a b. (a -> b) -> a -> b
$ Intervals
intervals Intervals -> Accidentals -> Maybe Accidentals
forall a. Unbox a => Vector a -> Accidentals -> Maybe a
Vector.!? (Accidentals
pc Accidentals -> Accidentals -> Accidentals
forall a. Integral a => a -> a -> a
`mod` Intervals -> Accidentals
forall a. Unbox a => Vector a -> Accidentals
Vector.length Intervals
intervals)

-- | True if the degree exists as its own key in the layout.
--
-- For a relative scale, the Intervals should be from 'key_intervals', which
-- considers that the tonic is shifted to PC 0.  For an absolute scale, the
-- keyboard never shifts, so use 'layout_intervals'.
contains_degree :: Intervals -> Pitch.Degree -> Bool
contains_degree :: Intervals -> Degree -> Bool
contains_degree Intervals
intervals (Pitch.Degree Accidentals
pc Accidentals
acc)
    | Accidentals
acc Accidentals -> Accidentals -> Bool
forall a. Ord a => a -> a -> Bool
>= Accidentals
0 = Accidentals
acc Accidentals -> Accidentals -> Bool
forall a. Ord a => a -> a -> Bool
< Intervals -> Accidentals -> Accidentals
layout_at Intervals
intervals Accidentals
pc
    | Bool
otherwise = Intervals -> Accidentals -> Accidentals
layout_at Intervals
intervals (Accidentals
pc Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
- Accidentals
1) Accidentals -> Accidentals -> Accidentals
forall a. Num a => a -> a -> a
+ Accidentals
acc Accidentals -> Accidentals -> Bool
forall a. Ord a => a -> a -> Bool
> Accidentals
0