{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.MIDI.Value.BendModulation where
import qualified Synthesizer.MIDI.Value.BendWheelPressure as BWP
import qualified Synthesizer.MIDI.Value as MV
import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Ring as Ring
import Foreign.Storable (Storable(sizeOf, alignment, peek, poke), )
import qualified Foreign.Storable.Traversable as Store
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import Control.Applicative (Applicative, (<*>), pure, liftA2, )
import Control.DeepSeq (NFData, rnf, )
import NumericPrelude.Numeric
import NumericPrelude.Base
data T a = Cons {forall a. T a -> a
bend, forall a. T a -> a
depth :: a}
deriving (Int -> T a -> ShowS
forall a. Show a => Int -> T a -> ShowS
forall a. Show a => [T a] -> ShowS
forall a. Show a => T a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T a] -> ShowS
$cshowList :: forall a. Show a => [T a] -> ShowS
show :: T a -> String
$cshow :: forall a. Show a => T a -> String
showsPrec :: Int -> T a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> T a -> ShowS
Show, T a -> T a -> Bool
forall a. Eq a => T a -> T a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T a -> T a -> Bool
$c/= :: forall a. Eq a => T a -> T a -> Bool
== :: T a -> T a -> Bool
$c== :: forall a. Eq a => T a -> T a -> Bool
Eq)
deflt :: (Ring.C a) => T a
deflt :: forall a. C a => T a
deflt = forall a. a -> a -> T a
Cons forall a. C a => a
one forall a. C a => a
zero
instance (NFData a) => NFData (T a) where
rnf :: T a -> ()
rnf T a
bm =
case forall a. NFData a => a -> ()
rnf (forall a. T a -> a
bend T a
bm) of () -> forall a. NFData a => a -> ()
rnf (forall a. T a -> a
depth T a
bm)
instance Functor T where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> T a -> T b
fmap a -> b
f (Cons a
b a
m) = forall a. a -> a -> T a
Cons (a -> b
f a
b) (a -> b
f a
m)
instance Applicative T where
{-# INLINE pure #-}
pure :: forall a. a -> T a
pure a
a = forall a. a -> a -> T a
Cons a
a a
a
{-# INLINE (<*>) #-}
(Cons a -> b
fb a -> b
fm) <*> :: forall a b. T (a -> b) -> T a -> T b
<*> (Cons a
b a
m) =
forall a. a -> a -> T a
Cons (a -> b
fb a
b) (a -> b
fm a
m)
instance Fold.Foldable T where
{-# INLINE foldMap #-}
foldMap :: forall m a. Monoid m => (a -> m) -> T a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Trav.foldMapDefault
instance Trav.Traversable T where
{-# INLINE sequenceA #-}
sequenceA :: forall (f :: * -> *) a. Applicative f => T (f a) -> f (T a)
sequenceA (Cons f a
b f a
m) =
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> T a
Cons f a
b f a
m
force :: T a -> T a
force :: forall a. T a -> T a
force ~(Cons a
a a
b) = (forall a. a -> a -> T a
Cons a
a a
b)
instance (Storable a) => Storable (T a) where
{-# INLINE sizeOf #-}
sizeOf :: T a -> Int
sizeOf = forall (f :: * -> *) a. (Foldable f, Storable a) => f a -> Int
Store.sizeOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> T a
force
{-# INLINE alignment #-}
alignment :: T a -> Int
alignment = forall (f :: * -> *) a. (Foldable f, Storable a) => f a -> Int
Store.alignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T a -> T a
force
{-# INLINE peek #-}
peek :: Ptr (T a) -> IO (T a)
peek = forall (f :: * -> *) a.
(Applicative f, Traversable f, Storable a) =>
Ptr (f a) -> IO (f a)
Store.peekApplicative
{-# INLINE poke #-}
poke :: Ptr (T a) -> T a -> IO ()
poke = forall (f :: * -> *) a.
(Foldable f, Storable a) =>
Ptr (f a) -> f a -> IO ()
Store.poke
shift ::
(Ring.C a) =>
a -> T a -> T a
shift :: forall a. C a => a -> T a -> T a
shift a
k (Cons a
b a
d) = forall a. a -> a -> T a
Cons (a
kforall a. C a => a -> a -> a
*a
b) a
d
fromBendWheelPressure ::
(RealRing.C a, Trans.C a) =>
Int -> a -> a ->
BWP.T -> T a
fromBendWheelPressure :: forall a. (C a, C a) => Int -> a -> a -> T -> T a
fromBendWheelPressure
Int
pitchRange a
wheelDepth a
pressDepth T
bwp =
forall a. a -> a -> T a
Cons
(forall y. C y => y -> y -> Int -> y
MV.pitchBend (a
2forall a. C a => a -> a -> a
^?(forall a b. (C a, C b) => a -> b
fromIntegral Int
pitchRangeforall a. C a => a -> a -> a
/a
12)) a
1 (T -> Int
BWP.bend_ T
bwp))
(forall y. C y => (y, y) -> Int -> y
MV.controllerLinear (a
0,a
wheelDepth) (T -> Int
BWP.wheel_ T
bwp) forall a. C a => a -> a -> a
+
forall y. C y => (y, y) -> Int -> y
MV.controllerLinear (a
0,a
pressDepth) (T -> Int
BWP.pressure_ T
bwp))