hsc3-dot (empty) → 0.5
raw patch · 5 files changed
+219/−0 lines, 5 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, hsc3, process
Files
- Help/hsc3-dot.help.lhs +34/−0
- README +12/−0
- Setup.lhs +3/−0
- Sound/SC3/UGen/Dot.hs +148/−0
- hsc3-dot.cabal +22/−0
+ Help/hsc3-dot.help.lhs view
@@ -0,0 +1,34 @@+> import Sound.SC3+> 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 draw (mrg [out 0 (sinOsc AR f 0 * 0.1), out 0 (sinOsc KR 1 0)])
+ README view
@@ -0,0 +1,12 @@+hsc3-dot - haskell supercollider dot++hsc3-dot provides dot graph drawing for SuperCollider unit generator+graphs.++ http://slavepianos.org/rd/+ http://haskell.org/+ http://audiosynth.com/+ http://graphviz.org++(c) rohan drape, 2006-2008+ gpl, http://gnu.org/copyleft/
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Sound/SC3/UGen/Dot.hs view
@@ -0,0 +1,148 @@+-- | 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 <http://graphviz.org>.+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++-- | 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++-- | 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++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 = concatMap f+ where f (NodeU x _ _ i _ _ _) = zip i (map (\n -> ToPort x n) [0..])+ f _ = error "edges"++record :: String -> String -> [[String]] -> String+record lbl clr slt = concat [ lbl+ , " [shape=\"record\", "+ , "color=\"", clr, "\", "+ , "label=\"{", concat (g (map f slt)), "}\"];" ]+ where f l = concat ["{", concat (g l), "}"]+ g l = (intersperse "|" l)++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 the UGen graph and display using the specified viewer.+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 ()++-- Read the environment variable @DOTVIEWER@, the default value is @"dotty"@.+get_dot_viewer :: IO String+get_dot_viewer = catch (getEnv "DOTVIEWER") (\_ -> return "dotty")
+ hsc3-dot.cabal view
@@ -0,0 +1,22 @@+Name: hsc3-dot+Version: 0.5+Synopsis: haskell supercollider graph drawing+Description: dot format graph generator for unit generator graphs+License: GPL+Category: Sound+Copyright: (c) Rohan Drape, 2006-2008+Author: Rohan Drape+Maintainer: rd@slavepianos.org+Stability: Experimental+Homepage: http://slavepianos.org/rd/f/890257/+Tested-With: GHC==6.10.1+Build-Type: Simple+Cabal-Version: >= 1.2++Data-files: README+ Help/hsc3-dot.help.lhs++Library+ Build-Depends: base, directory, filepath, hsc3 == 0.5, process+ GHC-Options: -Wall -fwarn-tabs+ Exposed-modules: Sound.SC3.UGen.Dot