module Notes
  where

import Data.Map              (Map, fromList, (!))
import Language.Notes        (Note (..), Pitch (..), Tone (..),
                              getOctaveFromInt, octaves)
import Synthesizer.Structure (Frequency)

-- | [C, C#, D, D#, E, F, F#, G, G#, A, A#, B]
playableTonesPitches :: [(Tone, Pitch)]
playableTonesPitches :: [(Tone, Pitch)]
playableTonesPitches = [(Tone
C, Pitch
Flat), (Tone
C, Pitch
Sharp), (Tone
D, Pitch
Flat), (Tone
D, Pitch
Sharp), (Tone
E, Pitch
Flat), (Tone
F, Pitch
Flat), (Tone
F, Pitch
Sharp), (Tone
G, Pitch
Flat), (Tone
G, Pitch
Sharp), (Tone
A, Pitch
Flat), (Tone
A, Pitch
Sharp), (Tone
B, Pitch
Flat)]

-- | length octaves * length playableTonesPitches
amountOfNotes :: Int
amountOfNotes :: Int
amountOfNotes = [Octave] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Octave]
octaves Int -> Int -> Int
forall a. Num a => a -> a -> a
* [(Tone, Pitch)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Tone, Pitch)]
playableTonesPitches

-- | Generates a Map of notes and their frequency given a base frequency for note A4
generateNotes :: Frequency          -- ^ Base frequency for note A4 (Most used value: 440 Hz)
              -> Map Note Frequency -- ^ Returns list of notes with their frequency
generateNotes :: Frequency -> Map Note Frequency
generateNotes Frequency
freqA4 = [(Note, Frequency)] -> Map Note Frequency
forall k a. Ord k => [(k, a)] -> Map k a
fromList [Frequency -> Int -> (Note, Frequency)
generateNote Frequency
c0 Int
i | Int
i <- [Int
0..Int
amountOfNotesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
  where
    c0 :: Frequency
    c0 :: Frequency
c0 = Frequency
freqA4 Frequency -> Frequency -> Frequency
forall a. Num a => a -> a -> a
* (Frequency
2 Frequency -> Frequency -> Frequency
forall a. Floating a => a -> a -> a
** (-Frequency
4.75))

-- | Generates a note and their frequency given the frequency for the note C0 and the offset from C0
generateNote :: Frequency         -- ^ The frequency of note C0
             -> Int               -- ^ The offset from the note C0
             -> (Note, Frequency) -- ^ A tuple with the note and their frequency
generateNote :: Frequency -> Int -> (Note, Frequency)
generateNote Frequency
freqBase Int
i = (Tone -> Pitch -> Octave -> Note
Note Tone
tone Pitch
pitch Octave
octave, Frequency
freq)
  where
    (Tone
tone, Pitch
pitch) = [(Tone, Pitch)]
playableTonesPitches [(Tone, Pitch)] -> Int -> (Tone, Pitch)
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [(Tone, Pitch)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Tone, Pitch)]
playableTonesPitches)
    freq :: Frequency
freq = Frequency -> Int -> Frequency
frequencySteps Frequency
freqBase Int
i
    semitone :: Int
semitone = Frequency -> Frequency -> Int
numberOfSemitones Frequency
freqBase Frequency
freq
    octave :: Octave
octave = Int -> Octave
getOctaveFromInt (Int -> Octave) -> Int -> Octave
forall a b. (a -> b) -> a -> b
$ Int
semitone Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [(Tone, Pitch)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Tone, Pitch)]
playableTonesPitches

-- | The basic formula for the frequencies of the notes of the equal tempered scale.
--
--   Source: https://pages.mtu.edu/~suits/NoteFreqCalcs.html
frequencySteps :: Double -- ^ The number of half steps away from the fixed note
               -> Int    -- ^ The frequency of one fixed note
               -> Double -- ^ The frequency of the note n half steps away
frequencySteps :: Frequency -> Int -> Frequency
frequencySteps Frequency
freq Int
n = Frequency
freq Frequency -> Frequency -> Frequency
forall a. Num a => a -> a -> a
* (Frequency
a Frequency -> Int -> Frequency
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n)
  where
    -- | a = (2)^(1/12)
    a :: Double
    a :: Frequency
a = Frequency
1.059463094359295

-- | Calculates the number n of semitones away from the base frequency
numberOfSemitones :: Double -- ^ The base frequency
                  -> Double -- ^ The frequency half steps away from the base frequency
                  -> Int    -- ^ The number of half steps away from the base frequency
numberOfSemitones :: Frequency -> Frequency -> Int
numberOfSemitones Frequency
freqBase Frequency
freqN = Frequency -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Frequency -> Int) -> Frequency -> Int
forall a b. (a -> b) -> a -> b
$ Frequency
12 Frequency -> Frequency -> Frequency
forall a. Num a => a -> a -> a
* Frequency -> Frequency -> Frequency
forall a. Floating a => a -> a -> a
logBase Frequency
2 (Frequency
freqN Frequency -> Frequency -> Frequency
forall a. Fractional a => a -> a -> a
/ Frequency
freqBase)

-- | Converts the frequency to the wavelength in meters.
frequencyToWaveLength :: Double -- ^ The frequency in Hz
                      -> Double -- ^ The wavelength in meters
frequencyToWaveLength :: Frequency -> Frequency
frequencyToWaveLength Frequency
freq = Frequency
c Frequency -> Frequency -> Frequency
forall a. Fractional a => a -> a -> a
/ Frequency
freq
  where
    c :: Double -- ^ The speed of sound in m/s
    c :: Frequency
c = Frequency
345

-- | Converts the wavelength to the frequency in Hz.
wavelengthToFrequency :: Double -- ^ The wavelength in meters
                      -> Double -- ^ The frequency in Hz
wavelengthToFrequency :: Frequency -> Frequency
wavelengthToFrequency Frequency
wl = Frequency
c Frequency -> Frequency -> Frequency
forall a. Fractional a => a -> a -> a
/ Frequency
wl
  where
    c :: Double -- ^ The speed of sound in m/s
    c :: Frequency
c = Frequency
345