-- | Binary 'Graph Definition' as understood by @scsynth@.
--   There are both encoders and decoders.
module Sound.SC3.Server.Graphdef where

import Control.Monad {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import System.FilePath {- filepath -}
import Text.Printf {- base -}

import qualified Data.Binary.Get as Get {- binary -}
import qualified Data.Binary.IEEE754 as IEEE754 {- data-binary-ieee754 -}
import qualified Data.ByteString.Lazy as L {- bytestring -}
import qualified Safe {- safe -}

import qualified Sound.OSC.Coding.Byte as Byte {- hosc -}
import qualified Sound.OSC.Coding.Cast as Cast {- hosc -}
import qualified Sound.OSC.Datum as Datum {- hosc -}

import qualified Sound.SC3.Common.Math.Operator as Operator {- hsc3 -}
import qualified Sound.SC3.Common.Rate as Rate {- hsc3 -}

-- * Type

-- | Names are ASCII strings (ie. ByteString.Char8)
type Name = Datum.ASCII

-- | Controls are a name and a ugen-index.
type Control = (Name,Int)

-- | Constants are floating point.
type Sample = Double

-- | UGen indices are Int.
type UGen_Index = Int

-- | Port indices are Int.
type Port_Index = Int

-- | Index used to indicate constants at UGen inputs.
--   Ie. if the ugen-index is this value (-1) it indicates a constant.
constant_index :: UGen_Index
constant_index :: UGen_Index
constant_index = -UGen_Index
1

-- | Inputs are a ugen-index and a port-index.
data Input = Input UGen_Index Port_Index deriving (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c== :: Input -> Input -> Bool
Eq,UGen_Index -> Input -> ShowS
[Input] -> ShowS
Input -> String
(UGen_Index -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(UGen_Index -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: UGen_Index -> Input -> ShowS
$cshowsPrec :: UGen_Index -> Input -> ShowS
Show)

-- | Rates are encoded as integers (IR = 0, KR = 1, AR = 2, DR = 3).
type Rate = Int

-- | Outputs each indicate a Rate.
type Output = Rate

-- | Secondary (special) index, used by operator UGens to select operation.
type Special = Int

-- | Unit generator type.
type UGen = (Name,Rate,[Input],[Output],Special)

-- | 'UGen' name.
ugen_name_str :: UGen -> String
ugen_name_str :: UGen -> String
ugen_name_str (Name
nm,UGen_Index
_,[Input]
_,[UGen_Index]
_,UGen_Index
_) = Name -> String
Datum.ascii_to_string Name
nm

-- | 'UGen' name, using operator name if appropriate.
ugen_name_op :: UGen -> String
ugen_name_op :: UGen -> String
ugen_name_op (Name
nm,UGen_Index
_,[Input]
_,[UGen_Index]
_,UGen_Index
k) =
  let s :: String
s = Name -> String
Datum.ascii_to_string Name
nm
  in String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
s (String -> UGen_Index -> Maybe String
Operator.ugen_operator_name String
s UGen_Index
k)

-- | 'UGen' 'Rate'.
ugen_rate :: UGen -> Rate
ugen_rate :: UGen -> UGen_Index
ugen_rate (Name
_,UGen_Index
r,[Input]
_,[UGen_Index]
_,UGen_Index
_) = UGen_Index
r

ugen_rate_enum :: UGen -> Rate.Rate
ugen_rate_enum :: UGen -> Rate
ugen_rate_enum = UGen_Index -> Rate
forall a. Enum a => UGen_Index -> a
toEnum (UGen_Index -> Rate) -> (UGen -> UGen_Index) -> UGen -> Rate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UGen -> UGen_Index
ugen_rate

-- | 'UGen' 'Input's.
ugen_inputs :: UGen -> [Input]
ugen_inputs :: UGen -> [Input]
ugen_inputs (Name
_,UGen_Index
_,[Input]
i,[UGen_Index]
_,UGen_Index
_) = [Input]
i

-- | 'UGen' 'Output's.
ugen_outputs :: UGen -> [Output]
ugen_outputs :: UGen -> [UGen_Index]
ugen_outputs (Name
_,UGen_Index
_,[Input]
_,[UGen_Index]
o,UGen_Index
_) = [UGen_Index]
o

-- | Predicate to examine UGen name and decide if it is a control.
ugen_is_control :: UGen -> Bool
ugen_is_control :: UGen -> Bool
ugen_is_control =
  (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"Control",String
"LagControl",String
"TrigControl"]) (String -> Bool) -> (UGen -> String) -> UGen -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  UGen -> String
ugen_name_str

-- | Input is a UGen (ie. not a constant, indicated by a ugen-index of -1) and the UGen is a control.
input_is_control :: Graphdef -> Input -> Bool
input_is_control :: Graphdef -> Input -> Bool
input_is_control Graphdef
g (Input UGen_Index
u UGen_Index
_) = (UGen_Index
u UGen_Index -> UGen_Index -> Bool
forall a. Eq a => a -> a -> Bool
/= UGen_Index
constant_index) Bool -> Bool -> Bool
&& UGen -> Bool
ugen_is_control (Graphdef -> UGen_Index -> UGen
graphdef_ugen Graphdef
g UGen_Index
u)

-- | Graph definition type.
data Graphdef = Graphdef {Graphdef -> Name
graphdef_name :: Name
                         ,Graphdef -> [Sample]
graphdef_constants :: [Sample]
                         ,Graphdef -> [(Control, Sample)]
graphdef_controls :: [(Control,Sample)]
                         ,Graphdef -> [UGen]
graphdef_ugens :: [UGen]}
                deriving (Graphdef -> Graphdef -> Bool
(Graphdef -> Graphdef -> Bool)
-> (Graphdef -> Graphdef -> Bool) -> Eq Graphdef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Graphdef -> Graphdef -> Bool
$c/= :: Graphdef -> Graphdef -> Bool
== :: Graphdef -> Graphdef -> Bool
$c== :: Graphdef -> Graphdef -> Bool
Eq,UGen_Index -> Graphdef -> ShowS
[Graphdef] -> ShowS
Graphdef -> String
(UGen_Index -> Graphdef -> ShowS)
-> (Graphdef -> String) -> ([Graphdef] -> ShowS) -> Show Graphdef
forall a.
(UGen_Index -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graphdef] -> ShowS
$cshowList :: [Graphdef] -> ShowS
show :: Graphdef -> String
$cshow :: Graphdef -> String
showsPrec :: UGen_Index -> Graphdef -> ShowS
$cshowsPrec :: UGen_Index -> Graphdef -> ShowS
Show)

-- | Lookup UGen by index.
graphdef_ugen :: Graphdef -> UGen_Index -> UGen
graphdef_ugen :: Graphdef -> UGen_Index -> UGen
graphdef_ugen Graphdef
g = String -> [UGen] -> UGen_Index -> UGen
forall a. Partial => String -> [a] -> UGen_Index -> a
Safe.atNote String
"graphdef_ugen" (Graphdef -> [UGen]
graphdef_ugens Graphdef
g)

-- | Lookup Control and default value by index.
graphdef_control :: Graphdef -> Int -> (Control,Sample)
graphdef_control :: Graphdef -> UGen_Index -> (Control, Sample)
graphdef_control Graphdef
g = String -> [(Control, Sample)] -> UGen_Index -> (Control, Sample)
forall a. Partial => String -> [a] -> UGen_Index -> a
Safe.atNote String
"graphdef_controls" (Graphdef -> [(Control, Sample)]
graphdef_controls Graphdef
g)

-- | nid of constant.
graphdef_constant_nid :: Graphdef -> Int -> Int
graphdef_constant_nid :: Graphdef -> UGen_Index -> UGen_Index
graphdef_constant_nid Graphdef
_ = UGen_Index -> UGen_Index
forall a. a -> a
id

-- | nid of control.
graphdef_control_nid :: Graphdef -> Int -> Int
graphdef_control_nid :: Graphdef -> UGen_Index -> UGen_Index
graphdef_control_nid Graphdef
g = UGen_Index -> UGen_Index -> UGen_Index
forall a. Num a => a -> a -> a
(+) ([Sample] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length (Graphdef -> [Sample]
graphdef_constants Graphdef
g))

-- | nid of UGen.
graphdef_ugen_nid :: Graphdef -> Int -> Int
graphdef_ugen_nid :: Graphdef -> UGen_Index -> UGen_Index
graphdef_ugen_nid Graphdef
g UGen_Index
n = Graphdef -> UGen_Index -> UGen_Index
graphdef_control_nid Graphdef
g UGen_Index
0 UGen_Index -> UGen_Index -> UGen_Index
forall a. Num a => a -> a -> a
+ [(Control, Sample)] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length (Graphdef -> [(Control, Sample)]
graphdef_controls Graphdef
g) UGen_Index -> UGen_Index -> UGen_Index
forall a. Num a => a -> a -> a
+ UGen_Index
n

-- * BINARY GET (version 0|1 or 2)

-- | Get a 'Name' (Pascal string).
get_pstr :: Get.Get Name
get_pstr :: Get Name
get_pstr = do
  Int64
n <- (Word8 -> Int64) -> Get Word8 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word8
Get.getWord8
  (ByteString -> Name) -> Get ByteString -> Get Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Name
Byte.decode_ascii (Int64 -> Get ByteString
Get.getLazyByteString Int64
n)

-- | Get functions for Graphdef types, (str_f,i8_f,i16_f,i32_f,f32_f)
type GET_F m = (m Name,m Int,m Int,m Int,m Double)

-- | GET_F for binary .scsyndef files.
binary_get_f :: GET_F Get.Get
binary_get_f :: GET_F Get
binary_get_f =
  (Get Name
get_pstr
  ,(Int8 -> UGen_Index) -> Get Int8 -> Get UGen_Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> UGen_Index
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int8
Get.getInt8
  ,(Int16 -> UGen_Index) -> Get Int16 -> Get UGen_Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> UGen_Index
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int16
Get.getInt16be
  ,(Int32 -> UGen_Index) -> Get Int32 -> Get UGen_Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> UGen_Index
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int32
Get.getInt32be
  ,(Float -> Sample) -> Get Float -> Get Sample
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Sample
forall a b. (Real a, Fractional b) => a -> b
realToFrac Get Float
IEEE754.getFloat32be)

-- | Get a 'Control'.
get_control :: Monad m => (GET_F m,m Int) -> m Control
get_control :: (GET_F m, m UGen_Index) -> m Control
get_control ((m Name
get_str,m UGen_Index
_,m UGen_Index
_,m UGen_Index
_,m Sample
_),m UGen_Index
get_i) = do
  Name
nm <- m Name
get_str
  UGen_Index
ix <- m UGen_Index
get_i
  Control -> m Control
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
nm,UGen_Index
ix)

-- | Get an 'Input'.
get_input :: Monad m => m Int -> m Input
get_input :: m UGen_Index -> m Input
get_input m UGen_Index
get_i = do
  UGen_Index
u <- m UGen_Index
get_i
  UGen_Index
p <- m UGen_Index
get_i
  Input -> m Input
forall (m :: * -> *) a. Monad m => a -> m a
return (UGen_Index -> UGen_Index -> Input
Input UGen_Index
u UGen_Index
p)

-- | Get a 'UGen'
get_ugen :: Monad m => (GET_F m,m Int) -> m UGen
get_ugen :: (GET_F m, m UGen_Index) -> m UGen
get_ugen ((m Name
get_str,m UGen_Index
get_i8,m UGen_Index
get_i16,m UGen_Index
_,m Sample
_),m UGen_Index
get_i) = do
  Name
name <- m Name
get_str
  UGen_Index
rate <- m UGen_Index
get_i8
  UGen_Index
number_of_inputs <- m UGen_Index
get_i
  UGen_Index
number_of_outputs <- m UGen_Index
get_i
  UGen_Index
special <- m UGen_Index
get_i16
  [Input]
inputs <- UGen_Index -> m Input -> m [Input]
forall (m :: * -> *) a. Applicative m => UGen_Index -> m a -> m [a]
replicateM UGen_Index
number_of_inputs (m UGen_Index -> m Input
forall (m :: * -> *). Monad m => m UGen_Index -> m Input
get_input m UGen_Index
get_i)
  [UGen_Index]
outputs <- UGen_Index -> m UGen_Index -> m [UGen_Index]
forall (m :: * -> *) a. Applicative m => UGen_Index -> m a -> m [a]
replicateM UGen_Index
number_of_outputs m UGen_Index
get_i8
  UGen -> m UGen
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name
         ,UGen_Index
rate
         ,[Input]
inputs
         ,[UGen_Index]
outputs
         ,UGen_Index
special)

-- | Get a 'Graphdef'. Supports version 0|1 and version 2 files.  Ignores variants.
get_graphdef :: Monad m => GET_F m -> m Graphdef
get_graphdef :: GET_F m -> m Graphdef
get_graphdef c :: GET_F m
c@(m Name
get_str,m UGen_Index
_,m UGen_Index
get_i16,m UGen_Index
get_i32,m Sample
get_f32) = do
  UGen_Index
magic <- m UGen_Index
get_i32
  UGen_Index
version <- m UGen_Index
get_i32
  let get_i :: m UGen_Index
get_i =
          case UGen_Index
version of
            UGen_Index
0 -> m UGen_Index
get_i16
            UGen_Index
1 -> m UGen_Index
get_i16 -- version one allows variants, which are not allowed by hsc3
            UGen_Index
2 -> m UGen_Index
get_i32
            UGen_Index
_ -> String -> m UGen_Index
forall a. Partial => String -> a
error (String
"get_graphdef: version not at {zero | one | two}: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UGen_Index -> String
forall a. Show a => a -> String
show UGen_Index
version)
  UGen_Index
number_of_definitions <- m UGen_Index
get_i16
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UGen_Index
magic UGen_Index -> UGen_Index -> Bool
forall a. Eq a => a -> a -> Bool
/= UGen_Index
forall n. Num n => n
scgf_i32)
       (String -> m ()
forall a. Partial => String -> a
error String
"get_graphdef: illegal magic string")
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UGen_Index
number_of_definitions UGen_Index -> UGen_Index -> Bool
forall a. Eq a => a -> a -> Bool
/= UGen_Index
1)
       (String -> m ()
forall a. Partial => String -> a
error String
"get_graphdef: non unary graphdef file")
  Name
name <- m Name
get_str
  UGen_Index
number_of_constants <- m UGen_Index
get_i
  [Sample]
constants <- UGen_Index -> m Sample -> m [Sample]
forall (m :: * -> *) a. Applicative m => UGen_Index -> m a -> m [a]
replicateM UGen_Index
number_of_constants m Sample
get_f32
  UGen_Index
number_of_control_defaults <- m UGen_Index
get_i
  [Sample]
control_defaults <- UGen_Index -> m Sample -> m [Sample]
forall (m :: * -> *) a. Applicative m => UGen_Index -> m a -> m [a]
replicateM UGen_Index
number_of_control_defaults m Sample
get_f32
  UGen_Index
number_of_controls <- m UGen_Index
get_i
  [Control]
controls <- UGen_Index -> m Control -> m [Control]
forall (m :: * -> *) a. Applicative m => UGen_Index -> m a -> m [a]
replicateM UGen_Index
number_of_controls ((GET_F m, m UGen_Index) -> m Control
forall (m :: * -> *).
Monad m =>
(GET_F m, m UGen_Index) -> m Control
get_control (GET_F m
c,m UGen_Index
get_i))
  UGen_Index
number_of_ugens <- m UGen_Index
get_i
  [UGen]
ugens <- UGen_Index -> m UGen -> m [UGen]
forall (m :: * -> *) a. Applicative m => UGen_Index -> m a -> m [a]
replicateM UGen_Index
number_of_ugens ((GET_F m, m UGen_Index) -> m UGen
forall (m :: * -> *). Monad m => (GET_F m, m UGen_Index) -> m UGen
get_ugen (GET_F m
c,m UGen_Index
get_i))
  Graphdef -> m Graphdef
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Sample] -> [(Control, Sample)] -> [UGen] -> Graphdef
Graphdef Name
name
                   [Sample]
constants
                   ([Control] -> [Sample] -> [(Control, Sample)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Control]
controls [Sample]
control_defaults)
                   [UGen]
ugens)

-- * READ

{- | Read Graphdef from .scsyndef file.

> dir = "/home/rohan/sw/rsc3-disassembler/scsyndef/"
> pp nm = read_graphdef_file (dir ++ nm) >>= putStrLn . graphdef_stat
> pp "simple.scsyndef"
> pp "with-ctl.scsyndef"
> pp "mce.scsyndef"
> pp "mrg.scsyndef"
-}
read_graphdef_file :: FilePath -> IO Graphdef
read_graphdef_file :: String -> IO Graphdef
read_graphdef_file String
nm = do
  ByteString
b <- String -> IO ByteString
L.readFile String
nm
  Graphdef -> IO Graphdef
forall (m :: * -> *) a. Monad m => a -> m a
return (Get Graphdef -> ByteString -> Graphdef
forall a. Get a -> ByteString -> a
Get.runGet (GET_F Get -> Get Graphdef
forall (m :: * -> *). Monad m => GET_F m -> m Graphdef
get_graphdef GET_F Get
binary_get_f) ByteString
b)

-- * STAT

-- | 'read_graphdef_file' and run 'graphdef_stat'.
scsyndef_stat :: FilePath -> IO String
scsyndef_stat :: String -> IO String
scsyndef_stat String
fn = do
  Graphdef
g <- String -> IO Graphdef
read_graphdef_file String
fn
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Graphdef -> String
graphdef_stat Graphdef
g)

-- * Encode (version zero)

-- | (join_f,str_f,i8_f,i16_f,i32_f,f32_f,com_f)
type ENCODE_F t = ([t] -> t,Name -> t,Int -> t,Int -> t,Int -> t,Double -> t,String -> t)

-- | 'ENCODE_F' for 'L.ByteString'
enc_bytestring :: ENCODE_F L.ByteString
enc_bytestring :: ENCODE_F ByteString
enc_bytestring =
  ([ByteString] -> ByteString
L.concat,Name -> ByteString
encode_pstr,UGen_Index -> ByteString
Byte.encode_i8,UGen_Index -> ByteString
Byte.encode_i16,UGen_Index -> ByteString
Byte.encode_i32,Sample -> ByteString
encode_sample
  ,ByteString -> String -> ByteString
forall a b. a -> b -> a
const ByteString
L.empty)

-- | Pascal (length prefixed) encoding of 'Name'.
encode_pstr :: Name -> L.ByteString
encode_pstr :: Name -> ByteString
encode_pstr = [Word8] -> ByteString
L.pack ([Word8] -> ByteString) -> (Name -> [Word8]) -> Name -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
Cast.str_pstr (String -> [Word8]) -> (Name -> String) -> Name -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
Datum.ascii_to_string

encode_input_f :: ENCODE_F t -> Input -> t
encode_input_f :: ENCODE_F t -> Input -> t
encode_input_f ([t] -> t
join_f,Name -> t
_,UGen_Index -> t
_,UGen_Index -> t
i16_f,UGen_Index -> t
_,Sample -> t
_,String -> t
_) (Input UGen_Index
u UGen_Index
p) = [t] -> t
join_f ((UGen_Index -> t) -> [UGen_Index] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map UGen_Index -> t
i16_f [UGen_Index
u,UGen_Index
p])

-- | Byte-encode 'Input'.
encode_input :: Input -> L.ByteString
encode_input :: Input -> ByteString
encode_input = ENCODE_F ByteString -> Input -> ByteString
forall t. ENCODE_F t -> Input -> t
encode_input_f ENCODE_F ByteString
enc_bytestring

encode_control_f :: ENCODE_F t -> Control -> t
encode_control_f :: ENCODE_F t -> Control -> t
encode_control_f ([t] -> t
join_f,Name -> t
str_f,UGen_Index -> t
_,UGen_Index -> t
i16_f,UGen_Index -> t
_,Sample -> t
_,String -> t
_) (Name
nm,UGen_Index
k) = [t] -> t
join_f [Name -> t
str_f Name
nm,UGen_Index -> t
i16_f UGen_Index
k]

-- | Byte-encode 'Control'.
encode_control :: Control -> L.ByteString
encode_control :: Control -> ByteString
encode_control = ENCODE_F ByteString -> Control -> ByteString
forall t. ENCODE_F t -> Control -> t
encode_control_f ENCODE_F ByteString
enc_bytestring

encode_ugen_f :: ENCODE_F t -> UGen -> t
encode_ugen_f :: ENCODE_F t -> UGen -> t
encode_ugen_f ENCODE_F t
enc (Name
nm,UGen_Index
r,[Input]
i,[UGen_Index]
o,UGen_Index
s) =
  let ([t] -> t
join_f,Name -> t
str_f,UGen_Index -> t
i8_f,UGen_Index -> t
i16_f,UGen_Index -> t
_,Sample -> t
_,String -> t
com_f) = ENCODE_F t
enc
  in [t] -> t
join_f [String -> t
com_f String
"ugen-name",Name -> t
str_f Name
nm
            ,String -> t
com_f String
"ugen-rate",UGen_Index -> t
i8_f UGen_Index
r
            ,String -> t
com_f String
"ugen-number-of-inputs",UGen_Index -> t
i16_f ([Input] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [Input]
i)
            ,String -> t
com_f String
"ugen-number-of-outputs",UGen_Index -> t
i16_f ([UGen_Index] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [UGen_Index]
o)
            ,String -> t
com_f String
"ugen-special",UGen_Index -> t
i16_f UGen_Index
s
            ,String -> t
com_f String
"ugen-inputs (ugen-index,port-index)",[t] -> t
join_f ((Input -> t) -> [Input] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (ENCODE_F t -> Input -> t
forall t. ENCODE_F t -> Input -> t
encode_input_f ENCODE_F t
enc) [Input]
i)
            ,String -> t
com_f String
"ugen-output-rates",[t] -> t
join_f ((UGen_Index -> t) -> [UGen_Index] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map UGen_Index -> t
i8_f [UGen_Index]
o)
            ]

-- | Byte-encode 'UGen'.
encode_ugen :: UGen -> L.ByteString
encode_ugen :: UGen -> ByteString
encode_ugen = ENCODE_F ByteString -> UGen -> ByteString
forall t. ENCODE_F t -> UGen -> t
encode_ugen_f ENCODE_F ByteString
enc_bytestring

-- | Encode 'Sample' as 32-bit IEEE float.
encode_sample :: Sample -> L.ByteString
encode_sample :: Sample -> ByteString
encode_sample = Float -> ByteString
Byte.encode_f32 (Float -> ByteString) -> (Sample -> Float) -> Sample -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

encode_graphdef_f :: ENCODE_F t -> Graphdef -> t
encode_graphdef_f :: ENCODE_F t -> Graphdef -> t
encode_graphdef_f ENCODE_F t
enc (Graphdef Name
nm [Sample]
cs [(Control, Sample)]
ks [UGen]
us) =
    let ([t] -> t
join_f,Name -> t
str_f,UGen_Index -> t
_,UGen_Index -> t
i16_f,UGen_Index -> t
i32_f,Sample -> t
f32_f,String -> t
com_f) = ENCODE_F t
enc
        ([Control]
ks_ctl,[Sample]
ks_def) = [(Control, Sample)] -> ([Control], [Sample])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Control, Sample)]
ks
    in [t] -> t
join_f [String -> t
com_f String
"SCgf",UGen_Index -> t
i32_f UGen_Index
forall n. Num n => n
scgf_i32
              ,String -> t
com_f String
"version",UGen_Index -> t
i32_f UGen_Index
0
              ,String -> t
com_f String
"number of graphs",UGen_Index -> t
i16_f UGen_Index
1
              ,String -> t
com_f String
"name",Name -> t
str_f Name
nm
              ,String -> t
com_f String
"number-of-constants",UGen_Index -> t
i16_f ([Sample] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [Sample]
cs)
              ,String -> t
com_f String
"constant-values",[t] -> t
join_f ((Sample -> t) -> [Sample] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Sample -> t
f32_f [Sample]
cs)
              ,String -> t
com_f String
"number-of-controls",UGen_Index -> t
i16_f ([Sample] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [Sample]
ks_def)
              ,String -> t
com_f String
"control-default-values",[t] -> t
join_f ((Sample -> t) -> [Sample] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Sample -> t
f32_f [Sample]
ks_def)
              ,String -> t
com_f String
"number-of-controls",UGen_Index -> t
i16_f ([Control] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [Control]
ks_ctl)
              ,String -> t
com_f String
"controls",[t] -> t
join_f ((Control -> t) -> [Control] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (ENCODE_F t -> Control -> t
forall t. ENCODE_F t -> Control -> t
encode_control_f ENCODE_F t
enc) [Control]
ks_ctl)
              ,String -> t
com_f String
"number-of-ugens",UGen_Index -> t
i16_f ([UGen] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [UGen]
us)
              ,[t] -> t
join_f ((UGen -> t) -> [UGen] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (ENCODE_F t -> UGen -> t
forall t. ENCODE_F t -> UGen -> t
encode_ugen_f ENCODE_F t
enc) [UGen]
us)]

-- | Encode 'Graphdef'.
encode_graphdef :: Graphdef -> L.ByteString
encode_graphdef :: Graphdef -> ByteString
encode_graphdef = ENCODE_F ByteString -> Graphdef -> ByteString
forall t. ENCODE_F t -> Graphdef -> t
encode_graphdef_f ENCODE_F ByteString
enc_bytestring

-- | "SCgf" encoded as 32-bit unsigned integer.
--
-- > Byte.decode_i32 (Byte.encode_ascii (Datum.ascii "SCgf"))
scgf_i32 :: Num n => n
scgf_i32 :: n
scgf_i32 = n
1396926310

-- * IO

-- | Write 'Graphdef' to indicated file.
graphdefWrite :: FilePath -> Graphdef -> IO ()
graphdefWrite :: String -> Graphdef -> IO ()
graphdefWrite String
fn = String -> ByteString -> IO ()
L.writeFile String
fn (ByteString -> IO ())
-> (Graphdef -> ByteString) -> Graphdef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graphdef -> ByteString
encode_graphdef

-- | Write 'Graphdef' to indicated directory.  The filename is the
-- 'graphdef_name' with the appropriate extension (@scsyndef@).
graphdefWrite_dir :: FilePath -> Graphdef -> IO ()
graphdefWrite_dir :: String -> Graphdef -> IO ()
graphdefWrite_dir String
dir Graphdef
s =
    let fn :: String
fn = String
dir String -> ShowS
</> Name -> String
Datum.ascii_to_string (Graphdef -> Name
graphdef_name Graphdef
s) String -> ShowS
<.> String
"scsyndef"
    in String -> Graphdef -> IO ()
graphdefWrite String
fn Graphdef
s

-- * Stat

-- | Simple statistics printer for 'Graphdef'.
graphdef_stat :: Graphdef -> String
graphdef_stat :: Graphdef -> String
graphdef_stat (Graphdef Name
nm [Sample]
cs [(Control, Sample)]
ks [UGen]
us) =
    let f :: (a -> a) -> [a] -> String
f a -> a
g = let h :: [a] -> (a, UGen_Index)
h (a
x:[a]
xs) = (a
x,[a] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs))
                  h [] = String -> (a, UGen_Index)
forall a. Partial => String -> a
error String
"graphdef_stat"
              in [(a, UGen_Index)] -> String
forall a. Show a => a -> String
show ([(a, UGen_Index)] -> String)
-> ([a] -> [(a, UGen_Index)]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> (a, UGen_Index)) -> [[a]] -> [(a, UGen_Index)]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> (a, UGen_Index)
forall a. [a] -> (a, UGen_Index)
h ([[a]] -> [(a, UGen_Index)])
-> ([a] -> [[a]]) -> [a] -> [(a, UGen_Index)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
g
        sq :: ([String] -> [String]) -> String
sq [String] -> [String]
pp_f = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> [String]
pp_f ((UGen -> String) -> [UGen] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UGen -> String
ugen_name_op [UGen]
us))
    in [String] -> String
unlines [String
"name                      : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
nm
               ,String
"number of constants       : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UGen_Index -> String
forall a. Show a => a -> String
show ([Sample] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [Sample]
cs)
               ,String
"number of controls        : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UGen_Index -> String
forall a. Show a => a -> String
show ([(Control, Sample)] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [(Control, Sample)]
ks)
               ,String
"number of unit generators : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UGen_Index -> String
forall a. Show a => a -> String
show ([UGen] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length [UGen]
us)
               ,String
"unit generator rates      : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (UGen -> UGen_Index) -> [UGen] -> String
forall a a. (Show a, Ord a) => (a -> a) -> [a] -> String
f UGen -> UGen_Index
ugen_rate [UGen]
us
               ,String
"unit generator set        : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]) -> String
sq ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort)
               ,String
"unit generator sequence   : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]) -> String
sq [String] -> [String]
forall a. a -> a
id]

-- * Dump UGens

-- | Pretty print UGen in the manner of SynthDef>>dumpUGens.
ugen_dump_ugen_str :: [Sample] -> [UGen] -> UGen_Index -> UGen -> String
ugen_dump_ugen_str :: [Sample] -> [UGen] -> UGen_Index -> UGen -> String
ugen_dump_ugen_str [Sample]
c_sq [UGen]
u_sq UGen_Index
ix UGen
u =
  let in_brackets :: String -> String
      in_brackets :: ShowS
in_brackets String
x = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"[%s]" String
x
      input_pp :: Input -> p
input_pp (Input UGen_Index
i UGen_Index
j) =
        let ui :: UGen
ui = [UGen]
u_sq [UGen] -> UGen_Index -> UGen
forall a. [a] -> UGen_Index -> a
!! UGen_Index
i
        in if UGen_Index
i UGen_Index -> UGen_Index -> Bool
forall a. Ord a => a -> a -> Bool
>= UGen_Index
0
           then if [UGen_Index] -> UGen_Index
forall (t :: * -> *) a. Foldable t => t a -> UGen_Index
length (UGen -> [UGen_Index]
ugen_outputs UGen
ui) UGen_Index -> UGen_Index -> Bool
forall a. Ord a => a -> a -> Bool
> UGen_Index
1
                then String -> UGen_Index -> String -> UGen_Index -> p
forall r. PrintfType r => String -> r
printf String
"%d_%s:%d" UGen_Index
i (UGen -> String
ugen_name_op UGen
ui) UGen_Index
j
                else String -> UGen_Index -> String -> p
forall r. PrintfType r => String -> r
printf String
"%d_%s" UGen_Index
i (UGen -> String
ugen_name_op UGen
ui)
           else String -> Sample -> p
forall r. PrintfType r => String -> r
printf String
"%f" ([Sample]
c_sq [Sample] -> UGen_Index -> Sample
forall a. [a] -> UGen_Index -> a
!! UGen_Index
j)
      inputs_pp :: [Input] -> String
inputs_pp = ShowS
in_brackets ShowS -> ([Input] -> String) -> [Input] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> ([Input] -> [String]) -> [Input] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Input -> String) -> [Input] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Input -> String
forall p. PrintfType p => Input -> p
input_pp
  in String -> UGen_Index -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%d_%s, %s, %s" UGen_Index
ix (UGen -> String
ugen_name_op UGen
u) (Rate -> String
forall a. Show a => a -> String
show (UGen -> Rate
ugen_rate_enum UGen
u)) ([Input] -> String
inputs_pp (UGen -> [Input]
ugen_inputs UGen
u))

-- | Print graphdef in format equivalent to SynthDef>>dumpUGens in SuperCollider
graphdef_dump_ugens_str :: Graphdef -> [String]
graphdef_dump_ugens_str :: Graphdef -> [String]
graphdef_dump_ugens_str (Graphdef Name
_nm [Sample]
cs [(Control, Sample)]
_ks [UGen]
us) = (UGen_Index -> UGen -> String)
-> [UGen_Index] -> [UGen] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([Sample] -> [UGen] -> UGen_Index -> UGen -> String
ugen_dump_ugen_str [Sample]
cs [UGen]
us) [UGen_Index
0..] [UGen]
us

{- | 'putStrLn' of 'unlines' of 'graphdef_dump_ugens_str'

> dir = "/home/rohan/sw/rsc3-disassembler/scsyndef/"
> pp nm = read_graphdef_file (dir ++ nm) >>= graphdef_dump_ugens
> pp "simple.scsyndef"
> pp "with-ctl.scsyndef"
> pp "mce.scsyndef"
> pp "mrg.scsyndef"
-}
graphdef_dump_ugens :: Graphdef -> IO ()
graphdef_dump_ugens :: Graphdef -> IO ()
graphdef_dump_ugens = String -> IO ()
putStrLn (String -> IO ()) -> (Graphdef -> String) -> Graphdef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> (Graphdef -> [String]) -> Graphdef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graphdef -> [String]
graphdef_dump_ugens_str