hsc3-dot 0.9 → 0.11

raw patch · 3 files changed

+137/−126 lines, 3 filesdep ~hsc3PVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hsc3

API changes (from Hackage documentation)

Files

• Help/hsc3-dot.help.lhs +0/−36
• Sound/SC3/UGen/Dot.hs +132/−84
• hsc3-dot.cabal +5/−6

@@ -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])

@@ -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 <http://graphviz.org>.-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 = "<I_" ++ show 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 -> "<O_" ++ show 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 -> "<O_" ++ show 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"

@@ -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