{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP #-}
module DobutokO.Sound.Presentation (
SoundI (..)
, SoundFN (..)
, SoundT (..)
, Timity (..)
, Timity1 (..)
, IntervalTim (..)
, IntervalTimI (..)
, IntervalG (..)
) where
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import Data.Bifunctor
#endif
#endif
import Numeric (showFFloat)
import DobutokO.Sound.Functional.Basics
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
import Data.Semigroup
#endif
#endif
data SoundI = Si Int Double Double OvertonesO | SAi Int Double Double Double OvertonesO | SAbi Int Double Double Double OvertonesO
deriving Eq
data SoundFN = Sn FilePath String Double Double | SAn FilePath String Double Double Double | SAbn FilePath String Double Double Double
deriving Eq
data SoundT = StO Double Double Double Double OvertonesO | SAtO Double Double Double Double Double OvertonesO |
SAbtO Double Double Double Double Double OvertonesO deriving Eq
data Timity = Time Double Double Double deriving Eq
instance Ord Timity where
compare (Time t01 t11 t21) (Time t02 t12 t22)
| t01 /= t02 = compare t01 t02
| abs t11 /= abs t12 = compare (abs t11) (abs t12)
| otherwise = compare (abs t22) (abs t21)
instance Show Timity where
show (Time t0 t1 t2) = showFFloat Nothing t0 ":(" ++ showFFloat Nothing t1 "):(" ++ showFFloat Nothing t2 ")"
data Timity1 a = Time1 Double Double a
instance (Eq a) => Eq (Timity1 a) where
(==) (Time1 x1 x2 a0) (Time1 x3 x4 a1)
| a0 /= a1 = False
| x1 /= x3 = False
| otherwise = x2 == x4
instance (Ord a) => Ord (Timity1 a) where
compare (Time1 t01 t11 a0) (Time1 t02 t12 a1)
| t01 /= t02 = compare t01 t02
| abs t11 /= abs t12 = compare (abs t11) (abs t12)
| otherwise = compare a0 a1
instance (Show a) => Show (Timity1 a) where
show (Time1 t0 t1 a1) = showFFloat Nothing t0 ":(" ++ showFFloat Nothing t1 "):(" ++ show a1 ++ ")"
instance Functor Timity1 where
fmap f (Time1 t1 t2 a0) = Time1 t1 t2 (f a0)
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
instance (Semigroup a) => Semigroup (Timity1 a) where
(<>) (Time1 t01 t11 a0) (Time1 t02 t12 a1) = Time1 (min t01 t02) ((signum (t11 * t12)) * (max (t01 + (abs t11)) (t02 + (abs t12)) - min t01 t02))
(a0 <> a1)
#endif
#endif
data IntervalTim = I Double Double
instance Eq IntervalTim where
(==) (I x1 x2) (I y1 y2)
| x1 /= y1 = if x1 == y2 then x2 == y1 else False
| otherwise = x2 == y2
instance Ord IntervalTim where
compare (I x01 x02) (I x11 x12)
| min x01 x02 == min x11 x12 = compare (max x01 x02) (max x11 x12)
| otherwise = compare (min x01 x02) (min x11 x12)
instance Show IntervalTim where
show (I x1 x2)
| compare x1 x2 /= GT = "[" ++ showFFloat Nothing x1 ", " ++ showFFloat Nothing x2 "]"
| otherwise = "[" ++ showFFloat Nothing x2 ", " ++ showFFloat Nothing x1 "]"
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
instance Semigroup IntervalTim where
(<>) (I x01 x02) (I x11 x12) = I (minimum [x01,x02,x11,x12]) (maximum [x01,x02,x11,x12])
#endif
#endif
data IntervalTimI = II Double Double
instance Eq IntervalTimI where
(==) (II x1 x2) (II y1 y2)
| x1 /= y1 = if x1 == y2 then x2 == y1 else False
| otherwise = x2 == y2
instance Ord IntervalTimI where
compare (II x01 x02) (II x11 x12)
| min x01 x02 == min x11 x12 = compare (max x01 x02) (max x11 x12)
| otherwise = compare (min x01 x02) (min x11 x12)
instance Show IntervalTimI where
show (II x1 x2)
| compare x1 x2 /= GT = "[" ++ showFFloat Nothing x1 ", " ++ showFFloat Nothing x2 "]"
| otherwise = "[" ++ showFFloat Nothing x2 ", " ++ showFFloat Nothing x1 "]"
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
instance Semigroup IntervalTimI where
(<>) (II x01 x02) (II x11 x12) = II (max (min x01 x02) (min x11 x12)) (min (max x01 x02) (max x11 x12))
#endif
#endif
data SoundTim = StOm Timity Double OvertonesO | SAtOm Timity Double Double OvertonesO | SAbtOm Timity Double Double OvertonesO
deriving (Eq, Ord, Show)
data IntervalG a b = IG a b
instance (Eq a, Eq b) => Eq (IntervalG a b) where
(==) (IG a0 b0) (IG a1 b1)
| a0 /= a1 = False
| otherwise = b0 == b1
instance (Ord a, Ord b) => Ord (IntervalG a b) where
compare (IG a0 b0) (IG a1 b1)
| a0 /= a1 = compare a0 a1
| otherwise = compare b0 b1
instance (Show a, Show b) => Show (IntervalG a b) where
show (IG x y) = "[|" ++ show x ++ " __ " ++ show y ++ "|]"
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=804
/* code that applies only to GHC 8.4.* and higher versions */
instance Semigroup (IntervalG a b) where
(<>) (IG x0 _) (IG _ w1) = IG x0 w1
#endif
#endif
instance Functor (IntervalG a) where
fmap f (IG a b) = IG a (f b)
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
instance Bifunctor IntervalG where
bimap f g (IG x y) = IG (f x) (g y)
#endif
#endif