diff --git a/README b/README --- a/README +++ b/README @@ -21,7 +21,7 @@ [hsc3-texts]: http://rd.slavepianos.org/?t=hsc3-texts [hsc3]: http://rd.slavepianos.org/?t=hsc3 -© [rohan drape][rd], 2006-2012, [gpl] +© [rohan drape][rd], 2006-2013, [gpl] [rd]: http://rd.slavepianos.org/ [gpl]: http://gnu.org/copyleft/ 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 @@ -63,9 +63,10 @@ -- -- > draw (out 0 (pan2 (sinOsc AR 440 0 * 0.1) 0 1)) -- --- With reserved labels (ie. <,>,&). +-- With reserved labels (ie. <,>,&), and fixed size graph (size in inches). -- --- > draw_svg (out 0 (sinOsc AR 440 0 >* 0)) +-- > let o = svg_options {graph_size = Just (1,4)} +-- > in draw_with_opt o (out 0 (sinOsc AR 440 0 >* 0)) module Sound.SC3.UGen.Dot where import Sound.SC3.UGen.Dot.Class @@ -103,6 +104,7 @@ ,svg_viewer = "rsvg-view" ,font_name = "Courier" ,font_size = 12 + ,graph_size = Nothing } -- | Default @svg@ format 'Dot_Options'. diff --git a/Sound/SC3/UGen/Dot/Internal.hs b/Sound/SC3/UGen/Dot/Internal.hs --- a/Sound/SC3/UGen/Dot/Internal.hs +++ b/Sound/SC3/UGen/Dot/Internal.hs @@ -3,9 +3,9 @@ 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 qualified Sound.SC3 as S {- hsc3 -} +import qualified Sound.SC3.Server.Synthdef.Internal as S +import Sound.SC3.UGen.Dot.Type {- hsc3-dot -} import System.IO import System.Cmd {- process -} import System.Directory {- directory -} @@ -15,10 +15,10 @@ 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 + sz_f (x,y) = printf ",size=\"%f,%f\"" x y + in [printf "graph [splines=%s%s];" s (maybe "" sz_f (graph_size o)) + ,printf "node [fontsize=%d" (font_size o) + ,printf " ,fontname=\"%s\"];" (font_name o) ,"edge [arrowhead=box,arrowsize=0.25];"] -- Generate dot representation of the provided unit generator graph. @@ -51,31 +51,31 @@ 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) + when (False && 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 + | IP_Const (Maybe String,String,Int) Float -- > 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 :: Int -> Float -> 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 :: Int -> Float -> 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) + f m = round ((read (take (n + 1) m) :: Float) / 10) k' = if length k > n then show (f k) else k @@ -84,13 +84,13 @@ else "." ++ k' ++ l -- > map (limit_precision 3) [1,1.25,0.05,pi*1e8,1e9] -limit_precision :: Int -> Double -> String +limit_precision :: Int -> Float -> String limit_precision n c = - if c < 0.001 || c > 1e6 + if c < 1e-3 || c > 1e6 then limit_precision_e n c else limit_precision_p n c -limit_precision_o :: Dot_Options -> Double -> String +limit_precision_o :: Dot_Options -> Float -> String limit_precision_o o = limit_precision (numeric_precision o) ip_record :: Dot_Options -> IP -> String @@ -124,7 +124,8 @@ 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 + f_str = "%s [shape=\"record\",color=\"%s\",label=\"{%s}\"];" + in printf f_str nm clr lbl table :: Dot_Options -> String -> String -> ([IP],[IP]) -> String table o lbl clr (upr,lwr) = @@ -161,15 +162,17 @@ 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 + 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 @@ -181,7 +184,8 @@ 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] + lwr = let n = length (S.node_u_outputs u) - 1 + in map (IP_Port (S.node_label u) 'o') [0 .. n] f = if use_tables o then table o else record o in if S.is_implicit_control u then "" @@ -203,11 +207,13 @@ concat [S.node_label u ,"[shape=\"plaintext\",color=\"" ,S.rate_color (S.node_k_rate u) - ,"\",label=<" + ,"
" + ,"\",label=<" + ,"
" ,S.node_k_name u ,":" ,limit_precision_o o (S.node_k_default u) - ,"
>];"] + ,"
>];"] dot_node_k :: Dot_Options -> S.Node -> String dot_node_k o = @@ -221,5 +227,5 @@ 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) + then S.get_env_default "DOTVIEWER" (dot_viewer o) + else S.get_env_default "SVGVIEWER" (svg_viewer o) diff --git a/Sound/SC3/UGen/Dot/Type.hs b/Sound/SC3/UGen/Dot/Type.hs --- a/Sound/SC3/UGen/Dot/Type.hs +++ b/Sound/SC3/UGen/Dot/Type.hs @@ -18,4 +18,5 @@ ,svg_viewer :: String -- ^ @svg@ file viewer (ie. "rsvg-view","inkview") ,font_name :: String -- ^ Name of font to use ,font_size :: Int -- ^ Font size + ,graph_size :: Maybe (Double,Double) -- ^ Graph box size (inches) } diff --git a/hsc3-dot.cabal b/hsc3-dot.cabal --- a/hsc3-dot.cabal +++ b/hsc3-dot.cabal @@ -1,11 +1,11 @@ Name: hsc3-dot -Version: 0.13 +Version: 0.14 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-2012 +Copyright: (c) Rohan Drape, 2006-2013 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental @@ -20,7 +20,7 @@ Build-Depends: base == 4.*, directory, filepath, - hsc3 == 0.13.*, + hsc3 == 0.14.*, process GHC-Options: -Wall -fwarn-tabs Exposed-modules: Sound.SC3.UGen.Dot