-- |
-- This module has some functions to use sound notation concepts like semitones for pitch and quarternotes for duration
module LambdaSound.Note where

import LambdaSound.Sound

-- * Semitones

-- | Semitones are tones like 'c4', 'd4' or 'c5'.
-- The semitone is used to determine the hz of the tone based on 'pitchStandard'
newtype Semitone = Semitone Int deriving (Int -> Semitone -> ShowS
[Semitone] -> ShowS
Semitone -> String
(Int -> Semitone -> ShowS)
-> (Semitone -> String) -> ([Semitone] -> ShowS) -> Show Semitone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Semitone -> ShowS
showsPrec :: Int -> Semitone -> ShowS
$cshow :: Semitone -> String
show :: Semitone -> String
$cshowList :: [Semitone] -> ShowS
showList :: [Semitone] -> ShowS
Show, Semitone -> Semitone -> Bool
(Semitone -> Semitone -> Bool)
-> (Semitone -> Semitone -> Bool) -> Eq Semitone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Semitone -> Semitone -> Bool
== :: Semitone -> Semitone -> Bool
$c/= :: Semitone -> Semitone -> Bool
/= :: Semitone -> Semitone -> Bool
Eq, Integer -> Semitone
Semitone -> Semitone
Semitone -> Semitone -> Semitone
(Semitone -> Semitone -> Semitone)
-> (Semitone -> Semitone -> Semitone)
-> (Semitone -> Semitone -> Semitone)
-> (Semitone -> Semitone)
-> (Semitone -> Semitone)
-> (Semitone -> Semitone)
-> (Integer -> Semitone)
-> Num Semitone
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Semitone -> Semitone -> Semitone
+ :: Semitone -> Semitone -> Semitone
$c- :: Semitone -> Semitone -> Semitone
- :: Semitone -> Semitone -> Semitone
$c* :: Semitone -> Semitone -> Semitone
* :: Semitone -> Semitone -> Semitone
$cnegate :: Semitone -> Semitone
negate :: Semitone -> Semitone
$cabs :: Semitone -> Semitone
abs :: Semitone -> Semitone
$csignum :: Semitone -> Semitone
signum :: Semitone -> Semitone
$cfromInteger :: Integer -> Semitone
fromInteger :: Integer -> Semitone
Num, Eq Semitone
Eq Semitone =>
(Semitone -> Semitone -> Ordering)
-> (Semitone -> Semitone -> Bool)
-> (Semitone -> Semitone -> Bool)
-> (Semitone -> Semitone -> Bool)
-> (Semitone -> Semitone -> Bool)
-> (Semitone -> Semitone -> Semitone)
-> (Semitone -> Semitone -> Semitone)
-> Ord Semitone
Semitone -> Semitone -> Bool
Semitone -> Semitone -> Ordering
Semitone -> Semitone -> Semitone
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
$ccompare :: Semitone -> Semitone -> Ordering
compare :: Semitone -> Semitone -> Ordering
$c< :: Semitone -> Semitone -> Bool
< :: Semitone -> Semitone -> Bool
$c<= :: Semitone -> Semitone -> Bool
<= :: Semitone -> Semitone -> Bool
$c> :: Semitone -> Semitone -> Bool
> :: Semitone -> Semitone -> Bool
$c>= :: Semitone -> Semitone -> Bool
>= :: Semitone -> Semitone -> Bool
$cmax :: Semitone -> Semitone -> Semitone
max :: Semitone -> Semitone -> Semitone
$cmin :: Semitone -> Semitone -> Semitone
min :: Semitone -> Semitone -> Semitone
Ord, Int -> Semitone
Semitone -> Int
Semitone -> [Semitone]
Semitone -> Semitone
Semitone -> Semitone -> [Semitone]
Semitone -> Semitone -> Semitone -> [Semitone]
(Semitone -> Semitone)
-> (Semitone -> Semitone)
-> (Int -> Semitone)
-> (Semitone -> Int)
-> (Semitone -> [Semitone])
-> (Semitone -> Semitone -> [Semitone])
-> (Semitone -> Semitone -> [Semitone])
-> (Semitone -> Semitone -> Semitone -> [Semitone])
-> Enum Semitone
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Semitone -> Semitone
succ :: Semitone -> Semitone
$cpred :: Semitone -> Semitone
pred :: Semitone -> Semitone
$ctoEnum :: Int -> Semitone
toEnum :: Int -> Semitone
$cfromEnum :: Semitone -> Int
fromEnum :: Semitone -> Int
$cenumFrom :: Semitone -> [Semitone]
enumFrom :: Semitone -> [Semitone]
$cenumFromThen :: Semitone -> Semitone -> [Semitone]
enumFromThen :: Semitone -> Semitone -> [Semitone]
$cenumFromTo :: Semitone -> Semitone -> [Semitone]
enumFromTo :: Semitone -> Semitone -> [Semitone]
$cenumFromThenTo :: Semitone -> Semitone -> Semitone -> [Semitone]
enumFromThenTo :: Semitone -> Semitone -> Semitone -> [Semitone]
Enum)

-- | 440 Hz is used at the pitch standard for the tone 'a4'
pitchStandard :: Hz
pitchStandard :: Hz
pitchStandard = Hz
440.0

-- | Converts a semitone to the appropriate frequency based on 'pitchStandard'
semitoneToHz :: Semitone -> Hz
semitoneToHz :: Semitone -> Hz
semitoneToHz Semitone
n = Hz
pitchStandard Hz -> Hz -> Hz
forall a. Num a => a -> a -> a
* (Hz
2 Hz -> Hz -> Hz
forall a. Floating a => a -> a -> a
** (Int -> Hz
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Semitone -> Int
forall a. Enum a => a -> Int
fromEnum Semitone
n) Hz -> Hz -> Hz
forall a. Num a => a -> a -> a
* Hz
1.0 Hz -> Hz -> Hz
forall a. Fractional a => a -> a -> a
/ Hz
12.0))

-- | Raise a sound by the given amount of semitones.
-- This only works for sounds which use the period length given
-- in the compute step of the sound. 'sineWave' works but 'noise' does not.
--
-- For example:
--
-- > raiseSemitones 2 (asNote pulse c3) = asNote pulse d3
raiseSemitones :: Int -> Sound d Pulse -> Sound d Pulse
raiseSemitones :: forall (d :: SoundDuration). Int -> Sound d Pulse -> Sound d Pulse
raiseSemitones Int
x = Float -> Sound d Pulse -> Sound d Pulse
forall (d :: SoundDuration).
Float -> Sound d Pulse -> Sound d Pulse
raise (Float
2 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
12))

-- | Diminishes a sound by the given amount of semitones
diminishSemitones :: Int -> Sound d Pulse -> Sound d Pulse
diminishSemitones :: forall (d :: SoundDuration). Int -> Sound d Pulse -> Sound d Pulse
diminishSemitones Int
x = Int -> Sound d Pulse -> Sound d Pulse
forall (d :: SoundDuration). Int -> Sound d Pulse -> Sound d Pulse
raiseSemitones (-Int
x)

-- | Transforms a function taking a 'Hz' to one taking a 'Semitone'.
-- Should be used like the following:
--
-- > asNote sineWave c4
asNote :: (Hz -> a) -> Semitone -> a
asNote :: forall a. (Hz -> a) -> Semitone -> a
asNote Hz -> a
f Semitone
s = Hz -> a
f (Semitone -> Hz
semitoneToHz Semitone
s)

c1, d1, e1, f1, g1, a1, b1 :: Semitone
c1 :: Semitone
c1 = -Semitone
45
d1 :: Semitone
d1 = -Semitone
43
e1 :: Semitone
e1 = -Semitone
41
f1 :: Semitone
f1 = -Semitone
40
g1 :: Semitone
g1 = -Semitone
38
a1 :: Semitone
a1 = -Semitone
36
b1 :: Semitone
b1 = -Semitone
34

c2, d2, e2, f2, g2, a2, b2 :: Semitone
c2 :: Semitone
c2 = -Semitone
33
d2 :: Semitone
d2 = -Semitone
31
e2 :: Semitone
e2 = -Semitone
29
f2 :: Semitone
f2 = -Semitone
28
g2 :: Semitone
g2 = -Semitone
26
a2 :: Semitone
a2 = -Semitone
24
b2 :: Semitone
b2 = -Semitone
22

c3, d3, e3, f3, g3, a3, b3 :: Semitone
c3 :: Semitone
c3 = -Semitone
21
d3 :: Semitone
d3 = -Semitone
19
e3 :: Semitone
e3 = -Semitone
17
f3 :: Semitone
f3 = -Semitone
16
g3 :: Semitone
g3 = -Semitone
14
a3 :: Semitone
a3 = -Semitone
12
b3 :: Semitone
b3 = -Semitone
10

c4, d4, e4, f4, g4, a4, b4 :: Semitone
c4 :: Semitone
c4 = -Semitone
9
d4 :: Semitone
d4 = -Semitone
7
e4 :: Semitone
e4 = -Semitone
5
f4 :: Semitone
f4 = -Semitone
4
g4 :: Semitone
g4 = -Semitone
2
a4 :: Semitone
a4 = Semitone
0
b4 :: Semitone
b4 = Semitone
2

c5, d5, e5, f5, g5, a5, b5 :: Semitone
c5 :: Semitone
c5 = Semitone
3
d5 :: Semitone
d5 = Semitone
5
e5 :: Semitone
e5 = Semitone
7
f5 :: Semitone
f5 = Semitone
8
g5 :: Semitone
g5 = Semitone
10
a5 :: Semitone
a5 = Semitone
12
b5 :: Semitone
b5 = Semitone
14

c6, d6, e6, f6, g6, a6, b6 :: Semitone
c6 :: Semitone
c6 = Semitone
15
d6 :: Semitone
d6 = Semitone
17
e6 :: Semitone
e6 = Semitone
19
f6 :: Semitone
f6 = Semitone
20
g6 :: Semitone
g6 = Semitone
22
a6 :: Semitone
a6 = Semitone
24
b6 :: Semitone
b6 = Semitone
26

c7, d7, e7, f7, g7, a7, b7 :: Semitone
c7 :: Semitone
c7 = Semitone
27
d7 :: Semitone
d7 = Semitone
29
e7 :: Semitone
e7 = Semitone
31
f7 :: Semitone
f7 = Semitone
32
g7 :: Semitone
g7 = Semitone
34
a7 :: Semitone
a7 = Semitone
36
b7 :: Semitone
b7 = Semitone
38

-- * Notes

-- | These are durations for the corresponding note lenghts
-- assuming 60 bpm.
--
-- If you know that a sound has 60 bpm, you can easily scale to
-- different bpm with 'scaleDuration':
--
-- > scaleDuration (wantedBPM / 60) soundWith60BPM
wholeNote, halfNote, quarterNote, eightNote :: Duration
wholeNote :: Duration
wholeNote = Duration
1
halfNote :: Duration
halfNote = Duration
1 Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
2
quarterNote :: Duration
quarterNote = Duration
1 Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
4
eightNote :: Duration
eightNote = Duration
1 Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
8