-- Copyright 2018 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Deriver code common to sampler patches.
module Synth.Sampler.Patch.Lib.Code where
import qualified Derive.Args as Args
import qualified Derive.Call as Call
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.EnvKey as EnvKey

import qualified Perform.Pitch as Pitch

import Global


-- | Modify a deriver to add 'Controls.variation'.  Only set it if it isn't
-- already set.
withVariation :: Derive.Deriver a -> Derive.Deriver a
withVariation :: forall a. Deriver a -> Deriver a
withVariation Deriver a
deriver =
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Control -> Deriver Bool
Derive.is_control_set Control
Controls.variation) Deriver a
deriver forall a b. (a -> b) -> a -> b
$ do
        Y
n <- forall a. Random a => Deriver a
Call.random
        forall a. Control -> Y -> Deriver a -> Deriver a
Derive.with_constant_control Control
Controls.variation Y
n Deriver a
deriver

-- | Like 'withVariation', but use a normal distribution.
withVariationNormal :: Double -> Derive.Deriver a -> Derive.Deriver a
withVariationNormal :: forall a. Y -> Deriver a -> Deriver a
withVariationNormal Y
stddev Deriver a
deriver =
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Control -> Deriver Bool
Derive.is_control_set Control
Controls.variation) Deriver a
deriver forall a b. (a -> b) -> a -> b
$ do
        Y
n <- Y -> Deriver Y
Call.normal Y
stddev
        forall a. Control -> Y -> Deriver a -> Deriver a
Derive.with_constant_control Control
Controls.variation Y
n Deriver a
deriver

addSymbolicPitch :: Derive.PassedArgs x -> Derive.Deriver a -> Derive.Deriver a
addSymbolicPitch :: forall x a. PassedArgs x -> Deriver a -> Deriver a
addSymbolicPitch PassedArgs x
args Deriver a
deriver = do
    Note
note <- RealTime -> Deriver State Error Note
Call.get_symbolic_pitch forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. PassedArgs a -> Deriver RealTime
Args.real_start PassedArgs x
args
    forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
EnvKey.element (Note -> Text
Pitch.note_text Note
note) Deriver a
deriver