-- | Generic constructors for the command set implemented by the SuperCollider synthesis server.
module Sound.Sc3.Server.Command.Generic where

import Data.List {- base -}
import Data.Maybe {- base -}

import Sound.Osc.Core {- hosc -}

import qualified Sound.Sc3.Common.Base as Common.Base
import qualified Sound.Sc3.Server.Command.Completion as Server.Command.Completion
import qualified Sound.Sc3.Server.Enum as Server.Enum
import qualified Sound.Sc3.Server.Graphdef as Server.Graphdef
import qualified Sound.Sc3.Server.Graphdef.Binary as Server.Graphdef
import qualified Sound.Sc3.Server.Synthdef as Server.Synthdef

cmd_check_arg :: String -> (t -> Bool) -> t -> t
cmd_check_arg :: forall t. String -> (t -> Bool) -> t -> t
cmd_check_arg String
e t -> Bool
f t
x = if Bool -> Bool
not (t -> Bool
f t
x) then String -> t
forall a. HasCallStack => String -> a
error String
e else t
x

-- * Buffer commands (b_)

-- | Buf-Num must be >= 0
b_bufnum :: Integral t => t -> Datum
b_bufnum :: forall t. Integral t => t -> Datum
b_bufnum = t -> Datum
forall t. Integral t => t -> Datum
int32 (t -> Datum) -> (t -> t) -> t -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (t -> Bool) -> t -> t
forall t. String -> (t -> Bool) -> t -> t
cmd_check_arg String
"buffer-number < 0?" (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0)

-- | Buf-Frame-Ix must be >= 0
b_ix :: Integral t => t -> Datum
b_ix :: forall t. Integral t => t -> Datum
b_ix = t -> Datum
forall t. Integral t => t -> Datum
int32 (t -> Datum) -> (t -> t) -> t -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (t -> Bool) -> t -> t
forall t. String -> (t -> Bool) -> t -> t
cmd_check_arg String
"buffer-ix < 0?" (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0)

-- | Buf-Channel must be >= 0
b_ch :: Integral t => t -> Datum
b_ch :: forall t. Integral t => t -> Datum
b_ch = t -> Datum
forall t. Integral t => t -> Datum
int32 (t -> Datum) -> (t -> t) -> t -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (t -> Bool) -> t -> t
forall t. String -> (t -> Bool) -> t -> t
cmd_check_arg String
"buffer-channel < 0?" (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0)

-- | Buf-Frame-Cnt must be >= 0
b_size :: Integral t => t -> Datum
b_size :: forall t. Integral t => t -> Datum
b_size = t -> Datum
forall t. Integral t => t -> Datum
int32 (t -> Datum) -> (t -> t) -> t -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (t -> Bool) -> t -> t
forall t. String -> (t -> Bool) -> t -> t
cmd_check_arg String
"buffer-size < 0?" (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0)

-- | Allocates zero filled buffer to number of channels and samples. (Asynchronous)
b_alloc :: Integral i => i -> i -> i -> Message
b_alloc :: forall i. Integral i => i -> i -> i -> Message
b_alloc i
b i
frames i
channels = String -> [Datum] -> Message
message String
"/b_alloc" [i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b, i -> Datum
forall t. Integral t => t -> Datum
b_size i
frames, i -> Datum
forall t. Integral t => t -> Datum
int32 i
channels]

-- | Allocate buffer space and read a sound file. (Asynchronous)
b_allocRead :: Integral i => i -> String -> i -> i -> Message
b_allocRead :: forall i. Integral i => i -> String -> i -> i -> Message
b_allocRead i
bufferNumber String
fileName i
startFrame i
frameCount =
  String -> [Datum] -> Message
message
    String
"/b_allocRead"
    [ i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
bufferNumber
    , String -> Datum
string String
fileName
    , i -> Datum
forall t. Integral t => t -> Datum
b_ix i
startFrame
    , i -> Datum
forall t. Integral t => t -> Datum
b_ix i
frameCount
    ]

-- | Allocate buffer space and read a sound file, picking specific channels. (Asynchronous)
b_allocReadChannel :: Integral i => i -> String -> i -> i -> [i] -> Message
b_allocReadChannel :: forall i. Integral i => i -> String -> i -> i -> [i] -> Message
b_allocReadChannel i
bufferNumber String
fileName i
startFrame i
frameCount [i]
channels =
  String -> [Datum] -> Message
message
    String
"/b_allocReadChannel"
    ( [ i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
bufferNumber
      , String -> Datum
string String
fileName
      , i -> Datum
forall t. Integral t => t -> Datum
b_ix i
startFrame
      , i -> Datum
forall t. Integral t => t -> Datum
b_ix i
frameCount
      ]
        [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
b_ch [i]
channels
    )

-- | Close attached soundfile and write header information. (Asynchronous)
b_close :: Integral i => i -> Message
b_close :: forall i. Integral i => i -> Message
b_close i
b = String -> [Datum] -> Message
message String
"/b_close" [i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b]

-- | Fill ranges of sample values.
b_fill :: (Integral i, Real n) => i -> [(i, i, n)] -> Message
b_fill :: forall i n. (Integral i, Real n) => i -> [(i, i, n)] -> Message
b_fill i
b [(i, i, n)]
l = String -> [Datum] -> Message
message String
"/b_fill" (i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (i -> Datum)
-> (i -> Datum) -> (n -> Datum) -> [(i, i, n)] -> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32 n -> Datum
forall n. Real n => n -> Datum
float [(i, i, n)]
l)

-- | Free buffer data. (Asynchronous)
b_free :: Integral i => i -> Message
b_free :: forall i. Integral i => i -> Message
b_free i
b = String -> [Datum] -> Message
message String
"/b_free" [i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b]

-- | Call a command to fill a buffer.  (Asynchronous)
b_gen :: Integral i => i -> String -> [Datum] -> Message
b_gen :: forall i. Integral i => i -> String -> [Datum] -> Message
b_gen i
b String
name [Datum]
arg = String -> [Datum] -> Message
message String
"/b_gen" (i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: String -> Datum
string String
name Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: [Datum]
arg)

-- | Call @sine1@ 'b_gen' command.
b_gen_sine1 :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [n] -> Message
b_gen_sine1 :: forall i n. (Integral i, Real n) => i -> [B_Gen] -> [n] -> Message
b_gen_sine1 i
z [B_Gen]
f [n]
n = i -> String -> [Datum] -> Message
forall i. Integral i => i -> String -> [Datum] -> Message
b_gen i
z String
"sine1" (Int -> Datum
forall t. Integral t => t -> Datum
int32 ([B_Gen] -> Int
Server.Enum.b_gen_flag [B_Gen]
f) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (n -> Datum) -> [n] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map n -> Datum
forall n. Real n => n -> Datum
float [n]
n)

-- | Call @sine2@ 'b_gen' command.
b_gen_sine2 :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [(n, n)] -> Message
b_gen_sine2 :: forall i n.
(Integral i, Real n) =>
i -> [B_Gen] -> [(n, n)] -> Message
b_gen_sine2 i
z [B_Gen]
f [(n, n)]
n = i -> String -> [Datum] -> Message
forall i. Integral i => i -> String -> [Datum] -> Message
b_gen i
z String
"sine2" (Int -> Datum
forall t. Integral t => t -> Datum
int32 ([B_Gen] -> Int
Server.Enum.b_gen_flag [B_Gen]
f) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (n -> Datum) -> (n -> Datum) -> [(n, n)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples n -> Datum
forall n. Real n => n -> Datum
float n -> Datum
forall n. Real n => n -> Datum
float [(n, n)]
n)

-- | Call @sine3@ 'b_gen' command.
b_gen_sine3 :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [(n, n, n)] -> Message
b_gen_sine3 :: forall i n.
(Integral i, Real n) =>
i -> [B_Gen] -> [(n, n, n)] -> Message
b_gen_sine3 i
z [B_Gen]
f [(n, n, n)]
n = i -> String -> [Datum] -> Message
forall i. Integral i => i -> String -> [Datum] -> Message
b_gen i
z String
"sine3" (Int -> Datum
forall t. Integral t => t -> Datum
int32 ([B_Gen] -> Int
Server.Enum.b_gen_flag [B_Gen]
f) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (n -> Datum)
-> (n -> Datum) -> (n -> Datum) -> [(n, n, n)] -> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples n -> Datum
forall n. Real n => n -> Datum
float n -> Datum
forall n. Real n => n -> Datum
float n -> Datum
forall n. Real n => n -> Datum
float [(n, n, n)]
n)

-- | Call @cheby@ 'b_gen' command.
b_gen_cheby :: (Integral i, Real n) => i -> [Server.Enum.B_Gen] -> [n] -> Message
b_gen_cheby :: forall i n. (Integral i, Real n) => i -> [B_Gen] -> [n] -> Message
b_gen_cheby i
z [B_Gen]
f [n]
n = i -> String -> [Datum] -> Message
forall i. Integral i => i -> String -> [Datum] -> Message
b_gen i
z String
"cheby" (Int -> Datum
forall t. Integral t => t -> Datum
int32 ([B_Gen] -> Int
Server.Enum.b_gen_flag [B_Gen]
f) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (n -> Datum) -> [n] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map n -> Datum
forall n. Real n => n -> Datum
float [n]
n)

-- | Call @copy@ 'b_gen' command.
b_gen_copy :: Integral i => i -> i -> i -> i -> Maybe i -> Message
b_gen_copy :: forall i. Integral i => i -> i -> i -> i -> Maybe i -> Message
b_gen_copy i
dst_b i
dst_ix i
src_b i
src_ix Maybe i
nf =
  let nf' :: i
nf' = i -> Maybe i -> i
forall a. a -> Maybe a -> a
fromMaybe (-i
1) Maybe i
nf
  in i -> String -> [Datum] -> Message
forall i. Integral i => i -> String -> [Datum] -> Message
b_gen i
dst_b String
"copy" ((i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32 [i
dst_ix, i
src_b, i
src_ix, i
nf'])

-- | Get sample values.
b_get :: Integral i => i -> [i] -> Message
b_get :: forall i. Integral i => i -> [i] -> Message
b_get i
b [i]
i = String -> [Datum] -> Message
message String
"/b_get" (i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32 [i]
i)

-- | Get ranges of sample values.
b_getn :: Integral i => i -> [(i, i)] -> Message
b_getn :: forall i. Integral i => i -> [(i, i)] -> Message
b_getn i
b [(i, i)]
l = String -> [Datum] -> Message
message String
"/b_getn" (i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (i -> Datum) -> (i -> Datum) -> [(i, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
b_ix i -> Datum
forall t. Integral t => t -> Datum
b_size [(i, i)]
l)

-- | Request \/b_info messages.
b_query :: Integral i => [i] -> Message
b_query :: forall i. Integral i => [i] -> Message
b_query = String -> [Datum] -> Message
message String
"/b_query" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32

{- | Read sound file data into an existing buffer. (Asynchronous)
     Param: bufId pathName startFrame numFrames bufFrame leaveOpen
-}
b_read :: Integral i => i -> String -> i -> i -> i -> Bool -> Message
b_read :: forall i.
Integral i =>
i -> String -> i -> i -> i -> Bool -> Message
b_read i
bufId String
pathName i
startFrame i
numFrames i
bufFrame Bool
leaveOpen =
  String -> [Datum] -> Message
message String
"/b_read" [i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
bufId, String -> Datum
string String
pathName, i -> Datum
forall t. Integral t => t -> Datum
int32 i
startFrame, i -> Datum
forall t. Integral t => t -> Datum
int32 i
numFrames, i -> Datum
forall t. Integral t => t -> Datum
int32 i
bufFrame, Int -> Datum
forall t. Integral t => t -> Datum
int32 (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
leaveOpen)]

-- | Read sound file data into an existing buffer, picking specific channels. (Asynchronous)
b_readChannel :: Integral i => i -> String -> i -> i -> i -> Bool -> [i] -> Message
b_readChannel :: forall i.
Integral i =>
i -> String -> i -> i -> i -> Bool -> [i] -> Message
b_readChannel i
b String
p i
f i
n i
f' Bool
z [i]
cs = String -> [Datum] -> Message
message String
"/b_readChannel" ([i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b, String -> Datum
string String
p, i -> Datum
forall t. Integral t => t -> Datum
int32 i
f, i -> Datum
forall t. Integral t => t -> Datum
int32 i
n, i -> Datum
forall t. Integral t => t -> Datum
int32 i
f', Int -> Datum
forall t. Integral t => t -> Datum
int32 (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
z)] [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32 [i]
cs)

-- | Set sample values.
b_set :: (Integral i, Real n) => i -> [(i, n)] -> Message
b_set :: forall i n. (Integral i, Real n) => i -> [(i, n)] -> Message
b_set i
b [(i, n)]
l = String -> [Datum] -> Message
message String
"/b_set" (i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (i -> Datum) -> (n -> Datum) -> [(i, n)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 n -> Datum
forall n. Real n => n -> Datum
float [(i, n)]
l)

-- | Set ranges of sample values.
b_setn :: (Integral i, Real n) => i -> [(i, [n])] -> Message
b_setn :: forall i n. (Integral i, Real n) => i -> [(i, [n])] -> Message
b_setn i
b [(i, [n])]
l =
  let f :: (n, [a]) -> [Datum]
f (n
i, [a]
d) = n -> Datum
forall t. Integral t => t -> Datum
int32 n
i Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: Int -> Datum
forall t. Integral t => t -> Datum
int32 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
d) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (a -> Datum) -> [a] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map a -> Datum
forall n. Real n => n -> Datum
float [a]
d
  in String -> [Datum] -> Message
message String
"/b_setn" (i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: ((i, [n]) -> [Datum]) -> [(i, [n])] -> [Datum]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (i, [n]) -> [Datum]
forall {n} {a}. (Integral n, Real a) => (n, [a]) -> [Datum]
f [(i, [n])]
l)

-- | Write sound file data. (Asynchronous)
b_write :: Integral i => i -> String -> Server.Enum.SoundFileFormat -> Server.Enum.SampleFormat -> i -> i -> Bool -> Message
b_write :: forall i.
Integral i =>
i
-> String
-> SoundFileFormat
-> SampleFormat
-> i
-> i
-> Bool
-> Message
b_write i
b String
p SoundFileFormat
h SampleFormat
t i
f i
s Bool
z =
  let h' :: Datum
h' = String -> Datum
string (SoundFileFormat -> String
Server.Enum.soundFileFormatString SoundFileFormat
h)
      t' :: Datum
t' = String -> Datum
string (SampleFormat -> String
Server.Enum.sampleFormatString SampleFormat
t)
  in String -> [Datum] -> Message
message String
"/b_write" [i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b, String -> Datum
string String
p, Datum
h', Datum
t', i -> Datum
forall t. Integral t => t -> Datum
int32 i
f, i -> Datum
forall t. Integral t => t -> Datum
int32 i
s, Int -> Datum
forall t. Integral t => t -> Datum
int32 (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
z)]

-- | Zero sample data. (Asynchronous)
b_zero :: Integral i => i -> Message
b_zero :: forall i. Integral i => i -> Message
b_zero i
b = String -> [Datum] -> Message
message String
"/b_zero" [i -> Datum
forall t. Integral t => t -> Datum
b_bufnum i
b]

-- * Control bus commands (c_)

-- |  Fill ranges of bus values.
c_fill :: (Integral i, Real n) => [(i, i, n)] -> Message
c_fill :: forall i n. (Integral i, Real n) => [(i, i, n)] -> Message
c_fill = String -> [Datum] -> Message
message String
"/c_fill" ([Datum] -> Message)
-> ([(i, i, n)] -> [Datum]) -> [(i, i, n)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum)
-> (i -> Datum) -> (n -> Datum) -> [(i, i, n)] -> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32 n -> Datum
forall n. Real n => n -> Datum
float

-- | Get bus values.
c_get :: Integral i => [i] -> Message
c_get :: forall i. Integral i => [i] -> Message
c_get = String -> [Datum] -> Message
message String
"/c_get" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Get ranges of bus values.
c_getn :: Integral i => [(i, i)] -> Message
c_getn :: forall i. Integral i => [(i, i)] -> Message
c_getn = String -> [Datum] -> Message
message String
"/c_getn" ([Datum] -> Message)
-> ([(i, i)] -> [Datum]) -> [(i, i)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (i -> Datum) -> [(i, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Set bus values.
c_set :: (Integral i, Real n) => [(i, n)] -> Message
c_set :: forall i n. (Integral i, Real n) => [(i, n)] -> Message
c_set = String -> [Datum] -> Message
message String
"/c_set" ([Datum] -> Message)
-> ([(i, n)] -> [Datum]) -> [(i, n)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (n -> Datum) -> [(i, n)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 n -> Datum
forall n. Real n => n -> Datum
float

-- | Set ranges of bus values.
c_setn :: (Integral i, Real n) => [(i, [n])] -> Message
c_setn :: forall i n. (Integral i, Real n) => [(i, [n])] -> Message
c_setn [(i, [n])]
l =
  let f :: (n, [a]) -> [Datum]
f (n
i, [a]
d) = n -> Datum
forall t. Integral t => t -> Datum
int32 n
i Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: Int -> Datum
forall t. Integral t => t -> Datum
int32 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
d) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (a -> Datum) -> [a] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map a -> Datum
forall n. Real n => n -> Datum
float [a]
d
  in String -> [Datum] -> Message
message String
"/c_setn" (((i, [n]) -> [Datum]) -> [(i, [n])] -> [Datum]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (i, [n]) -> [Datum]
forall {n} {a}. (Integral n, Real a) => (n, [a]) -> [Datum]
f [(i, [n])]
l)

-- * Instrument definition commands (d_)

-- | Install a bytecode instrument definition. (Asynchronous)
d_recv_bytes :: Blob -> Message
d_recv_bytes :: Blob -> Message
d_recv_bytes Blob
b = String -> [Datum] -> Message
message String
"/d_recv" [Blob -> Datum
Blob Blob
b]

-- | Graphdef encoding variant.
d_recv_gr :: Server.Graphdef.Graphdef -> Message
d_recv_gr :: Graphdef -> Message
d_recv_gr = Blob -> Message
d_recv_bytes (Blob -> Message) -> (Graphdef -> Blob) -> Graphdef -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graphdef -> Blob
Server.Graphdef.encode_graphdef

-- | Synthdef encoding variant.
d_recv :: Server.Synthdef.Synthdef -> Message
d_recv :: Synthdef -> Message
d_recv = Blob -> Message
d_recv_bytes (Blob -> Message) -> (Synthdef -> Blob) -> Synthdef -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> Blob
Server.Synthdef.synthdefData

-- | Load an instrument definition from a named file. (Asynchronous)
d_load :: String -> Message
d_load :: String -> Message
d_load String
p = String -> [Datum] -> Message
message String
"/d_load" [String -> Datum
string String
p]

-- | Load a directory of instrument definitions files. (Asynchronous)
d_loadDir :: String -> Message
d_loadDir :: String -> Message
d_loadDir String
p = String -> [Datum] -> Message
message String
"/d_loadDir" [String -> Datum
string String
p]

-- | Remove definition once all nodes using it have ended.
d_free :: [String] -> Message
d_free :: [String] -> Message
d_free = String -> [Datum] -> Message
message String
"/d_free" ([Datum] -> Message)
-> ([String] -> [Datum]) -> [String] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Datum) -> [String] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map String -> Datum
string

-- * Group node commands (g_)

-- | Free all synths in this group and all its sub-groups.
g_deepFree :: Integral i => [i] -> Message
g_deepFree :: forall i. Integral i => [i] -> Message
g_deepFree = String -> [Datum] -> Message
message String
"/g_deepFree" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Delete all nodes in a group.
g_freeAll :: Integral i => [i] -> Message
g_freeAll :: forall i. Integral i => [i] -> Message
g_freeAll = String -> [Datum] -> Message
message String
"/g_freeAll" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Add node to head of group.
g_head :: Integral i => [(i, i)] -> Message
g_head :: forall i. Integral i => [(i, i)] -> Message
g_head = String -> [Datum] -> Message
message String
"/g_head" ([Datum] -> Message)
-> ([(i, i)] -> [Datum]) -> [(i, i)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (i -> Datum) -> [(i, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Create a new group.
g_new :: Integral i => [(i, Server.Enum.AddAction, i)] -> Message
g_new :: forall i. Integral i => [(i, AddAction, i)] -> Message
g_new = String -> [Datum] -> Message
message String
"/g_new" ([Datum] -> Message)
-> ([(i, AddAction, i)] -> [Datum])
-> [(i, AddAction, i)]
-> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum)
-> (AddAction -> Datum)
-> (i -> Datum)
-> [(i, AddAction, i)]
-> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples i -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum) -> (AddAction -> Int) -> AddAction -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddAction -> Int
forall a. Enum a => a -> Int
fromEnum) i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Add node to tail of group.
g_tail :: Integral i => [(i, i)] -> Message
g_tail :: forall i. Integral i => [(i, i)] -> Message
g_tail = String -> [Datum] -> Message
message String
"/g_tail" ([Datum] -> Message)
-> ([(i, i)] -> [Datum]) -> [(i, i)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (i -> Datum) -> [(i, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Post a representation of a group's node subtree, optionally including the current control values for synths.
g_dumpTree :: Integral i => [(i, Bool)] -> Message
g_dumpTree :: forall i. Integral i => [(i, Bool)] -> Message
g_dumpTree = String -> [Datum] -> Message
message String
"/g_dumpTree" ([Datum] -> Message)
-> ([(i, Bool)] -> [Datum]) -> [(i, Bool)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (Bool -> Datum) -> [(i, Bool)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum) -> (Bool -> Int) -> Bool -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum)

{- | Request a representation of a group's node subtree, optionally including the current control values for synths.

Replies to the sender with a @/g_queryTree.reply@ message listing all of the nodes contained within the group in the following format:

@
int32 - if synth control values are included 1, else 0
int32 - node ID of the requested group
int32 - number of child nodes contained within the requested group

For each node in the subtree:
[
  int32 - node ID
  int32 - number of child nodes contained within this node. If -1 this is a synth, if >= 0 it's a group.

  If this node is a synth:
    symbol - the SynthDef name for this node.

  If flag (see above) is true:
    int32 - numControls for this synth (M)
    [
      symbol or int: control name or index
      float or symbol: value or control bus mapping symbol (e.g. 'c1')
    ] * M
] * the number of nodes in the subtree
@
N.b. The order of nodes corresponds to their execution order on the server. Thus child nodes (those contained within a group) are listed immediately following their parent.
-}
g_queryTree :: Integral i => [(i, Bool)] -> Message
g_queryTree :: forall i. Integral i => [(i, Bool)] -> Message
g_queryTree = String -> [Datum] -> Message
message String
"/g_queryTree" ([Datum] -> Message)
-> ([(i, Bool)] -> [Datum]) -> [(i, Bool)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (Bool -> Datum) -> [(i, Bool)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum) -> (Bool -> Int) -> Bool -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum)

-- * Node commands (n_)

-- | Node-Id must be >= -1
n_id :: Integral t => t -> Datum
n_id :: forall t. Integral t => t -> Datum
n_id = t -> Datum
forall t. Integral t => t -> Datum
int32 (t -> Datum) -> (t -> t) -> t -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (t -> Bool) -> t -> t
forall t. String -> (t -> Bool) -> t -> t
cmd_check_arg String
"node-id < -1?" (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= (-t
1))

-- | Place a node after another.
n_after :: Integral i => [(i, i)] -> Message
n_after :: forall i. Integral i => [(i, i)] -> Message
n_after = String -> [Datum] -> Message
message String
"/n_after" ([Datum] -> Message)
-> ([(i, i)] -> [Datum]) -> [(i, i)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (i -> Datum) -> [(i, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
n_id i -> Datum
forall t. Integral t => t -> Datum
n_id

-- | Place a node before another.
n_before :: Integral i => [(i, i)] -> Message
n_before :: forall i. Integral i => [(i, i)] -> Message
n_before = String -> [Datum] -> Message
message String
"/n_before" ([Datum] -> Message)
-> ([(i, i)] -> [Datum]) -> [(i, i)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (i -> Datum) -> [(i, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Fill ranges of a node's control values.
n_fill :: (Integral i, Real f) => i -> [(String, i, f)] -> Message
n_fill :: forall i f.
(Integral i, Real f) =>
i -> [(String, i, f)] -> Message
n_fill i
n [(String, i, f)]
l = String -> [Datum] -> Message
message String
"/n_fill" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum)
-> (i -> Datum) -> (f -> Datum) -> [(String, i, f)] -> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples String -> Datum
string i -> Datum
forall t. Integral t => t -> Datum
int32 f -> Datum
forall n. Real n => n -> Datum
float [(String, i, f)]
l)

-- | Delete a node.
n_free :: Integral i => [i] -> Message
n_free :: forall i. Integral i => [i] -> Message
n_free = String -> [Datum] -> Message
message String
"/n_free" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
n_id

n_map :: Integral i => i -> [(String, i)] -> Message
n_map :: forall i. Integral i => i -> [(String, i)] -> Message
n_map i
n [(String, i)]
l = String -> [Datum] -> Message
message String
"/n_map" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum) -> (i -> Datum) -> [(String, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples String -> Datum
string i -> Datum
forall t. Integral t => t -> Datum
int32 [(String, i)]
l)

{- | Map a node's controls to read from buses.
  n_mapn only works if the control is given as an index and not as a name (3.8.0).
-}
n_mapn :: Integral i => i -> [(i, i, i)] -> Message
n_mapn :: forall i. Integral i => i -> [(i, i, i)] -> Message
n_mapn i
n [(i, i, i)]
l = String -> [Datum] -> Message
message String
"/n_mapn" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (i -> Datum)
-> (i -> Datum) -> (i -> Datum) -> [(i, i, i)] -> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32 [(i, i, i)]
l)

-- | Map a node's controls to read from an audio bus.
n_mapa :: Integral i => i -> [(String, i)] -> Message
n_mapa :: forall i. Integral i => i -> [(String, i)] -> Message
n_mapa i
n [(String, i)]
l = String -> [Datum] -> Message
message String
"/n_mapa" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum) -> (i -> Datum) -> [(String, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples String -> Datum
string i -> Datum
forall t. Integral t => t -> Datum
int32 [(String, i)]
l)

-- | Map a node's controls to read from audio buses.
n_mapan :: Integral i => i -> [(String, i, i)] -> Message
n_mapan :: forall i. Integral i => i -> [(String, i, i)] -> Message
n_mapan i
n [(String, i, i)]
l = String -> [Datum] -> Message
message String
"/n_mapan" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum)
-> (i -> Datum) -> (i -> Datum) -> [(String, i, i)] -> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples String -> Datum
string i -> Datum
forall t. Integral t => t -> Datum
int32 i -> Datum
forall t. Integral t => t -> Datum
int32 [(String, i, i)]
l)

-- | Get info about a node.
n_query :: Integral i => [i] -> Message
n_query :: forall i. Integral i => [i] -> Message
n_query = String -> [Datum] -> Message
message String
"/n_query" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
n_id

-- | Turn node on or off.
n_run :: Integral i => [(i, Bool)] -> Message
n_run :: forall i. Integral i => [(i, Bool)] -> Message
n_run = String -> [Datum] -> Message
message String
"/n_run" ([Datum] -> Message)
-> ([(i, Bool)] -> [Datum]) -> [(i, Bool)] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> (Bool -> Datum) -> [(i, Bool)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples i -> Datum
forall t. Integral t => t -> Datum
n_id (Int -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum) -> (Bool -> Int) -> Bool -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum)

-- | Set a node's control values.
n_set :: (Integral i, Real n) => i -> [(String, n)] -> Message
n_set :: forall i n. (Integral i, Real n) => i -> [(String, n)] -> Message
n_set i
n [(String, n)]
c = String -> [Datum] -> Message
message String
"/n_set" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum) -> (n -> Datum) -> [(String, n)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples String -> Datum
string n -> Datum
forall n. Real n => n -> Datum
float [(String, n)]
c)

{- | Set ranges of a node's control values.
n_mapn and n_setn only work if the control is given as an index and not as a name.
-}
n_setn :: (Integral i, Real n) => i -> [(i, [n])] -> Message
n_setn :: forall i n. (Integral i, Real n) => i -> [(i, [n])] -> Message
n_setn i
n [(i, [n])]
l =
  let f :: (n, [a]) -> [Datum]
f (n
s, [a]
d) = n -> Datum
forall t. Integral t => t -> Datum
int32 n
s Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: Int -> Datum
forall t. Integral t => t -> Datum
int32 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
d) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (a -> Datum) -> [a] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map a -> Datum
forall n. Real n => n -> Datum
float [a]
d
  in String -> [Datum] -> Message
message String
"/n_setn" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: ((i, [n]) -> [Datum]) -> [(i, [n])] -> [Datum]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (i, [n]) -> [Datum]
forall {n} {a}. (Integral n, Real a) => (n, [a]) -> [Datum]
f [(i, [n])]
l)

-- | Trace a node.
n_trace :: Integral i => [i] -> Message
n_trace :: forall i. Integral i => [i] -> Message
n_trace = String -> [Datum] -> Message
message String
"/n_trace" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32

-- | Move an ordered sequence of nodes.
n_order :: Integral i => Server.Enum.AddAction -> i -> [i] -> Message
n_order :: forall i. Integral i => AddAction -> i -> [i] -> Message
n_order AddAction
a i
n [i]
ns = String -> [Datum] -> Message
message String
"/n_order" (Int -> Datum
forall t. Integral t => t -> Datum
int32 (AddAction -> Int
forall a. Enum a => a -> Int
fromEnum AddAction
a) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: i -> Datum
forall t. Integral t => t -> Datum
int32 i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32 [i]
ns)

-- * Par commands (p_)

-- | Create a new parallel group (supernova specific).
p_new :: Integral i => [(i, Server.Enum.AddAction, i)] -> Message
p_new :: forall i. Integral i => [(i, AddAction, i)] -> Message
p_new = String -> [Datum] -> Message
message String
"/p_new" ([Datum] -> Message)
-> ([(i, AddAction, i)] -> [Datum])
-> [(i, AddAction, i)]
-> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum)
-> (AddAction -> Datum)
-> (i -> Datum)
-> [(i, AddAction, i)]
-> [Datum]
forall a d b c.
(a -> d) -> (b -> d) -> (c -> d) -> [(a, b, c)] -> [d]
Common.Base.mk_triples i -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum
forall t. Integral t => t -> Datum
int32 (Int -> Datum) -> (AddAction -> Int) -> AddAction -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddAction -> Int
forall a. Enum a => a -> Int
fromEnum) i -> Datum
forall t. Integral t => t -> Datum
int32

-- * Synthesis node commands (s_)

-- | Get control values.
s_get :: Integral i => i -> [String] -> Message
s_get :: forall i. Integral i => i -> [String] -> Message
s_get i
n [String]
i = String -> [Datum] -> Message
message String
"/s_get" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum) -> [String] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map String -> Datum
string [String]
i)

-- | Get ranges of control values.
s_getn :: Integral i => i -> [(String, i)] -> Message
s_getn :: forall i. Integral i => i -> [(String, i)] -> Message
s_getn i
n [(String, i)]
l = String -> [Datum] -> Message
message String
"/s_getn" (i -> Datum
forall t. Integral t => t -> Datum
n_id i
n Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum) -> (i -> Datum) -> [(String, i)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples String -> Datum
string i -> Datum
forall t. Integral t => t -> Datum
int32 [(String, i)]
l)

-- | Create a new synth.
s_new :: (Integral i, Real n) => String -> i -> Server.Enum.AddAction -> i -> [(String, n)] -> Message
s_new :: forall i n.
(Integral i, Real n) =>
String -> i -> AddAction -> i -> [(String, n)] -> Message
s_new String
synthdefName i
nodeId AddAction
addAction i
targetId [(String, n)]
controlValues =
  String -> [Datum] -> Message
message
    String
"/s_new"
    ( String -> Datum
string String
synthdefName
        Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: i -> Datum
forall t. Integral t => t -> Datum
int32 i
nodeId
        Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: Int -> Datum
forall t. Integral t => t -> Datum
int32 (AddAction -> Int
forall a. Enum a => a -> Int
fromEnum AddAction
addAction)
        Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: i -> Datum
forall t. Integral t => t -> Datum
int32 i
targetId
        Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: (String -> Datum) -> (n -> Datum) -> [(String, n)] -> [Datum]
forall a c b. (a -> c) -> (b -> c) -> [(a, b)] -> [c]
Common.Base.mk_duples String -> Datum
string n -> Datum
forall n. Real n => n -> Datum
float [(String, n)]
controlValues
    )

-- | Auto-reassign synth's ID to a reserved value.
s_noid :: Integral i => [i] -> Message
s_noid :: forall i. Integral i => [i] -> Message
s_noid = String -> [Datum] -> Message
message String
"/s_noid" ([Datum] -> Message) -> ([i] -> [Datum]) -> [i] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32

-- * Ugen commands (u_)

-- | Send a command to a unit generator.
u_cmd :: Integral i => i -> i -> String -> [Datum] -> Message
u_cmd :: forall i. Integral i => i -> i -> String -> [Datum] -> Message
u_cmd i
n i
uid String
name [Datum]
arg = String -> [Datum] -> Message
message String
"/u_cmd" ([i -> Datum
forall t. Integral t => t -> Datum
n_id i
n, i -> Datum
forall t. Integral t => t -> Datum
int32 i
uid, String -> Datum
string String
name] [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ [Datum]
arg)

-- * Server operation commands

-- | Send a plugin command.
cmd :: String -> [Datum] -> Message
cmd :: String -> [Datum] -> Message
cmd String
name = String -> [Datum] -> Message
message String
"/cmd" ([Datum] -> Message) -> ([Datum] -> [Datum]) -> [Datum] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Datum
string String
name Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
:)

-- | Remove all bundles from the scheduling queue.
clearSched :: Message
clearSched :: Message
clearSched = String -> [Datum] -> Message
message String
"/clearSched" []

-- | Select printing of incoming Open Sound Control messages.
dumpOsc :: Server.Enum.PrintLevel -> Message
dumpOsc :: PrintLevel -> Message
dumpOsc PrintLevel
c = String -> [Datum] -> Message
message String
"/dumpOSC" [Int -> Datum
forall t. Integral t => t -> Datum
int32 (PrintLevel -> Int
forall a. Enum a => a -> Int
fromEnum PrintLevel
c)]

-- | Set error posting scope and mode.
errorMode :: Server.Enum.ErrorScope -> Server.Enum.ErrorMode -> Message
errorMode :: ErrorScope -> ErrorMode -> Message
errorMode ErrorScope
scope ErrorMode
mode =
  let e :: Int
e = case ErrorScope
scope of
        ErrorScope
Server.Enum.Globally -> ErrorMode -> Int
forall a. Enum a => a -> Int
fromEnum ErrorMode
mode
        ErrorScope
Server.Enum.Locally -> -Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ErrorMode -> Int
forall a. Enum a => a -> Int
fromEnum ErrorMode
mode
  in String -> [Datum] -> Message
message String
"/error" [Int -> Datum
forall t. Integral t => t -> Datum
int32 Int
e]

-- | Select reception of notification messages. (Asynchronous)
notify :: Bool -> Message
notify :: Bool -> Message
notify Bool
c = String -> [Datum] -> Message
message String
"/notify" [Int -> Datum
forall t. Integral t => t -> Datum
int32 (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
c)]

-- | End real time mode, close file (un-implemented).
nrt_end :: Message
nrt_end :: Message
nrt_end = String -> [Datum] -> Message
message String
"/nrt_end" []

-- | Stop synthesis server.
quit :: Message
quit :: Message
quit = String -> [Datum] -> Message
message String
"/quit" []

-- | Request \/status.reply message.
status :: Message
status :: Message
status = String -> [Datum] -> Message
message String
"/status" []

-- | Request \/synced message when all current asynchronous commands complete.
sync :: Integral i => i -> Message
sync :: forall i. Integral i => i -> Message
sync i
sid = String -> [Datum] -> Message
message String
"/sync" [i -> Datum
forall t. Integral t => t -> Datum
int32 i
sid]

-- * Variants to simplify common cases

-- | Pre-allocate for b_setn1, values preceding offset are zeroed.
b_alloc_setn1 :: (Integral i, Real n) => i -> i -> [n] -> Message
b_alloc_setn1 :: forall i n. (Integral i, Real n) => i -> i -> [n] -> Message
b_alloc_setn1 i
b i
i [n]
xs =
  let k :: i
k = i
i i -> i -> i
forall a. Num a => a -> a -> a
+ [n] -> i
forall i a. Num i => [a] -> i
genericLength [n]
xs
      xs' :: [n]
xs' = i -> n -> [n]
forall i a. Integral i => i -> a -> [a]
genericReplicate i
i n
0 [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [n]
xs
  in Message -> Message -> Message
Server.Command.Completion.withCm (i -> i -> i -> Message
forall i. Integral i => i -> i -> i -> Message
b_alloc i
b i
k i
1) (i -> i -> [n] -> Message
forall i n. (Integral i, Real n) => i -> i -> [n] -> Message
b_setn1 i
b i
0 [n]
xs')

-- | Get ranges of sample values.
b_getn1 :: Integral i => i -> (i, i) -> Message
b_getn1 :: forall i. Integral i => i -> (i, i) -> Message
b_getn1 i
b = i -> [(i, i)] -> Message
forall i. Integral i => i -> [(i, i)] -> Message
b_getn i
b ([(i, i)] -> Message) -> ((i, i) -> [(i, i)]) -> (i, i) -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, i) -> [(i, i)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Variant on 'b_query'.
b_query1 :: Integral i => i -> Message
b_query1 :: forall i. Integral i => i -> Message
b_query1 = [i] -> Message
forall i. Integral i => [i] -> Message
b_query ([i] -> Message) -> (i -> [i]) -> i -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> [i]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Set single sample value.
b_set1 :: (Integral i, Real n) => i -> i -> n -> Message
b_set1 :: forall i n. (Integral i, Real n) => i -> i -> n -> Message
b_set1 i
b i
i n
x = i -> [(i, n)] -> Message
forall i n. (Integral i, Real n) => i -> [(i, n)] -> Message
b_set i
b [(i
i, n
x)]

-- | Set a range of sample values.
b_setn1 :: (Integral i, Real n) => i -> i -> [n] -> Message
b_setn1 :: forall i n. (Integral i, Real n) => i -> i -> [n] -> Message
b_setn1 i
b i
i [n]
xs = i -> [(i, [n])] -> Message
forall i n. (Integral i, Real n) => i -> [(i, [n])] -> Message
b_setn i
b [(i
i, [n]
xs)]

-- | Segmented variant of 'b_setn1'.
b_setn1_segmented :: (Integral i, Real n) => i -> i -> i -> [n] -> [Message]
b_setn1_segmented :: forall i n. (Integral i, Real n) => i -> i -> i -> [n] -> [Message]
b_setn1_segmented i
k i
b i
i [n]
d =
  if [n] -> i
forall i a. Num i => [a] -> i
genericLength [n]
d i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
k
    then [i -> i -> [n] -> Message
forall i n. (Integral i, Real n) => i -> i -> [n] -> Message
b_setn1 i
b i
i [n]
d]
    else i -> i -> [n] -> Message
forall i n. (Integral i, Real n) => i -> i -> [n] -> Message
b_setn1 i
b i
i (i -> [n] -> [n]
forall i a. Integral i => i -> [a] -> [a]
genericTake i
k [n]
d) Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: i -> i -> i -> [n] -> [Message]
forall i n. (Integral i, Real n) => i -> i -> i -> [n] -> [Message]
b_setn1_segmented i
k i
b (i
i i -> i -> i
forall a. Num a => a -> a -> a
+ i
k) (i -> [n] -> [n]
forall i a. Integral i => i -> [a] -> [a]
genericDrop i
k [n]
d)

-- | Get ranges of sample values.
c_getn1 :: Integral i => (i, i) -> Message
c_getn1 :: forall i. Integral i => (i, i) -> Message
c_getn1 = [(i, i)] -> Message
forall i. Integral i => [(i, i)] -> Message
c_getn ([(i, i)] -> Message) -> ((i, i) -> [(i, i)]) -> (i, i) -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, i) -> [(i, i)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Set single bus values.
c_set1 :: (Integral i, Real n) => i -> n -> Message
c_set1 :: forall i n. (Integral i, Real n) => i -> n -> Message
c_set1 i
i n
x = [(i, n)] -> Message
forall i n. (Integral i, Real n) => [(i, n)] -> Message
c_set [(i
i, n
x)]

-- | Set single range of bus values.
c_setn1 :: (Integral i, Real n) => (i, [n]) -> Message
c_setn1 :: forall i n. (Integral i, Real n) => (i, [n]) -> Message
c_setn1 = [(i, [n])] -> Message
forall i n. (Integral i, Real n) => [(i, [n])] -> Message
c_setn ([(i, [n])] -> Message)
-> ((i, [n]) -> [(i, [n])]) -> (i, [n]) -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, [n]) -> [(i, [n])]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Turn a single node on or off.
n_run1 :: Integral i => i -> Bool -> Message
n_run1 :: forall i. Integral i => i -> Bool -> Message
n_run1 i
n Bool
k = [(i, Bool)] -> Message
forall i. Integral i => [(i, Bool)] -> Message
n_run [(i
n, Bool
k)]

-- | Set a single node control value.
n_set1 :: (Integral i, Real n) => i -> String -> n -> Message
n_set1 :: forall i n. (Integral i, Real n) => i -> String -> n -> Message
n_set1 i
n String
k n
v = i -> [(String, n)] -> Message
forall i n. (Integral i, Real n) => i -> [(String, n)] -> Message
n_set i
n [(String
k, n
v)]

-- | @s_new@ with no parameters.
s_new0 :: Integral i => String -> i -> Server.Enum.AddAction -> i -> Message
s_new0 :: forall i. Integral i => String -> i -> AddAction -> i -> Message
s_new0 String
n i
i AddAction
a i
t = String -> i -> AddAction -> i -> [(String, Double)] -> Message
forall i n.
(Integral i, Real n) =>
String -> i -> AddAction -> i -> [(String, n)] -> Message
s_new String
n i
i AddAction
a i
t ([] :: [(String, Double)])

-- * Buffer segmentation and indices

{- | Segment a request for /m/ places into sets of at most /n/.

>>> b_segment 1024 2056
[8,1024,1024]

>>> b_segment 1 5 == replicate 5 1
True
-}
b_segment :: Integral i => i -> i -> [i]
b_segment :: forall i. Integral i => i -> i -> [i]
b_segment i
n i
m =
  let (i
q, i
r) = i
m i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
`quotRem` i
n
      s :: [i]
s = i -> i -> [i]
forall i a. Integral i => i -> a -> [a]
genericReplicate i
q i
n
  in if i
r i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0 then [i]
s else i
r i -> [i] -> [i]
forall a. a -> [a] -> [a]
: [i]
s

{- | Variant of 'b_segment' that takes a starting index and returns /(index,size)/ duples.

>>> b_indices 1 5 0 == zip [0..4] (replicate 5 1)
True

>>> b_indices 1024 2056 16
[(16,8),(24,1024),(1048,1024)]
-}
b_indices :: Integral i => i -> i -> i -> [(i, i)]
b_indices :: forall i. Integral i => i -> i -> i -> [(i, i)]
b_indices i
n i
m i
k =
  let s :: [i]
s = i -> i -> [i]
forall i. Integral i => i -> i -> [i]
b_segment i
n i
m
      i :: [i]
i = i
0 i -> [i] -> [i]
forall a. a -> [a] -> [a]
: [i] -> [i]
forall n. Num n => [n] -> [n]
Common.Base.dx_d [i]
s
  in [i] -> [i] -> [(i, i)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((i -> i) -> [i] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map (i -> i -> i
forall a. Num a => a -> a -> a
+ i
k) [i]
i) [i]
s

-- * Ugen commands.

-- | Generate accumulation buffer given time-domain IR buffer and FFT size.
partConv_preparePartConv :: Integral i => i -> i -> i -> Message
partConv_preparePartConv :: forall i. Integral i => i -> i -> i -> Message
partConv_preparePartConv i
b i
irb i
fft_size = i -> String -> [Datum] -> Message
forall i. Integral i => i -> String -> [Datum] -> Message
b_gen i
b String
"PreparePartConv" ((i -> Datum) -> [i] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map i -> Datum
forall t. Integral t => t -> Datum
int32 [i
irb, i
fft_size])

-- * Unpack

-- | Result is null for non-conforming data, or has five or seven elements.
unpack_n_info_datum_plain :: Num i => [Datum] -> [i]
unpack_n_info_datum_plain :: forall i. Num i => [Datum] -> [i]
unpack_n_info_datum_plain [Datum]
m =
  let to_i :: Int32 -> i
to_i = Int32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  in case [Datum]
m of
      [Int32 Int32
i1, Int32 Int32
i2, Int32 Int32
i3, Int32 Int32
i4, Int32 Int32
i5] -> [Int32 -> i
to_i Int32
i1, Int32 -> i
to_i Int32
i2, Int32 -> i
to_i Int32
i3, Int32 -> i
to_i Int32
i4, Int32 -> i
to_i Int32
i5]
      [Int32 Int32
i1, Int32 Int32
i2, Int32 Int32
i3, Int32 Int32
i4, Int32 Int32
i5, Int32 Int32
i6, Int32 Int32
i7] -> [Int32 -> i
to_i Int32
i1, Int32 -> i
to_i Int32
i2, Int32 -> i
to_i Int32
i3, Int32 -> i
to_i Int32
i4, Int32 -> i
to_i Int32
i5, Int32 -> i
to_i Int32
i6, Int32 -> i
to_i Int32
i7]
      [Datum]
_ -> []

unpack_n_info_plain :: Num i => Message -> [i]
unpack_n_info_plain :: forall i. Num i => Message -> [i]
unpack_n_info_plain Message
m =
  case Message
m of
    Message String
"/n_info" [Datum]
dat -> [Datum] -> [i]
forall i. Num i => [Datum] -> [i]
unpack_n_info_datum_plain [Datum]
dat
    Message
_ -> []

-- | Unpack @n_info@ message.
unpack_n_info :: Num i => Message -> Maybe (i, i, i, i, i, Maybe (i, i))
unpack_n_info :: forall i. Num i => Message -> Maybe (i, i, i, i, i, Maybe (i, i))
unpack_n_info Message
m =
  case Message -> [i]
forall i. Num i => Message -> [i]
unpack_n_info_plain Message
m of
    [i
i1, i
i2, i
i3, i
i4, i
i5] -> (i, i, i, i, i, Maybe (i, i))
-> Maybe (i, i, i, i, i, Maybe (i, i))
forall a. a -> Maybe a
Just (i
i1, i
i2, i
i3, i
i4, i
i5, Maybe (i, i)
forall a. Maybe a
Nothing)
    [i
i1, i
i2, i
i3, i
i4, i
i5, i
i6, i
i7] -> (i, i, i, i, i, Maybe (i, i))
-> Maybe (i, i, i, i, i, Maybe (i, i))
forall a. a -> Maybe a
Just (i
i1, i
i2, i
i3, i
i4, i
i5, (i, i) -> Maybe (i, i)
forall a. a -> Maybe a
Just (i
i6, i
i7))
    [i]
_ -> Maybe (i, i, i, i, i, Maybe (i, i))
forall a. Maybe a
Nothing

unpack_n_info_err :: Num i => Message -> (i, i, i, i, i, Maybe (i, i))
unpack_n_info_err :: forall i. Num i => Message -> (i, i, i, i, i, Maybe (i, i))
unpack_n_info_err = (i, i, i, i, i, Maybe (i, i))
-> Maybe (i, i, i, i, i, Maybe (i, i))
-> (i, i, i, i, i, Maybe (i, i))
forall a. a -> Maybe a -> a
fromMaybe (String -> (i, i, i, i, i, Maybe (i, i))
forall a. HasCallStack => String -> a
error String
"unpack_n_info") (Maybe (i, i, i, i, i, Maybe (i, i))
 -> (i, i, i, i, i, Maybe (i, i)))
-> (Message -> Maybe (i, i, i, i, i, Maybe (i, i)))
-> Message
-> (i, i, i, i, i, Maybe (i, i))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Maybe (i, i, i, i, i, Maybe (i, i))
forall i. Num i => Message -> Maybe (i, i, i, i, i, Maybe (i, i))
unpack_n_info

-- | Unpack the '/tr' messages sent by 'sendTrig'.
unpack_tr :: (Num i, Fractional f) => Message -> Maybe (i, i, f)
unpack_tr :: forall i f. (Num i, Fractional f) => Message -> Maybe (i, i, f)
unpack_tr Message
m =
  let to_i :: Int32 -> i
to_i = Int32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      to_f :: Float -> f
to_f = Float -> f
forall a b. (Real a, Fractional b) => a -> b
realToFrac
  in case Message
m of
      Message String
"/tr" [Int32 Int32
p, Int32 Int32
q, Float Float
r] -> (i, i, f) -> Maybe (i, i, f)
forall a. a -> Maybe a
Just (Int32 -> i
to_i Int32
p, Int32 -> i
to_i Int32
q, Float -> f
to_f Float
r)
      Message
_ -> Maybe (i, i, f)
forall a. Maybe a
Nothing

unpack_tr_err :: (Num i, Fractional f) => Message -> (i, i, f)
unpack_tr_err :: forall i f. (Num i, Fractional f) => Message -> (i, i, f)
unpack_tr_err = (i, i, f) -> Maybe (i, i, f) -> (i, i, f)
forall a. a -> Maybe a -> a
fromMaybe (String -> (i, i, f)
forall a. HasCallStack => String -> a
error String
"unpack_tr") (Maybe (i, i, f) -> (i, i, f))
-> (Message -> Maybe (i, i, f)) -> Message -> (i, i, f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Maybe (i, i, f)
forall i f. (Num i, Fractional f) => Message -> Maybe (i, i, f)
unpack_tr

unpack_b_setn :: (Num i, Fractional f) => Message -> Maybe (i, i, i, [f])
unpack_b_setn :: forall i f.
(Num i, Fractional f) =>
Message -> Maybe (i, i, i, [f])
unpack_b_setn Message
m =
  let to_i :: Int32 -> i
to_i = Int32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      to_f :: Datum -> b
to_f Datum
d = case Datum
d of
        Float Float
n -> Float -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n
        Datum
_ -> String -> b
forall a. HasCallStack => String -> a
error String
"unpack_b_setn: non-float data"
  in case Message
m of
      Message String
"/b_setn" (Int32 Int32
p : Int32 Int32
q : Int32 Int32
r : [Datum]
z) -> (i, i, i, [f]) -> Maybe (i, i, i, [f])
forall a. a -> Maybe a
Just (Int32 -> i
to_i Int32
p, Int32 -> i
to_i Int32
q, Int32 -> i
to_i Int32
r, (Datum -> f) -> [Datum] -> [f]
forall a b. (a -> b) -> [a] -> [b]
map Datum -> f
forall {b}. Fractional b => Datum -> b
to_f [Datum]
z)
      Message
_ -> Maybe (i, i, i, [f])
forall a. Maybe a
Nothing

unpack_b_setn_err :: (Num i, Fractional f) => Message -> (i, i, i, [f])
unpack_b_setn_err :: forall i f. (Num i, Fractional f) => Message -> (i, i, i, [f])
unpack_b_setn_err = (i, i, i, [f]) -> Maybe (i, i, i, [f]) -> (i, i, i, [f])
forall a. a -> Maybe a -> a
fromMaybe (String -> (i, i, i, [f])
forall a. HasCallStack => String -> a
error String
"unpack_b_setn") (Maybe (i, i, i, [f]) -> (i, i, i, [f]))
-> (Message -> Maybe (i, i, i, [f])) -> Message -> (i, i, i, [f])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Maybe (i, i, i, [f])
forall i f.
(Num i, Fractional f) =>
Message -> Maybe (i, i, i, [f])
unpack_b_setn

-- | Unpack b_info message, fields are (id,frames,channels,sample-rate).
unpack_b_info :: (Num i, Fractional f) => Message -> Maybe (i, i, i, f)
unpack_b_info :: forall i f. (Num i, Fractional f) => Message -> Maybe (i, i, i, f)
unpack_b_info Message
m =
  let to_i :: Int32 -> i
to_i = Int32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      to_f :: Float -> f
to_f = Float -> f
forall a b. (Real a, Fractional b) => a -> b
realToFrac
  in case Message
m of
      Message String
"/b_info" [Int32 Int32
p, Int32 Int32
q, Int32 Int32
r, Float Float
s] -> (i, i, i, f) -> Maybe (i, i, i, f)
forall a. a -> Maybe a
Just (Int32 -> i
to_i Int32
p, Int32 -> i
to_i Int32
q, Int32 -> i
to_i Int32
r, Float -> f
to_f Float
s)
      Message
_ -> Maybe (i, i, i, f)
forall a. Maybe a
Nothing

-- | Variant generating 'error'.
unpack_b_info_err :: (Num i, Fractional f) => Message -> (i, i, i, f)
unpack_b_info_err :: forall i f. (Num i, Fractional f) => Message -> (i, i, i, f)
unpack_b_info_err = (i, i, i, f) -> Maybe (i, i, i, f) -> (i, i, i, f)
forall a. a -> Maybe a -> a
fromMaybe (String -> (i, i, i, f)
forall a. HasCallStack => String -> a
error String
"unpack_b_info") (Maybe (i, i, i, f) -> (i, i, i, f))
-> (Message -> Maybe (i, i, i, f)) -> Message -> (i, i, i, f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Maybe (i, i, i, f)
forall i f. (Num i, Fractional f) => Message -> Maybe (i, i, i, f)
unpack_b_info

-- Local Variables:
-- truncate-lines:t
-- End: