{- | Request and display status information from the synthesis server.

\/status messages receive \/status.reply messages.

\/g_queryTree messages recieve \/g_queryTree.reply messages.

-}
module Sound.Sc3.Server.Status where

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

import qualified Data.ByteString.Char8 as C {- bytestring -}
import qualified Data.Tree as T {- containers -}
import qualified Safe {- safe -}

import Sound.Osc.Datum {- hosc -}
import Sound.Osc.Text {- hosc -}

import Sound.Sc3.Server.Command.Plain

-- * Status

-- | Get /n/th field of /status.reply message as 'Floating'.
extractStatusField :: Floating n => Int -> [Datum] -> n
extractStatusField :: forall n. Floating n => Int -> [Datum] -> n
extractStatusField Int
n =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"extractStatusField")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Floating n => Datum -> Maybe n
datum_floating
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. HasCallStack => String -> [a] -> Int -> a
Safe.atNote String
"extractStatusField") Int
n

-- | Names of /status.reply fields sent in reply to /status request.
statusFields :: [String]
statusFields :: [String]
statusFields =
    [String
"Unused                      "
    ,String
"# Ugens                     "
    ,String
"# Synths                    "
    ,String
"# Groups                    "
    ,String
"# Synthdefs                 "
    ,String
"% CPU (Average)             "
    ,String
"% CPU (Peak)                "
    ,String
"Sample Rate (Nominal)       "
    ,String
"Sample Rate (Actual)        "]

-- | Status pretty printer.
statusFormat :: [Datum] -> [String]
statusFormat :: [Datum] -> [String]
statusFormat [Datum]
d =
    let s :: String
s = String
"***** SuperCollider Server Status *****"
    in String
s forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) (forall a. [a] -> [a]
tail [String]
statusFields) (forall a b. (a -> b) -> [a] -> [b]
map (FpPrecision -> Datum -> String
showDatum (forall a. a -> Maybe a
Just Int
5)) (forall a. [a] -> [a]
tail [Datum]
d))

-- | Concise pretty printer, one line, omits PEAK-CPU and NOMINAL-SR.
status_format_concise :: [Datum] -> String
status_format_concise :: [Datum] -> String
status_format_concise [Datum]
d =
  case [Datum]
d of
    [Int32 Int32
_,Int32 Int32
ugn,Int32 Int32
grp,Int32 Int32
syn,Int32 Int32
ins,Float Float
cpu1,Float Float
_cpu2,Double Double
_sr1,Double Double
sr2] ->
      forall r. PrintfType r => String -> r
printf
      String
"UGN=%-5d GRP=%-5d SYN=%-5d INS=%-5d CPU=%-5.1f SR=%-7.1f"
      Int32
ugn Int32
grp Int32
syn Int32
ins Float
cpu1 Double
sr2
    [Datum]
_ -> forall a. HasCallStack => String -> a
error String
"status_format_concise?"

-- * Query Group

-- | Name or index and value or bus mapping.
type Query_Ctl = (Either String Int,Either Double Int)

-- | Nodes are either groups of synths.
data Query_Node = Query_Group Group_Id [Query_Node]
                | Query_Synth Synth_Id String (Maybe [Query_Ctl])
                deriving (Query_Node -> Query_Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Query_Node -> Query_Node -> Bool
$c/= :: Query_Node -> Query_Node -> Bool
== :: Query_Node -> Query_Node -> Bool
$c== :: Query_Node -> Query_Node -> Bool
Eq,Int -> Query_Node -> ShowS
[Query_Node] -> ShowS
Query_Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query_Node] -> ShowS
$cshowList :: [Query_Node] -> ShowS
show :: Query_Node -> String
$cshow :: Query_Node -> String
showsPrec :: Int -> Query_Node -> ShowS
$cshowsPrec :: Int -> Query_Node -> ShowS
Show)

-- | Pretty-print 'Query_Ctl'
query_ctl_pp :: Query_Ctl -> String
query_ctl_pp :: Query_Ctl -> String
query_ctl_pp (Either String Int
p,Either Double Int
q) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. Show a => a -> String
show Either String Int
p forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Show a => a -> String
show forall a. Show a => a -> String
show Either Double Int
q

-- | Pretty-print 'Query_Node'
query_node_pp :: Query_Node -> String
query_node_pp :: Query_Node -> String
query_node_pp Query_Node
n =
    case Query_Node
n of
      Query_Group Int
k [Query_Node]
_ -> forall a. Show a => a -> String
show Int
k
      Query_Synth Int
k String
nm Maybe [Query_Ctl]
c ->
          let c' :: String
c' = [String] -> String
unwords (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map Query_Ctl -> String
query_ctl_pp) Maybe [Query_Ctl]
c)
          in forall a. Show a => a -> String
show (Int
k,String
nm,String
c')

-- | Control (parameter) data may be given as names or indices and as
-- values or bus mappings.
--
-- > queryTree_ctl (string "freq",float 440) == (Left "freq",Left 440.0)
-- > queryTree_ctl (int32 1,string "c0") == (Right 1,Right 0)
queryTree_ctl :: (Datum,Datum) -> Query_Ctl
queryTree_ctl :: (Datum, Datum) -> Query_Ctl
queryTree_ctl (Datum
p,Datum
q) =
    let err :: b -> c -> a
err b
msg c
val = forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"queryTree_ctl",b
msg,c
val))
        f :: Datum -> Either String b
f Datum
d = case Datum
d of
                AsciiString Ascii
nm -> forall a b. a -> Either a b
Left (Ascii -> String
C.unpack Ascii
nm)
                Int32 Int32
ix -> forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ix)
                Datum
_ -> forall {b} {c} {a}. (Show b, Show c) => b -> c -> a
err String
"string/int32" Datum
d
        g :: Datum -> Either a b
g Datum
d = case Datum
d of
                Float Float
k -> forall a b. a -> Either a b
Left (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
k)
                AsciiString Ascii
b -> case Ascii -> String
C.unpack Ascii
b of
                                    Char
'c' : String
n -> forall a b. b -> Either a b
Right (forall a. Read a => String -> a
read String
n)
                                    String
_ -> forall {b} {c} {a}. (Show b, Show c) => b -> c -> a
err String
"c:_" Datum
d
                Datum
_ -> forall {b} {c} {a}. (Show b, Show c) => b -> c -> a
err String
"float/string" Datum
d
    in (forall {b}. Num b => Datum -> Either String b
f Datum
p,forall {a} {b}. (Fractional a, Read b) => Datum -> Either a b
g Datum
q)

{- | If /rc/ is 'True' then 'Query_Ctl' data is expected (ie. flag was set at @\/g_queryTree@).
/k/ is the synth-id, and /nm/ the name.

> let d = [int32 1,string "freq",float 440]
> in queryTree_synth True 1000 "saw" d

-}
queryTree_synth :: Bool -> Synth_Id -> String -> [Datum] -> (Query_Node,[Datum])
queryTree_synth :: Bool -> Int -> String -> [Datum] -> (Query_Node, [Datum])
queryTree_synth Bool
rc Int
k String
nm [Datum]
d =
    let pairs :: [b] -> [(b, b)]
pairs [b]
l = case [b]
l of
                    b
e0:b
e1:[b]
l' -> (b
e0,b
e1) forall a. a -> [a] -> [a]
: [b] -> [(b, b)]
pairs [b]
l'
                    [b]
_ -> []
        f :: [Datum] -> ([Query_Ctl], [Datum])
f [Datum]
r = case [Datum]
r of
                Int32 Int32
n : [Datum]
r' -> let ([Datum]
p,[Datum]
r'') = forall i a. Integral i => i -> [a] -> ([a], [a])
genericSplitAt (Int32
n forall a. Num a => a -> a -> a
* Int32
2) [Datum]
r'
                                in (forall a b. (a -> b) -> [a] -> [b]
map (Datum, Datum) -> Query_Ctl
queryTree_ctl (forall {b}. [b] -> [(b, b)]
pairs [Datum]
p),[Datum]
r'')
                [Datum]
_ -> forall a. HasCallStack => String -> a
error String
"queryTree_synth"
    in if Bool
rc
       then let ([Query_Ctl]
p,[Datum]
d') = [Datum] -> ([Query_Ctl], [Datum])
f [Datum]
d
            in (Int -> String -> Maybe [Query_Ctl] -> Query_Node
Query_Synth Int
k String
nm (forall a. a -> Maybe a
Just [Query_Ctl]
p),[Datum]
d')
       else (Int -> String -> Maybe [Query_Ctl] -> Query_Node
Query_Synth Int
k String
nm forall a. Maybe a
Nothing,[Datum]
d)

-- | Generate 'Query_Node' for indicated 'Group_Id'.
queryTree_group :: Bool -> Group_Id -> Int -> [Datum] -> (Query_Node,[Datum])
queryTree_group :: Bool -> Int -> Int -> [Datum] -> (Query_Node, [Datum])
queryTree_group Bool
rc Int
gid Int
nc =
    let recur :: t -> [Query_Node] -> [Datum] -> (Query_Node, [Datum])
recur t
n [Query_Node]
r [Datum]
d =
            if t
n forall a. Eq a => a -> a -> Bool
== t
0
            then (Int -> [Query_Node] -> Query_Node
Query_Group Int
gid (forall a. [a] -> [a]
reverse [Query_Node]
r),[Datum]
d)
            else let (Query_Node
c,[Datum]
d') = Bool -> [Datum] -> (Query_Node, [Datum])
queryTree_child Bool
rc [Datum]
d
                 in t -> [Query_Node] -> [Datum] -> (Query_Node, [Datum])
recur (t
n forall a. Num a => a -> a -> a
- t
1) (Query_Node
c forall a. a -> [a] -> [a]
: [Query_Node]
r) [Datum]
d'
    in forall {t}.
(Eq t, Num t) =>
t -> [Query_Node] -> [Datum] -> (Query_Node, [Datum])
recur Int
nc []

-- | Either 'queryTree_synth' or 'queryTree_group'.
queryTree_child :: Bool -> [Datum] -> (Query_Node,[Datum])
queryTree_child :: Bool -> [Datum] -> (Query_Node, [Datum])
queryTree_child Bool
rc [Datum]
d =
    case [Datum]
d of
      Int32 Int32
nid : Int32 (-1) : AsciiString Ascii
nm : [Datum]
d' ->
          Bool -> Int -> String -> [Datum] -> (Query_Node, [Datum])
queryTree_synth Bool
rc (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nid) (Ascii -> String
C.unpack Ascii
nm) [Datum]
d'
      Int32 Int32
gid : Int32 Int32
nc : [Datum]
d' ->
          Bool -> Int -> Int -> [Datum] -> (Query_Node, [Datum])
queryTree_group Bool
rc (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
gid) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nc) [Datum]
d'
      [Datum]
_ -> forall a. HasCallStack => String -> a
error String
"queryTree_child"

-- | Parse result of ' g_queryTree '.
queryTree :: [Datum] -> Query_Node
queryTree :: [Datum] -> Query_Node
queryTree [Datum]
d =
    case [Datum]
d of
      Int32 Int32
rc : Int32 Int32
gid : Int32 Int32
nc : [Datum]
d' ->
          let rc' :: Bool
rc' = Int32
rc forall a. Eq a => a -> a -> Bool
/= Int32
0
              gid' :: Int
gid' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
gid
              nc' :: Int
nc' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
nc
          in case Bool -> Int -> Int -> [Datum] -> (Query_Node, [Datum])
queryTree_group Bool
rc' Int
gid' Int
nc' [Datum]
d' of
               (Query_Node
r,[]) -> Query_Node
r
               (Query_Node, [Datum])
_ -> forall a. HasCallStack => String -> a
error String
"queryTree"
      [Datum]
_ -> forall a. HasCallStack => String -> a
error String
"queryTree"

-- | Extact sequence of 'Group_Id's from 'Query_Node'.
queryNode_to_group_seq :: Query_Node -> [Group_Id]
queryNode_to_group_seq :: Query_Node -> [Int]
queryNode_to_group_seq Query_Node
nd =
    case Query_Node
nd of
      Query_Group Int
k [Query_Node]
ch -> Int
k forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Query_Node -> [Int]
queryNode_to_group_seq [Query_Node]
ch
      Query_Synth Int
_ String
_ Maybe [Query_Ctl]
_ -> []

-- | Transform 'Query_Node' to 'T.Tree'.
queryTree_rt :: Query_Node -> T.Tree Query_Node
queryTree_rt :: Query_Node -> Tree Query_Node
queryTree_rt Query_Node
n =
    case Query_Node
n of
      Query_Synth Int
_ String
_ Maybe [Query_Ctl]
_ -> forall a. a -> [Tree a] -> Tree a
T.Node Query_Node
n []
      Query_Group Int
_ [Query_Node]
c -> forall a. a -> [Tree a] -> Tree a
T.Node Query_Node
n (forall a b. (a -> b) -> [a] -> [b]
map Query_Node -> Tree Query_Node
queryTree_rt [Query_Node]
c)