-- |
-- Module      :  DobutokO.Sound.FunctionF
-- 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.FunctionF (
  -- * Working with OvertonesO and function f
  maybeFFromStrVec
  , fVecCoefs
  , showFFromStrVec
) where

import Text.Read (readMaybe)
import Data.Maybe (isNothing,fromJust,fromMaybe)
import Numeric
import qualified Data.Vector as V
import DobutokO.Sound.Functional.Basics

-- | Gets a function @f::Float -> OvertonesO@ that can be used further. Has two variants with usage of 'closestNote' ('Int' argument is greater than 0)v
--  and without it ('Int' argument is less than 0). For both cases 'String' must be in a form list of tuples of pairs of 'Float' to get somewhat
-- reasonable result. The function @f@ can be shown using a special printing function 'showFFromStrVec'. It is a simplest multiplicative (somewhat
-- acoustically and musically reasonable) form for the function that can provide such a result that fits into the given data.
--
-- > let (y,f1) = fromJust (maybeFFromStrVec 1 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783)
-- >
-- > (3520.0,[(25.829079975681818,0.2486356),(37.936206670369316,0.6464867),(494.9891484317899,0.374618646),(803.9138234326421,0.463486461)])
-- >
-- > let (y,f1) = fromJust (maybeFFromStrVec (-1) 3583.9783 "[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)]") in (y,f1 3583.9783)
-- > 
-- > (3583.9783,[(25.368,0.2486356),(37.259,0.6464867),(486.153,0.374618646),(789.563,0.463486461)])
-- 
maybeFFromStrVec :: Int -> Float -> String -> Maybe (Float,(Float -> V.Vector (Float,Float)))
maybeFFromStrVec :: Int
-> Float -> String -> Maybe (Float, Float -> Vector (Float, Float))
maybeFFromStrVec Int
n Float
x String
ys
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys = Maybe (Float, Float -> Vector (Float, Float))
forall a. Maybe a
Nothing
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = 
     let y :: Float
y = Float -> Float
closestNote (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
         v :: Maybe (Vector (Float, Float))
v = String -> Maybe (Vector (Float, Float))
forall a. Read a => String -> Maybe a
readMaybe String
ys::Maybe (V.Vector (Float,Float))
         v2 :: Vector (Float, Float)
v2 = Vector (Float, Float)
-> Maybe (Vector (Float, Float)) -> Vector (Float, Float)
forall a. a -> Maybe a -> a
fromMaybe Vector (Float, Float)
forall a. Vector a
V.empty Maybe (Vector (Float, Float))
v
         v3 :: Vector Float
v3 = ((Float, Float) -> Float) -> Vector (Float, Float) -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
t,Float
_) -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
y) Vector (Float, Float)
v2 in
           if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v3 then Maybe (Float, Float -> Vector (Float, Float))
forall a. Maybe a
Nothing
           else (Float, Float -> Vector (Float, Float))
-> Maybe (Float, Float -> Vector (Float, Float))
forall a. a -> Maybe a
Just (Float
y,(\Float
t1 -> (Int -> (Float, Float) -> (Float, Float))
-> Vector (Float, Float) -> Vector (Float, Float)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,Float
ampl2) -> ((Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v3 Int
i) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t1,Float
ampl2)) Vector (Float, Float)
v2))
  | Bool
otherwise = 
     let y :: Float
y = (if Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
0.0 then Float -> Float
forall a. Num a => a -> a
abs Float
x else Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
notes Int
0)
         v :: Maybe (Vector (Float, Float))
v = String -> Maybe (Vector (Float, Float))
forall a. Read a => String -> Maybe a
readMaybe String
ys::Maybe (V.Vector (Float,Float))
         v2 :: Vector (Float, Float)
v2 = Vector (Float, Float)
-> Maybe (Vector (Float, Float)) -> Vector (Float, Float)
forall a. a -> Maybe a -> a
fromMaybe Vector (Float, Float)
forall a. Vector a
V.empty Maybe (Vector (Float, Float))
v
         v3 :: Vector Float
v3 = ((Float, Float) -> Float) -> Vector (Float, Float) -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
t,Float
_) -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
y) Vector (Float, Float)
v2 in
           if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v3 then Maybe (Float, Float -> Vector (Float, Float))
forall a. Maybe a
Nothing
           else (Float, Float -> Vector (Float, Float))
-> Maybe (Float, Float -> Vector (Float, Float))
forall a. a -> Maybe a
Just (Float
y,(\Float
t1 -> (Int -> (Float, Float) -> (Float, Float))
-> Vector (Float, Float) -> Vector (Float, Float)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
_,Float
ampl2) -> ((Vector Float -> Int -> Float
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Float
v3 Int
i) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t1,Float
ampl2)) Vector (Float, Float)
v2))

-- | Gets multiplication coefficients for @f::Float -> Vector (Float,Float)@ from the 'maybeFFromStrVec' with the same arguments.
fVecCoefs :: Int -> Float -> String -> V.Vector Float
fVecCoefs :: Int -> Float -> String -> Vector Float
fVecCoefs Int
n Float
x String
ys =
  let rs :: Maybe (Float, Float -> Vector (Float, Float))
rs = Int
-> Float -> String -> Maybe (Float, Float -> Vector (Float, Float))
maybeFFromStrVec Int
n Float
x String
ys in
    case Maybe (Float, Float -> Vector (Float, Float))
rs of
      Maybe (Float, Float -> Vector (Float, Float))
Nothing -> Vector Float
forall a. Vector a
V.empty
      Maybe (Float, Float -> Vector (Float, Float))
_       ->
        let (Float
_,Float -> Vector (Float, Float)
f1) = Maybe (Float, Float -> Vector (Float, Float))
-> (Float, Float -> Vector (Float, Float))
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Float, Float -> Vector (Float, Float))
rs in
          ((Float, Float) -> Float) -> Vector (Float, Float) -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float -> Vector (Float, Float)
f1 Float
1)

-- | Experimental 'show' for @f::Float -> Vector (Float,Float)@ that is used only for visualisation. It is correct only with 'maybeFFromStrVec' or
-- equivalent function. Because the shape of the @f@ is known the function can be defined.
-- 
-- > showFFromStrVec (-1) 440 "[(25.358,0.3598),(489.35,0.4588962),(795.35,0.6853)]"
-- > 
-- > "(440.00,(\t -> <(0.05763181818181818 * t, 0.3598),(1.112159090909091 * t, 0.4588962),(1.8076136363636364 * t, 0.6853)>))"
-- 
showFFromStrVec :: Int -> Float -> String -> String
showFFromStrVec :: Int -> Float -> String -> String
showFFromStrVec Int
n Float
x String
ys
 | Maybe (Float, Float -> Vector (Float, Float)) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Float, Float -> Vector (Float, Float)) -> Bool)
-> (String -> Maybe (Float, Float -> Vector (Float, Float)))
-> String
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Float -> String -> Maybe (Float, Float -> Vector (Float, Float))
maybeFFromStrVec Int
n Float
x (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
ys = String
""
 | Bool
otherwise =
    let (Float
y,Float -> Vector (Float, Float)
f) = Maybe (Float, Float -> Vector (Float, Float))
-> (Float, Float -> Vector (Float, Float))
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Float, Float -> Vector (Float, Float))
 -> (Float, Float -> Vector (Float, Float)))
-> (String -> Maybe (Float, Float -> Vector (Float, Float)))
-> String
-> (Float, Float -> Vector (Float, Float))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Float -> String -> Maybe (Float, Float -> Vector (Float, Float))
maybeFFromStrVec Int
n Float
x (String -> (Float, Float -> Vector (Float, Float)))
-> String -> (Float, Float -> Vector (Float, Float))
forall a b. (a -> b) -> a -> b
$ String
ys
        l :: Int
l = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",(\t -> <(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Vector String -> [String]
forall a. Vector a -> [a]
V.toList (Vector String -> [String])
-> (Vector (Float, Float) -> Vector String)
-> Vector (Float, Float)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> String)
-> Vector (Float, Float) -> Vector String
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float, Float)
z -> (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing ((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
z) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
              String
" * t, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing ((Float, Float) -> Float
forall a b. (a, b) -> b
snd (Float, Float)
z) String
"),("))) (Vector (Float, Float) -> [String])
-> Vector (Float, Float) -> [String]
forall a b. (a -> b) -> a -> b
$ (Float -> Vector (Float, Float)
f Float
1))) in Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",(\t -> <("
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Vector String -> [String]
forall a. Vector a -> [a]
V.toList (Vector String -> [String])
-> (Vector (Float, Float) -> Vector String)
-> Vector (Float, Float)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> String)
-> Vector (Float, Float) -> Vector String
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float, Float)
z -> (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing ((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
z) String
" * t, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe Int -> Float -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing ((Float, Float) -> Float
forall a b. (a, b) -> b
snd (Float, Float)
z) String
"),("))) (Vector (Float, Float) -> [String])
-> Vector (Float, Float) -> [String]
forall a b. (a -> b) -> a -> b
$ (Float -> Vector (Float, Float)
f Float
1))) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">))"