-- Copyright 2013 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

-- | This module defines control names understood by the default calls, or by
-- the MIDI deriver.  There are also conventional names for certain controls
-- that instruments can use.  Although each instrument as its own independent
-- set of controls, they're easier to remember if they reuse some conventional
-- names.
module Derive.Controls where
import           Prelude hiding (null)
import qualified Data.Set as Set

import qualified Derive.EnvKey as EnvKey
import qualified Derive.ScoreT as ScoreT
import           Derive.ScoreT (Control(..))

import qualified Perform.Pitch as Pitch
import qualified Synth.Shared.Control as Shared.Control

import           Global


-- | These controls should be combined with addition by default instead of
-- multiplication.
additive_controls :: [Control]
additive_controls :: [Control]
additive_controls = [Control
octave, Control
diatonic, Control
chromatic, Control
nn, Control
hz]

-- | Used as the default control by control block calls.  This is because
-- a ControlCall produces a Signal, but for it to be derived in a block it
-- needs a temporary name.
null :: Control
null :: Control
null = Control
""

-- | The tempo track is handled differently than other controls, and winds up
-- in the warp rather than the 'ControlMap'.
tempo :: Control
tempo :: Control
tempo = Control
"tempo"

-- | Converted into velocity or breath depending on the instrument.
dynamic :: Control
dynamic :: Control
dynamic = Control
"dyn"

-- * generally understood by the note deriver

-- | Scale note duration.  This is multiplicative, so 1 is no change.
--
-- Note duration is documented in 'Derive.Call.Note.duration_attributes'.
sustain :: Control
sustain :: Control
sustain = Control
"sus"

-- | Add an absolute amount of real time to the duration of each note.
sustain_abs :: Control
sustain_abs :: Control
sustain_abs = Control
"sus-abs"

sustain_set :: Control
sustain_set :: Control
sustain_set = Control
"sus-set"

-- | Start offset, in RealTime.  This is added to event start times.  The end
-- times stay the same, so it changes note duration, and is limited to not
-- force a note to 0 duration.
start_s :: Control
start_s :: Control
start_s = Control
"start-s"

-- | Start offset, in ScoreTime.
start_t :: Control
start_t :: Control
start_t = Control
"start-t"

-- * internal

-- | Save ambient dyn before an integrate.  See usage in
-- "Cmd.Integrate.Convert".
dynamic_integrate :: Control
dynamic_integrate :: Control
dynamic_integrate = Control
"dyn-integrate"

integrate_keep :: Set Control
integrate_keep :: Set Control
integrate_keep =
    forall a. Ord a => [a] -> Set a
Set.fromList [Control
dynamic_integrate, Text -> Control
Control Text
EnvKey.voice]
    forall a. Semigroup a => a -> a -> a
<> Set Control
transposers

-- * specific to instruments

-- | Variable mute control, where 1 is fully muted.
mute :: Control
mute :: Control
mute = Control
"mute"

-- | Finger weight, when stopping a string.  In newtons.
finger :: Control
finger :: Control
finger = Control
"finger"

-- * understood by MIDI performer

-- | Breath controller.  Generally you should use 'dynamic', which will emit
-- velocity or breath depending on the instrument.
breath :: Control
breath :: Control
breath = Control
"breath"

-- | Channel pressure.
pressure :: Control
pressure :: Control
pressure = Control
"pressure"

-- | Polyphonic aftertouch.  Unlike other controls, this one can share
-- channels.
aftertouch :: Control
aftertouch :: Control
aftertouch = Control
"at"

-- | Modulation wheel.
mod :: Control
mod :: Control
mod = Control
"mod"

-- | Force MIDI note on velocity to this value.  Normally a Pressure instrument
-- will get both breath controller and note on velocity from the 'dynamic'
-- control, but sometimes I need separate control.  This can be used to
-- override the note on velocity.
attack_velocity :: Control
attack_velocity :: Control
attack_velocity = Control
"attack-vel"

-- | Normally the NoteOff velocity is the same as 'dynamic', but if set, this
-- force it to a particular value.
release_velocity :: Control
release_velocity :: Control
release_velocity = Control
"release-vel"

-- * transposition

-- | The common transpose controls.  A scale with special needs could still
-- have its own unique transposers, but most all scales should respond to
-- these.
transposers :: Set Control
transposers :: Set Control
transposers = forall a. Ord a => [a] -> Set a
Set.fromList [Control
octave, Control
diatonic, Control
chromatic, Control
nn, Control
hz]

transpose_control :: Pitch.Transpose -> (Double, Control)
transpose_control :: Transpose -> (Double, Control)
transpose_control Transpose
t = case Transpose
t of
    Pitch.Diatonic Double
d -> (Double
d, Control
diatonic)
    Pitch.Chromatic Double
d -> (Double
d, Control
chromatic)
    Pitch.Nn Double
d -> (Double
d, Control
nn)

transpose_type :: ScoreT.Type -> Maybe Control
transpose_type :: Type -> Maybe Control
transpose_type Type
t = case Type
t of
    Type
ScoreT.Diatonic -> forall a. a -> Maybe a
Just Control
diatonic
    Type
ScoreT.Chromatic -> forall a. a -> Maybe a
Just Control
chromatic
    Type
ScoreT.Nn -> forall a. a -> Maybe a
Just Control
nn
    Type
_ -> forall a. Maybe a
Nothing

-- | Transpose by this many octaves.
octave :: Control
octave :: Control
octave = Control
"t-oct"

-- | Pitches respond to this with diatonic transposition, which generally
-- requires a key.  This is stepwise transposition for scales with no
-- distinction between chromatic and diatonic.
diatonic :: Control
diatonic :: Control
diatonic = Control
"t-dia"

-- | Pitches respond to this with chromatic transposition.  This is stepwise
-- transposition for scales with no distinction between chromatic and diatonic.
chromatic :: Control
chromatic :: Control
chromatic = Control
"t-chrom"

-- | Transpose by NoteNumber, which is cents \/ 100.
nn :: Control
nn :: Control
nn = Control
"t-nn"

-- | Transpose in absolute hz.
hz :: Control
hz :: Control
hz = Control
"t-hz"

-- * conventional control names

-- | Volume control, conventionally mapped to CC 7.
vol :: Control
vol :: Control
vol = Control
"vol"

pan :: Control
pan :: Control
pan = Control
"pan"

-- | Sustain pedal.
pedal :: Control
pedal :: Control
pedal = Control
"pedal"

-- * standard names for patches

-- | Low and high pass filter cutoff.
lpf, hpf :: Control
lpf :: Control
lpf = Control
"lpf"
hpf :: Control
hpf = Control
"hpf"

-- | Filter resonance.
q :: Control
q :: Control
q = Control
"q"

-- | Often 'mod' is mapped to vibrato, but when it's more specifically vibrato
-- depth rather than general modulation, whatever that is, it's nicer to use
-- a more specific name.
vib, vib_speed :: Control
vib :: Control
vib = Control
"vib"
vib_speed :: Control
vib_speed = Control
"vib-speed"

mc :: Int -> Control
mc :: Int -> Control
mc = Text -> Control
ScoreT.Control forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"mc"<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt

-- | Macro controls.  Many synths have general-purpose "change the timbre"
-- knobs.
mc1, mc2, mc3, mc4 :: Control
mc1 :: Control
mc1 = Int -> Control
mc Int
1
mc2 :: Control
mc2 = Int -> Control
mc Int
2
mc3 :: Control
mc3 = Int -> Control
mc Int
3
mc4 :: Control
mc4 = Int -> Control
mc Int
4


-- * shared with im

variation :: Control
variation :: Control
variation = Control -> Control
from_shared Control
Shared.Control.variation

from_shared :: Shared.Control.Control -> Control
from_shared :: Control -> Control
from_shared (Shared.Control.Control Text
a) = Text -> Control
ScoreT.Control Text
a