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
additive_controls :: [Control]
additive_controls :: [Control]
additive_controls = [Control
octave, Control
diatonic, Control
chromatic, Control
nn, Control
hz]
null :: Control
null :: Control
null = Control
""
tempo :: Control
tempo :: Control
tempo = Control
"tempo"
dynamic :: Control
dynamic :: Control
dynamic = Control
"dyn"
sustain :: Control
sustain :: Control
sustain = Control
"sus"
sustain_abs :: Control
sustain_abs :: Control
sustain_abs = Control
"sus-abs"
sustain_set :: Control
sustain_set :: Control
sustain_set = Control
"sus-set"
start_s :: Control
start_s :: Control
start_s = Control
"start-s"
start_t :: Control
start_t :: Control
start_t = Control
"start-t"
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
mute :: Control
mute :: Control
mute = Control
"mute"
finger :: Control
finger :: Control
finger = Control
"finger"
breath :: Control
breath :: Control
breath = Control
"breath"
pressure :: Control
pressure :: Control
pressure = Control
"pressure"
aftertouch :: Control
aftertouch :: Control
aftertouch = Control
"at"
mod :: Control
mod :: Control
mod = Control
"mod"
attack_velocity :: Control
attack_velocity :: Control
attack_velocity = Control
"attack-vel"
release_velocity :: Control
release_velocity :: Control
release_velocity = Control
"release-vel"
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
octave :: Control
octave :: Control
octave = Control
"t-oct"
diatonic :: Control
diatonic :: Control
diatonic = Control
"t-dia"
chromatic :: Control
chromatic :: Control
chromatic = Control
"t-chrom"
nn :: Control
nn :: Control
nn = Control
"t-nn"
hz :: Control
hz :: Control
hz = Control
"t-hz"
vol :: Control
vol :: Control
vol = Control
"vol"
pan :: Control
pan :: Control
pan = Control
"pan"
pedal :: Control
pedal :: Control
pedal = Control
"pedal"
lpf, hpf :: Control
lpf :: Control
lpf = Control
"lpf"
hpf :: Control
hpf = Control
"hpf"
q :: Control
q :: Control
q = Control
"q"
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
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
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