diff --git a/Help/hsc3-dot.help.lhs b/Help/hsc3-dot.help.lhs deleted file mode 100644 --- a/Help/hsc3-dot.help.lhs +++ /dev/null @@ -1,36 +0,0 @@ -> import Sound.SC3.Monadic -> import Sound.SC3.UGen.Dot - -Simple a-rate only graph. - -> draw (out 0 (sinOsc AR 440 0 * 0.1)) - -With k-rate subgraph. - -> let f = lfSaw KR 1 0 * 220 + 440 -> in draw (out 0 (sinOsc AR f 0 * 0.1)) - -With i-rate subgraph - -> do { l <- rand 200 400 -> ; m <- rand l 600 -> ; a <- rand 500 900 -> ; let f = lfSaw KR 1 0 * m + a -> in draw (out 0 (sinOsc AR f 0 * 0.1)) } - -With control input - -> let f = control KR "freq" 440 -> in draw (out 0 (sinOsc AR f 0 * 0.1)) - -With multiple channel expansion. - -> let f = mce2 440 220 -> in draw (out 0 (sinOsc AR f 0 * 0.1)) - -With multiple root graph. - -> let { f = mce2 440 220 + in' 2 KR 0 -> ; o1 = sinOsc AR f 0 * 0.1 -> ; o2 = sinOsc KR (mce2 0.25 0.35) 0 * mce2 10 15 } -> in draw (mrg [out 0 o1, out 0 o2]) diff --git a/Sound/SC3/UGen/Dot.hs b/Sound/SC3/UGen/Dot.hs --- a/Sound/SC3/UGen/Dot.hs +++ b/Sound/SC3/UGen/Dot.hs @@ -1,41 +1,96 @@ -- | Module to provide graph drawing of unit generator graphs. The -- output is in the form of a dot graph, which can be layed out -- using the @graphviz@ tools, see . -module Sound.SC3.UGen.Dot ( dot, draw ) where +-- +-- > import Sound.SC3.ID +-- > import Sound.SC3.UGen.Dot +-- +-- Simple a-rate only graph. +-- +-- > draw (out 0 (sinOsc AR 440 0 * 0.1)) +-- +-- With k-rate subgraph. +-- +-- > let f = lfSaw KR 1 0 * 220 + 440 +-- > in draw (out 0 (sinOsc AR f 0 * 0.1)) +-- +-- With i-rate subgraph +-- +-- > let {l = rand 'a' 200 400 +-- > ;m = rand 'b' l 600 +-- > ;a = rand 'c' 500 900 +-- > ;f = lfSaw KR 1 0 * m + a} +-- > in draw (out 0 (sinOsc AR f 0 * 0.1)) +-- +-- With control input +-- +-- > let f = control KR "freq" 440 +-- > in draw (out 0 (sinOsc AR f 0 * 0.1)) +-- +-- With multiple channel expansion. +-- +-- > let f = mce2 440 220 +-- > in draw (out 0 (sinOsc AR f 0 * 0.1)) +-- +-- With multiple root graph. +-- +-- > let {f = mce2 440 220 + in' 2 KR 0 +-- > ;o1 = sinOsc AR f 0 * 0.1 +-- > ;o2 = sinOsc KR (mce2 0.25 0.35) 0 * mce2 10 15 } +-- > in draw (mrg [out 0 o1,out 0 o2]) +module Sound.SC3.UGen.Dot (Drawable(..)) where -import Control.Exception hiding (catch) +import Control.Exception +import Control.Monad import Data.List import Data.Maybe import Sound.SC3 import System.IO -import System.Cmd -import System.Directory +import System.IO.Error +import System.Cmd {- process -} +import System.Directory {- directory -} import System.Environment -import System.FilePath - --- | Generate the dot representation of the provided unit generator --- graph. -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 +import System.FilePath {- filepath -} -- | Draw the unit generator graph provided using the viewer at the -- environment variable @DOTVIEWER@, or @dotty@ if that variable is -- not defined. -draw :: UGen -> IO () -draw u = get_dot_viewer >>= draw_with u +class Drawable a where + dot :: a -> String + draw :: a -> IO () + draw x = get_dot_viewer >>= view_with (dot x) +instance Drawable UGen where + dot = dotGraph . synth + +instance Drawable Synthdef where + dot = dotGraph . synthdefGraph + +-- * Implemetation + +-- Generate dot representation of the provided unit generator graph. +dotGraph :: Graph -> String +dotGraph g = + let (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 + +view_with :: String -> String -> IO () +view_with x v = do + d <- getTemporaryDirectory + let f = d "hsc3.dot" + withFile f WriteMode (`hPutStr` x) + _ <- system (v ++ " " ++ f) + return () + data ToPort = ToPort Int Int - deriving (Eq, Show) + deriving (Eq,Show) -type Edge = (FromPort, ToPort) +type Edge = (FromPort,ToPort) type Edges = [Edge] find_node :: Graph -> Int -> Node @@ -44,31 +99,29 @@ edges :: [Node] -> Edges edges = - let f (NodeU x _ _ i _ _ _) = zip i (map (\n -> ToPort x n) [0..]) + let f (NodeU x _ _ i _ _ _) = zip i (map (ToPort x) [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 "|" +record lbl clr slt = + let f l = concat ["{",g l,"}"] + g = intercalate "|" + in concat [lbl + ,"[shape=\"record\"," + ,"color=\"",clr,"\"," + ,"label=\"{",g (map f slt),"}\"];"] 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 +label nd = + case nd of + NodeC n _ -> "N_" ++ show n + NodeK n _ _ _ _ -> "C_" ++ show n + NodeU n _ _ _ _ _ _ -> "U_" ++ show n + NodeP n _ _ -> "U_" ++ show n port_indx :: FromPort -> Int -port_indx (U _ x) = x +port_indx (FromPort_U _ x) = x port_indx _ = 0 is_node_c :: Node -> Bool @@ -79,20 +132,20 @@ 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 - , ";" ] +dot_edge :: Graph -> Edge -> String +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" @@ -101,7 +154,7 @@ rate_color DR = "red" input :: Graph -> FromPort -> Int -> String -input g (C n) _ = show (node_c_value (find_node g n)) +input g (FromPort_C n) _ = show (node_c_value (find_node g n)) input _ _ i = "" name :: String -> Int -> String @@ -111,43 +164,38 @@ is_implicit_control :: Node -> Bool is_implicit_control (NodeU x _ s _ _ _ _) = - let cs = ["AudioControl", "Control", "TrigControl"] + let cs = ["AudioControl","Control","TrigControl"] in x == -1 && s `elem` cs 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 -> "") [0..o] +dot_node_u g u = + let 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 -> "") [0..o] + in if is_implicit_control u + then "" + else record lbl clr [upr,lwr] 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 the UGen graph and display using the specified viewer. -draw_with :: UGen -> String -> IO () -draw_with u v = - do d <- getTemporaryDirectory - let f = d "hsc3.dot" - bracket (openFile f WriteMode) - hClose - (flip hPutStr (dot u)) - _ <- system (v ++ " " ++ f) - return () +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) + ,"\"];"] -- Read the environment variable @DOTVIEWER@, the default value is -- @"dotty"@. get_dot_viewer :: IO String -get_dot_viewer = catch (getEnv "DOTVIEWER") (\_ -> return "dotty") +get_dot_viewer = do + r <- tryJust (guard . isDoesNotExistError) (getEnv "DOTVIEWER") + case r of + Right v -> return v + _ -> return "dotty" diff --git a/hsc3-dot.cabal b/hsc3-dot.cabal --- a/hsc3-dot.cabal +++ b/hsc3-dot.cabal @@ -1,7 +1,7 @@ Name: hsc3-dot -Version: 0.9 +Version: 0.11 Synopsis: haskell supercollider graph drawing -Description: dot format graph generator for SuperCollider +Description: dot format graph generator for SuperCollider unit generator graphs constructed using hsc3. License: GPL Category: Sound @@ -10,18 +10,17 @@ Maintainer: rd@slavepianos.org Stability: Experimental Homepage: http://slavepianos.org/rd/?t=hsc3-dot -Tested-With: GHC == 6.12.1 +Tested-With: GHC == 7.2.2 Build-Type: Simple -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.8 Data-files: README - Help/hsc3-dot.help.lhs Library Build-Depends: base == 4.*, directory, filepath, - hsc3 == 0.9, + hsc3 == 0.11.*, process GHC-Options: -Wall -fwarn-tabs Exposed-modules: Sound.SC3.UGen.Dot