module Sound.SC3.UGen.Dot ( dot, draw ) where
import Control.Exception hiding (catch)
import Data.List
import Data.Maybe
import Sound.SC3
import System.IO
import System.Cmd
import System.Directory
import System.Environment
import System.FilePath
dot :: UGen -> String
dot r =
let g = synth r
(Graph _ _ ks us) = g
ls = concat [ ["digraph Anonymous {"]
, map dot_node_k ks
, map (dot_node_u g) us
, map (dot_edge g) (edges us)
, ["}"] ]
in unlines ls
draw :: UGen -> IO ()
draw u = get_dot_viewer >>= draw_with u
data ToPort = ToPort Int Int
deriving (Eq, Show)
type Edge = (FromPort, ToPort)
type Edges = [Edge]
find_node :: Graph -> Int -> Node
find_node (Graph _ cs ks us) n =
fromJust (find (\x -> node_id x == n) (cs ++ ks ++ us))
edges :: [Node] -> Edges
edges =
let f (NodeU x _ _ i _ _ _) = zip i (map (\n -> ToPort x n) [0..])
f _ = error "edges"
in concatMap f
record :: String -> String -> [[String]] -> String
record lbl clr slt = concat [ lbl
, " [shape=\"record\", "
, "color=\"", clr, "\", "
, "label=\"{", g (map f slt), "}\"];" ]
where f l = concat ["{", g l, "}"]
g = concat . intersperse "|"
label :: Node -> String
label (NodeC n _) = "N_" ++ show n
label (NodeK n _ _ _ ) = "C_" ++ show n
label (NodeU n _ _ _ _ _ _) = "U_" ++ show n
label (NodeP n _ _) = "U_" ++ show n
port_nid :: FromPort -> Int
port_nid (C n) = n
port_nid (K n) = n
port_nid (U n _) = n
port_indx :: FromPort -> Int
port_indx (U _ x) = x
port_indx _ = 0
is_node_c :: Node -> Bool
is_node_c (NodeC _ _) = True
is_node_c _ = False
is_node_u :: Node -> Bool
is_node_u (NodeU _ _ _ _ _ _ _) = True
is_node_u _ = False
dot_edge :: Graph -> Edge -> [Char]
dot_edge g (l, ToPort ri rn)
= let ln = find_node g (port_nid l)
in if is_node_c ln
then ""
else concat [ label ln
, if is_node_u ln
then ":O_" ++ show (port_indx l)
else ""
, " -> "
, label (find_node g ri)
, ":I_"
, show rn
, ";" ]
rate_color :: Rate -> String
rate_color AR = "black"
rate_color KR = "blue"
rate_color IR = "yellow"
rate_color DR = "red"
input :: Graph -> FromPort -> Int -> String
input g (C n) _ = show (node_c_value (find_node g n))
input _ _ i = "<I_" ++ show i ++ ">"
name :: String -> Int -> String
name "UnaryOpUGen" n = unaryName n
name "BinaryOpUGen" n = binaryName n
name n _ = n
is_implicit_control :: Node -> Bool
is_implicit_control (NodeU x _ s _ _ _ _) = x == 1 && s == "Control"
is_implicit_control _ = False
dot_node_u :: Graph -> Node -> String
dot_node_u g u = if is_implicit_control u
then ""
else record lbl clr [upr,lwr]
where lbl = label u
clr = rate_color (node_u_rate u)
i = node_u_inputs u
i' = length i 1
(Special s) = node_u_special u
upr = name (node_u_name u) s : zipWith (input g) i [0..i']
o = length (node_u_outputs u) 1
lwr = map (\j -> "<O_" ++ show j ++ ">") [0..o]
dot_node_k :: Node -> String
dot_node_k u = concat [ label u
, "[shape=\"trapezium\", color=\""
, rate_color (node_k_rate u)
, "\",label=\""
, node_k_name u, ":", show (node_k_default u)
, "\"];" ]
draw_with :: UGen -> String -> IO ()
draw_with u v =
do d <- getTemporaryDirectory
let f = d </> "hsc.dot"
bracket (openFile f WriteMode)
hClose
(flip hPutStr (dot u))
system $ v ++ " " ++ f
return ()
get_dot_viewer :: IO String
get_dot_viewer = catch (getEnv "DOTVIEWER") (\_ -> return "dotty")