-- | 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>.
--
-- > import Sound.SC3.ID
-- > import Sound.SC3.UGen.Dot
--
-- Simple a-rate only graph.
--
-- > 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 k-rate & i-rate subgraphs
--
-- > 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))
--
-- 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
-- > 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])
--
-- 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

import Sound.SC3.UGen.Dot.Class
import Sound.SC3.UGen.Dot.Internal
import Sound.SC3.UGen.Dot.Type

dot :: Drawable a => a -> String
dot = dot_with_opt dot_options

dot_svg :: Drawable a => a -> String
dot_svg = dot_with_opt svg_options

draw_with_opt :: Drawable a => Dot_Options -> a -> IO ()
draw_with_opt o x = view_with o (dot_with_opt o x)

draw :: Drawable a => a -> IO ()
draw = draw_with_opt dot_options

draw_svg :: Drawable a => a -> IO ()
draw_svg = draw_with_opt svg_options

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

-- | Default @svg@ format 'Dot_Options'.
svg_options :: Dot_Options
svg_options = dot_options {output_format = SVG
                          ,fix_edge_location = True}