-- | 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.Db {- hsc3 -}
import Sound.Sc3.Ugen.Bindings.Composite {- 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]
_ -> 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i)
  in (forall {a}. Integral a => [Char] -> a -> Ugen
k [Char]
"ccEventAddr" Int
p, forall {a}. Integral a => [Char] -> a -> Ugen
k [Char]
"ccEventIncr" Int
q, 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 forall a. Num a => a -> a -> a
+ ((Ugen
c0 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c) forall a. Num a => a -> a -> a
* Ugen
stp))
  in 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 (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 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 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 forall n. Num n => CcEventMeta n
ccEventMetaDefault)

{- | Given /g/ and /p/ fields of an 'CcEvent' derive a 'gateReset' from g
and a trigger derived from monitoring /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 forall a. Num a => a -> a -> a
+ Ugen -> Ugen -> Ugen
changed Ugen
g Ugen
0.01 in (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 (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]
_ -> 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 (forall a b. (a -> b) -> [a] -> [b]
map (\Int
c -> Int -> Ctl8 -> Ugen
f Int
c (Int -> Ctl8
ctl8At (Int
11000 forall a. Num a => a -> a -> a
+ (Int
8 forall a. Num a => a -> a -> a
* Int
c)))) [Int
0 .. Int
n 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 (forall a b. (a -> b) -> [a] -> [b]
map (\Int
c -> let i :: Int
i = Int
11000 forall a. Num a => a -> a -> a
+ (Int
16 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 forall a. Num a => a -> a -> a
+ Int
8))) [Int
0 .. Int
n 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))

-- | Comma separated, no spaces.
control_spec_parse :: String -> ControlSpec Double
control_spec_parse :: [Char] -> ControlSpec Double
control_spec_parse [Char]
str =
  case forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"," [Char]
str of
    [[Char]
cnmdef,[Char]
lhs,[Char]
rhs,[Char]
wrp] -> case forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
":" [Char]
cnmdef of
                              [[Char]
cnm,[Char]
def] -> ([Char]
cnm,forall a. Read a => [Char] -> a
read [Char]
def,(forall a. Read a => [Char] -> a
read [Char]
lhs,forall a. Read a => [Char] -> a
read [Char]
rhs,[Char]
wrp))
                              [[Char]]
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"control_spec_parse: " forall a. [a] -> [a] -> [a]
++ [Char]
cnmdef)
    [[Char]]
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"control_spec_parse: " 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"
control_spec_seq_parse :: String -> [ControlSpec Double]
control_spec_seq_parse :: [Char] -> [ControlSpec Double]
control_spec_seq_parse = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ControlSpec Double
control_spec_parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)) = forall a. [a] -> [[a]] -> [a]
intercalate [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")
control_spec_seq_print :: [ControlSpec Double] -> String
control_spec_seq_print :: [ControlSpec Double] -> [Char]
control_spec_seq_print = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
";" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. [a] -> a
last [Char]
cnm forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"[]" then forall a. a -> Maybe a
Just Control_Group
Control_Range else forall a. Maybe a
Nothing
  in Rate
-> Maybe Int
-> [Char]
-> Double
-> Bool
-> Maybe (Control_Meta Double)
-> Brackets
-> Control
Control Rate
ControlRate forall a. Maybe a
Nothing [Char]
cnm Double
def Bool
False (forall a. a -> Maybe a
Just (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.

> 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
-}
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"))]