-- | 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.Ugen.Graph as Graph {- hsc3 -}
import qualified Sound.Sc3.Ugen.Types as Types {- 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 Ugen_Index
_ [U_Node]
cs [U_Node]
ks [U_Node]
us) =
    (forall a. [(Ugen_Index, a)] -> IntMap a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (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
    ,forall a. [(Ugen_Index, a)] -> IntMap a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Ugen_Index
Graph.u_node_id [U_Node]
ks) [Ugen_Index
0..])
    ,forall a. [(Ugen_Index, a)] -> IntMap a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (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 -> Int_Map -> Ugen_Index
uid_lookup = forall a. a -> Ugen_Index -> IntMap a -> a
M.findWithDefault (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 = forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show ([Char]
"ktype_map_lookup",K_Type
k,[(K_Type, Ugen_Index)]
m))
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e (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 (Int_Map
cs,[U_Node]
ks,Int_Map
_,Int_Map
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 -> Int_Map -> Ugen_Index
uid_lookup Ugen_Index
n Int_Map
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 -> Int_Map -> Ugen_Index
uid_lookup Ugen_Index
n Int_Map
us) (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 (Int_Map
_,[U_Node]
_,Int_Map
ks,Int_Map
_,[(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 -> Int_Map -> Ugen_Index
uid_lookup Ugen_Index
n Int_Map
ks)
      U_Node
_ -> 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' = 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',forall a b. (a -> b) -> [a] -> [b]
map Rate -> Ugen_Index
Rate.rateId [Rate]
o,Ugen_Index
s)
      U_Node
_ -> 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' = 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 = forall a b. (a -> b) -> [a] -> [b]
map U_Node -> Sample
Graph.u_node_k_default [U_Node]
ks
        ks_ctl :: [Control]
ks_ctl = forall a b. (a -> b) -> [a] -> [b]
map (Encoding_Maps -> U_Node -> Control
make_control Encoding_Maps
mm) [U_Node]
ks
        us' :: [Ugen]
us' = 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' (forall a b. [a] -> [b] -> [(a, b)]
zip [Control]
ks_ctl [Sample]
ks_def) [Ugen]
us'