-- | Transform 'Graph.U_Graph' to 'Graphdef.Graphdef'.
module Sound.SC3.Server.Graphdef.Graph where

import Data.Maybe {- base -}

import qualified Data.IntMap as M {- containers -}

import qualified Sound.OSC.Datum as Datum {- hosc -}

import qualified Sound.SC3.Common.Rate as Rate {- hsc3 -}
import qualified Sound.SC3.UGen.Graph as Graph {- hsc3 -}
import qualified Sound.SC3.UGen.Type as Type {- hsc3 -}
import qualified Sound.SC3.Server.Graphdef as Graphdef {- hsc3 -}

-- * Maps

-- | (Int,Int) map.
type Int_Map = M.IntMap Int

-- | (constants-map,controls,controls-map,ugen-map,ktype-map)
type Encoding_Maps = (Int_Map,[Graph.U_Node],Int_Map,Int_Map,[(Rate.K_Type,Int)])

-- | Generate 'Encoding_Maps' translating node identifiers to synthdef indexes.
mk_encoding_maps :: Graph.U_Graph -> Encoding_Maps
mk_encoding_maps :: U_Graph -> Encoding_Maps
mk_encoding_maps (Graph.U_Graph UID_t
_ [U_Node]
cs [U_Node]
ks [U_Node]
us) =
    ([(UID_t, UID_t)] -> IntMap UID_t
forall a. [(UID_t, a)] -> IntMap a
M.fromList ([UID_t] -> [UID_t] -> [(UID_t, UID_t)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((U_Node -> UID_t) -> [U_Node] -> [UID_t]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> UID_t
Graph.u_node_id [U_Node]
cs) [UID_t
0..])
    ,[U_Node]
ks
    ,[(UID_t, UID_t)] -> IntMap UID_t
forall a. [(UID_t, a)] -> IntMap a
M.fromList ([UID_t] -> [UID_t] -> [(UID_t, UID_t)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((U_Node -> UID_t) -> [U_Node] -> [UID_t]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> UID_t
Graph.u_node_id [U_Node]
ks) [UID_t
0..])
    ,[(UID_t, UID_t)] -> IntMap UID_t
forall a. [(UID_t, a)] -> IntMap a
M.fromList ([UID_t] -> [UID_t] -> [(UID_t, UID_t)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((U_Node -> UID_t) -> [U_Node] -> [UID_t]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> UID_t
Graph.u_node_id [U_Node]
us) [UID_t
0..])
    ,[U_Node] -> [(K_Type, UID_t)]
Graph.u_node_mk_ktype_map [U_Node]
us)

-- | Locate index in map given node identifer 'UID_t'.
uid_lookup :: Type.UID_t -> Int_Map -> Int
uid_lookup :: UID_t -> IntMap UID_t -> UID_t
uid_lookup = UID_t -> UID_t -> IntMap UID_t -> UID_t
forall a. a -> UID_t -> IntMap a -> a
M.findWithDefault ([Char] -> UID_t
forall a. HasCallStack => [Char] -> a
error [Char]
"uid_lookup")

-- | Lookup 'K_Type' index from map (erroring variant of 'lookup').
ktype_map_lookup :: Rate.K_Type -> [(Rate.K_Type,Int)] -> Int
ktype_map_lookup :: K_Type -> [(K_Type, UID_t)] -> UID_t
ktype_map_lookup K_Type
k =
    let e :: a
e = [Char] -> a
forall a. HasCallStack => [Char] -> a
error (([Char], K_Type) -> [Char]
forall a. Show a => a -> [Char]
show ([Char]
"ktype_map_lookup",K_Type
k))
    in UID_t -> Maybe UID_t -> UID_t
forall a. a -> Maybe a -> a
fromMaybe UID_t
forall a. a
e (Maybe UID_t -> UID_t)
-> ([(K_Type, UID_t)] -> Maybe UID_t) -> [(K_Type, UID_t)] -> UID_t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K_Type -> [(K_Type, UID_t)] -> Maybe UID_t
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup K_Type
k

-- * Encoding

-- | Byte-encode 'Graph.From_Port' primitive node.
make_input :: Encoding_Maps -> Graph.From_Port -> Graphdef.Input
make_input :: Encoding_Maps -> From_Port -> Input
make_input (IntMap UID_t
cs,[U_Node]
ks,IntMap UID_t
_,IntMap UID_t
us,[(K_Type, UID_t)]
kt) From_Port
fp =
    case From_Port
fp of
      Graph.From_Port_C UID_t
n -> UID_t -> UID_t -> Input
Graphdef.Input (-UID_t
1) (UID_t -> IntMap UID_t -> UID_t
uid_lookup UID_t
n IntMap UID_t
cs)
      Graph.From_Port_K UID_t
n K_Type
t ->
        let i :: UID_t
i = K_Type -> [(K_Type, UID_t)] -> UID_t
ktype_map_lookup K_Type
t [(K_Type, UID_t)]
kt
        in UID_t -> UID_t -> Input
Graphdef.Input UID_t
i (UID_t -> K_Type -> [U_Node] -> UID_t
Graph.u_node_fetch_k UID_t
n K_Type
t [U_Node]
ks)
      Graph.From_Port_U UID_t
n Maybe UID_t
p -> UID_t -> UID_t -> Input
Graphdef.Input (UID_t -> IntMap UID_t -> UID_t
uid_lookup UID_t
n IntMap UID_t
us) (UID_t -> Maybe UID_t -> UID_t
forall a. a -> Maybe a -> a
fromMaybe UID_t
0 Maybe UID_t
p)

-- | Byte-encode 'Graph.U_Node_K' primitive node.
make_control :: Encoding_Maps -> Graph.U_Node -> Graphdef.Control
make_control :: Encoding_Maps -> U_Node -> Control
make_control (IntMap UID_t
_,[U_Node]
_,IntMap UID_t
ks,IntMap UID_t
_,[(K_Type, UID_t)]
_) U_Node
nd =
    case U_Node
nd of
      Graph.U_Node_K UID_t
n Rate
_ Maybe UID_t
_ [Char]
nm Sample
_ K_Type
_ Maybe (Control_Meta Sample)
_ -> ([Char] -> ASCII
Datum.ascii [Char]
nm,UID_t -> IntMap UID_t -> UID_t
uid_lookup UID_t
n IntMap UID_t
ks)
      U_Node
_ -> [Char] -> Control
forall a. HasCallStack => [Char] -> a
error [Char]
"make_control"

-- | Byte-encode 'Graph.U_Node_U' primitive node.
make_ugen :: Encoding_Maps -> Graph.U_Node -> Graphdef.UGen
make_ugen :: Encoding_Maps -> U_Node -> UGen
make_ugen Encoding_Maps
m U_Node
n =
    case U_Node
n of
      Graph.U_Node_U UID_t
_ Rate
r [Char]
nm [From_Port]
i [Rate]
o (Type.Special UID_t
s) UGenId
_ ->
          let i' :: [Input]
i' = (From_Port -> Input) -> [From_Port] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map (Encoding_Maps -> From_Port -> Input
make_input Encoding_Maps
m) [From_Port]
i
          in ([Char] -> ASCII
Datum.ascii [Char]
nm,Rate -> UID_t
Rate.rateId Rate
r,[Input]
i',(Rate -> UID_t) -> [Rate] -> [UID_t]
forall a b. (a -> b) -> [a] -> [b]
map Rate -> UID_t
Rate.rateId [Rate]
o,UID_t
s)
      U_Node
_ -> [Char] -> UGen
forall a. HasCallStack => [Char] -> a
error [Char]
"encode_node_u: illegal input"

-- | Construct instrument definition bytecode.
graph_to_graphdef :: String -> Graph.U_Graph -> Graphdef.Graphdef
graph_to_graphdef :: [Char] -> U_Graph -> Graphdef
graph_to_graphdef [Char]
nm U_Graph
g =
    let Graph.U_Graph UID_t
_ [U_Node]
cs [U_Node]
ks [U_Node]
us = U_Graph
g
        cs' :: [Sample]
cs' = (U_Node -> Sample) -> [U_Node] -> [Sample]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Sample
Graph.u_node_c_value [U_Node]
cs
        mm :: Encoding_Maps
mm = U_Graph -> Encoding_Maps
mk_encoding_maps U_Graph
g
        ks_def :: [Sample]
ks_def = (U_Node -> Sample) -> [U_Node] -> [Sample]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Sample
Graph.u_node_k_default [U_Node]
ks
        ks_ctl :: [Control]
ks_ctl = (U_Node -> Control) -> [U_Node] -> [Control]
forall a b. (a -> b) -> [a] -> [b]
map (Encoding_Maps -> U_Node -> Control
make_control Encoding_Maps
mm) [U_Node]
ks
        us' :: [UGen]
us' = (U_Node -> UGen) -> [U_Node] -> [UGen]
forall a b. (a -> b) -> [a] -> [b]
map (Encoding_Maps -> U_Node -> UGen
make_ugen Encoding_Maps
mm) [U_Node]
us
    in ASCII -> [Sample] -> [(Control, Sample)] -> [UGen] -> Graphdef
Graphdef.Graphdef ([Char] -> ASCII
Datum.ascii [Char]
nm) [Sample]
cs' ([Control] -> [Sample] -> [(Control, Sample)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Control]
ks_ctl [Sample]
ks_def) [UGen]
us'