Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Continous controller event and Ctl systems for external control interfaces.
Synopsis
- type CcEvent t = (Int, t, t, t, t, t, t, t, t, t, t)
- cc_event_from_list :: Num t => Int -> [t] -> CcEvent t
- type CcEventMeta t = (t, t, t)
- ccEventMetaDefault :: Num n => CcEventMeta n
- ccEventMetaControls :: CcEventMeta Int -> CcEventMeta Ugen
- ccEventAddr :: (Ugen, Ugen, Ugen) -> Int -> CcEvent Ugen
- ccEventVoicerAddr :: CcEventMeta Ugen -> Int -> (CcEvent Ugen -> Ugen) -> Ugen
- ccEventVoicer :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
- voicer :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
- ccEventVoicerParam :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
- ccEventGateReset :: Ugen -> Ugen -> (Ugen, Ugen)
- type Ctl8 = (Ugen, Ugen, Ugen, Ugen, Ugen, Ugen, Ugen, Ugen)
- ctl8At :: Int -> Ctl8
- ctl8Voicer :: Int -> (Int -> Ctl8 -> Ugen) -> Ugen
- type Ctl16 = (Ctl8, Ctl8)
- ctl16Voicer :: Int -> (Int -> Ctl16 -> Ugen) -> Ugen
- type ControlSpec t = (String, t, (t, t, String))
- control_spec_parse :: String -> ControlSpec Double
- control_spec_seq_parse :: String -> [ControlSpec Double]
- control_spec_print :: ControlSpec Double -> String
- control_spec_seq_print :: [ControlSpec Double] -> String
- control_spec_to_control :: ControlSpec Double -> Control
- sc3_control_spec :: Fractional t => [ControlSpec t]
- kyma_event_value_ranges :: Fractional t => [ControlSpec t]
Cc Event
type CcEvent t = (Int, t, t, t, t, t, t, t, t, t, t) Source #
(v, w, x, y, z, o, rx, ry, p, px, _)
v = voice, w = gate, z = force/pressure, o = orientation/angle, r = radius, p = pitch
type CcEventMeta t = (t, t, t) Source #
(ccEventAddr, ccEventIncr, ccEventZero)
ccEventAddr = k0 = index of control bus zero for event system, ccEventIncr = stp = voice index increment, ccEventZero = c0 = offset for event voices at current server
ccEventMetaDefault :: Num n => CcEventMeta n Source #
ccEventVoicerAddr :: CcEventMeta Ugen -> Int -> (CcEvent Ugen -> Ugen) -> Ugen Source #
c0 = index of voice (channel) zero for event set, n = number of voices (channels)
ccEventVoicer :: Int -> (CcEvent Ugen -> Ugen) -> Ugen Source #
eventVoicerAddr
with default (addr, inct, zero).
ccEventVoicerParam :: Int -> (CcEvent Ugen -> Ugen) -> Ugen Source #
eventVoicerAddr
with control
inputs for eventAddr, eventIncr and eventZero.
Ctl
type Ctl8 = (Ugen, Ugen, Ugen, Ugen, Ugen, Ugen, Ugen, Ugen) Source #
Sequence of 8 continous controller inputs in range (0-1).
ctl8Voicer :: Int -> (Int -> Ctl8 -> Ugen) -> Ugen Source #
ctlVoicerAddr
with control
inputs for CtlAddr and CtlZero.
type Ctl16 = (Ctl8, Ctl8) Source #
Sequence of 16 continous controller inputs arranged as two Ctl8 sequences.
ctl16Voicer :: Int -> (Int -> Ctl16 -> Ugen) -> Ugen Source #
ctl16VoicerAddr
with control
inputs for CtlAddr and CtlZero.
Names
type ControlSpec t = (String, t, (t, t, String)) Source #
Control Specificier. (name,default,(minValue,maxValue,warpName))
control_spec_parse :: String -> ControlSpec Double Source #
Comma separated, no spaces.
control_spec_seq_parse :: String -> [ControlSpec Double] Source #
Semicolon separated, no spaces.
control_spec_seq_parse "freq:220,110,440,exp;amp:0.1,0,1,amp;pan:0,-1,1,lin"
control_spec_print :: ControlSpec Double -> String Source #
Comma separated, 6 decimal places, no spaces.
control_spec_seq_print :: [ControlSpec Double] -> String Source #
Semicolon separated, no spaces.
control_spec_seq_print (control_spec_seq_parse "freq:220,220,440,exp;amp:0.1,0,1,amp;pan:0,-1,1,lin")
sc3_control_spec :: Fractional t => [ControlSpec t] Source #
See SCClassLibraryCommonControl/Spec:ControlSpec.initClass
"ControlSpec defines the range and curve of a control"
This list adds default values.
kyma_event_value_ranges :: Fractional t => [ControlSpec t] Source #
See Kyma X Revealed, p.403
"The following EventValue names are associated with initial ranges other than (0,1). EventValue names are not case-sensitive."
This list adds curve specifiers as strings and default values.
let x = Data.List.intersect (map fst sc3_control_spec) (map fst kyma_event_value_ranges) x == ["beats","boostcut","freq","rate"] let c z = let (p,q) = unzip z in let f i = filter (flip elem i . fst) in zip (f p sc3_control_spec) (f q kyma_event_value_ranges) c (zip x x)
c [("lofreq","freqlow"),("midfreq","freqmid")] lookup "freqhigh" kyma_event_value_ranges