-- |
-- Module      :  Composition.Sound.FunctionF
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@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 Composition.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 GHC.Arr
import qualified Data.Foldable as F
import Composition.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 -> [(Float,Float)]))
maybeFFromStrVec :: Int -> Float -> String -> Maybe (Float, Float -> [(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 (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys = Maybe (Float, Float -> [(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 Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0)
         v :: Maybe [(Float, Float)]
v = String -> Maybe [(Float, Float)]
forall a. Read a => String -> Maybe a
readMaybe String
ys::Maybe ([(Float,Float)])
         v2 :: [(Float, Float)]
v2 = [(Float, Float)] -> Maybe [(Float, Float)] -> [(Float, Float)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(Float, Float)]
v
         v30 :: [Float]
v30 = ((Float, Float) -> Float) -> [(Float, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\(Float
t,Float
_) -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
y) ([(Float, Float)] -> [Float]) -> [(Float, Float)] -> [Float]
forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
v2 in
           if [Float] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null [Float]
v30 then Maybe (Float, Float -> [(Float, Float)])
forall a. Maybe a
Nothing
           else let v3 :: Array Int Float
v3 = (\[Float]
rs -> (Int, Int) -> [Float] -> Array Int Float
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Float]
rs) [Float]
v30 in (Float, Float -> [(Float, Float)])
-> Maybe (Float, Float -> [(Float, Float)])
forall a. a -> Maybe a
Just (Float
y,(\Float
t1 -> ((Int, (Float, Float)) -> (Float, Float))
-> [(Int, (Float, Float))] -> [(Float, Float)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, (Float
_,Float
ampl2)) -> ((Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
v3 Int
i) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t1,Float
ampl2)) ([(Int, (Float, Float))] -> [(Float, Float)])
-> ([(Float, Float)] -> [(Int, (Float, Float))])
-> [(Float, Float)]
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [(Float, Float)] -> [(Int, (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Float, Float)] -> [(Float, Float)])
-> [(Float, Float)] -> [(Float, Float)]
forall a b. (a -> b) -> a -> b
$ [(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 Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
notes Int
0)
         v :: Maybe [(Float, Float)]
v = String -> Maybe [(Float, Float)]
forall a. Read a => String -> Maybe a
readMaybe String
ys::Maybe ([(Float,Float)])
         v2 :: [(Float, Float)]
v2 = [(Float, Float)] -> Maybe [(Float, Float)] -> [(Float, Float)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(Float, Float)]
v
         v30 :: [Float]
v30 = ((Float, Float) -> Float) -> [(Float, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\(Float
t,Float
_) -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
y) [(Float, Float)]
v2 in
           if [Float] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null [Float]
v30 then Maybe (Float, Float -> [(Float, Float)])
forall a. Maybe a
Nothing
           else let v3 :: Array Int Float
v3 = (\[Float]
rs -> (Int, Int) -> [Float] -> Array Int Float
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Float]
rs) [Float]
v30 in (Float, Float -> [(Float, Float)])
-> Maybe (Float, Float -> [(Float, Float)])
forall a. a -> Maybe a
Just (Float
y,(\Float
t1 -> ((Int, (Float, Float)) -> (Float, Float))
-> [(Int, (Float, Float))] -> [(Float, Float)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, (Float
_,Float
ampl2)) -> ((Array Int Float -> Int -> Float
forall i e. Array i e -> Int -> e
unsafeAt Array Int Float
v3 Int
i) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t1,Float
ampl2)) ([(Int, (Float, Float))] -> [(Float, Float)])
-> ([(Float, Float)] -> [(Int, (Float, Float))])
-> [(Float, Float)]
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [(Float, Float)] -> [(Int, (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Float, Float)] -> [(Float, Float)])
-> [(Float, Float)] -> [(Float, Float)]
forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
v2))

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

-- | Experimental 'show' for @f::Float -> [(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 -> [(Float, Float)]) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Float, Float -> [(Float, Float)]) -> Bool)
-> (String -> Maybe (Float, Float -> [(Float, Float)]))
-> String
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float -> String -> Maybe (Float, Float -> [(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 -> [(Float, Float)]
f) = Maybe (Float, Float -> [(Float, Float)])
-> (Float, Float -> [(Float, Float)])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Float, Float -> [(Float, Float)])
 -> (Float, Float -> [(Float, Float)]))
-> (String -> Maybe (Float, Float -> [(Float, Float)]))
-> String
-> (Float, Float -> [(Float, Float)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float -> String -> Maybe (Float, Float -> [(Float, Float)])
maybeFFromStrVec Int
n Float
x (String -> (Float, Float -> [(Float, Float)]))
-> String -> (Float, Float -> [(Float, Float)])
forall a b. (a -> b) -> a -> b
$ String
ys
        l :: Int
l = String -> 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]
++ ((Float, Float) -> String) -> [(Float, Float)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(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
"),("))) (Float -> [(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]
++ ((Float, Float) -> String) -> [(Float, Float)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(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
"),("))) (Float -> [(Float, Float)]
f Float
1)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]))"