hsc3-dot 0.11 → 0.12

raw patch · 6 files changed

+362/−169 lines, 6 filesdep ~hsc3PVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hsc3

API changes (from Hackage documentation)

Files

• README +23/−9
• Sound/SC3/UGen/Dot.hs +64/−154
• Sound/SC3/UGen/Dot/Class.hs +20/−0
• Sound/SC3/UGen/Dot/Internal.hs +225/−0
• Sound/SC3/UGen/Dot/Type.hs +21/−0
• hsc3-dot.cabal +9/−6

@@ -1,13 +1,27 @@ hsc3-dot - haskell supercollider dot+------------------------------------ -hsc3-dot provides dot graph drawing for SuperCollider unit generator-graphs.  The graph rendering is delegated to graphviz, which must be-installed.+[hsc3-dot][hsc3-dot] provides [dot][dot] graph drawing for+[SuperCollider][sc3] unit generator graphs generated by the+[hsc3][hsc3] [haskell][hs] library. -  http://slavepianos.org/rd/?t=hsc3-dot-  http://haskell.org/-  http://audiosynth.com/-  http://graphviz.org/+The graph rendering is delegated to [graphviz][graphviz], which must+be installed. -(c) rohan drape, 2006-2011-    gpl, http://gnu.org/copyleft/+There is an+[entry](?t=hsc3-texts&l=lhs/hsc3-tutorial.lhs#ugen-graph-drawings)+at the [hsc3-texts](?t=hsc3-texts)+[tutorial](?t=hsc3-texts&l=lhs/hsc3-tutorial.lhs).++[hs]: http://haskell.org/+[sc3]: http://audiosynth.com/+[graphviz]: http://graphviz.org/+[dot]: http://www.graphviz.org/doc/info/lang.html+[hsc3-dot]: http://rd.slavepianos.org/?t=hsc3-dot+[hsc3-texts]: http://rd.slavepianos.org/?t=hsc3-texts+[hsc3]: http://rd.slavepianos.org/?t=hsc3++© [rohan drape][rd], 2006-2012, [gpl]++[rd]: http://rd.slavepianos.org/+[gpl]: http://gnu.org/copyleft/

@@ -9,12 +9,19 @@ -- -- > draw (out 0 (sinOsc AR 440 0 * 0.1)) --+-- As above, but using the /record/ interface.+--+-- > import Sound.SC3.UGen.Dot.Type+--+-- > let o = dot_options {use_tables = False}+-- > in draw_with_opt o (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+-- With k-rate & i-rate subgraphs -- -- > let {l = rand 'a' 200 400 -- >     ;m = rand 'b' l 600@@ -27,6 +34,19 @@ -- > let f = control KR "freq" 440 -- > in draw (out 0 (sinOsc AR f 0 * 0.1)) --+-- As above but with inlined controls.+--+-- > let {f = control KR "freq" 440+-- >     ;o = dot_options {inline_controls = True}}+-- > in draw_with_opt o (out 0 (sinOsc AR f 0 * 0.1))+--+-- As above but without control name label.+--+-- > let {o = dot_options {inline_controls = True+-- >                      ,display_control_names = False}+-- >     ;f = control KR "freq" 440}+-- > in draw_with_opt o (out 0 (sinOsc AR f 0 * 0.1))+-- -- With multiple channel expansion. -- -- > let f = mce2 440 220@@ -38,164 +58,54 @@ -- >     ;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-import Control.Monad-import Data.List-import Data.Maybe-import Sound.SC3-import System.IO-import System.IO.Error-import System.Cmd {- process -}-import System.Directory {- directory -}-import System.Environment-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.-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)--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 (ToPort x) [0..])-        f _ = error "edges"-    in concatMap f--record :: String -> String -> [[String]] -> String-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 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 (FromPort_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+--+-- With multiple channel UGen.+--+-- > draw (out 0 (pan2 (sinOsc AR 440 0 * 0.1) 0 1))+--+-- With reserved labels (ie. <,>,&).+--+-- > draw_svg (out 0 (sinOsc AR 440 0 >* 0))+module Sound.SC3.UGen.Dot where -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-                   ,";"]+import Sound.SC3.UGen.Dot.Class+import Sound.SC3.UGen.Dot.Internal+import Sound.SC3.UGen.Dot.Type -rate_color :: Rate -> String-rate_color AR = "black"-rate_color KR = "blue"-rate_color IR = "yellow"-rate_color DR = "red"+dot :: Drawable a => a -> String+dot = dot_with_opt dot_options -input :: Graph -> FromPort -> Int -> String-input g (FromPort_C n) _ = show (node_c_value (find_node g n))-input _ _ i = "<I_" ++ show i ++ ">"+dot_svg :: Drawable a => a -> String+dot_svg = dot_with_opt svg_options -name :: String -> Int -> String-name "UnaryOpUGen" n = unaryName n-name "BinaryOpUGen" n = binaryName n-name n _ = n+draw_with_opt :: Drawable a => Dot_Options -> a -> IO ()+draw_with_opt o x = view_with o (dot_with_opt o x) -is_implicit_control :: Node -> Bool-is_implicit_control (NodeU x _ s _ _ _ _) =-    let cs = ["AudioControl","Control","TrigControl"]-    in x == -1 && s `elem` cs-is_implicit_control _ = False+draw :: Drawable a => a -> IO ()+draw = draw_with_opt dot_options -dot_node_u :: Graph -> Node -> String-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]+draw_svg :: Drawable a => a -> IO ()+draw_svg = draw_with_opt svg_options -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)-           ,"\"];"]+-- | Default @dot@ format 'Dot_Options'.+dot_options :: Dot_Options+dot_options = Dot_Options+    {use_tables = True+    ,use_splines = False+    ,output_format = DOT+    ,output_directory = "/tmp"+    ,output_file_name = "hsc3"+    ,fix_edge_location = False+    ,numeric_precision = 3+    ,inline_controls = False+    ,display_control_names = True+    ,dot_viewer = "dotty"+    ,svg_viewer = "rsvg-view"+    ,font_name = "Courier"+    ,font_size = 12+    } --- Read the environment variable @DOTVIEWER@, the default value is--- @"dotty"@.-get_dot_viewer :: IO String-get_dot_viewer = do-  r <- tryJust (guard . isDoesNotExistError) (getEnv "DOTVIEWER")-  case r of-    Right v -> return v-    _ -> return "dotty"+-- | Default @svg@ format 'Dot_Options'.+svg_options :: Dot_Options+svg_options = dot_options {output_format = SVG+                          ,fix_edge_location = True}

@@ -0,0 +1,20 @@+module Sound.SC3.UGen.Dot.Class where++import Sound.SC3 as S+import Sound.SC3.UGen.Dot.Internal+import Sound.SC3.UGen.Dot.Type++-- | Draw the unit generator graph provided using the viewer at the+--   environment variable @DOTVIEWER@, or @dotty@ if that variable is+--   not defined.+class Drawable a where+    dot_with_opt :: Dot_Options -> a -> String++instance Drawable S.Graph where+    dot_with_opt = dotGraph++instance Drawable S.UGen where+    dot_with_opt o = dotGraph o . S.synth++instance Drawable S.Synthdef where+    dot_with_opt o = dotGraph o . S.synthdefGraph

@@ -0,0 +1,225 @@+module Sound.SC3.UGen.Dot.Internal where++import Control.Monad+import Data.List+import Data.Maybe+import Sound.SC3 as S {- hsc3 -}+import Sound.SC3.Server.Synthdef.Internal as S+import Sound.SC3.UGen.Dot.Type+import System.IO+import System.Cmd {- process -}+import System.Directory {- directory -}+import System.FilePath {- filepath -}+import Text.Printf++std_style :: Dot_Options -> [String]+std_style o =+    let s = if use_splines o then "true" else "false"+        sz = font_size o+        nm = font_name o+    in [printf "graph [splines=%s];" s+       ,printf "node [fontsize=%d,fontname=\"%s\"];" sz nm+       ,"edge [arrowhead=box,arrowsize=0.25];"]++-- Generate dot representation of the provided unit generator graph.+dotGraph :: Dot_Options -> S.Graph -> String+dotGraph o g =+    let (S.Graph _ _ ks us) = g+        ls = concat [["digraph Anonymous {"]+                    ,std_style o+                    ,if inline_controls o+                     then []+                     else map (dot_node_k o) ks+                    ,map (dot_node_u o g) us+                    ,map (dot_edge o g) (S.edges us)+                    ,["}"]]+    in unlines (filter (not.null) ls)++view_with :: Dot_Options -> String -> IO ()+view_with o x = do+  v <- get_viewer o+  let d = output_directory o+      f = d </> output_file_name o+      f_dot = f <.> "dot"+      f_svg = f <.> "svg"+      f_svg_gz = f_svg <.> "gz"+      f_view = case output_format o of+                 DOT -> f_dot+                 SVG -> f_svg+                 SVG_GZ -> f_svg_gz+      gen_svg = rawSystem "dot" ["-T","svg",f_dot,"-o",f_svg]+  withFile f_dot WriteMode (`hPutStr` x)+  when (output_format o `elem` [SVG,SVG_GZ]) (void gen_svg)+  when (output_format o == SVG_GZ) (void (rawSystem "gzip" ["-f",f_svg]))+  when (output_format o /= DOT) (removeFile f_dot)+  _ <- rawSystem v [f_view]+  return ()++data IP = IP_Label String+        | IP_Port String Char Int+        | IP_Const (Maybe String,String,Int) Double++-- > drop_while_right f = right_variant (dropWhile f)+right_variant :: ([a] -> [b]) -> [a] -> [b]+right_variant f = reverse . f . reverse++-- > map (limit_precision_p 3) [1,1.25,0.05,pi*1e8,1e9]+limit_precision_p :: Int -> Double -> String+limit_precision_p n c =+    let i = printf "%.*f" n c+    in right_variant (dropWhile (== '.') . dropWhile (== '0')) i++-- > map (limit_precision_e 3) [1,1.25,0.05,pi*1e8,1e9]+limit_precision_e :: Int -> Double -> String+limit_precision_e n c =+    let (i,_:j) = break (== '.') (show c)+        (k,l) = break (== 'e') j+        f :: String -> Int+        f m = round ((read (take (n + 1) m) :: Double) / 10)+        k' = if length k > n+             then show (f k)+             else k+    in i ++ if k == "0"+            then l+            else "." ++ k' ++ l++-- > map (limit_precision 3) [1,1.25,0.05,pi*1e8,1e9]+limit_precision :: Int -> Double -> String+limit_precision n c =+    if c < 0.001 || c > 1e6+    then limit_precision_e n c+    else limit_precision_p n c++limit_precision_o :: Dot_Options -> Double -> String+limit_precision_o o = limit_precision (numeric_precision o)++ip_record :: Dot_Options -> IP -> String+ip_record o i =+    case i of+      IP_Label l -> l+      IP_Port _ d n -> '<' : d : '_' : show n ++ ">"+      IP_Const _ n -> limit_precision_o o n++escape_html :: String -> String+escape_html =+    let t = [('<',"&lt;"),('>',"&gt;"),('&',"&amp;")]+        f c = fromMaybe [c] (lookup c t)+    in concatMap f++ip_html :: Dot_Options -> IP -> String+ip_html o i =+    case i of+      IP_Label l -> printf "<TD>%s</TD>" (escape_html l)+      IP_Port u c n ->+          let p = c : '_' : show n+          in printf "<TD PORT=\"%s\" ID=\"%s:%s\"></TD>" p u p+      IP_Const (k,u,p) n ->+          let p' = "K_" ++ show p+              n' = limit_precision_o o n+              l = maybe "" (++":") k ++ n'+          in printf "<TD ID=\"%s:%s\">%s</TD>" u p' l++record :: Dot_Options -> String -> String -> ([IP],[IP]) -> String+record o nm clr (upr,lwr) =+    let f l = concat ["{",g (map (ip_record o) l),"}"]+        g = intercalate "|"+        lbl = g [f upr,f lwr]+    in printf "%s [shape=\"record\",color=\"%s\",label=\"{%s}\"];" nm clr lbl++table :: Dot_Options -> String -> String -> ([IP],[IP]) -> String+table o lbl clr (upr,lwr) =+    let k = length upr - length lwr+        e = concat (replicate k "<TD BORDER=\"0\"></TD>")+        f p l = if null l+                then ""+                else concat ["<TR>",p ++ concatMap (ip_html o) l,"</TR>"]+    in concat [lbl+              ,"[shape=\"plaintext\","+              ,"color=\"",clr,"\","+              ,"label=<<TABLE BORDER=\"0\" CELLBORDER=\"1\">"+              ,f [] upr ++ f e lwr+              ,"</TABLE>>];"]++dot_edge :: Dot_Options -> S.Graph -> S.Edge -> String+dot_edge o g (l,S.ToPort ri rn) =+    let Just ln = S.find_node g (S.port_nid l)+        s = if fix_edge_location o then ":s" else ""+    in if S.is_node_c ln || S.is_node_k ln && inline_controls o+       then ""+       else concat [S.node_label ln+                   ,if S.is_node_u ln+                    then ":o_" ++ show (S.port_idx_or_zero l) ++ s+                    else if S.is_node_k ln+                         then ":o_0"+                         else ""+                   ," -> "+                   ,let Just ri_n = S.find_node g ri in S.node_label ri_n+                   ,":i_"+                   ,show rn+                   ,";"]++input :: Dot_Options -> S.Graph -> S.Node -> S.FromPort -> Int -> IP+input o g u fp k =+    case fp of+      S.FromPort_C i -> let Just n = S.find_node g i+                        in IP_Const (Nothing,S.node_label u,k) (S.node_c_value n)+      S.FromPort_K i _ -> if inline_controls o+                          then let Just n = S.find_node g i+                                   l = if display_control_names o+                                       then Just (S.node_k_name n)+                                       else Nothing+                               in IP_Const (l,S.node_label u,k) (S.node_k_default n)+                          else IP_Port (S.node_label u) 'i' k+      _ -> IP_Port (S.node_label u) 'i' k++dot_node_u :: Dot_Options -> S.Graph -> S.Node -> String+dot_node_u o g u =+    let lbl = S.node_label u+        clr = S.rate_color (S.node_u_rate u)+        i = S.node_u_inputs u+        i' = length i - 1+        s = S.node_u_special u+        upr = IP_Label (S.ugen_user_name (S.node_u_name u) s) :+              zipWith (input o g u) i [0..i']+        lwr = map (IP_Port (S.node_label u) 'o') [0 .. length (S.node_u_outputs u) - 1]+        f = if use_tables o then table o else record o+    in if S.is_implicit_control u+       then ""+       else f lbl clr (upr,lwr)++dot_node_k_rec :: Dot_Options -> S.Node -> String+dot_node_k_rec o u =+    concat [S.node_label u+           ,"[shape=\"rect\",color=\""+           ,S.rate_color (S.node_k_rate u)+           ,"\",label=\""+           ,S.node_k_name u+           ,":"+           ,limit_precision_o o (S.node_k_default u)+           ,"\"];"]++dot_node_k_html :: Dot_Options -> S.Node -> String+dot_node_k_html o u =+    concat [S.node_label u+           ,"[shape=\"plaintext\",color=\""+           ,S.rate_color (S.node_k_rate u)+           ,"\",label=<<TABLE BORDER=\"0\" CELLBORDER=\"1\"><TR><TD PORT=\"o_0\">"+           ,S.node_k_name u+           ,":"+           ,limit_precision_o o (S.node_k_default u)+           ,"</TD></TR></TABLE>>];"]++dot_node_k :: Dot_Options -> S.Node -> String+dot_node_k o =+    if use_tables o+    then dot_node_k_html o+    else dot_node_k_rec o++-- | Considering 'output_format' read either the environment variable+-- @DOTVIEWER@ or @SVGVIEWER@, the default values are 'dot_viewer' and+-- 'svg_viewer'.+get_viewer :: Dot_Options -> IO String+get_viewer o =+    if output_format o == DOT+    then get_env_default "DOTVIEWER" (dot_viewer o)+    else get_env_default "SVGVIEWER" (svg_viewer o)

@@ -0,0 +1,21 @@+module Sound.SC3.UGen.Dot.Type where++-- | Dot output formats.+data Dot_Format = DOT | SVG | SVG_GZ deriving (Eq)++-- | Dot options record.+data Dot_Options = Dot_Options+    {use_tables :: Bool -- ^ Select @record@ or @html/table@ rendering.+    ,use_splines :: Bool -- ^ Select edge rendering+    ,output_format :: Dot_Format -- ^ Select viewer format.+    ,fix_edge_location :: Bool -- ^ Select output port edge location.+    ,numeric_precision :: Int -- ^ Printing precision for constants.+    ,inline_controls :: Bool+    ,display_control_names :: Bool+    ,output_directory :: FilePath -- ^ File name (without suffix).+    ,output_file_name :: String -- ^ File name (without suffix).+    ,dot_viewer :: String -- ^ @dot@ file viewer (ie. "dotty")+    ,svg_viewer :: String -- ^ @svg@ file viewer (ie. "rsvg-view","inkview")+    ,font_name :: String -- ^ Name of font to use+    ,font_size :: Int -- ^ Font size+    }

@@ -1,16 +1,16 @@ Name:              hsc3-dot-Version:           0.11+Version:           0.12 Synopsis:          haskell supercollider graph drawing Description:       dot format graph generator for SuperCollider                    unit generator graphs constructed using hsc3. License:           GPL Category:          Sound-Copyright:         (c) Rohan Drape, 2006-2011+Copyright:         (c) Rohan Drape, 2006-2012 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://slavepianos.org/rd/?t=hsc3-dot-Tested-With:       GHC == 7.2.2+Homepage:          http://rd.slavepianos.org/?t=hsc3-dot+Tested-With:       GHC == 7.6.1 Build-Type:        Simple Cabal-Version:     >= 1.8 @@ -20,11 +20,14 @@   Build-Depends:   base == 4.*,                    directory,                    filepath,-                   hsc3 == 0.11.*,+                   hsc3 == 0.12.*,                    process   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Sound.SC3.UGen.Dot+                   Sound.SC3.UGen.Dot.Class+                   Sound.SC3.UGen.Dot.Internal+                   Sound.SC3.UGen.Dot.Type  Source-Repository  head   Type:            darcs-  Location:        http://slavepianos.org/rd/sw/hsc3-dot/+  Location:        http://rd.slavepianos.org/sw/hsc3-dot/