module Sound.DF.Uniform.LL.Dot where
import Data.List
import Data.Maybe
import Data.Typeable
import Text.Printf
import Sound.DF.Uniform.LL.K
import Sound.DF.Uniform.LL.UId
ty_colour :: Maybe TypeRep -> String
ty_colour m =
let tbl = [(bool_t,"brown")
,(int32_t,"orange")
,(float_t,"blue")
,(nil_t,"black")
,(vec_float_t,"purple")]
in case m of
Nothing -> "grey"
Just ty -> fromMaybe "red" (lookup ty tbl)
w_bracket :: a -> a -> [a] -> [a]
w_bracket p q l = p : l ++ [q]
dot_attr :: [(String,String)] -> String
dot_attr a =
let in_quotes = w_bracket '"' '"'
in_square = w_bracket '[' ']'
sep_commas = intercalate ","
join_eq p q = p ++ "=" ++ q
(k,v) = unzip a
in in_square (sep_commas (zipWith join_eq k (map in_quotes v)))
dot_rec :: Id -> String -> [Either Int K] -> Maybe TypeRep -> String
dot_rec k nm ar ty =
let mk_i i = case i of
Left i_k -> printf "<i_%d>" i_k
Right i_k -> k_concise i_k
ip = if null ar
then ""
else '|' : intercalate "|" (map mk_i ar)
op = maybe "" (const "|<o_0>") ty
nm' = fromMaybe nm (stripPrefix "df_" nm)
c = ty_colour ty
a = [("shape","record")
,("color",c)
,("label",printf "{{%s%s%s}}" nm' ip op)]
in printf "%d %s;" k (dot_attr a)
dot_rec_ar :: Int -> [Either Int K]
dot_rec_ar n = map Left [0 .. n 1]
dot_rec' :: Id -> String -> [Either Int K] -> TypeRep -> String
dot_rec' k nm n ty =
let ty' = if ty == nil_t then Nothing else Just ty
in dot_rec k nm n ty'