-- |
-- Module      :  DobutokO.Sound.Frequency
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music. 
-- Can be used for applying the SoX \"synth\" effect and frequency modulation. 
-- 

{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP, FlexibleInstances #-}

module DobutokO.Sound.Frequency where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import Numeric (showFFloat)
import Data.List (intersperse)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

data Frequency a b c = F a b [c] | F2 a a b [c] deriving Frequency a b c -> Frequency a b c -> Bool
(Frequency a b c -> Frequency a b c -> Bool)
-> (Frequency a b c -> Frequency a b c -> Bool)
-> Eq (Frequency a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
Frequency a b c -> Frequency a b c -> Bool
/= :: Frequency a b c -> Frequency a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
Frequency a b c -> Frequency a b c -> Bool
== :: Frequency a b c -> Frequency a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
Frequency a b c -> Frequency a b c -> Bool
Eq

instance Show (Frequency Float Int Char) where
  show :: Frequency Float Int Char -> String
show (F Float
x Int
n String
xs) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Float
x String
xs
  show (F2 Float
x1 Float
x2 Int
n String
xs) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Float
x1 (Int -> String -> Float -> Float -> String
forall a. RealFloat a => Int -> String -> a -> a -> String
freqChange Int
n String
xs Float
x2 Float
x1)

freqChange :: (RealFloat a) => Int -> String -> a -> a -> String
freqChange :: Int -> String -> a -> a -> String
freqChange Int
n String
xs a
freq a
freq1 
 | a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
freq a
16 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
freq a
20000 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
freq1 a
16 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
freq1 a
20000 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT = if a
freq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
freq1 then
   case String
xs of 
    String
"l" -> Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) a
freq String
""
    String
"s" -> Char
'+'Char -> ShowS
forall a. a -> [a] -> [a]
:Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) a
freq String
""
    String
"e" -> Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) a
freq String
""
    String
_ -> Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) a
freq String
"" 
     else String
""
 | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error String
"DobutokO.Sound.Frequency.freqChange: undefined for this value of the frequencies. "  
 
data Swept a b c = SineS a b c | SquareS a b c | TriangleS a b c | SawtoothS a b c | TrapeziumS a b c | ExpS a b c
  deriving Swept a b c -> Swept a b c -> Bool
(Swept a b c -> Swept a b c -> Bool)
-> (Swept a b c -> Swept a b c -> Bool) -> Eq (Swept a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
Swept a b c -> Swept a b c -> Bool
/= :: Swept a b c -> Swept a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
Swept a b c -> Swept a b c -> Bool
== :: Swept a b c -> Swept a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
Swept a b c -> Swept a b c -> Bool
Eq

sweptC :: Swept a b c -> String
sweptC :: Swept a b c -> String
sweptC (SineS a
_ b
_ c
_) = String
"sine"
sweptC (SquareS a
_ b
_ c
_) = String
"square"
sweptC (TriangleS a
_ b
_ c
_) = String
"triangle"
sweptC (SawtoothS a
_ b
_ c
_) = String
"sawtooth"
sweptC (TrapeziumS a
_ b
_ c
_) = String
"trapezium"
sweptC (ExpS a
_ b
_ c
_) = String
"exp"

swept1 :: Swept a b c -> a
swept1 :: Swept a b c -> a
swept1 (SineS a
x b
_ c
_) = a
x
swept1 (SquareS a
x b
_ c
_) = a
x
swept1 (TriangleS a
x b
_ c
_) = a
x
swept1 (SawtoothS a
x b
_ c
_) = a
x
swept1 (TrapeziumS a
x b
_ c
_) = a
x
swept1 (ExpS a
x b
_ c
_) = a
x

swept1N :: Int -> Swept [Float] b c -> Float
swept1N :: Int -> Swept [Float] b c -> Float
swept1N Int
n Swept [Float] b c
x 
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Float] -> Float
forall a. [a] -> a
head ([Float] -> Float)
-> (Swept [Float] b c -> [Float]) -> Swept [Float] b c -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swept [Float] b c -> [Float]
forall a b c. Swept a b c -> a
swept1 (Swept [Float] b c -> Float) -> Swept [Float] b c -> Float
forall a b. (a -> b) -> a -> b
$ Swept [Float] b c
x
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
7 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = 
    if [Float] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Float] -> Bool)
-> (Swept [Float] b c -> [Float]) -> Swept [Float] b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Float] -> [Float])
-> (Swept [Float] b c -> [Float]) -> Swept [Float] b c -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
n ([Float] -> [Float])
-> (Swept [Float] b c -> [Float]) -> Swept [Float] b c -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swept [Float] b c -> [Float]
forall a b c. Swept a b c -> a
swept1 (Swept [Float] b c -> Bool) -> Swept [Float] b c -> Bool
forall a b. (a -> b) -> a -> b
$ Swept [Float] b c
x then String -> Float
forall a. HasCallStack => String -> a
error (String -> Float) -> String -> Float
forall a b. (a -> b) -> a -> b
$ String
"DobutokO.Sound.Frequency.swept1N: Not defined for the arguments. " 
    else [Float] -> Float
forall a. [a] -> a
head ([Float] -> Float)
-> (Swept [Float] b c -> [Float]) -> Swept [Float] b c -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Float] -> [Float])
-> (Swept [Float] b c -> [Float]) -> Swept [Float] b c -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
n ([Float] -> [Float])
-> (Swept [Float] b c -> [Float]) -> Swept [Float] b c -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swept [Float] b c -> [Float]
forall a b c. Swept a b c -> a
swept1 (Swept [Float] b c -> Float) -> Swept [Float] b c -> Float
forall a b. (a -> b) -> a -> b
$ Swept [Float] b c
x
 | Bool
otherwise = String -> Float
forall a. HasCallStack => String -> a
error (String -> Float) -> String -> Float
forall a b. (a -> b) -> a -> b
$ String
"DobutokO.Sound.Frequency.swept1N: Not defined for the first argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

toRange100 :: Float -> Float
toRange100 :: Float -> Float
toRange100 Float
percent = Float -> Float
forall a. Num a => a -> a
abs Float
percent Float -> Float -> Float
forall a. Num a => a -> a -> a
- Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float
forall a. Num a => a -> a
abs Float
percent Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100)

swept1N100 :: Int -> Swept [Float] b c -> Float
swept1N100 :: Int -> Swept [Float] b c -> Float
swept1N100 Int
n = Float -> Float
toRange100 (Float -> Float)
-> (Swept [Float] b c -> Float) -> Swept [Float] b c -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Swept [Float] b c -> Float
forall b c. Int -> Swept [Float] b c -> Float
swept1N Int
n

swept2 :: Swept a b c -> b
swept2 :: Swept a b c -> b
swept2 (SineS a
_ b
x c
_) = b
x
swept2 (SquareS a
_ b
x c
_) = b
x
swept2 (TriangleS a
_ b
x c
_) = b
x
swept2 (SawtoothS a
_ b
x c
_) = b
x
swept2 (TrapeziumS a
_ b
x c
_) = b
x
swept2 (ExpS a
_ b
x c
_) = b
x

swept3 :: Swept a b c -> c
swept3 :: Swept a b c -> c
swept3 (SineS a
_ b
_ c
x) = c
x
swept3 (SquareS a
_ b
_ c
x) = c
x
swept3 (TriangleS a
_ b
_ c
x) = c
x
swept3 (SawtoothS a
_ b
_ c
x) = c
x
swept3 (TrapeziumS a
_ b
_ c
x) = c
x
swept3 (ExpS a
_ b
_ c
x) = c
x


instance Show (Swept [Float] String Int) where
  show :: Swept [Float] String Int -> String
show Swept [Float] String Int
x 
   | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Float] -> Int)
-> (Swept [Float] String Int -> [Float])
-> Swept [Float] String Int
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swept [Float] String Int -> [Float]
forall a b c. Swept a b c -> a
swept1 (Swept [Float] String Int -> Int)
-> Swept [Float] String Int -> Int
forall a b. (a -> b) -> a -> b
$ Swept [Float] String Int
x) Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Swept [Float] String Int -> String
forall a b c. Swept a b c -> String
sweptC Swept [Float] String Int
x, String
" ", Frequency Float Int Char -> String
forall a. Show a => a -> String
show (Float -> Float -> Int -> String -> Frequency Float Int Char
forall a b c. a -> a -> b -> [c] -> Frequency a b c
F2 (Int -> Swept [Float] String Int -> Float
forall b c. Int -> Swept [Float] b c -> Float
swept1N Int
1 Swept [Float] String Int
x) (Int -> Swept [Float] String Int -> Float
forall b c. Int -> Swept [Float] b c -> Float
swept1N Int
2 Swept [Float] String Int
x) (Swept [Float] String Int -> Int
forall a b c. Swept a b c -> c
swept3 Swept [Float] String Int
x) (Swept [Float] String Int -> String
forall a b c. Swept a b c -> b
swept2 Swept [Float] String Int
x)), String
" ",
     if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Float] -> Int)
-> (Swept [Float] String Int -> [Float])
-> Swept [Float] String Int
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swept [Float] String Int -> [Float]
forall a b c. Swept a b c -> a
swept1 (Swept [Float] String Int -> Int)
-> Swept [Float] String Int -> Int
forall a b. (a -> b) -> a -> b
$ Swept [Float] String Int
x) Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String]) -> ([Int] -> [String]) -> [Int] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
z -> Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just (Swept [Float] String Int -> Int
forall a b c. Swept a b c -> c
swept3 Swept [Float] String Int
x)) (Int -> Swept [Float] String Int -> Float
forall b c. Int -> Swept [Float] b c -> Float
swept1N100 Int
z Swept [Float] String Int
x) String
"") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int
3..[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Swept [Float] String Int -> [Float]
forall a b c. Swept a b c -> a
swept1 Swept [Float] String Int
x)]
     else String
""]
   | Bool
otherwise = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$String
"DobutokO.Sound.Frequency.show: Too less arguments for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Float] -> String
forall a. Show a => a -> String
show (Swept [Float] String Int -> [Float]
forall a b c. Swept a b c -> a
swept1 Swept [Float] String Int
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" sweep the frequencies to show them. "

data Single a b = Whitenoise a b | Tpdfnoise a b | Pinknoise a b | Brownnoise a b | Pluck a b | Sine a b | Square a b | Triangle a b | Sawtooth a b | 
  Trapezium a b | Exp a b 
    deriving Single a b -> Single a b -> Bool
(Single a b -> Single a b -> Bool)
-> (Single a b -> Single a b -> Bool) -> Eq (Single a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Single a b -> Single a b -> Bool
/= :: Single a b -> Single a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Single a b -> Single a b -> Bool
== :: Single a b -> Single a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Single a b -> Single a b -> Bool
Eq

singleC :: Single a b -> String
singleC :: Single a b -> String
singleC (Whitenoise a
_ b
_) = String
"whitenoise"
singleC (Tpdfnoise a
_ b
_) = String
"tpdfnoise"
singleC (Pinknoise a
_ b
_) = String
"pinknoise"
singleC (Brownnoise a
_ b
_) = String
"brownnoise"
singleC (Pluck a
_ b
_) = String
"pluck"
singleC (Sine a
_ b
_) = String
"sine"
singleC (Square a
_ b
_) = String
"square"
singleC (Triangle a
_ b
_) = String
"triangle"
singleC (Sawtooth a
_ b
_) = String
"sawtooth"
singleC (Trapezium a
_ b
_) = String
"trapezium"
singleC (Exp a
_ b
_) = String
"exp"

single1 :: Single a b -> a
single1 :: Single a b -> a
single1 (Whitenoise a
x b
_) = a
x
single1 (Tpdfnoise a
x b
_) = a
x
single1 (Pinknoise a
x b
_) = a
x
single1 (Brownnoise a
x b
_) = a
x
single1 (Pluck a
x b
_) = a
x
single1 (Sine a
x b
_) = a
x
single1 (Square a
x b
_) = a
x
single1 (Triangle a
x b
_) = a
x
single1 (Sawtooth a
x b
_) = a
x
single1 (Trapezium a
x b
_) = a
x
single1 (Exp a
x b
_) = a
x

single1N :: Int -> Single [Float] b -> Float
single1N :: Int -> Single [Float] b -> Float
single1N Int
n Single [Float] b
x 
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Float] -> Float
forall a. [a] -> a
head ([Float] -> Float)
-> (Single [Float] b -> [Float]) -> Single [Float] b -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Single [Float] b -> [Float]
forall a b. Single a b -> a
single1 (Single [Float] b -> Float) -> Single [Float] b -> Float
forall a b. (a -> b) -> a -> b
$ Single [Float] b
x
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
6 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = 
    if [Float] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Float] -> Bool)
-> (Single [Float] b -> [Float]) -> Single [Float] b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Float] -> [Float])
-> (Single [Float] b -> [Float]) -> Single [Float] b -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
n ([Float] -> [Float])
-> (Single [Float] b -> [Float]) -> Single [Float] b -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Single [Float] b -> [Float]
forall a b. Single a b -> a
single1 (Single [Float] b -> Bool) -> Single [Float] b -> Bool
forall a b. (a -> b) -> a -> b
$ Single [Float] b
x then String -> Float
forall a. HasCallStack => String -> a
error (String -> Float) -> String -> Float
forall a b. (a -> b) -> a -> b
$ String
"DobutokO.Sound.Frequency.single1N: Not defined for the arguments. " 
    else [Float] -> Float
forall a. [a] -> a
head ([Float] -> Float)
-> (Single [Float] b -> [Float]) -> Single [Float] b -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Float] -> [Float])
-> (Single [Float] b -> [Float]) -> Single [Float] b -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
n ([Float] -> [Float])
-> (Single [Float] b -> [Float]) -> Single [Float] b -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Single [Float] b -> [Float]
forall a b. Single a b -> a
single1 (Single [Float] b -> Float) -> Single [Float] b -> Float
forall a b. (a -> b) -> a -> b
$ Single [Float] b
x
 | Bool
otherwise = String -> Float
forall a. HasCallStack => String -> a
error (String -> Float) -> String -> Float
forall a b. (a -> b) -> a -> b
$ String
"DobutokO.Sound.Frequency.single1N: Not defined for the first argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

single1N100 :: Int -> Single [Float] b -> Float
single1N100 :: Int -> Single [Float] b -> Float
single1N100 Int
n = Float -> Float
toRange100 (Float -> Float)
-> (Single [Float] b -> Float) -> Single [Float] b -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Single [Float] b -> Float
forall b. Int -> Single [Float] b -> Float
single1N Int
n

single2 :: Single a b -> b
single2 :: Single a b -> b
single2 (Whitenoise a
_ b
x) = b
x
single2 (Tpdfnoise a
_ b
x) = b
x
single2 (Pinknoise a
_ b
x) = b
x
single2 (Brownnoise a
_ b
x) = b
x
single2 (Pluck a
_ b
x) = b
x
single2 (Sine a
_ b
x) = b
x
single2 (Square a
_ b
x) = b
x
single2 (Triangle a
_ b
x) = b
x
single2 (Sawtooth a
_ b
x) = b
x
single2 (Trapezium a
_ b
x) = b
x
single2 (Exp a
_ b
x) = b
x

instance Show (Single [Float] Int) where
  show :: Single [Float] Int -> String
show Single [Float] Int
x 
   | [Float] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Float] -> Bool)
-> (Single [Float] Int -> [Float]) -> Single [Float] Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Single [Float] Int -> [Float]
forall a b. Single a b -> a
single1 (Single [Float] Int -> Bool) -> Single [Float] Int -> Bool
forall a b. (a -> b) -> a -> b
$ Single [Float] Int
x = ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"DobutokO.Sound.Frequency.show: Too less arguments. "
   | Bool
otherwise = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Single [Float] Int -> String
forall a b. Single a b -> String
singleC Single [Float] Int
x, String
" ", Frequency Float Int Char -> String
forall a. Show a => a -> String
show (Float -> Int -> String -> Frequency Float Int Char
forall a b c. a -> b -> [c] -> Frequency a b c
F (Int -> Single [Float] Int -> Float
forall b. Int -> Single [Float] b -> Float
single1N Int
1 Single [Float] Int
x) (Single [Float] Int -> Int
forall a b. Single a b -> b
single2 Single [Float] Int
x) String
""), String
" ",
      if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Float] -> Int)
-> (Single [Float] Int -> [Float]) -> Single [Float] Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Single [Float] Int -> [Float]
forall a b. Single a b -> a
single1 (Single [Float] Int -> Int) -> Single [Float] Int -> Int
forall a b. (a -> b) -> a -> b
$ Single [Float] Int
x) Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT 
        then [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String]) -> ([Int] -> [String]) -> [Int] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
z -> Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just (Single [Float] Int -> Int
forall a b. Single a b -> b
single2 Single [Float] Int
x)) (Int -> Single [Float] Int -> Float
forall b. Int -> Single [Float] b -> Float
single1N100 Int
z Single [Float] Int
x) String
"") ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int
2..[Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Single [Float] Int -> [Float]
forall a b. Single a b -> a
single1 Single [Float] Int
x)]
        else if ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Float] -> Int)
-> (Single [Float] Int -> [Float]) -> Single [Float] Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Single [Float] Int -> [Float]
forall a b. Single a b -> a
single1 (Single [Float] Int -> Int) -> Single [Float] Int -> Int
forall a b. (a -> b) -> a -> b
$ Single [Float] Int
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then  Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just (Single [Float] Int -> Int
forall a b. Single a b -> b
single2 Single [Float] Int
x)) (Int -> Single [Float] Int -> Float
forall b. Int -> Single [Float] b -> Float
single1N100 Int
1 Single [Float] Int
x) String
"" else String
""]

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

data Di = O | T deriving Di -> Di -> Bool
(Di -> Di -> Bool) -> (Di -> Di -> Bool) -> Eq Di
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Di -> Di -> Bool
$c/= :: Di -> Di -> Bool
== :: Di -> Di -> Bool
$c== :: Di -> Di -> Bool
Eq

data Choice a b c d = C2 (Swept a b c) (Single a c) d
    deriving Choice a b c d -> Choice a b c d -> Bool
(Choice a b c d -> Choice a b c d -> Bool)
-> (Choice a b c d -> Choice a b c d -> Bool)
-> Eq (Choice a b c d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d.
(Eq a, Eq b, Eq c, Eq d) =>
Choice a b c d -> Choice a b c d -> Bool
/= :: Choice a b c d -> Choice a b c d -> Bool
$c/= :: forall a b c d.
(Eq a, Eq b, Eq c, Eq d) =>
Choice a b c d -> Choice a b c d -> Bool
== :: Choice a b c d -> Choice a b c d -> Bool
$c== :: forall a b c d.
(Eq a, Eq b, Eq c, Eq d) =>
Choice a b c d -> Choice a b c d -> Bool
Eq

choice1 :: Choice a b c d -> Swept a b c
choice1 :: Choice a b c d -> Swept a b c
choice1 (C2 Swept a b c
x Single a c
_ d
_) = Swept a b c
x

choice2 :: Choice a b c d -> Single a c
choice2 :: Choice a b c d -> Single a c
choice2 (C2 Swept a b c
_ Single a c
y d
_) = Single a c
y

choice3 :: Choice a b c d -> d
choice3 :: Choice a b c d -> d
choice3 (C2 Swept a b c
_ Single a c
_ d
z) = d
z

choiceSet1 :: Swept a b c -> Choice a b c d -> Choice a b c d
choiceSet1 :: Swept a b c -> Choice a b c d -> Choice a b c d
choiceSet1 Swept a b c
x (C2 Swept a b c
_ Single a c
y d
z) = Swept a b c -> Single a c -> d -> Choice a b c d
forall a b c d. Swept a b c -> Single a c -> d -> Choice a b c d
C2 Swept a b c
x Single a c
y d
z

choiceSet2 :: Single a c -> Choice a b c d -> Choice a b c d
choiceSet2 :: Single a c -> Choice a b c d -> Choice a b c d
choiceSet2 Single a c
y (C2 Swept a b c
x Single a c
_ d
z) = Swept a b c -> Single a c -> d -> Choice a b c d
forall a b c d. Swept a b c -> Single a c -> d -> Choice a b c d
C2 Swept a b c
x Single a c
y d
z

choiceSet3 :: d -> Choice a b c d -> Choice a b c d
choiceSet3 :: d -> Choice a b c d -> Choice a b c d
choiceSet3 d
z (C2 Swept a b c
x Single a c
y d
_) = Swept a b c -> Single a c -> d -> Choice a b c d
forall a b c d. Swept a b c -> Single a c -> d -> Choice a b c d
C2 Swept a b c
x Single a c
y d
z

instance Show (Choice [Float] String Int Di) where
  show :: Choice [Float] String Int Di -> String
show (C2 Swept [Float] String Int
y Single [Float] Int
_ Di
O) = Swept [Float] String Int -> String
forall a. Show a => a -> String
show Swept [Float] String Int
y
  show (C2 Swept [Float] String Int
_ Single [Float] Int
z Di
T) = Single [Float] Int -> String
forall a. Show a => a -> String
show Single [Float] Int
z

type Synth = Choice [Float] String Int Di

showQ :: Synth -> [String]
showQ :: Choice [Float] String Int Di -> [String]
showQ = String -> [String]
words (String -> [String])
-> (Choice [Float] String Int Di -> String)
-> Choice [Float] String Int Di
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choice [Float] String Int Di -> String
forall a. Show a => a -> String
show