-- | 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.Common.Uid as Uid {- hsc3 -}
import qualified Sound.Sc3.Server.Graphdef as Graphdef {- hsc3 -}
import qualified Sound.Sc3.Ugen.Graph as Graph {- hsc3 -}
import qualified Sound.Sc3.Ugen.Types as Types {- 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 Ugen_Index
_ [U_Node]
cs [U_Node]
ks [U_Node]
us) =
  ( [(Ugen_Index, Ugen_Index)] -> IntMap Ugen_Index
forall a. [(Ugen_Index, a)] -> IntMap a
M.fromList ([Ugen_Index] -> [Ugen_Index] -> [(Ugen_Index, Ugen_Index)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((U_Node -> Ugen_Index) -> [U_Node] -> [Ugen_Index]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Ugen_Index
Graph.u_node_id [U_Node]
cs) [Ugen_Index
0 ..])
  , [U_Node]
ks
  , [(Ugen_Index, Ugen_Index)] -> IntMap Ugen_Index
forall a. [(Ugen_Index, a)] -> IntMap a
M.fromList ([Ugen_Index] -> [Ugen_Index] -> [(Ugen_Index, Ugen_Index)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((U_Node -> Ugen_Index) -> [U_Node] -> [Ugen_Index]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Ugen_Index
Graph.u_node_id [U_Node]
ks) [Ugen_Index
0 ..])
  , [(Ugen_Index, Ugen_Index)] -> IntMap Ugen_Index
forall a. [(Ugen_Index, a)] -> IntMap a
M.fromList ([Ugen_Index] -> [Ugen_Index] -> [(Ugen_Index, Ugen_Index)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((U_Node -> Ugen_Index) -> [U_Node] -> [Ugen_Index]
forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Ugen_Index
Graph.u_node_id [U_Node]
us) [Ugen_Index
0 ..])
  , [U_Node] -> [(K_Type, Ugen_Index)]
Graph.u_node_mk_ktype_map [U_Node]
us
  )

-- | Locate index in map given node identifer 'UID_t'.
uid_lookup :: Uid.Id -> Int_Map -> Int
uid_lookup :: Ugen_Index -> IntMap Ugen_Index -> Ugen_Index
uid_lookup = Ugen_Index -> Ugen_Index -> IntMap Ugen_Index -> Ugen_Index
forall a. a -> Ugen_Index -> IntMap a -> a
M.findWithDefault ([Char] -> Ugen_Index
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, Ugen_Index)] -> Ugen_Index
ktype_map_lookup K_Type
k [(K_Type, Ugen_Index)]
m =
  let e :: a
e = [Char] -> a
forall a. HasCallStack => [Char] -> a
error (([Char], K_Type, [(K_Type, Ugen_Index)]) -> [Char]
forall a. Show a => a -> [Char]
show ([Char]
"ktype_map_lookup", K_Type
k, [(K_Type, Ugen_Index)]
m))
  in Ugen_Index -> Maybe Ugen_Index -> Ugen_Index
forall a. a -> Maybe a -> a
fromMaybe Ugen_Index
forall {a}. a
e (K_Type -> [(K_Type, Ugen_Index)] -> Maybe Ugen_Index
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup K_Type
k [(K_Type, Ugen_Index)]
m)

-- * 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 Ugen_Index
cs, [U_Node]
ks, IntMap Ugen_Index
_, IntMap Ugen_Index
us, [(K_Type, Ugen_Index)]
kt) From_Port
fp =
  case From_Port
fp of
    Graph.From_Port_C Ugen_Index
n -> Ugen_Index -> Ugen_Index -> Input
Graphdef.Input (-Ugen_Index
1) (Ugen_Index -> IntMap Ugen_Index -> Ugen_Index
uid_lookup Ugen_Index
n IntMap Ugen_Index
cs)
    Graph.From_Port_K Ugen_Index
n K_Type
t ->
      let i :: Ugen_Index
i = K_Type -> [(K_Type, Ugen_Index)] -> Ugen_Index
ktype_map_lookup K_Type
t [(K_Type, Ugen_Index)]
kt
      in Ugen_Index -> Ugen_Index -> Input
Graphdef.Input Ugen_Index
i (Ugen_Index -> K_Type -> [U_Node] -> Ugen_Index
Graph.u_node_fetch_k Ugen_Index
n K_Type
t [U_Node]
ks)
    Graph.From_Port_U Ugen_Index
n Maybe Ugen_Index
p -> Ugen_Index -> Ugen_Index -> Input
Graphdef.Input (Ugen_Index -> IntMap Ugen_Index -> Ugen_Index
uid_lookup Ugen_Index
n IntMap Ugen_Index
us) (Ugen_Index -> Maybe Ugen_Index -> Ugen_Index
forall a. a -> Maybe a -> a
fromMaybe Ugen_Index
0 Maybe Ugen_Index
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 Ugen_Index
_, [U_Node]
_, IntMap Ugen_Index
ks, IntMap Ugen_Index
_, [(K_Type, Ugen_Index)]
_) U_Node
nd =
  case U_Node
nd of
    Graph.U_Node_K Ugen_Index
n Rate
_ Maybe Ugen_Index
_ [Char]
nm Sample
_ K_Type
_ Maybe (Control_Meta Sample)
_ -> ([Char] -> Ascii
Datum.ascii [Char]
nm, Ugen_Index -> IntMap Ugen_Index -> Ugen_Index
uid_lookup Ugen_Index
n IntMap Ugen_Index
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 Ugen_Index
_ Rate
r [Char]
nm [From_Port]
i [Rate]
o (Types.Special Ugen_Index
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 -> Ugen_Index
Rate.rateId Rate
r, [Input]
i', (Rate -> Ugen_Index) -> [Rate] -> [Ugen_Index]
forall a b. (a -> b) -> [a] -> [b]
map Rate -> Ugen_Index
Rate.rateId [Rate]
o, Ugen_Index
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 Ugen_Index
_ [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'