{- | This module provides variations of the asynchronous server commands that
expect a /completion packet/ as the first argument. The completion packet
is executed by the server when the asynchronous command has finished. Note
that this mechanism is for synchronizing server side processes only, for
client side synchronization use @\/done@ message notification or the
@\/sync@ barrier.
-}
module Sound.Sc3.Server.Command.Plain.Completion where

import Sound.Osc.Core {- hosc -}

import Sound.Sc3.Server.Enum
import Sound.Sc3.Server.Synthdef

-- | Encode an Osc packet as an Osc blob.
encode_blob :: PacketOf Message -> Datum
encode_blob :: PacketOf Message -> Datum
encode_blob = Blob -> Datum
Blob (Blob -> Datum)
-> (PacketOf Message -> Blob) -> PacketOf Message -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PacketOf Message -> Blob
encodePacket

-- | Install a bytecode instrument definition. (Asynchronous)
d_recv :: PacketOf Message -> Synthdef -> Message
d_recv :: PacketOf Message -> Synthdef -> Message
d_recv PacketOf Message
pkt Synthdef
d = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/d_recv" [Blob -> Datum
Blob (Synthdef -> Blob
synthdefData Synthdef
d), PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

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

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

-- | Allocates zero filled buffer to number of channels and samples. (Asynchronous)
b_alloc :: PacketOf Message -> Int -> Int -> Int -> Message
b_alloc :: PacketOf Message -> Int -> Int -> Int -> Message
b_alloc PacketOf Message
pkt Int
nid Int
frames Int
channels = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_alloc" [Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
frames, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
channels, PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

-- | Allocate buffer space and read a sound file. (Asynchronous)
b_allocRead :: PacketOf Message -> Int -> String -> Int -> Int -> Message
b_allocRead :: PacketOf Message -> Int -> Address_Pattern -> Int -> Int -> Message
b_allocRead PacketOf Message
pkt Int
nid Address_Pattern
p Int
f Int
n = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_allocRead" [Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, Address_Pattern -> Datum
string Address_Pattern
p, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
f, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
n, PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

-- | Allocate buffer space and read a sound file, picking specific channels. (Asynchronous)
b_allocReadChannel :: PacketOf Message -> Int -> String -> Int -> Int -> [Int] -> Message
b_allocReadChannel :: PacketOf Message
-> Int -> Address_Pattern -> Int -> Int -> [Int] -> Message
b_allocReadChannel PacketOf Message
pkt Int
nid Address_Pattern
p Int
f Int
n [Int]
cs = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_allocReadChannel" ([Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, Address_Pattern -> Datum
string Address_Pattern
p, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
f, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
n] [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ (Int -> Datum) -> [Int] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Datum
forall n. Integral n => n -> Datum
int32 [Int]
cs [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ [PacketOf Message -> Datum
encode_blob PacketOf Message
pkt])

-- | Free buffer data. (Asynchronous)
b_free :: PacketOf Message -> Int -> Message
b_free :: PacketOf Message -> Int -> Message
b_free PacketOf Message
pkt Int
nid = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_free" [Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

-- | Close attached soundfile and write header information. (Asynchronous)
b_close :: PacketOf Message -> Int -> Message
b_close :: PacketOf Message -> Int -> Message
b_close PacketOf Message
pkt Int
nid = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_close" [Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

-- | Read sound file data into an existing buffer. (Asynchronous)
b_read :: PacketOf Message -> Int -> String -> Int -> Int -> Int -> Bool -> Message
b_read :: PacketOf Message
-> Int -> Address_Pattern -> Int -> Int -> Int -> Bool -> Message
b_read PacketOf Message
pkt Int
nid Address_Pattern
p Int
f Int
n Int
f' Bool
z = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_read" [Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, Address_Pattern -> Datum
string Address_Pattern
p, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
f, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
n, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
f', Int -> Datum
forall n. Integral n => n -> Datum
int32 (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
z), PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

-- | Read sound file data into an existing buffer. (Asynchronous)
b_readChannel :: PacketOf Message -> Int -> String -> Int -> Int -> Int -> Bool -> [Int] -> Message
b_readChannel :: PacketOf Message
-> Int
-> Address_Pattern
-> Int
-> Int
-> Int
-> Bool
-> [Int]
-> Message
b_readChannel PacketOf Message
pkt Int
nid Address_Pattern
p Int
f Int
n Int
f' Bool
z [Int]
cs = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_readChannel" ([Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, Address_Pattern -> Datum
string Address_Pattern
p, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
f, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
n, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
f', Int -> Datum
forall n. Integral n => n -> Datum
int32 (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
z)] [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ (Int -> Datum) -> [Int] -> [Datum]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Datum
forall n. Integral n => n -> Datum
int32 [Int]
cs [Datum] -> [Datum] -> [Datum]
forall a. [a] -> [a] -> [a]
++ [PacketOf Message -> Datum
encode_blob PacketOf Message
pkt])

-- | Write sound file data. (Asynchronous)
b_write :: PacketOf Message -> Int -> String -> SoundFileFormat -> SampleFormat -> Int -> Int -> Bool -> Message
b_write :: PacketOf Message
-> Int
-> Address_Pattern
-> SoundFileFormat
-> SampleFormat
-> Int
-> Int
-> Bool
-> Message
b_write PacketOf Message
pkt Int
nid Address_Pattern
p SoundFileFormat
h SampleFormat
t Int
f Int
s Bool
z = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_write" [Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, Address_Pattern -> Datum
string Address_Pattern
p, Address_Pattern -> Datum
string (SoundFileFormat -> Address_Pattern
soundFileFormatString SoundFileFormat
h), Address_Pattern -> Datum
string (SampleFormat -> Address_Pattern
sampleFormatString SampleFormat
t), Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
f, Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
s, Int -> Datum
forall n. Integral n => n -> Datum
int32 (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
z), PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

-- | Zero sample data. (Asynchronous)
b_zero :: PacketOf Message -> Int -> Message
b_zero :: PacketOf Message -> Int -> Message
b_zero PacketOf Message
pkt Int
nid = Address_Pattern -> [Datum] -> Message
Message Address_Pattern
"/b_zero" [Int -> Datum
forall n. Integral n => n -> Datum
int32 Int
nid, PacketOf Message -> Datum
encode_blob PacketOf Message
pkt]

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