module Sound.SC3.Server.Status where
import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Maybe
import qualified Data.Tree as T
import Sound.OSC.Datum
extractStatusField :: Floating n => Int -> [Datum] -> n
extractStatusField n =
fromMaybe (error "extractStatusField")
. datum_floating
. (!! n)
statusFields :: [String]
statusFields =
["Unused "
,"# UGens "
,"# Synths "
,"# Groups "
,"# Instruments "
,"% CPU (Average) "
,"% CPU (Peak) "
,"Sample Rate (Nominal) "
,"Sample Rate (Actual) "]
statusFormat :: [Datum] -> [String]
statusFormat d =
let s = "***** SuperCollider Server Status *****"
in s : zipWith (++) (tail statusFields) (map (datum_pp_typed (Just 5)) (tail d))
type Query_Ctl = (Either String Int,Either Double Int)
data Query_Node = Query_Group Int [Query_Node]
| Query_Synth Int String (Maybe [Query_Ctl])
deriving (Eq,Show)
query_ctl_pp :: Query_Ctl -> String
query_ctl_pp (p,q) = either id show p ++ ":" ++ either show show q
query_node_pp :: Query_Node -> String
query_node_pp n =
case n of
Query_Group k _ -> show k
Query_Synth k nm c ->
let c' = unwords (map query_ctl_pp (fromMaybe [] c))
in show (k,nm,c')
queryTree_ctl :: (Datum,Datum) -> Query_Ctl
queryTree_ctl (p,q) =
let err msg val = error (show ("queryTree_ctl",msg,val))
f d = case d of
ASCII_String nm -> Left (C.unpack nm)
Int32 ix -> Right (fromIntegral ix)
_ -> err "string/int32" d
g d = case d of
Float k -> Left (realToFrac k)
ASCII_String b -> case C.unpack b of
'c' : n -> Right (read n)
_ -> err "c:_" d
_ -> err "float/string" d
in (f p,g q)
queryTree_synth :: Bool -> Int -> String -> [Datum] -> (Query_Node,[Datum])
queryTree_synth rc k nm d =
let pairs l = case l of
e0:e1:l' -> (e0,e1) : pairs l'
_ -> []
f r = case r of
Int32 n : r' -> let (p,r'') = genericSplitAt (n * 2) r'
in (map queryTree_ctl (pairs p),r'')
_ -> error "queryTree_synth"
in if rc
then let (p,d') = f d
in (Query_Synth k nm (Just p),d')
else (Query_Synth k nm Nothing,d)
queryTree_group :: Bool -> Int -> Int -> [Datum] -> (Query_Node,[Datum])
queryTree_group rc gid nc =
let recur n r d =
if n == 0
then (Query_Group gid (reverse r),d)
else let (c,d') = queryTree_child rc d
in recur (n 1) (c : r) d'
in recur nc []
queryTree_child :: Bool -> [Datum] -> (Query_Node,[Datum])
queryTree_child rc d =
case d of
Int32 nid : Int32 (1) : ASCII_String nm : d' ->
queryTree_synth rc (fromIntegral nid) (C.unpack nm) d'
Int32 gid : Int32 nc : d' ->
queryTree_group rc (fromIntegral gid) (fromIntegral nc) d'
_ -> error "queryTree_child"
queryTree :: [Datum] -> Query_Node
queryTree d =
case d of
Int32 rc : Int32 gid : Int32 nc : d' ->
let rc' = rc /= 0
gid' = fromIntegral gid
nc' = fromIntegral nc
in case queryTree_group rc' gid' nc' d' of
(r,[]) -> r
_ -> error "queryTree"
_ -> error "queryTree"
queryNode_to_group_seq :: Query_Node -> [Int]
queryNode_to_group_seq nd =
case nd of
Query_Group k ch -> k : concatMap queryNode_to_group_seq ch
Query_Synth _ _ _ -> []
queryTree_rt :: Query_Node -> T.Tree Query_Node
queryTree_rt n =
case n of
Query_Synth _ _ _ -> T.Node n []
Query_Group _ c -> T.Node n (map queryTree_rt c)