-- | Continous controller event and Ctl systems for external control interfaces.
module Sound.Sc3.Ugen.Event where

import Data.List {- base -}

import Data.List.Split {- split -}

import Sound.Sc3.Common.Math {- hsc3 -}
import Sound.Sc3.Common.Rate {- hsc3 -}
import Sound.Sc3.Ugen.Bindings.Composite {- hsc3 -}
import Sound.Sc3.Ugen.Bindings.Db {- hsc3 -}
import Sound.Sc3.Ugen.Types {- hsc3 -}
import Sound.Sc3.Ugen.Util {- hsc3 -}

-- * Cc Event

{- | (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 CcEvent t = (Int, t, t, t, t, t, t, t, t, t, t)

-- | Translate list to Event.
cc_event_from_list :: Num t => Int -> [t] -> CcEvent t
cc_event_from_list :: forall t. Num t => Int -> [t] -> CcEvent t
cc_event_from_list Int
v [t]
l =
  case [t]
l of
    [t
w, t
x, t
y, t
z, t
o, t
rx, t
ry, t
p, t
px, t
py] -> (Int
v, t
w, t
x, t
y, t
z, t
o, t
rx, t
ry, t
p, t
px, t
py)
    [t]
_ -> [Char] -> CcEvent t
forall a. HasCallStack => [Char] -> a
error [Char]
"cc_event_from_list?"

{- | (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
-}
type CcEventMeta t = (t, t, t)

ccEventMetaDefault :: Num n => CcEventMeta n
ccEventMetaDefault :: forall n. Num n => CcEventMeta n
ccEventMetaDefault = (n
13000, n
10, n
0)

ccEventMetaControls :: CcEventMeta Int -> CcEventMeta Ugen
ccEventMetaControls :: CcEventMeta Int -> CcEventMeta Ugen
ccEventMetaControls (Int
p, Int
q, Int
r) =
  let k :: [Char] -> a -> Ugen
k [Char]
nm a
i = Rate -> [Char] -> Double -> Ugen
control Rate
kr [Char]
nm (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
  in ([Char] -> Int -> Ugen
forall {a}. Integral a => [Char] -> a -> Ugen
k [Char]
"ccEventAddr" Int
p, [Char] -> Int -> Ugen
forall {a}. Integral a => [Char] -> a -> Ugen
k [Char]
"ccEventIncr" Int
q, [Char] -> Int -> Ugen
forall {a}. Integral a => [Char] -> a -> Ugen
k [Char]
"ccEventZero" Int
r)

-- | c = event number (zero indexed)
ccEventAddr :: (Ugen, Ugen, Ugen) -> Int -> CcEvent Ugen
ccEventAddr :: CcEventMeta Ugen -> Int -> CcEvent Ugen
ccEventAddr (Ugen
k0, Ugen
stp, Ugen
c0) Int
c =
  let u :: Ugen
u = Int -> Rate -> Ugen -> Ugen
in' Int
10 Rate
kr (Ugen
k0 Ugen -> Ugen -> Ugen
forall a. Num a => a -> a -> a
+ ((Ugen
c0 Ugen -> Ugen -> Ugen
forall a. Num a => a -> a -> a
+ Int -> Ugen
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c) Ugen -> Ugen -> Ugen
forall a. Num a => a -> a -> a
* Ugen
stp))
  in Int -> [Ugen] -> CcEvent Ugen
forall t. Num t => Int -> [t] -> CcEvent t
cc_event_from_list Int
c (Ugen -> [Ugen]
mceChannels Ugen
u)

-- | c0 = index of voice (channel) zero for event set, n = number of voices (channels)
ccEventVoicerAddr :: CcEventMeta Ugen -> Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicerAddr :: CcEventMeta Ugen -> Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicerAddr CcEventMeta Ugen
m Int
n CcEvent Ugen -> Ugen
f = [Ugen] -> Ugen
mce ((Int -> Ugen) -> [Int] -> [Ugen]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
c -> CcEvent Ugen -> Ugen
f (CcEventMeta Ugen -> Int -> CcEvent Ugen
ccEventAddr CcEventMeta Ugen
m Int
c)) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])

-- | 'eventVoicerAddr' with default (addr, inct, zero).
ccEventVoicer :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicer :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicer = CcEventMeta Ugen -> Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicerAddr CcEventMeta Ugen
forall n. Num n => CcEventMeta n
ccEventMetaDefault

-- | Synonym for ccEventVoicer.
voicer :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
voicer :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
voicer = Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicer

-- | 'eventVoicerAddr' with 'control' inputs for /eventAddr/, /eventIncr/ and /eventZero/.
ccEventVoicerParam :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicerParam :: Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicerParam = CcEventMeta Ugen -> Int -> (CcEvent Ugen -> Ugen) -> Ugen
ccEventVoicerAddr (CcEventMeta Int -> CcEventMeta Ugen
ccEventMetaControls CcEventMeta Int
forall n. Num n => CcEventMeta n
ccEventMetaDefault)

{- | Given /w|g/ and /p/ fields of an 'CcEvent' derive a 'gateReset' from g
and a trigger derived from monitoring /w|g/ and /p/ for changed values.
-}
ccEventGateReset :: Ugen -> Ugen -> (Ugen, Ugen)
ccEventGateReset :: Ugen -> Ugen -> (Ugen, Ugen)
ccEventGateReset Ugen
g Ugen
p =
  let tr :: Ugen
tr = Ugen -> Ugen -> Ugen
changed Ugen
p Ugen
0.01 Ugen -> Ugen -> Ugen
forall a. Num a => a -> a -> a
+ Ugen -> Ugen -> Ugen
changed Ugen
g Ugen
0.01
  in (Ugen -> Ugen -> Ugen
forall a. Num a => a -> a -> a
gateReset Ugen
g Ugen
tr, Ugen
tr)

-- * Ctl

-- | Sequence of 8 continous controller inputs in range (0-1).
type Ctl8 = (Ugen, Ugen, Ugen, Ugen, Ugen, Ugen, Ugen, Ugen)

-- | k0 = index of control bus zero
ctl8At :: Int -> Ctl8
ctl8At :: Int -> Ctl8
ctl8At Int
k0 =
  let u :: Ugen
u = Int -> Rate -> Ugen -> Ugen
in' Int
8 Rate
kr (Int -> Ugen
forall n. Real n => n -> Ugen
constant Int
k0)
  in case Ugen -> [Ugen]
mceChannels Ugen
u of
      [Ugen
cc0, Ugen
cc1, Ugen
cc2, Ugen
cc3, Ugen
cc4, Ugen
cc5, Ugen
cc6, Ugen
cc7] -> (Ugen
cc0, Ugen
cc1, Ugen
cc2, Ugen
cc3, Ugen
cc4, Ugen
cc5, Ugen
cc6, Ugen
cc7)
      [Ugen]
_ -> [Char] -> Ctl8
forall a. HasCallStack => [Char] -> a
error [Char]
"ctl8At?"

-- | 'ctlVoicerAddr' with 'control' inputs for /CtlAddr/ and /CtlZero/.
ctl8Voicer :: Int -> (Int -> Ctl8 -> Ugen) -> Ugen
ctl8Voicer :: Int -> (Int -> Ctl8 -> Ugen) -> Ugen
ctl8Voicer Int
n Int -> Ctl8 -> Ugen
f = [Ugen] -> Ugen
mce ((Int -> Ugen) -> [Int] -> [Ugen]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
c -> Int -> Ctl8 -> Ugen
f Int
c (Int -> Ctl8
ctl8At (Int
11000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c)))) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])

-- | Sequence of 16 continous controller inputs arranged as two Ctl8 sequences.
type Ctl16 = (Ctl8, Ctl8)

-- | 'ctl16VoicerAddr' with 'control' inputs for /CtlAddr/ and /CtlZero/.
ctl16Voicer :: Int -> (Int -> Ctl16 -> Ugen) -> Ugen
ctl16Voicer :: Int -> (Int -> Ctl16 -> Ugen) -> Ugen
ctl16Voicer Int
n Int -> Ctl16 -> Ugen
f = [Ugen] -> Ugen
mce ((Int -> Ugen) -> [Int] -> [Ugen]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
c -> let i :: Int
i = Int
11000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c) in Int -> Ctl16 -> Ugen
f Int
c (Int -> Ctl8
ctl8At Int
i, Int -> Ctl8
ctl8At (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])

-- * Names

-- | Control Specificier.  (name,default,(minValue,maxValue,warpName))
type ControlSpec t = (String, t, (t, t, String))

control_spec_name :: ControlSpec t -> String
control_spec_name :: forall t. ControlSpec t -> [Char]
control_spec_name ([Char]
name, t
_, (t, t, [Char])
_) = [Char]
name

-- | Comma separated, no spaces.
control_spec_parse :: String -> ControlSpec Double
control_spec_parse :: [Char] -> ControlSpec Double
control_spec_parse [Char]
str =
  case [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"," [Char]
str of
    [[Char]
cnmdef, [Char]
lhs, [Char]
rhs, [Char]
wrp] -> case [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
":" [Char]
cnmdef of
      [[Char]
cnm, [Char]
def] -> ([Char]
cnm, [Char] -> Double
forall a. Read a => [Char] -> a
read [Char]
def, ([Char] -> Double
forall a. Read a => [Char] -> a
read [Char]
lhs, [Char] -> Double
forall a. Read a => [Char] -> a
read [Char]
rhs, [Char]
wrp))
      [[Char]]
_ -> [Char] -> ControlSpec Double
forall a. HasCallStack => [Char] -> a
error ([Char]
"control_spec_parse: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cnmdef)
    [[Char]]
_ -> [Char] -> ControlSpec Double
forall a. HasCallStack => [Char] -> a
error ([Char]
"control_spec_parse: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str)

{- | Semicolon separated, no spaces.

>>> control_spec_seq_parse "freq:220,110,440,exp;amp:0.1,0,1,amp;pan:0,-1,1,lin"
[("freq",220.0,(110.0,440.0,"exp")),("amp",0.1,(0.0,1.0,"amp")),("pan",0.0,(-1.0,1.0,"lin"))]
-}
control_spec_seq_parse :: String -> [ControlSpec Double]
control_spec_seq_parse :: [Char] -> [ControlSpec Double]
control_spec_seq_parse = ([Char] -> ControlSpec Double) -> [[Char]] -> [ControlSpec Double]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ControlSpec Double
control_spec_parse ([[Char]] -> [ControlSpec Double])
-> ([Char] -> [[Char]]) -> [Char] -> [ControlSpec Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
";"

-- | Comma separated, 6 decimal places, no spaces.
control_spec_print :: ControlSpec Double -> String
control_spec_print :: ControlSpec Double -> [Char]
control_spec_print ([Char]
cnm, Double
def, (Double
lhs, Double
rhs, [Char]
wrp)) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," [[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
cnm, [Char]
":", Int -> Double -> [Char]
double_pp Int
6 Double
def], Int -> Double -> [Char]
double_pp Int
6 Double
lhs, Int -> Double -> [Char]
double_pp Int
6 Double
rhs, [Char]
wrp]

{- | 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")
"freq:220.0,220.0,440.0,exp;amp:0.1,0.0,1.0,amp;pan:0.0,-1.0,1.0,lin"
-}
control_spec_seq_print :: [ControlSpec Double] -> String
control_spec_seq_print :: [ControlSpec Double] -> [Char]
control_spec_seq_print = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
";" ([[Char]] -> [Char])
-> ([ControlSpec Double] -> [[Char]])
-> [ControlSpec Double]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlSpec Double -> [Char]) -> [ControlSpec Double] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ControlSpec Double -> [Char]
control_spec_print

control_spec_to_control :: ControlSpec Double -> Control
control_spec_to_control :: ControlSpec Double -> Control
control_spec_to_control ([Char]
cnm, Double
def, (Double
lhs, Double
rhs, [Char]
wrp)) =
  let grp :: Maybe Control_Group
grp = if [Char] -> Char
forall a. HasCallStack => [a] -> a
last [Char]
cnm Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"[]" then Control_Group -> Maybe Control_Group
forall a. a -> Maybe a
Just Control_Group
Control_Range else Maybe Control_Group
forall a. Maybe a
Nothing
  in Rate
-> Maybe Int
-> [Char]
-> Double
-> Bool
-> Maybe (Control_Meta Double)
-> Brackets
-> Control
Control Rate
ControlRate Maybe Int
forall a. Maybe a
Nothing [Char]
cnm Double
def Bool
False (Control_Meta Double -> Maybe (Control_Meta Double)
forall a. a -> Maybe a
Just (Double
-> Double
-> [Char]
-> Double
-> [Char]
-> Maybe Control_Group
-> Control_Meta Double
forall n.
n
-> n
-> [Char]
-> n
-> [Char]
-> Maybe Control_Group
-> Control_Meta n
Control_Meta Double
lhs Double
rhs [Char]
wrp Double
0 [Char]
"" Maybe Control_Group
grp)) Brackets
emptyBrackets

{- | See SCClassLibrary/Common/Control/Spec:ControlSpec.initClass

"ControlSpec defines the range and curve of a control"

This list adds default values.
-}
sc3_control_spec :: Fractional t => [ControlSpec t]
sc3_control_spec :: forall t. Fractional t => [ControlSpec t]
sc3_control_spec =
  [ ([Char]
"amp", t
0.1, (t
0, t
1, [Char]
"amp"))
  , ([Char]
"beats", t
1, (t
0, t
20, [Char]
"lin"))
  , ([Char]
"bipolar", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"boostcut", t
0, (-t
20, t
20, [Char]
"lin"))
  , ([Char]
"db", -t
12, (-t
180, t
0, [Char]
"db"))
  , ([Char]
"delay", t
0.01, (t
0.0001, t
1, [Char]
"exp"))
  , ([Char]
"detune", t
0, (-t
20, t
20, [Char]
"lin"))
  , ([Char]
"freq", t
440, (t
20, t
20000, [Char]
"exp"))
  , ([Char]
"lofreq", t
20, (t
0.1, t
100, [Char]
"exp"))
  , ([Char]
"midfreq", t
440, (t
25, t
4200, [Char]
"exp"))
  , ([Char]
"midi", t
64, (t
0, t
127, [Char]
"lin"))
  , ([Char]
"midinote", t
64, (t
0, t
127, [Char]
"lin"))
  , ([Char]
"midivelocity", t
64, (t
1, t
127, [Char]
"lin"))
  , ([Char]
"pan", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"phase", t
0, (t
0, t
6.28318, [Char]
"lin"))
  , ([Char]
"rate", t
1, (t
0.125, t
8, [Char]
"exp"))
  , ([Char]
"rq", t
0.1, (t
0.001, t
2, [Char]
"exp"))
  , ([Char]
"unipolar", t
0, (t
0, t
1, [Char]
"lin"))
  , ([Char]
"widefreq", t
440, (t
0.1, t
20000, [Char]
"exp"))
  ]

{- | 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.

>>> Data.List.intersect (map control_spec_name sc3_control_spec) (map control_spec_name kyma_event_value_ranges)
["beats","boostcut","freq","rate"]

>>> let f i = filter ((== i) . control_spec_name)
>>> let c (p,q) = (f p sc3_control_spec, f q kyma_event_value_ranges)
>>> c ("lofreq","freqlow")
([("lofreq",20.0,(0.1,100.0,"exp"))],[("freqlow",120.0,(0.0,1000.0,"exp"))])

>>> c ("midfreq","freqmid")
([("midfreq",440.0,(25.0,4200.0,"exp"))],[("freqmid",1200.0,(1000.0,8000.0,"exp"))])

>>> find ((==) "freqhigh" . control_spec_name) kyma_event_value_ranges
Just ("freqhigh",12000.0,(8000.0,24000.0,"exp"))
-}
kyma_event_value_ranges :: Fractional t => [ControlSpec t]
kyma_event_value_ranges :: forall t. Fractional t => [ControlSpec t]
kyma_event_value_ranges =
  [ ([Char]
"angle", t
0, (-t
0.5, t
1.5, [Char]
"lin"))
  , ([Char]
"beats", t
1, (t
1, t
16, [Char]
"lin"))
  , ([Char]
"boostcut", t
0, (-t
12, t
12, [Char]
"lin"))
  , ([Char]
"bpm", t
60, (t
0, t
2000, [Char]
"lin"))
  , ([Char]
"centervalue", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"coef", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"cutoff", t
440, (t
0, t
10000, [Char]
"exp"))
  , ([Char]
"cycles", t
1, (t
0, t
100, [Char]
"lin"))
  , ([Char]
"dcoffset", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"direction", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"distance", t
0, (-t
2, t
2, [Char]
"lin"))
  , ([Char]
"fmntshift", t
1, (t
0.75, t
1.25, [Char]
"lin"))
  , ([Char]
"freq", t
440, (t
0, t
10000, [Char]
"exp"))
  , ([Char]
"freqhigh", t
12000, (t
8000, t
24000, [Char]
"exp")) -- sampleRate / 2
  , ([Char]
"freqjitter", t
0, (t
0, t
1, [Char]
"lin"))
  , ([Char]
"freqlow", t
120, (t
0, t
1000, [Char]
"exp"))
  , ([Char]
"freqmid", t
1200, (t
1000, t
8000, [Char]
"exp"))
  , ([Char]
"gain", t
0.1, (t
0, t
10, [Char]
"amp"))
  , ([Char]
"gaindb", -t
12, (-t
128, t
128, [Char]
"lin"))
  , ([Char]
"interval", t
0, (-t
24, t
24, [Char]
"lin"))
  , ([Char]
"keynumber", t
64, (t
0, t
127, [Char]
"lin"))
  , ([Char]
"logfreq", t
20, (t
0, t
127, [Char]
"lin"))
  , ([Char]
"looplength", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"offset", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"onduration", t
0.1, (t
0, t
30, [Char]
"lin"))
  , ([Char]
"panner", t
0, (-t
0.5, t
1.5, [Char]
"lin"))
  , ([Char]
"pitch", t
64, (t
0, t
127, [Char]
"lin"))
  , ([Char]
"q", t
0.1, (t
0, t
10, [Char]
"lin"))
  , ([Char]
"radius", t
1, (-t
2, t
2, [Char]
"lin"))
  , ([Char]
"rate", t
1, (t
0, t
2, [Char]
"lin"))
  , ([Char]
"ratio", t
1, (t
0, t
100, [Char]
"lin"))
  , ([Char]
"scale", t
0, (-t
2, t
2, [Char]
"lin"))
  , ([Char]
"smallInterval", t
0, (t
0, t
12, [Char]
"lin"))
  , ([Char]
"steps", t
1, (t
1, t
128, [Char]
"lin"))
  , ([Char]
"swing", t
0, (t
0, t
0.5, [Char]
"lin"))
  , ([Char]
"threshdb", -t
12, (-t
60, t
0, [Char]
"lin"))
  , ([Char]
"timeconstant", t
1, (t
0.0001, t
5, [Char]
"lin"))
  , ([Char]
"timeindex", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"tune", t
0, (-t
1, t
1, [Char]
"lin"))
  , ([Char]
"upinterval", t
0, (t
0, t
24, [Char]
"lin"))
  ]