-- |
-- Module      :  DobutokO.Sound.Octaves
-- Copyright   :  (c) OleksandrZhabenko 2020, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Helps to create experimental music from a file (or its part) and a Ukrainian text. 
-- It can also generate a timbre for the notes. Uses SoX inside.

{-# OPTIONS_GHC -threaded #-}

module DobutokO.Sound.Octaves (
  -- * Work with octaves
  octaveUp
  , octaveDown
  , liftInOctave
  , liftInOctaveV
) where

import Data.Maybe (fromJust)
import qualified Data.Vector as V
import DobutokO.Sound.Functional.Basics

-- | Returns an analogous note in the higher octave (its frequency in Hz).
octaveUp :: Float -> Float
octaveUp :: Float -> Float
octaveUp Float
x = Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x
{-# INLINE octaveUp #-}

-- | Returns an analogous note in the lower octave (its frequency in Hz).
octaveDown :: Float -> Float
octaveDown :: Float -> Float
octaveDown Float
x = Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
{-# INLINE octaveDown #-}

-- | Function lifts the given frequency to the given number of the octave (in American notation, from 0 to 8). This number is an 'Int' parameter.
-- The function also takes into account the lower pure quint for the closest note.
-- If it is not practical to determine the number, then the function returns 'Nothing'.
liftInOctave :: Int -> Float -> Maybe Float
liftInOctave :: Int -> Float -> Maybe Float
liftInOctave Int
n Float
x
  | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT Bool -> Bool -> Bool
|| Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
8 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = Maybe Float
forall a. Maybe a
Nothing
  | Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
closestNote Float
x) Float
24.4996 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT =
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> (Float -> Maybe Int) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Maybe Int
whichOctave (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
x) Int
n of
        Ordering
EQ -> Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Float
closestNote Float
x)
        Ordering
LT -> let z :: Float
z  = Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2.0 (Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float -> Float
closestNote Float
x)
                  z1 :: Integer
z1 = Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
z in
                   if Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.999 Bool -> Bool -> Bool
|| Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.001
                     then Float -> Maybe Float
forall a. a -> Maybe a
Just (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float
octaveUp (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
                     else Float -> Maybe Float
forall a. a -> Maybe a
Just (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Float -> Float
octaveUp (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
        Ordering
_  -> let z :: Float
z  = Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2.0 (Float -> Float
closestNote Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12))
                  z1 :: Integer
z1 = Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
z in
                   if Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.999 Bool -> Bool -> Bool
|| Float -> Float
forall a. Num a => a -> a
abs (Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.001
                     then Float -> Maybe Float
forall a. a -> Maybe a
Just (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Float -> Float
octaveDown (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
                     else Float -> Maybe Float
forall a. a -> Maybe a
Just (Vector Float -> Float
forall a. Vector a -> a
V.unsafeLast (Vector Float -> Float)
-> (Float -> Vector Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Float -> Float) -> Float -> Vector Float
forall a. Int -> (a -> a) -> a -> Vector a
V.iterateN (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float
octaveDown (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
closestNote Float
x)
  | Bool
otherwise = Maybe Float
forall a. Maybe a
Nothing

-- | Function lifts the 'V.Vector' of 'Float' representing frequencies to the given octave with the 'Int' number. Better to use numbers in the range [1..8].
-- The function also takes into account the lower pure quint for the obtained note behaviour. If it is not practical to determine the octave, the resulting
-- frequency is omitted from the resulting 'V.Vector'.
liftInOctaveV :: Int -> V.Vector Float -> V.Vector Float
liftInOctaveV :: Int -> Vector Float -> Vector Float
liftInOctaveV Int
n = (Float -> Maybe Float) -> Vector Float -> Vector Float
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe (Int -> Float -> Maybe Float
liftInOctave Int
n)

--------------------------------------------------------------------------------------------------------------------------------