-- | 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 B
import qualified Sound.SC3.Server.Command.Enum as C
import qualified Sound.SC3.Server.Enum as E
import qualified Sound.SC3.Server.Graphdef as G
import qualified Sound.SC3.Server.Synthdef as S

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

-- * Buffer commands (b_)

-- | BUF-NUM must be >= 0
b_bufnum :: Integral t => t -> Datum
b_bufnum = int32 . cmd_check_arg "buffer-number < 0?" (>= 0)

-- | BUF-FRAME-IX must be >= 0
b_ix :: Integral t => t -> Datum
b_ix = int32 . cmd_check_arg "buffer-ix < 0?" (>= 0)

-- | BUF-CHANNEL must be >= 0
b_ch :: Integral t => t -> Datum
b_ch = int32 . cmd_check_arg "buffer-channel < 0?" (>= 0)

-- | BUF-FRAME-CNT must be >= 0
b_size :: Integral t => t -> Datum
b_size = int32 . cmd_check_arg "buffer-size < 0?" (>= 0)

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

-- | Allocate buffer space and read a sound file. (Asynchronous)
b_allocRead :: Integral i => i -> String -> i -> i -> Message
b_allocRead b p f n = message "/b_allocRead" [b_bufnum b,string p,b_ix f,b_ix n]

-- | Allocate buffer space and read a sound file, picking specific channels. (Asynchronous)
b_allocReadChannel :: Integral i => i -> String -> i -> i -> [i] -> Message
b_allocReadChannel b p f n cs = message "/b_allocReadChannel" ([b_bufnum b,string p,b_ix f,b_ix n] ++ map b_ch cs)

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

-- | Fill ranges of sample values.
b_fill :: (Integral i,Real n) => i -> [(i,i,n)] -> Message
b_fill b l = message "/b_fill" (b_bufnum b : B.mk_triples int32 int32 float l)

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

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

-- | Call @sine1@ 'b_gen' command.
b_gen_sine1 :: (Integral i,Real n) => i -> [E.B_Gen] -> [n] -> Message
b_gen_sine1 z f n = b_gen z "sine1" (int32 (E.b_gen_flag f) : map float n)

-- | Call @sine2@ 'b_gen' command.
b_gen_sine2 :: (Integral i,Real n) => i -> [E.B_Gen] -> [(n,n)] -> Message
b_gen_sine2 z f n = b_gen z "sine2" (int32 (E.b_gen_flag f) : B.mk_duples float float n)

-- | Call @sine3@ 'b_gen' command.
b_gen_sine3 :: (Integral i,Real n) => i -> [E.B_Gen] -> [(n,n,n)] -> Message
b_gen_sine3 z f n = b_gen z "sine3" (int32 (E.b_gen_flag f) : B.mk_triples float float float n)

-- | Call @cheby@ 'b_gen' command.
b_gen_cheby :: (Integral i,Real n) => i -> [E.B_Gen] -> [n] -> Message
b_gen_cheby z f n = b_gen z "cheby" (int32 (E.b_gen_flag f) : map float n)

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

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

-- | Get ranges of sample values.
b_getn :: Integral i => i -> [(i,i)] -> Message
b_getn b l = message "/b_getn" (b_bufnum b : B.mk_duples b_ix b_size l)

-- | Request \/b_info messages.
b_query :: Integral i => [i] -> Message
b_query = message "/b_query" . map int32

-- | Read sound file data into an existing buffer. (Asynchronous)
b_read :: Integral i => i -> String -> i -> i -> i -> Bool -> Message
b_read b p f n f' z = message "/b_read" [b_bufnum b,string p,int32 f,int32 n,int32 f',int32 (fromEnum z)]

-- | 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 b p f n f' z cs = message "/b_readChannel" ([b_bufnum b,string p,int32 f,int32 n,int32 f',int32 (fromEnum z)] ++ map int32 cs)

-- | Set sample values.
b_set :: (Integral i,Real n) => i -> [(i,n)] -> Message
b_set b l = message "/b_set" (b_bufnum b : B.mk_duples int32 float l)

-- | Set ranges of sample values.
b_setn :: (Integral i,Real n) => i -> [(i,[n])] -> Message
b_setn b l =
    let f (i,d) = int32 i : int32 (length d) : map float d
    in message "/b_setn" (b_bufnum b : concatMap f l)

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

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

-- * Control bus commands (c_)

-- |  Fill ranges of bus values.
c_fill :: (Integral i,Real n) => [(i,i,n)] -> Message
c_fill = message "/c_fill" . B.mk_triples int32 int32 float

-- | Get bus values.
c_get :: Integral i => [i] -> Message
c_get = message "/c_get" . map int32

-- | Get ranges of bus values.
c_getn :: Integral i => [(i,i)] -> Message
c_getn = message "/c_getn" . B.mk_duples int32 int32

-- | Set bus values.
c_set :: (Integral i,Real n) => [(i,n)] -> Message
c_set = message "/c_set" . B.mk_duples int32 float

-- | Set ranges of bus values.
c_setn :: (Integral i,Real n) => [(i,[n])] -> Message
c_setn l =
    let f (i,d) = int32 i : int32 (length d) : map float d
    in message "/c_setn" (concatMap f l)

-- * Instrument definition commands (d_)

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

-- | 'G.Graphdef' encoding variant.
d_recv_gr :: G.Graphdef -> Message
d_recv_gr = d_recv_bytes . G.encode_graphdef

-- | 'S.Synthdef' encoding variant.
d_recv :: S.Synthdef -> Message
d_recv = d_recv_bytes . S.synthdefData

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

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

-- | Remove definition once all nodes using it have ended.
d_free :: [String] -> Message
d_free = message "/d_free" . map string

-- * Group node commands (g_)

-- | Free all synths in this group and all its sub-groups.
g_deepFree :: Integral i => [i] -> Message
g_deepFree = message "/g_deepFree" . map int32

-- | Delete all nodes in a group.
g_freeAll :: Integral i => [i] -> Message
g_freeAll = message "/g_freeAll" . map int32

-- | Add node to head of group.
g_head :: Integral i => [(i,i)] -> Message
g_head = message "/g_head" . B.mk_duples int32 int32

-- | Create a new group.
g_new :: Integral i => [(i,E.AddAction,i)] -> Message
g_new = message "/g_new" . B.mk_triples int32 (int32 . fromEnum) int32

-- | Add node to tail of group.
g_tail :: Integral i => [(i,i)] -> Message
g_tail = message "/g_tail" . B.mk_duples int32 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 = message "/g_dumpTree" . B.mk_duples int32 (int32 . 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 = message "/g_queryTree" . B.mk_duples int32 (int32 . fromEnum)

-- * Node commands (n_)

-- | NODE-ID must be >= -1
n_id :: Integral t => t -> Datum
n_id = int32 . cmd_check_arg "node-id < -1?" (>= (-1))

-- | Place a node after another.
n_after :: Integral i => [(i,i)] -> Message
n_after = message "/n_after" . B.mk_duples n_id n_id

-- | Place a node before another.
n_before :: Integral i => [(i,i)] -> Message
n_before = message "/n_before" . B.mk_duples int32 int32

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

-- | Delete a node.
n_free :: Integral i => [i] -> Message
n_free = message "/n_free" . map n_id

n_map :: Integral i => i -> [(String,i)] -> Message
n_map n l = message "/n_map" (n_id n : B.mk_duples string int32 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 n l = message "/n_mapn" (n_id n : B.mk_triples int32 int32 int32 l)

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

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

-- | Get info about a node.
n_query :: Integral i => [i] -> Message
n_query = message "/n_query" . map n_id

-- | Turn node on or off.
n_run :: Integral i => [(i,Bool)] -> Message
n_run = message "/n_run" . B.mk_duples n_id (int32 . fromEnum)

-- | Set a node's control values.
n_set :: (Integral i,Real n) => i -> [(String,n)] -> Message
n_set n c = message "/n_set" (n_id n : B.mk_duples string float 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 n l =
    let f (s,d) = int32 s : int32 (length d) : map float d
    in message "/n_setn" (n_id n : concatMap f l)

-- | Trace a node.
n_trace :: Integral i => [i] -> Message
n_trace = message "/n_trace" . map int32

-- | Move an ordered sequence of nodes.
n_order :: Integral i => E.AddAction -> i -> [i] -> Message
n_order a n ns = message "/n_order" (int32 (fromEnum a) : int32 n : map int32 ns)

-- * Par commands (p_)

-- | Create a new parallel group (supernova specific).
p_new :: Integral i => [(i,E.AddAction,i)] -> Message
p_new = message "/p_new" . B.mk_triples int32 (int32 . fromEnum) int32

-- * Synthesis node commands (s_)

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

-- | Get ranges of control values.
s_getn :: Integral i => i -> [(String,i)] -> Message
s_getn n l = message "/s_getn" (n_id n : B.mk_duples string int32 l)

-- | Create a new synth.
s_new :: (Integral i,Real n) => String -> i -> E.AddAction -> i -> [(String,n)] -> Message
s_new n i a t c = message "/s_new" (string n : int32 i : int32 (fromEnum a) : int32 t : B.mk_duples string float c)

-- | Auto-reassign synth's ID to a reserved value.
s_noid :: Integral i => [i] -> Message
s_noid = message "/s_noid" . map int32

-- * UGen commands (u_)

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

-- * Server operation commands

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

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

-- | Select printing of incoming Open Sound Control messages.
dumpOSC :: E.PrintLevel -> Message
dumpOSC c = message "/dumpOSC" [int32 (fromEnum c)]

-- | Set error posting scope and mode.
errorMode :: E.ErrorScope -> E.ErrorMode -> Message
errorMode scope mode =
    let e = case scope of
              E.Globally -> fromEnum mode
              E.Locally  -> -1 - fromEnum mode
    in message "/error" [int32 e]

-- | Select reception of notification messages. (Asynchronous)
notify :: Bool -> Message
notify c = message "/notify" [int32 (fromEnum c)]

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

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

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

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

-- * Modify existing message to include completion message

-- | Add a completion packet to an existing asynchronous command.
with_completion_packet :: Message -> Packet -> Message
with_completion_packet (Message c xs) cm =
    if c `elem` C.async_cmds
    then let xs' = xs ++ [Blob (encodePacket cm)]
         in Message c xs'
    else error ("with_completion_packet: not async: " ++ c)

-- | Add a completion message to an existing asynchronous command.
--
-- > let m = n_set1 0 "0" 0
-- > let e = encodeMessage m
-- > withCM (b_close 0) m == Message "/b_close" [Int32 0,Blob e]
withCM :: Message -> Message -> Message
withCM m cm = with_completion_packet m (Packet_Message cm)

-- * 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 b i xs =
    let k = i + genericLength xs
        xs' = genericReplicate i 0 ++ xs
    in withCM (b_alloc b k 1) (b_setn1 b 0 xs')

-- | Get ranges of sample values.
b_getn1 :: Integral i => i -> (i,i) -> Message
b_getn1 b = b_getn b . return

-- | Variant on 'b_query'.
b_query1 :: Integral i => i -> Message
b_query1 = b_query . return

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

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

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

-- | Get ranges of sample values.
c_getn1 :: Integral i => (i,i) -> Message
c_getn1 = c_getn . return

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

-- | Set single range of bus values.
c_setn1 :: (Integral i,Real n) => (i,[n]) -> Message
c_setn1 = c_setn . return

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

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

-- | @s_new@ with no parameters.
s_new0 :: Integral i => String -> i -> E.AddAction -> i -> Message
s_new0 n i a t = s_new n i a 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
b_segment :: Integral i => i -> i -> [i]
b_segment n m =
    let (q,r) = m `quotRem` n
        s = genericReplicate q n
    in if r == 0 then s else r : 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)
-- > b_indices 1024 2056 16 == [(16,8),(24,1024),(1048,1024)]
b_indices :: Integral i => i -> i -> i -> [(i,i)]
b_indices n m k =
    let s = b_segment n m
        i = 0 : B.dx_d s
    in zip (map (+ k) i) s

-- * UGen commands.

-- | Generate accumulation buffer given time-domain IR buffer and FFT size.
pc_preparePartConv :: Integral i => i -> i -> i -> Message
pc_preparePartConv b irb fft_size =
    b_gen b "PreparePartConv" (map int32 [irb, 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 m =
    let to_i = fromIntegral
    in case m of
         [Int32 i1,Int32 i2,Int32 i3,Int32 i4,Int32 i5] -> [to_i i1,to_i i2,to_i i3,to_i i4,to_i i5]
         [Int32 i1,Int32 i2,Int32 i3,Int32 i4,Int32 i5,Int32 i6,Int32 i7] -> [to_i i1,to_i i2,to_i i3,to_i i4,to_i i5,to_i i6,to_i i7]
         _ -> []

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

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

unpack_n_info_err :: Num i => Message -> (i,i,i,i,i,Maybe (i,i))
unpack_n_info_err = fromMaybe (error "unpack_n_info") . unpack_n_info

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

unpack_tr_err :: (Num i,Fractional f) => Message -> (i,i,f)
unpack_tr_err = fromMaybe (error "unpack_tr") . unpack_tr

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

unpack_b_setn_err :: (Num i,Fractional f) => Message -> (i,i,i,[f])
unpack_b_setn_err = fromMaybe (error "unpack_b_setn") . 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 m =
    let to_i = fromIntegral
        to_f = realToFrac
    in case m of
         Message "/b_info" [Int32 p,Int32 q,Int32 r,Float s] -> Just (to_i p,to_i q,to_i r,to_f s)
         _ -> Nothing

-- | Variant generating 'error'.
unpack_b_info_err :: (Num i,Fractional f) => Message -> (i,i,i,f)
unpack_b_info_err = fromMaybe (error "unpack_b_info") . unpack_b_info

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