module Synthesizer.MIDI.Value.BendWheelPressure where

import qualified Sound.MIDI.Message.Class.Check as Check
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import Sound.MIDI.Message.Channel (Channel, )

import qualified Data.Accessor.Monad.Trans.State as AccState
import qualified Data.Accessor.Basic as Accessor

import Control.Monad.Trans.State (State, get, )
import Control.Monad (msum, )

import Data.Traversable (sequence, )

import Control.DeepSeq (NFData, rnf, )

import Prelude hiding (sequence, )


data T = Cons {T -> Int
bend_, T -> Int
wheel_, T -> Int
pressure_ :: Int}
   deriving (Int -> T -> ShowS
[T] -> ShowS
T -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show, T -> T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq)

deflt :: T
deflt :: T
deflt = Int -> Int -> Int -> T
Cons Int
0 Int
0 Int
0


bend, wheel, pressure :: Accessor.T T Int
bend :: T T Int
bend =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet
      (\Int
b (Cons Int
_ Int
w Int
p) -> Int -> Int -> Int -> T
Cons Int
b Int
w Int
p)
      T -> Int
bend_

wheel :: T T Int
wheel =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet
      (\Int
w (Cons Int
b Int
_ Int
p) -> Int -> Int -> Int -> T
Cons Int
b Int
w Int
p)
      T -> Int
wheel_

pressure :: T T Int
pressure =
   forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet
      (\Int
p (Cons Int
b Int
w Int
_) -> Int -> Int -> Int -> T
Cons Int
b Int
w Int
p)
      T -> Int
pressure_


instance NFData T where
   rnf :: T -> ()
rnf (Cons Int
b Int
w Int
p) =
      case (forall a. NFData a => a -> ()
rnf Int
b, forall a. NFData a => a -> ()
rnf Int
w, forall a. NFData a => a -> ()
rnf Int
p) of
         ((), (), ()) -> ()


check ::
   Check.C event =>
   Channel -> event -> State T (Maybe T)
check :: forall event. C event => Channel -> event -> State T (Maybe T)
check Channel
chan event
ev =
   forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => StateT s m s
get)) forall a b. (a -> b) -> a -> b
$
   forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ event
ev) forall a b. (a -> b) -> a -> b
$
      (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) r a. Monad m => T r a -> a -> StateT r m ()
AccState.set T T Int
bend) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event. C event => Channel -> event -> Maybe Int
Check.pitchBend Channel
chan) forall a. a -> [a] -> [a]
:
      (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) r a. Monad m => T r a -> a -> StateT r m ()
AccState.set T T Int
wheel) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event.
C event =>
Channel -> Controller -> event -> Maybe Int
Check.controller Channel
chan Controller
VoiceMsg.modulation) forall a. a -> [a] -> [a]
:
      (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) r a. Monad m => T r a -> a -> StateT r m ()
AccState.set T T Int
pressure) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall event. C event => Channel -> event -> Maybe Int
Check.channelPressure Channel
chan) forall a. a -> [a] -> [a]
:
      []