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

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

module DobutokO.Sound.Effects.Spectrogram 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 DobutokO.Sound.ToRange
import qualified DobutokO.Sound.Effects.Timespec as TS
import DobutokO.Sound.Effects.Misc (MscS(..))

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

data SFloat1 a = X1 a | X a | Y1 a | Y a | Z1 a | Z a | Q a | W a | P a deriving SFloat1 a -> SFloat1 a -> Bool
(SFloat1 a -> SFloat1 a -> Bool)
-> (SFloat1 a -> SFloat1 a -> Bool) -> Eq (SFloat1 a)
forall a. Eq a => SFloat1 a -> SFloat1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SFloat1 a -> SFloat1 a -> Bool
$c/= :: forall a. Eq a => SFloat1 a -> SFloat1 a -> Bool
== :: SFloat1 a -> SFloat1 a -> Bool
$c== :: forall a. Eq a => SFloat1 a -> SFloat1 a -> Bool
Eq

instance Show (SFloat1 Float) where
  show :: SFloat1 Float -> String
show (X1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-x ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
200000.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
100.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
100.0 else Float -> Float -> Float
toRange Float
200000.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (X Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-X ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
5000.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
1.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
1.0 else Float -> Float -> Float
toRange Float
5000.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (Y1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-y ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
1200.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
64.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
64.0 else Float -> Float -> Float
toRange Float
1200.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (Y Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-Y ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
2050.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
130.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
130.0 else Float -> Float -> Float
toRange Float
2050.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (Z1 Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-z ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
180.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
20.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
20.0 else Float -> Float -> Float
toRange Float
180.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (Z Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-Z ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
100.0 Float
x) String
" "]
  show (Q Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-q ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
249.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]
  show (W Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-W ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float -> Float
toRange Float
10.0 Float
x) String
" "]
  show (P Float
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-p ", Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (if Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float -> Float
toRange Float
6.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) Float
1.0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Float
1.0 else Float -> Float -> Float
toRange Float
6.0 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x) String
" "]

type SFloat = SFloat1 Float

sFloat1C :: SFloat1 a -> String
sFloat1C :: SFloat1 a -> String
sFloat1C (X1 a
_) = String
"X1"
sFloat1C (X a
_) = String
"X"
sFloat1C (Y1 a
_) = String
"Y1"
sFloat1C (Y a
_) = String
"Y"
sFloat1C (Z1 a
_) = String
"Z1"
sFloat1C (Z a
_) = String
"Z"
sFloat1C (Q a
_) = String
"Q"
sFloat1C (W a
_) = String
"W"
sFloat1C SFloat1 a
_ = String
"P"

sFloat11 :: SFloat1 a -> a
sFloat11 :: SFloat1 a -> a
sFloat11 (X1 a
x) = a
x
sFloat11 (X a
x) = a
x
sFloat11 (Y1 a
x) = a
x
sFloat11 (Y a
x) = a
x
sFloat11 (Z1 a
x) = a
x
sFloat11 (Z a
x) = a
x
sFloat11 (Q a
x) = a
x
sFloat11 (W a
x) = a
x
sFloat11 (P a
x) = a
x

sFloat1Set1 :: a -> SFloat1 a -> SFloat1 a
sFloat1Set1 :: a -> SFloat1 a -> SFloat1 a
sFloat1Set1 a
x (X1 a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
X1 a
x
sFloat1Set1 a
x (X a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
X a
x
sFloat1Set1 a
x (Y1 a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
Y1 a
x
sFloat1Set1 a
x (Y a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
Y a
x
sFloat1Set1 a
x (Z1 a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
Z1 a
x
sFloat1Set1 a
x (Z a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
Z a
x
sFloat1Set1 a
x (Q a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
Q a
x
sFloat1Set1 a
x (W a
_) = a -> SFloat1 a
forall a. a -> SFloat1 a
W a
x
sFloat1Set1 a
x SFloat1 a
_ = a -> SFloat1 a
forall a. a -> SFloat1 a
P a
x

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

-- | For 'W1' the argument can be one of the following: \"Hann\" (default), \"Hamming\", \"Bartlett\", \"Rectangular\", \"Kaiser\", \"Dolph\".
instance Show (SString1 String) where
  show :: SString1 String -> String
show (W1 String
xs) 
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs Bool -> Bool -> Bool
|| Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
3 String
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Han" = []
    | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'B' = String
"-w Bartlett "
    | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'D' = String
"-w Dolph "
    | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'H' = String
"-w Hamming "
    | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'K' = String
"-w Kaiser "
    | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'R' = String
"-w Rectangular "
    | Bool
otherwise = String
""
  show (T String
xs) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-t ", String
xs , String
" "]
  show (C String
xs) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-c ", String
xs , String
" "]
  show (O String
xs) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-o ", String
xs , String
" "]

type SString = SString1 String

sString1C :: SString1 a -> String
sString1C :: SString1 a -> String
sString1C (W1 a
_) = String
"W1"
sString1C (T a
_) = String
"T"
sString1C (C a
_) = String
"C"
sString1C SString1 a
_ = String
"O"

sString11 :: SString1 a -> a
sString11 :: SString1 a -> a
sString11 (W1 a
x) = a
x
sString11 (T a
x) = a
x
sString11 (C a
x) = a
x
sString11 (O a
x) = a
x

sString1Set1 :: a -> SString1 a -> SString1 a
sString1Set1 :: a -> SString1 a -> SString1 a
sString1Set1 a
x (W1 a
_) = a -> SString1 a
forall a. a -> SString1 a
W1 a
x
sString1Set1 a
x (T a
_) = a -> SString1 a
forall a. a -> SString1 a
T a
x
sString1Set1 a
x (C a
_) = a -> SString1 a
forall a. a -> SString1 a
C a
x
sString1Set1 a
x (O a
_) = a -> SString1 a
forall a. a -> SString1 a
O a
x

data Spectr = S1 | M | H | L | A1 | A | R deriving Spectr -> Spectr -> Bool
(Spectr -> Spectr -> Bool)
-> (Spectr -> Spectr -> Bool) -> Eq Spectr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spectr -> Spectr -> Bool
$c/= :: Spectr -> Spectr -> Bool
== :: Spectr -> Spectr -> Bool
$c== :: Spectr -> Spectr -> Bool
Eq

instance Show Spectr where
  show :: Spectr -> String
show Spectr
S1 = String
"-s "
  show Spectr
M = String
"-m "
  show Spectr
H = String
"-h "
  show Spectr
L = String
"-l "
  show Spectr
A1 = String
"-a "
  show Spectr
A = String
"-A "
  show Spectr
_ = String
"-r "

data Advanced1 a = S a deriving Advanced1 a -> Advanced1 a -> Bool
(Advanced1 a -> Advanced1 a -> Bool)
-> (Advanced1 a -> Advanced1 a -> Bool) -> Eq (Advanced1 a)
forall a. Eq a => Advanced1 a -> Advanced1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Advanced1 a -> Advanced1 a -> Bool
$c/= :: forall a. Eq a => Advanced1 a -> Advanced1 a -> Bool
== :: Advanced1 a -> Advanced1 a -> Bool
$c== :: forall a. Eq a => Advanced1 a -> Advanced1 a -> Bool
Eq

instance Show (Advanced1 TS.TSpecification) where
  show :: Advanced1 TSpecification -> String
show (S TSpecification
x) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"-S ", TSpecification -> String
forall a. Show a => a -> String
show TSpecification
x]

advanced11 :: Advanced1 a -> a
advanced11 :: Advanced1 a -> a
advanced11 (S a
x) = a
x

advanced1Set1 :: a -> Advanced1 a
advanced1Set1 :: a -> Advanced1 a
advanced1Set1 = a -> Advanced1 a
forall a. a -> Advanced1 a
S

type PositionS = Advanced1 TS.TSpecification  

data DTSpec2 a b = DTs b | DTm a b | DTh a a b | DS a deriving DTSpec2 a b -> DTSpec2 a b -> Bool
(DTSpec2 a b -> DTSpec2 a b -> Bool)
-> (DTSpec2 a b -> DTSpec2 a b -> Bool) -> Eq (DTSpec2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq b, Eq a) => DTSpec2 a b -> DTSpec2 a b -> Bool
/= :: DTSpec2 a b -> DTSpec2 a b -> Bool
$c/= :: forall a b. (Eq b, Eq a) => DTSpec2 a b -> DTSpec2 a b -> Bool
== :: DTSpec2 a b -> DTSpec2 a b -> Bool
$c== :: forall a b. (Eq b, Eq a) => DTSpec2 a b -> DTSpec2 a b -> Bool
Eq

instance Show (DTSpec2 Int Float) where 
  show :: DTSpec2 Int Float -> String
show (DTs Float
y) = Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
y) String
"t"
  show (DTm Int
y Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y),String
":",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
z) String
"t"]
  show (DTh Int
y1 Int
y2 Float
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y1),String
":",Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y2),String
":",Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing (Float -> Float
forall a. Num a => a -> a
abs Float
z) String
"t"]
  show (DS Int
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs Int
y),String
"s"]

type FirstDTSpec = DTSpec2 Int Float

isTimeD :: DTSpec2 a b -> Bool
isTimeD :: DTSpec2 a b -> Bool
isTimeD (DS a
_) = Bool
False
isTimeD DTSpec2 a b
_ = Bool
True

isSamplesD :: DTSpec2 a b -> Bool
isSamplesD :: DTSpec2 a b -> Bool
isSamplesD (DS a
_) = Bool
True
isSamplesD DTSpec2 a b
_ = Bool
False

dTSpec2CD :: FirstDTSpec -> String
dTSpec2CD :: DTSpec2 Int Float -> String
dTSpec2CD (DTs Float
_) = String
"DTs"
dTSpec2CD (DTm Int
_ Float
_) = String
"DTm"
dTSpec2CD (DTh Int
_ Int
_ Float
_) = String
"DTh"
dTSpec2CD (DS Int
_) = String
"DS"

secondsD :: FirstDTSpec -> Maybe Float
secondsD :: DTSpec2 Int Float -> Maybe Float
secondsD (DTs Float
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Float
forall a. Num a => a -> a
abs Float
x)
secondsD (DTm Int
x Float
y) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Float
forall a. Num a => a -> a
abs Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Num a => a -> a
abs Int
x))
secondsD (DTh Int
x Int
y Float
z) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Float
forall a. Num a => a -> a
abs Float
z Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
3600 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Num a => a -> a
abs Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Num a => a -> a
abs Int
y))
secondsD DTSpec2 Int Float
_ = Maybe Float
forall a. Maybe a
Nothing

minutesD :: FirstDTSpec -> Maybe Int
minutesD :: DTSpec2 Int Float -> Maybe Int
minutesD (DTs Float
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float -> Float
forall a. Num a => a -> a
abs Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60.0)
minutesD (DTm Int
x Float
y) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
abs Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float
forall a. Num a => a -> a
abs Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60.0))
minutesD (DTh Int
x Int
y Float
z) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
abs Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float
forall a. Num a => a -> a
abs Float
z Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60.0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Num a => a -> a
abs Int
x)
minutesD DTSpec2 Int Float
_ = Maybe Int
forall a. Maybe a
Nothing

hoursD :: FirstDTSpec -> Maybe Int
hoursD :: DTSpec2 Int Float -> Maybe Int
hoursD (DTs Float
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float -> Float
forall a. Num a => a -> a
abs Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
3600.0)
hoursD (DTm Int
x Float
y) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
abs Int
x) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float
forall a. Num a => a -> a
abs Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
3600.0))
hoursD (DTh Int
x Int
y Float
z) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
abs Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Float
forall a. Num a => a -> a
abs Float
z Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
3600.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
abs Int
y) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60.0))
hoursD DTSpec2 Int Float
_ = Maybe Int
forall a. Maybe a
Nothing

samplesD :: FirstDTSpec -> Maybe Int
samplesD :: DTSpec2 Int Float -> Maybe Int
samplesD (DS Int
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
samplesD DTSpec2 Int Float
_ = Maybe Int
forall a. Maybe a
Nothing

seconds2FstDTSpec2 :: Float -> FirstDTSpec
seconds2FstDTSpec2 :: Float -> DTSpec2 Int Float
seconds2FstDTSpec2 Float
y = Float -> DTSpec2 Int Float
forall a b. b -> DTSpec2 a b
DTs (Float -> Float
forall a. Num a => a -> a
abs Float
y)

samples2FstDTSpec2 :: Int -> FirstDTSpec
samples2FstDTSpec2 :: Int -> DTSpec2 Int Float
samples2FstDTSpec2 Int
y = Int -> DTSpec2 Int Float
forall a b. a -> DTSpec2 a b
DS (Int -> Int
forall a. Num a => a -> a
abs Int
y)

type TSpec = TS.TimeSpec FirstDTSpec TS.NextTSpec

instance Show (TS.TimeSpec FirstDTSpec TS.NextTSpec) where
  show :: TimeSpec (DTSpec2 Int Float) NextTSpec -> String
show (TS.TS1 DTSpec2 Int Float
x) = DTSpec2 Int Float -> String
forall a. Show a => a -> String
show DTSpec2 Int Float
x
  show (TS.TS2 DTSpec2 Int Float
x [NextTSpec]
ys) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [DTSpec2 Int Float -> String
forall a. Show a => a -> String
show DTSpec2 Int Float
x,[String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([NextTSpec] -> [String]) -> [NextTSpec] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NextTSpec -> String) -> [NextTSpec] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NextTSpec -> String
forall a. Show a => a -> String
show ([NextTSpec] -> String) -> [NextTSpec] -> String
forall a b. (a -> b) -> a -> b
$ [NextTSpec]
ys]

data DurationD1 a = D a deriving DurationD1 a -> DurationD1 a -> Bool
(DurationD1 a -> DurationD1 a -> Bool)
-> (DurationD1 a -> DurationD1 a -> Bool) -> Eq (DurationD1 a)
forall a. Eq a => DurationD1 a -> DurationD1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DurationD1 a -> DurationD1 a -> Bool
$c/= :: forall a. Eq a => DurationD1 a -> DurationD1 a -> Bool
== :: DurationD1 a -> DurationD1 a -> Bool
$c== :: forall a. Eq a => DurationD1 a -> DurationD1 a -> Bool
Eq

instance Show (DurationD1 TSpec) where 
  show :: DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec) -> String
show (D TimeSpec (DTSpec2 Int Float) NextTSpec
x) = TimeSpec (DTSpec2 Int Float) NextTSpec -> String
forall a. Show a => a -> String
show TimeSpec (DTSpec2 Int Float) NextTSpec
x

type DurationD = DurationD1 TSpec

data Spectrogram3 a b c d e = SG [a] [b] [c] [d] [e] deriving Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool
(Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool)
-> (Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool)
-> Eq (Spectrogram3 a b c d e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e.
(Eq a, Eq b, Eq c, Eq d, Eq e) =>
Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool
/= :: Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool
$c/= :: forall a b c d e.
(Eq a, Eq b, Eq c, Eq d, Eq e) =>
Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool
== :: Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool
$c== :: forall a b c d e.
(Eq a, Eq b, Eq c, Eq d, Eq e) =>
Spectrogram3 a b c d e -> Spectrogram3 a b c d e -> Bool
Eq

instance Show (Spectrogram3 SFloat SString Spectr PositionS DurationD) where
  show :: Spectrogram3
  (SFloat1 Float)
  (SString1 String)
  Spectr
  (Advanced1 TSpecification)
  (DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec))
-> String
show (SG [SFloat1 Float]
xs [SString1 String]
ys [Spectr]
zs [Advanced1 TSpecification]
ts [DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec)]
us) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"spectrogram ", MscS (SFloat1 Float) -> String
forall a. Show a => a -> String
show ([SFloat1 Float] -> MscS (SFloat1 Float)
forall a. [a] -> MscS a
Msc [SFloat1 Float]
xs), MscS (SString1 String) -> String
forall a. Show a => a -> String
show ([SString1 String] -> MscS (SString1 String)
forall a. [a] -> MscS a
Msc [SString1 String]
ys), MscS Spectr -> String
forall a. Show a => a -> String
show ([Spectr] -> MscS Spectr
forall a. [a] -> MscS a
Msc [Spectr]
zs), MscS (Advanced1 TSpecification) -> String
forall a. Show a => a -> String
show ([Advanced1 TSpecification] -> MscS (Advanced1 TSpecification)
forall a. [a] -> MscS a
Msc [Advanced1 TSpecification]
ts), MscS (DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec))
-> String
forall a. Show a => a -> String
show ([DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec)]
-> MscS (DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec))
forall a. [a] -> MscS a
Msc [DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec)]
us)]
  
type Spectrogram = Spectrogram3 SFloat SString Spectr PositionS DurationD

spectrogram31 :: Spectrogram3 a b c d e -> [a]
spectrogram31 :: Spectrogram3 a b c d e -> [a]
spectrogram31 (SG [a]
xs [b]
_ [c]
_ [d]
_ [e]
_) = [a]
xs

spectrogram32 :: Spectrogram3 a b c d e -> [b]
spectrogram32 :: Spectrogram3 a b c d e -> [b]
spectrogram32 (SG [a]
_ [b]
ys [c]
_ [d]
_ [e]
_) = [b]
ys

spectrogram33 :: Spectrogram3 a b c d e -> [c]
spectrogram33 :: Spectrogram3 a b c d e -> [c]
spectrogram33 (SG [a]
_ [b]
_ [c]
zs [d]
_ [e]
_) = [c]
zs

spectrogram34 :: Spectrogram3 a b c d e -> [d]
spectrogram34 :: Spectrogram3 a b c d e -> [d]
spectrogram34 (SG [a]
_ [b]
_ [c]
_ [d]
ts [e]
_) = [d]
ts

spectrogram35 :: Spectrogram3 a b c d e -> [e]
spectrogram35 :: Spectrogram3 a b c d e -> [e]
spectrogram35 (SG [a]
_ [b]
_ [c]
_ [d]
_ [e]
us) = [e]
us

spectrogramSet31 :: [a] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet31 :: [a] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet31 [a]
xs (SG [a]
_ [b]
ys [c]
zs [d]
ts [e]
us) = [a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
SG [a]
xs [b]
ys [c]
zs [d]
ts [e]
us

spectrogramSet32 :: [b] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet32 :: [b] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet32 [b]
ys (SG [a]
xs [b]
_ [c]
zs [d]
ts [e]
us) = [a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
SG [a]
xs [b]
ys [c]
zs [d]
ts [e]
us

spectrogramSet33 :: [c] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet33 :: [c] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet33 [c]
zs (SG [a]
xs [b]
ys [c]
_ [d]
ts [e]
us) = [a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
SG [a]
xs [b]
ys [c]
zs [d]
ts [e]
us

spectrogramSet34 :: [d] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet34 :: [d] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet34 [d]
ts (SG [a]
xs [b]
ys [c]
zs [d]
_ [e]
us) = [a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
SG [a]
xs [b]
ys [c]
zs [d]
ts [e]
us

spectrogramSet35 :: [e] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet35 :: [e] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e
spectrogramSet35 [e]
us (SG [a]
xs [b]
ys [c]
zs [d]
ts [e]
_) = [a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> Spectrogram3 a b c d e
SG [a]
xs [b]
ys [c]
zs [d]
ts [e]
us

showSGQ :: Spectrogram -> [String]
showSGQ :: Spectrogram3
  (SFloat1 Float)
  (SString1 String)
  Spectr
  (Advanced1 TSpecification)
  (DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec))
-> [String]
showSGQ = String -> [String]
words (String -> [String])
-> (Spectrogram3
      (SFloat1 Float)
      (SString1 String)
      Spectr
      (Advanced1 TSpecification)
      (DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec))
    -> String)
-> Spectrogram3
     (SFloat1 Float)
     (SString1 String)
     Spectr
     (Advanced1 TSpecification)
     (DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec))
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spectrogram3
  (SFloat1 Float)
  (SString1 String)
  Spectr
  (Advanced1 TSpecification)
  (DurationD1 (TimeSpec (DTSpec2 Int Float) NextTSpec))
-> String
forall a. Show a => a -> String
show