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

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

module DobutokO.Sound.Effects.Pitch where


import Numeric (showFFloat)
import DobutokO.Sound.Effects.Segment

data Pitch a b c = Pt2 a b | Pt3 a b c deriving Pitch a b c -> Pitch a b c -> Bool
(Pitch a b c -> Pitch a b c -> Bool)
-> (Pitch a b c -> Pitch a b c -> Bool) -> Eq (Pitch a b c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
Pitch a b c -> Pitch a b c -> Bool
/= :: Pitch a b c -> Pitch a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
Pitch a b c -> Pitch a b c -> Bool
== :: Pitch a b c -> Pitch a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
Pitch a b c -> Pitch a b c -> Bool
Eq

instance Show (Pitch Qdash Float Segm) where
  show :: Pitch Qdash Float Segm -> String
show (Pt2 Qdash
x Float
y) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"pitch ", Qdash -> String
forall a. Show a => a -> String
show Qdash
x,Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y String
" "]
  show (Pt3 Qdash
x Float
y Segm
z) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"pitch ", Qdash -> String
forall a. Show a => a -> String
show Qdash
x, Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
y String
" ", Segm -> String
forall a. Show a => a -> String
show Segm
z]

type Ptch = Pitch Qdash Float Segm

pitchC :: Pitch a b c -> String
pitchC :: Pitch a b c -> String
pitchC (Pt2 a
_ b
_) = String
"Pt2"
pitchC (Pt3 a
_ b
_ c
_) = String
"Pt3"

pitch1 :: Pitch a b c -> a
pitch1 :: Pitch a b c -> a
pitch1 (Pt2 a
x b
_) = a
x
pitch1 (Pt3 a
x b
_ c
_) = a
x

pitch2 :: Pitch a b c -> b
pitch2 :: Pitch a b c -> b
pitch2 (Pt2 a
_ b
y) = b
y
pitch2 (Pt3 a
_ b
y c
_) = b
y

pitch3 :: Pitch a b c -> Maybe c
pitch3 :: Pitch a b c -> Maybe c
pitch3 (Pt3 a
_ b
_ c
z) = c -> Maybe c
forall a. a -> Maybe a
Just c
z
pitch3 Pitch a b c
_ = Maybe c
forall a. Maybe a
Nothing

pitchSet1 :: a -> Pitch a b c -> Pitch a b c
pitchSet1 :: a -> Pitch a b c -> Pitch a b c
pitchSet1 a
x (Pt2 a
_ b
y) = a -> b -> Pitch a b c
forall a b c. a -> b -> Pitch a b c
Pt2 a
x b
y
pitchSet1 a
x (Pt3 a
_ b
y c
z) = a -> b -> c -> Pitch a b c
forall a b c. a -> b -> c -> Pitch a b c
Pt3 a
x b
y c
z

pitchSet2 :: b -> Pitch a b c -> Pitch a b c
pitchSet2 :: b -> Pitch a b c -> Pitch a b c
pitchSet2 b
y (Pt2 a
x b
_) = a -> b -> Pitch a b c
forall a b c. a -> b -> Pitch a b c
Pt2 a
x b
y
pitchSet2 b
y (Pt3 a
x b
_ c
z) = a -> b -> c -> Pitch a b c
forall a b c. a -> b -> c -> Pitch a b c
Pt3 a
x b
y c
z

pitchSet3 :: c -> Pitch a b c -> Pitch a b c
pitchSet3 :: c -> Pitch a b c -> Pitch a b c
pitchSet3 c
z (Pt3 a
x b
y c
_) = a -> b -> c -> Pitch a b c
forall a b c. a -> b -> c -> Pitch a b c
Pt3 a
x b
y c
z
pitchSet3 c
z (Pt2 a
x b
y) = a -> b -> c -> Pitch a b c
forall a b c. a -> b -> c -> Pitch a b c
Pt3 a
x b
y c
z

showPtchQ :: Ptch -> [String]
showPtchQ :: Pitch Qdash Float Segm -> [String]
showPtchQ = String -> [String]
words (String -> [String])
-> (Pitch Qdash Float Segm -> String)
-> Pitch Qdash Float Segm
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch Qdash Float Segm -> String
forall a. Show a => a -> String
show