diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,8 +3,8 @@ ## 0.1.0.0 -- 2021-02-22 * First version. Released on an unsuspecting world. -Rewritten from the dobutokO2 package using arrays and lists based functionality instead of vector based one. Added some new -functions, removed some functions. +Rewritten from the dobutokO2 package using arrays and lists based functionality instead of vector based one. Added some new +functions, removed some functions. ## 0.1.1.0 -- 2021-22-02 @@ -23,16 +23,19 @@ ## 0.2.2.0 -- 2021-03-02 * Second version revised B. Fixed issue with being not imported iterate' from GHC.List for lower than 8.6 versions -of GHC. +of GHC. ## 0.3.0.0 -- 2021-03-07 * Third version. Fixed some issues with functions in the Composition.Sound.IntermediateF module. Added a new function to it -and some other new functions to the Composition.Sound.Functional.Basics module. Added process-sequential as a new lightweight +and some other new functions to the Composition.Sound.Functional.Basics module. Added process-sequential as a new lightweight dependency. ## 0.3.1.0 -- 2021-03-09 -* Third version revised A. Added new function overMeloPar2G to the Composition.Sound.Functional.Params module. Changed the +* Third version revised A. Added new function overMeloPar2G to the Composition.Sound.Functional.Params module. Changed the dependency boundaries for process-sequential. +## 0.4.0.0 -- 2021-11-04 + +* Fourth version. Updated the dependencies and some code improvements. diff --git a/Composition/Sound/Functional/Elements.hs b/Composition/Sound/Functional/Elements.hs --- a/Composition/Sound/Functional/Elements.hs +++ b/Composition/Sound/Functional/Elements.hs @@ -9,7 +9,7 @@ -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- --- Helps to create experimental music from a file (or its part) and a Ukrainian text. +-- 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. module Composition.Sound.Functional.Elements ( @@ -42,7 +42,6 @@ ) where import Data.List ---import qualified Data.Vector as V import GHC.Arr import qualified Data.Foldable as F import Data.Maybe (fromJust) @@ -90,10 +89,10 @@ sameFreqFI freq (noteN0,amplN0) f g = g (noteN0,amplN0) . filter (\(x,_) -> x == noteN0) $ f freq -- | @gAdd :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO@ is a function that defines how the element is added --- to the 'OvertonesO'. 'fAddFElem' is --- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task --- (in general) to look at such a function through a prism of notion of operator (mathematical, for example similar to that ones that --- are used for quantum mechanics and quantum field theory). +-- to the 'OvertonesO'. 'fAddFElem' is +-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task +-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example similar to that ones that +-- are used for quantum mechanics and quantum field theory). -- @gAdd@ allows not only to insert an element if missing, but to change all the 'OvertonesO' system. So depending on the complexity, -- it can produce rather complex behaviour. fAddFElem :: (Float, Float) -> (Float -> OvertonesO) -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO) -> @@ -102,26 +101,26 @@ -- | @gRem:: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO@ is a function that defines how the element is removed -- from the 'OvertonesO'. 'fRemoveFElem' is --- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task --- (in general) to look at such a function through a prism of notion of operator (mathematical, for example that ones that are used --- for quantum mechanics and quantum field theory). +-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task +-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example that ones that are used +-- for quantum mechanics and quantum field theory). -- @gRem@ allows not only to delete an element if existing, but to change all the 'OvertonesO' system. So depending on the complexity, -- it can produce rather complex behaviour. -fRemoveFElem :: (Float, Float) -> (Float -> OvertonesO) -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO) -> +fRemoveFElem :: (Float, Float) -> (Float -> OvertonesO) -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO) -> (Float -> OvertonesO) fRemoveFElem (noteN, amplN) f gRem t = gRem (noteN, amplN) t f --- | Changes elements of the 'OvertonesO' using two functions. It is a generalization of the 'fAddFElem' and 'fRemoveFElem' functions. For example, if the first --- of the two inner functional arguments acts as 'gAdd01' or similar, then it adds element to the 'OvertonesO', if it acts as 'gRem01', then it removes the element. +-- | Changes elements of the 'OvertonesO' using two functions. It is a generalization of the 'fAddFElem' and 'fRemoveFElem' functions. For example, if the first +-- of the two inner functional arguments acts as 'gAdd01' or similar, then it adds element to the 'OvertonesO', if it acts as 'gRem01', then it removes the element. -- Its behaviour is defined by the 'Float' parameter (meaning frequency, probably), so you can change elements depending on what point it is applied. -fChangeFElem :: (Float, Float) -> Float -> (Float -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> +fChangeFElem :: (Float, Float) -> Float -> (Float -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> (Float -> OvertonesO) fChangeFElem (noteN, amplN) freq h f t = (h freq) (noteN, amplN) t f -- | Example of the function gAdd for the 'fAddFElem'. If the frequency is already in the 'OvertonesO' then the corresponding amplitude is divided -- equally between all the elements with the repeated given frequency from @(Float, Float)@. Otherwise, it is just concatenated to the 'OvertonesO'. gAdd01 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO -gAdd01 (note,ampl) freq f +gAdd01 (note,ampl) freq f | null . f $ freq = [(note,ampl)] | otherwise = let v1 = renormF . f $ freq in @@ -141,7 +140,7 @@ -- values notes as an intermediate value with the respective amplitude, or if there is only one element, to produce two elements in -- the resulting list with two consequent harmonics. gAdd03 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO -gAdd03 (note,ampl) freq f +gAdd03 (note,ampl) freq f | null . f $ freq = [(note,ampl)] | otherwise = let v1 = renormF . f $ freq in @@ -174,24 +173,24 @@ gRem02 :: Float -> (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO gRem02 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) freq --- | Similar to 'fAddFElem', but instead of one element @(Float,Float)@ it deals with a list of such elements that is 'OvertonesO'. +-- | Similar to 'fAddFElem', but instead of one element @(Float,Float)@ it deals with a list of such elements that is 'OvertonesO'. fAddFElems :: OvertonesO -> (Float -> OvertonesO) -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO) -> (Float -> OvertonesO) fAddFElems v f gAdds t = gAdds v t f --- | Similar to 'fRemoveFElem', but instead of one element @(Float,Float)@ it deals with a list of such elements that is 'OvertonesO'. -fRemoveFElems :: OvertonesO -> (Float -> OvertonesO) -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO) -> +-- | Similar to 'fRemoveFElem', but instead of one element @(Float,Float)@ it deals with a list of such elements that is 'OvertonesO'. +fRemoveFElems :: OvertonesO -> (Float -> OvertonesO) -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO) -> (Float -> OvertonesO) fRemoveFElems v f gRems t = gRems v t f --- | Similar to 'fChangeFElem', but use another form of the changing function, so it can deal with not only single element of the 'OvertonesO', +-- | Similar to 'fChangeFElem', but use another form of the changing function, so it can deal with not only single element of the 'OvertonesO', -- but also with several ones. -fChangeFElems :: OvertonesO -> Float -> (Float -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> +fChangeFElems :: OvertonesO -> Float -> (Float -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> (Float -> OvertonesO) fChangeFElems v freq h f t = (h freq) v t f -- | Binary predicate to check whether two given 'OvertonesO' both have the elements with the same first element in the tuples. If 'True' then --- this means that 'OvertonesO' are at least partially overlaped by the first elements in the tuples (meaning frequencies). +-- this means that 'OvertonesO' are at least partially overlaped by the first elements in the tuples (meaning frequencies). freqsOverlapOvers :: OvertonesO -> OvertonesO -> Bool freqsOverlapOvers v1 v2 = let [v11,v21] = map (map fst) [v1,v2] @@ -232,7 +231,7 @@ -- | Example of the function @gAdds@ for the 'fAddFElems'. -- Partial function. gAdds01 :: OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO -gAdds01 v0 freq f +gAdds01 v0 freq f | null . f $ freq = v0 | freqsOverlapOvers v0 (f freq) = let ys = sortBy (\(x1,_) (x2,_) -> compare x1 x2) v0 @@ -254,7 +253,7 @@ -- | Example of the function @gAdd@. for the 'fAddFElem'. It tries to insert the given ('Float','Float') into the less dense frequency region. gAdd04 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO -gAdd04 (note,ampl) freq f +gAdd04 (note,ampl) freq f | null . f $ freq = [(note,ampl)] | otherwise = let v1 = sortBy (\(x1,_) (x2,_) -> compare x1 x2) . f $ freq @@ -271,4 +270,4 @@ let v1 = filter (\(x,_) -> abs (x - note) <= halfwidth) . f $ freq in if length v1 <= 5 then renormF . map (\i -> (fromIntegral (i + 1) * note, halfwidth / fromIntegral (i + 3))) $ [0..4] else v1 - + diff --git a/Composition/Sound/Functional/Params.hs b/Composition/Sound/Functional/Params.hs --- a/Composition/Sound/Functional/Params.hs +++ b/Composition/Sound/Functional/Params.hs @@ -5,8 +5,8 @@ -- 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. +-- 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. {-# LANGUAGE BangPatterns, LambdaCase #-} {-# OPTIONS_GHC -threaded #-} @@ -35,7 +35,7 @@ , overSoXSynthGen2FDN_SG6GPar , overSoXSynthGen2FDN_SG2GPar , overSoXSynthGen2FDN_Sf3GPar - , overSoXSynthGen2FDN_Sf3G2GPar + , overSoXSynthGen2FDN_Sf3G2GPar -- * Creating melody from overtones , overMeloPar , overMeloPar2G @@ -66,7 +66,7 @@ import EndOfExe import System.Directory import Languages.Phonetic.Ukrainian.Syllable.Arr -import Melodics.ByteString.Ukrainian.Arr (convertToProperUkrainianS) +import Melodics.ByteString.Ukrainian.Arr import Sound.SoXBasics (upperBnd,selMaxAbs) import MMSyn7l import qualified Data.Foldable as F @@ -74,21 +74,21 @@ import Composition.Sound.Functional.Basics import Data.Foldable.Ix --- | Representation of the scales and modes for the notes. Can be extended further, but for a lot of situations the following realization is sufficient. --- See, for example, 'filterInParams' and so on. 'String' is (are) used as a general classification name, for some of them there are provided two --- 'String' to classify. Lists are used to specify remainders in some meaning. See also, 'liftInParams' and 'toneE' ('toneD') functions, 'elemP' and +-- | Representation of the scales and modes for the notes. Can be extended further, but for a lot of situations the following realization is sufficient. +-- See, for example, 'filterInParams' and so on. 'String' is (are) used as a general classification name, for some of them there are provided two +-- 'String' to classify. Lists are used to specify remainders in some meaning. See also, 'liftInParams' and 'toneE' ('toneD') functions, 'elemP' and -- 'elemCloseP', 'lengthP' and 'showD'. -data Params = P2 Int Int | P2s Int Int String | P3sf Int Int Int String | P4lsf Int Int Int [Int] String | P32sf Int Int Int String String +data Params = P2 Int Int | P2s Int Int String | P3sf Int Int Int String | P4lsf Int Int Int [Int] String | P32sf Int Int Int String String | P3lf Int Int [Int] deriving (Eq, Ord, Show) --- | Is used to represent a set of durations parameters of the sounds and pauses. The positive value corresponds to the sound +-- | Is used to represent a set of durations parameters of the sounds and pauses. The positive value corresponds to the sound -- and the negative one -- to the pause. type Durations = Array Int Float -- | Is used to represent a set of volumes in the amplitude scale for SoX \"vol\" effect. type Strengths = Array Int Float --- | Is used to represent a set of intervals for notes (each element is a number of semi-tones between parts of interval). +-- | Is used to represent a set of intervals for notes (each element is a number of semi-tones between parts of interval). -- Positive values corresponds to lower notes and negative to higher ones. type Intervals = Array Int Int @@ -104,11 +104,11 @@ UZ _ M -> (-1) UZ _ S -> (-1) UZ _ O -> (-1) - _ -> 0) . concat) . createSyllablesUkrS . take (3 * n1) . cycle - --- | Generalized version of the 'overSoXSynthGen2FDN_SG4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to + _ -> 0) . concat) . createSyllablesUkrS . take (3 * n1) . cycle + +-- | Generalized version of the 'overSoXSynthGen2FDN_SG4G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_SG4GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> +overSoXSynthGen2FDN_SG4GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> IO () overSoXSynthGen2FDN_SG4GPar file params f y arr2 wws h = do n <- duration1000 file @@ -117,11 +117,11 @@ zeroN = numVZeroesPre vecB in mapM_ (\(j, x) -> do h f (x, (unsafeAt arr2 (j `rem` numElements arr2))) j wws renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") . zip [0..] $ vecB - endFromResult - --- | Generalized version of the 'overSoXSynthGen2FDN_SG6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to + endFromResult + +-- | Generalized version of the 'overSoXSynthGen2FDN_SG6G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. -overSoXSynthGen2FDN_SG6GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> +overSoXSynthGen2FDN_SG6GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Durations -> String -> ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> IO ()) -> Strengths -> Float -> IO () overSoXSynthGen2FDN_SG6GPar file params f y v2 wws h v6 limV | F.null v6 = putStrLn "You did not provide a volume adjustments array! " @@ -138,7 +138,7 @@ zip [0..] $ ys endFromResult --- | Generalized version of the 'overSoXSynthGen2FDN_SG2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- | Generalized version of the 'overSoXSynthGen2FDN_SG2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthGen2FDN_SG2GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> String -> String -> ((Float -> OvertonesO) -> (Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO () @@ -154,7 +154,7 @@ if drop 3 ys == "f" then ".flac" else ".wav") . zip [0..] $ vecB endFromResult2G ys --- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthGen2FDN_Sf3GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Float -> String -> String -> ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> IO ()) -> IO () @@ -169,7 +169,7 @@ renameFile "result.wav" $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") . zip [0..] $ vecB endFromResult --- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to +-- | Generalized version of the 'overSoXSynthGen2FDN_Sf3G2G' where instead of lifting with 'liftInEnkuV' 'liftInParamsV' is used. It allows e. g. to -- use some tonality. For more information, please, refer to 'filterInParams'. overSoXSynthGen2FDN_Sf3G2GPar :: FilePath -> Params -> (Float -> OvertonesO) -> Float -> Float -> String -> String -> ((Float -> OvertonesO) -> (Float, Float, Float) -> Int -> String -> String -> IO ()) -> String -> IO () @@ -185,43 +185,43 @@ then ".flac" else ".wav") . zip [0..] $ vecB endFromResult2G ys --- | A way to get from a 'Params' a corresponding 'Array' 'Int' of 'Float' (if any) and so to work with them further. May contain some issues --- so please, before production usage check thoroughly. --- For information there were used the following: --- +-- | A way to get from a 'Params' a corresponding 'Array' 'Int' of 'Float' (if any) and so to work with them further. May contain some issues +-- so please, before production usage check thoroughly. +-- For information there were used the following: +-- -- https://en.wikipedia.org/wiki/Mode_(music) --- +-- -- https://en.wikipedia.org/wiki/Ukrainian_Dorian_scale --- +-- -- https://en.wikipedia.org/wiki/List_of_musical_scales_and_modes --- +-- -- https://en.wikipedia.org/wiki/Octatonic_scale --- --- several other articles in the English Wikipedia --- --- and in Ukrainian: --- Смаглій Г., Маловик Л. Теорія музики : Підруч. для навч. закл. освіти, культури і мистецтв / Г.А. Смаглій. -- Х. : Вид-во \"Ранок\", 2013. -- 392 с. +-- +-- several other articles in the English Wikipedia +-- +-- and in Ukrainian: +-- Смаглій Г., Маловик Л. Теорія музики : Підруч. для навч. закл. освіти, культури і мистецтв / Г.А. Смаглій. -- Х. : Вид-во \"Ранок\", 2013. -- 392 с. -- ISBN 978-617-09-1294-7 --- +-- filterInParams :: Params -> Maybe (Array Int Float) filterInParams (P3lf n2 nL zs) -- generalized sound series, e. g. the chromatic ones etc. - | all (>= 0) ([nL,107 - nL - n2,n2 - 2] ++ zs) = - if any (\(i, _) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . + | all (>= 0) ([nL,107 - nL - n2,n2 - 2] ++ zs) = + if any (\(i, _) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes then Just (h4 . filter (\(i, _) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) else Nothing | otherwise = Nothing filterInParams (P32sf nT n2 nL xs ys) -- dur and moll in various their modifications - | all (>= 0) [107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 12] = - case xs of - "dur" -> getBFstL' Nothing (zip ["FloatH","H","Full","Full moll","M","N"] . fmap Just $ + | all (>= 0) [107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 12] = + case xs of + "dur" -> getBFstL' Nothing (zip ["FloatH","H","Full","Full moll","M","N"] . fmap Just $ [h4 . filter (\(i,_) -> toneD i nL nT [2,3,6,8,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,3,5,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,3,5]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,6]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,3,5,9,11]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,3,5,8,10]) . zip [0..] . sliceToList nL n2 $ notes]) ys - "moll" -> getBFstL' Nothing (zip ["FloatH1","H","Full","Full dur","M","N"] . fmap Just $ + "moll" -> getBFstL' Nothing (zip ["FloatH1","H","Full","Full dur","M","N"] . fmap Just $ [h4 . filter (\(i,_) -> toneD i nL nT [1,4,5,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneD i nL nT [1,4,6,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) `notElem` [1,4,6]) . zip [0..] . sliceToList nL n2 $ @@ -231,88 +231,88 @@ zip [0..] . sliceToList nL n2 $ notes]) ys _ -> Nothing | otherwise = Nothing -filterInParams (P4lsf nT n2 nL zs xs) - | all (>= 0) ([107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 2] ++ zs) = +filterInParams (P4lsf nT n2 nL zs xs) + | all (>= 0) ([107 - nL - n2,nT,nL,nT - nL,nL + n2 - nT,n2 - 2] ++ zs) = case xs of - "ditonic" -> - if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) - i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 2 + "ditonic" -> + if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) $ replicate n2 True) + i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 2 then Nothing - else - if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 2 . sortNoDup . filter (< n2) $ zs) $ + else + if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 2 . sortNoDup . filter (< n2) $ zs) $ replicate n2 True) i) . zip [0..] . sliceToList nL n2 $ notes) - then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 2 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) + then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 2 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) else Nothing - "tritonic" -> - if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) - i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 3 + "tritonic" -> + if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) + i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 3 then Nothing - else - if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 3 . sortNoDup . filter (< n2) $ zs) . + else + if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 3 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) - then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 3 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) + then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 3 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) else Nothing - "tetratonic" -> - if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) - i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 4 + "tetratonic" -> + if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) + i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 4 then Nothing - else - if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 4 . sortNoDup . filter (< n2) $ zs) . + else + if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 4 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) - then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 4 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) + then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 4 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) else Nothing - "octatonic" -> - if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) - i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 8 + "octatonic" -> + if (length . filter (\(i,_) -> getBFstLSorted' False (zip (sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) + i) $ (zip [0..] . sliceToList nL n2 $ notes)) /= 8 then Nothing - else - if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 8 . sortNoDup . filter (< n2) $ zs) . + else + if (unsafeAt notes nT) `elem` (map snd . filter (\(i,_) -> getBFstLSorted' False (zip (take 8 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) - then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 8 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) + then Just (h4 . filter (\(i,_) -> getBFstLSorted' False (zip (take 8 . sortNoDup . filter (< n2) $ zs) . replicate n2 $ True) i) . zip [0..] . sliceToList nL n2 $ notes) else Nothing _ -> Nothing | nL >= 0 && nL <= 107 && n2 == 1 && xs == "monotonic" = Just (listArray (0,0) . (:[]) $ (unsafeAt notes nL)) | otherwise = Nothing -filterInParams (P2 nL n2) - | all (>= 0) [107 - nL - n2,nL,n2 - 2] = Just ((\rs -> listArray (0,length rs - 1) rs) . sliceToList nL n2 $ notes) +filterInParams (P2 nL n2) + | all (>= 0) [107 - nL - n2,nL,n2 - 2] = Just ((\rs -> listArray (0,length rs - 1) rs) . sliceToList nL n2 $ notes) | otherwise = Nothing -filterInParams (P2s nL n2 xs) - | all (>= 0) [107 - nL - n2,nL,n2 - 12] = - getBFstLSorted' Nothing (zip ["Egyptian pentatonic", "Prometheus hexatonic scale", "Ukrainian Dorian scale", "augmented hexatonic scale", - "blues major pentatonic", "blues minor pentatonic", "blues scale", "major hexatonic scale", "major pentatonic", "minor hexatonic scale", +filterInParams (P2s nL n2 xs) + | all (>= 0) [107 - nL - n2,nL,n2 - 12] = + getBFstLSorted' Nothing (zip ["Egyptian pentatonic", "Prometheus hexatonic scale", "Ukrainian Dorian scale", "augmented hexatonic scale", + "blues major pentatonic", "blues minor pentatonic", "blues scale", "major hexatonic scale", "major pentatonic", "minor hexatonic scale", "minor pentatonic", "tritone hexatonic scale", "two-semitone tritone hexatonic scale", "whole tone scale"] . map Just $ [h4 . filter (\(i,_) -> toneE i nL nL [0,2,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . - filter (\(i,_) -> toneE i nL nL [0,2,4,6,9,10]) . zip [0..] . sliceToList nL n2 $ notes, - h4 . filter (\(i,_) -> toneE i nL nL [0,2,3,6,7,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,4,7,8,11]) . zip [0..] . sliceToList nL n2 $ notes, - h4 . filter (\(i,_) -> toneE i nL nL [0,2,5,7,9]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,8,10]) . zip [0..] . sliceToList nL n2 $ notes, - h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, - h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,5,7,9]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,7,9]) . zip [0..] . sliceToList nL n2 $ notes, - h4 . filter (\(i,_) -> toneE i nL nL [0,2,3,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, - h4 . filter (\(i,_) -> toneE i nL nL [0,1,4,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,1,3,7,8,9]) . zip [0..] . sliceToList nL n2 $ notes, + filter (\(i,_) -> toneE i nL nL [0,2,4,6,9,10]) . zip [0..] . sliceToList nL n2 $ notes, + h4 . filter (\(i,_) -> toneE i nL nL [0,2,3,6,7,9,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,4,7,8,11]) . zip [0..] . sliceToList nL n2 $ notes, + h4 . filter (\(i,_) -> toneE i nL nL [0,2,5,7,9]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,8,10]) . zip [0..] . sliceToList nL n2 $ notes, + h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, + h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,5,7,9]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,7,9]) . zip [0..] . sliceToList nL n2 $ notes, + h4 . filter (\(i,_) -> toneE i nL nL [0,2,3,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,3,5,7,10]) . zip [0..] . sliceToList nL n2 $ notes, + h4 . filter (\(i,_) -> toneE i nL nL [0,1,4,6,7,10]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,1,3,7,8,9]) . zip [0..] . sliceToList nL n2 $ notes, h4 . filter (\(i,_) -> toneE i nL nL [0,2,4,6,8,10]) . zip [0..] . sliceToList nL n2 $ notes]) xs | otherwise = Nothing -filterInParams (P3sf nT nL n2 xs) - | all (>= 0) [101 - nL,nT,nL,nT - nL,nL + 6 - nT] && n2 == 6 = - case xs of - "Dorian tetrachord" -> +filterInParams (P3sf nT nL n2 xs) + | all (>= 0) [101 - nL,nT,nL,nT - nL,nL + 6 - nT] && n2 == 6 = + case xs of + "Dorian tetrachord" -> if (nT - nL) `elem` [0,1,3,5] then Just (h4 . filter (\(i,_) -> toneE i nL nT [0,1,3,5]) . zip [0..] . sliceToList nL 6 $ notes) else Nothing - "Phrygian tetrachord" -> + "Phrygian tetrachord" -> if (nT - nL) `elem` [0,2,3,5] then Just (h4 . filter (\(i,_) -> toneE i nL nT [0,2,3,5]) . zip [0..] . sliceToList nL 6 $ notes) else Nothing - "Lydian tetrachord" -> + "Lydian tetrachord" -> if (nT - nL) `elem` [0,2,4,5] then Just (h4 . filter (\(i,_) -> toneE i nL nT [0,2,4,5]) . zip [0..] . sliceToList nL 6 $ notes) else Nothing _ -> Nothing - | all (>= 0) [94 - nL,nT,nL,nT - nL,nL + 13 - nT] && n2 == 13 = - getBFstLSorted' Nothing (zip ["modern Aeolian mode", "modern Dorian mode", "modern Ionian mode", "modern Locrian mode", - "modern Lydian mode", "modern Mixolydian mode", "modern Phrygian mode"] $ fmap (h3 nT n2 nL) [[1,4,6,9,11], [1,4,6,8,11], [1,3,6,8,10], + | all (>= 0) [94 - nL,nT,nL,nT - nL,nL + 13 - nT] && n2 == 13 = + getBFstLSorted' Nothing (zip ["modern Aeolian mode", "modern Dorian mode", "modern Ionian mode", "modern Locrian mode", + "modern Lydian mode", "modern Mixolydian mode", "modern Phrygian mode"] $ fmap (h3 nT n2 nL) [[1,4,6,9,11], [1,4,6,8,11], [1,3,6,8,10], [2,4,7,9,11], [1,3,5,8,10], [1,3,6,8,11], [2,4,6,9,11]]) xs | otherwise = Nothing h3 :: Int -> Int -> Int -> [Int] -> Maybe (Array Int Float) -h3 nT n2 nL zs +h3 nT n2 nL zs | nT == nL = Just ((\rs -> listArray (0,length rs - 1) rs) . map snd . filter (\(i, _) -> toneD i nL nT zs) . zip [0..] . sliceToList nL n2 $ notes) | otherwise = Nothing @@ -322,33 +322,33 @@ {-# INLINE h4 #-} -- | For the list of @a@ from the @Ord@ class it builds a sorted in the ascending order list without duplicates. --- +-- -- > sortNoDup [2,1,4,5,6,78,7,7,5,4,3,2,5,4,2,4,54,3,5,65,4,3,54,56,43,5,2] = [1,2,3,4,5,6,7,43,54,56,65,78] --- +-- sortNoDup :: Ord a => [a] -> [a] sortNoDup = sortNoDup' . sort - where sortNoDup' (x:x1@(y:_)) + where sortNoDup' (x:x1@(y:_)) | x == y = sortNoDup' x1 | otherwise = x:sortNoDup' x1 sortNoDup' (x:_) = [x] sortNoDup' _ = [] --- | Checks whether its first 'Int' argument does not belong to those ones that are included into the list argument on the reminders basis. +-- | Checks whether its first 'Int' argument does not belong to those ones that are included into the list argument on the reminders basis. -- The opposite to 'toneE' with the same arguments. The list argument must be sorted in the ascending order. toneD :: Int -> Int -> Int -> [Int] -> Bool toneD i nL nT zs = getBFstLSorted' True (zip zs . replicate 12 $ False) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) --- | Checks whether its first 'Int' argument does belong to those ones that are included into the list argument on the reminders basis. +-- | Checks whether its first 'Int' argument does belong to those ones that are included into the list argument on the reminders basis. -- The opposite to 'toneD' with the same arguments. The list argument must be sorted in the ascending order. toneE :: Int -> Int -> Int -> [Int] -> Bool toneE i nL nT zs = getBFstLSorted' False (zip zs . replicate 12 $ True) ((nL + i - nT + (((nT - nL) `quot` 12) + 1) * 12) `rem` 12) --- | Analogous to 'liftInEnku' lifts a frequency into a tonality (or something that can be treated alike one) specified by 'Params'. If not +-- | Analogous to 'liftInEnku' lifts a frequency into a tonality (or something that can be treated alike one) specified by 'Params'. If not -- reasonably one exists then the result is 11440 (Hz). -- Partial function. liftInParams :: Float -> Params -> Float -liftInParams x params - | lengthP params == 0 || (isNothing . whichOctaveG $ x) = 11440.0 +liftInParams x params + | lengthP params == 0 || (isNothing . whichOctaveG $ x) = 11440.0 | otherwise = let !ys = map (abs . log . (\t -> t / x) . (\i -> unsafeAt notes (12 * fromJust (whichOctaveG x)) * 2 ** (fromIntegral i / fromIntegral (lengthP params)))) @@ -367,16 +367,16 @@ elemP :: Float -> Params -> Bool elemP note = fromMaybe False . fmap (note `F.elem`) . filterInParams --- | Check whether a given 'Float' value (frequency of the closest note to the given frequency) is in the vector of Floats that +-- | Check whether a given 'Float' value (frequency of the closest note to the given frequency) is in the vector of Floats that -- corresponds to the given 'Params'. elemCloseP :: Float -> Params -> Bool elemCloseP note = fromMaybe False . fmap (closestNote note `F.elem`) . filterInParams --- | A way to show not the (somewhat algebraic) structure of the 'Params' (as the usual 'show' does), but the contained frequencies in it. +-- | A way to show not the (somewhat algebraic) structure of the 'Params' (as the usual 'show' does), but the contained frequencies in it. showD :: Params -> String -showD = show . filterInParams +showD = show . filterInParams --- | Check whether for the given arguments there are the notes and whether 'String' is a name signature for the scale in 'Params' (can they be used +-- | Check whether for the given arguments there are the notes and whether 'String' is a name signature for the scale in 'Params' (can they be used -- together to correspond to a non-empty set of notes). isStrParams :: String -> Params -> Bool isStrParams xs (P2s x y zs) = if isJust (filterInParams (P2s x y zs)) then xs == zs else False @@ -385,58 +385,58 @@ isStrParams xs (P32sf x y z zs ys) = if isJust (filterInParams (P32sf x y z zs ys)) then (xs == zs || xs == ys || xs == (ys ++ " " ++ zs)) else False isStrParams _ _ = False --- | Check whether for the given arguments there are the notes and whether list of 'Int' is a part of the constructed 'Params' (can they be used +-- | Check whether for the given arguments there are the notes and whether list of 'Int' is a part of the constructed 'Params' (can they be used -- together to correspond to a non-empty set of notes). isListParams :: [Int] -> Params -> Bool isListParams xs (P4lsf x y z ts zs) = if isJust (filterInParams (P4lsf x y z ts zs)) then xs == ts else False isListParams xs (P3lf x y zs) = if isJust (filterInParams (P3lf x y zs)) then xs == zs else False isListParams _ _ = False --- | Generates melody for the given parameters. The idea is that every application of the function @f :: Float -> OvertonesO@ to its argument --- possibly can produce multiple overtones being represented as list of tuples of pairs of 'Float'. We can use the first element in the --- tuple to obtain a new sound parameters and the second one -- to obtain its new duration in the melody. Additional function @g :: Float -> Float@ --- is used to avoid the effect of becoming less and less -- closer to the zero for the higher overtones so the durations will become also less. --- Besides it allows to rescale the durations in a much more convenient way. --- --- The first 'Float' parameter is a multiplication coefficient to increase or to decrease the durations (values with an absolute values greater than --- one correspond to increasing inside the @g@. function applied afterwards with function composition and the values with an absolute values less --- than one and not equal to zero correspond to decreasing inside the @g@ function. --- The second 'Float' parameter is a usual frequency which is used instead of the 11440.0 (Hz) value. --- The third 'Float' parameter is a main argument -- the frequency for which the 'OvertonesO' are generated as a first step of the computation. +-- | Generates melody for the given parameters. The idea is that every application of the function @f :: Float -> OvertonesO@ to its argument +-- possibly can produce multiple overtones being represented as list of tuples of pairs of 'Float'. We can use the first element in the +-- tuple to obtain a new sound parameters and the second one -- to obtain its new duration in the melody. Additional function @g :: Float -> Float@ +-- is used to avoid the effect of becoming less and less -- closer to the zero for the higher overtones so the durations will become also less. +-- Besides it allows to rescale the durations in a much more convenient way. +-- +-- The first 'Float' parameter is a multiplication coefficient to increase or to decrease the durations (values with an absolute values greater than +-- one correspond to increasing inside the @g@. function applied afterwards with function composition and the values with an absolute values less +-- than one and not equal to zero correspond to decreasing inside the @g@ function. +-- The second 'Float' parameter is a usual frequency which is used instead of the 11440.0 (Hz) value. +-- The third 'Float' parameter is a main argument -- the frequency for which the 'OvertonesO' are generated as a first step of the computation. overMeloPar :: (Float -> OvertonesO) -> (Float -> Float) -> Params -> Float -> Float -> Float -> IO () -overMeloPar f g params coeff freq0 freq = do +overMeloPar f g params coeff freq0 freq = do let v = f freq vFreqs = map ((\z -> if z == 11440.0 then freq0 else z) . flip liftInParams params . fst) v vD = map (g . (* coeff) . snd) v v2 = map f vFreqs vS = map (\z -> showFFloat (Just 4) (abs z) "") vD !l3 = length v2 - h42 j (x,v3,y,ts) - | y > 0.0 = do + h42 j (x,v3,y,ts) + | y > 0.0 = do (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing (fst x) ""] "" print herr partialTest_k1G v3 0 ts ((\rs -> listArray (0, l3 - 1) rs) . replicate l3 $ 0.0) mixTest renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav" - | y < 0.0 = do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"] "" + | y < 0.0 = do + (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"] "" putStr herr renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav" - | otherwise = putStrLn "Zero length of the sound! " + | otherwise = putStrLn "Zero length of the sound! " mapM_ (\(j, zz) -> h42 j zz) . zip [0..] . zip4 v v2 vD $ vS {-| A variant of the 'overMeloPar2G' with the first argument controlling the sound quality parameters. For more information, please, refer to 'soxBasicParams' documentation. -} overMeloPar2G :: String -> (Float -> OvertonesO) -> (Float -> Float) -> Params -> Float -> Float -> Float -> IO () -overMeloPar2G ys f g params coeff freq0 freq = do +overMeloPar2G ys f g params coeff freq0 freq = do let v = f freq vFreqs = map ((\z -> if z == 11440.0 then freq0 else z) . flip liftInParams params . fst) v vD = map (g . (* coeff) . snd) v v2 = map f vFreqs vS = map (\z -> showFFloat (Just 4) (abs z) "") vD !l3 = length v2 - h42 j (x,v3,y,ts) - | y > 0.0 = do + h42 j (x,v3,y,ts) + | y > 0.0 = do (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing (fst x) ""]) "" print herr partialTest_k2G v3 0 ts ((\rs -> listArray (0, l3 - 1) rs) . replicate l3 $ 0.0) ys @@ -447,8 +447,8 @@ flacF <- doesFileExist "result.flac" if flacF then renameFile "result.flac" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".flac" else putStrLn "Composition.Sound.Functional.Params.overMeloPar2G: No \"result*\" file is present in the directory. " - | y < 0.0 = do - (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"]) "" + | y < 0.0 = do + (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ((if null ys then id else soxBasicParams ys) ["-r22050", "-n", "result.wav", "synth", ts,"sine",showFFloat Nothing (fst x) "","vol","0"]) "" putStr herr wavF <- doesFileExist "result.wav" if wavF then renameFile "result.wav" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".wav" @@ -456,19 +456,19 @@ flacF <- doesFileExist "result.flac" if flacF then renameFile "result.flac" $ "result" ++ prependZeroes (numVZeroesPre v) (show j) ++ ".flac" else putStrLn "Composition.Sound.Functional.Params.overMeloPar2G: No \"result*\" file is present in the directory. " - | otherwise = putStrLn "Zero length of the sound! " + | otherwise = putStrLn "Zero length of the sound! " mapM_ (\(j, zz) -> h42 j zz) . zip [0..] . zip4 v v2 vD $ vS --- | A default way to get 'Durations' for the sounds up to 0.35.2.0 version of the package including. It is based on the number of Ukrainian --- sounds representations (see, 'convertToProperUkrainianS') in a Ukrainian syllables or somewhat generated by the same rules as they. +-- | A default way to get 'Durations' for the sounds up to 0.35.2.0 version of the package including. It is based on the number of Ukrainian +-- sounds representations (see, 'convertToProperUkrainianS') in a Ukrainian syllables or somewhat generated by the same rules as they. -- The rhythm using the function is very often not binary but its ratios are almost always a ratios of the small natural numbers (1, 2, 3, 4, 5, 6, 7 etc.). -- Partial function. str2DurationsDef :: Int -> String -> Float -> Durations -str2DurationsDef n zs y = +str2DurationsDef n zs y = let (!t, !ws) = splitAt 1 . syllableStr n $ zs !l = length ws - 1 in amap (\yy -> y * fromIntegral (yy * length ws) / fromIntegral (head t)) . listArray (0,l) $ ws - + apply6GSilentFile :: FilePath -> Float -> Float -> IO () apply6GSilentFile file limV vol = do upp <- upperBnd file @@ -485,7 +485,7 @@ _ -> do removeFile $ file ++ "effects" ++ efw2 file putStrLn $ "MMSyn7l.soxE \"" ++ file ++ "\" has not been successful. The file has not been changed at all. " - + -- | Function is used to generate a rhythm of the resulting file \'end.wav\' from the Ukrainian text and a number of sounds either in the syllables or in the words without vowels. syllableStr :: Int -> String -> [Int] syllableStr n xs = @@ -493,7 +493,7 @@ y = sum ps in case y of 0 -> [0] - _ -> y:ps + _ -> y:ps -- | Generalized variant of the 'overSoXSynth2FDN_Sf31G' with a possibility to specify sound quality using the second 'String' parameter. -- For more information, please, refer to 'soxBasicParams'. @@ -532,7 +532,7 @@ soundGenF32G :: [Float -> Float] -> [Float] -> [Int] -> (Float -> OvertonesO) -> (Float, Float, Float) -> Int -> Array Int Float -> String -> IO () soundGenF32G vf vd vi f (x, y, t0) j vdB ys = do - let vD = helpF1 vf vd vi + let vD = helpF1 vf vd vi vDz = mapMaybe id vD -- The previous one without Nothings and Justs vNotes = doubleVecFromVecOfFloat f t0 . map Just $ vDz ts = showFFloat (Just 4) (abs y) "" -- duration of the sound to be generated @@ -544,7 +544,7 @@ helpF0 :: Int -> String helpF0 = getBFstLSorted' "ZZ0" (zip [0..] $ (map (:[]) "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ++ concatMap (\z -> map ((z:) . (:[])) "ABCDEFGHIJKLMNOPQRSTUVWXYZ") - "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) + "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) helpF1 :: [Float -> Float] -> [Float] -> [Int] -> [Maybe Float] helpF1 vf vd = @@ -553,7 +553,7 @@ 0 -> Nothing _ -> Just $ f1 x) . zip3 vf vd --- | Generates a list of 'OvertonesO' that represents the melodic line. +-- | Generates a list of 'OvertonesO' that represents the melodic line. doubleVecFromVecOfFloat :: (Float -> OvertonesO) -> Float -> [Maybe Float] -> [OvertonesO] doubleVecFromVecOfFloat f t0 = map (\note1 -> if isNothing note1 then [] else filter (\(_,!z) -> abs z > t0) . f . fromJust $ note1) diff --git a/algorithmic-composition-basic.cabal b/algorithmic-composition-basic.cabal --- a/algorithmic-composition-basic.cabal +++ b/algorithmic-composition-basic.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: algorithmic-composition-basic -version: 0.3.1.0 +version: 0.4.0.0 synopsis: Helps to create experimental music from a file (or its part) and a Ukrainian text. description: It can also generate a timbre for the notes. Uses SoX inside. homepage: https://hackage.haskell.org/package/algorithmic-composition-basic @@ -20,6 +20,6 @@ exposed-modules: Composition.Sound.IntermediateF, Composition.Sound.Keyboard, Composition.Sound.Functional.Basics, Composition.Sound.Functional.Params, Composition.Sound.Functional.Elements -- other-modules: other-extensions: BangPatterns - build-depends: base >=4.8 && <4.15, bytestring >= 0.10.6 && <1, process >=1.4 && <1.9, mmsyn3 >=0.1.5 && <1, directory >=1.2.7 && <1.7, mmsyn7ukr-common >=0.1.1 && <1, mmsyn2-array >=0.1.1 && <1, ukrainian-phonetics-basic-array >=0.1.2 && <1, mmsyn7l >=0.9 && <1, phonetic-languages-simplified-base >=0.2 && <1, foldable-ix >=0.2 && <1, process-sequential >=0.1.1 && <1 + build-depends: base >=4.8 && <4.16, bytestring >= 0.10.6 && <1, process >=1.4 && <1.9, mmsyn3 >=0.1.5 && <1, directory >=1.2.7 && <1.7, mmsyn7ukr-common >=0.1.1 && <1, mmsyn2-array >=0.3 && <1, ukrainian-phonetics-basic-array >=0.4.1 && <1, mmsyn7l >=0.9 && <1, foldable-ix >=0.2 && <1, process-sequential >=0.1.1 && <1 -- hs-source-dirs: default-language: Haskell2010