--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: graphviz help.markup help.syntax kernel strings ;
+IN: graphviz.attributes
+
+{
+ node-attributes
+ edge-attributes
+ graph-attributes
+ <node-attributes>
+ <edge-attributes>
+ <graph-attributes>
+} related-words
+
+HELP: <edge-attributes>
+{ $values
+ { "attrs" edge-attributes }
+}
+{ $description "Constructs " { $instance edge-attributes } " tuple with no attributes set." } ;
+
+HELP: <graph-attributes>
+{ $values
+ { "attrs" graph-attributes }
+}
+{ $description "Constructs " { $instance graph-attributes } " tuple with no attributes set." } ;
+
+HELP: <node-attributes>
+{ $values
+ { "attrs" node-attributes }
+}
+{ $description "Constructs " { $instance node-attributes } " tuple with no attributes set." } ;
+
+HELP: edge-attributes
+{ $class-description "Represents Graphviz attributes that are valid for edges. See attributes marked " { $emphasis "E" } " in " { $url "http://graphviz.org/content/attrs" } ". Each slot must be " { $maybe string } "." } ;
+
+HELP: graph-attributes
+{ $class-description "Represents Graphviz attributes that are valid for graphs and subgraphs (including clusters). See attributes marked " { $emphasis "G" } ", " { $emphasis "S" } ", and " { $emphasis "C" } " in " { $url "http://graphviz.org/content/attrs" } ". Each slot must be " { $maybe string } "." } ;
+
+HELP: node-attributes
+{ $class-description "Represents Graphviz attributes that are valid for nodes. See attributes marked " { $emphasis "N" } " in " { $url "http://graphviz.org/content/attrs" } ". Each slot must be " { $maybe string } "." } ;
+
+ARTICLE: "graphviz.attributes" "Graphviz attributes"
+"In Graphviz, " { $emphasis "attributes" } " control different layout characteristics of graphs, subgraphs, nodes, and edges. For example, you can specify the color of an edge or the shape of a node. Graphviz provides documentation for all valid attributes at " { $url "http://graphviz.org/content/attrs" } "."
+$nl
+"The " { $vocab-link "graphviz.attributes" } " vocabulary simply provides three different tuples to encapsulate Graphviz attributes:"
+{ $subsections node-attributes edge-attributes graph-attributes }
+"Empty instances are created with the following constructors:"
+{ $subsections <node-attributes> <edge-attributes> <graph-attributes> }
+;
+
+ABOUT: "graphviz.attributes"
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel ;
+IN: graphviz.attributes
+
+TUPLE: graph-attributes
+Damping
+K
+URL
+aspect
+bb
+bgcolor
+center
+charset
+clusterrank
+color
+colorscheme
+comment
+compound
+concentrate
+defaultdist
+dim
+dimen
+diredgeconstraints
+dpi
+epsilon
+esep
+fillcolor
+fontcolor
+fontname
+fontnames
+fontpath
+fontsize
+id
+label
+labeljust
+labelloc
+landscape
+layers
+layersep
+layout
+levels
+levelsgap
+lheight
+lp
+lwidth
+margin
+maxiter
+mclimit
+mindist
+mode
+model
+mosek
+nodesep
+nojustify
+normalize
+nslimit
+nslimit1
+ordering
+orientation
+outputorder
+overlap
+overlap_scaling
+pack
+packmode
+pad
+page
+pagedir
+pencolor
+penwidth
+peripheries
+quadtree
+quantum
+rank
+rankdir
+ranksep
+ratio
+remincross
+repulsiveforce
+resolution
+root
+rotate
+searchsize
+sep
+showboxes
+size
+smoothing
+sortv
+splines
+start
+style
+stylesheet
+target
+tooltip
+truecolor
+viewport
+voro_margin ;
+
+TUPLE: node-attributes
+URL
+color
+colorscheme
+comment
+distortion
+fillcolor
+fixedsize
+fontcolor
+fontname
+fontsize
+group
+height
+id
+image
+imagescale
+label
+labelloc
+layer
+margin
+nojustify
+orientation
+penwidth
+peripheries
+pin
+pos
+rects
+regular
+root
+samplepoints
+shape
+shapefile
+showboxes
+sides
+skew
+sortv
+style
+target
+tooltip
+vertices
+width
+z ;
+
+TUPLE: edge-attributes
+URL
+arrowhead
+arrowsize
+arrowtail
+color
+colorscheme
+comment
+constraint
+decorate
+dir
+edgeURL
+edgehref
+edgetarget
+edgetooltip
+fontcolor
+fontname
+fontsize
+headURL
+headclip
+headhref
+headlabel
+headport
+headtarget
+headtooltip
+href
+id
+label
+labelURL
+labelangle
+labeldistance
+labelfloat
+labelfontcolor
+labelfontname
+labelfontsize
+labelhref
+labeltarget
+labeltooltip
+layer
+len
+lhead
+lp
+ltail
+minlen
+nojustify
+penwidth
+pos
+samehead
+sametail
+showboxes
+style
+tailURL
+tailclip
+tailhref
+taillabel
+tailport
+tailtarget
+tailtooltip
+target
+tooltip
+weight ;
+
+: <graph-attributes> ( -- attrs )
+ graph-attributes new ;
+
+: <edge-attributes> ( -- attrs )
+ edge-attributes new ;
+
+: <node-attributes> ( -- attrs )
+ node-attributes new ;
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien graphviz graphviz.attributes graphviz.ffi
+help.markup help.syntax kernel ;
+IN: graphviz.builder
+
+HELP: build-alien
+{ $values
+ { "Agraph_t*" c-ptr }
+ { "graph" graph }
+}
+{ $description "Constructs a C representation of the given " { $link graph } " in memory by using the " { $vocab-link "graphviz.ffi" } " vocabulary to destructively modify " { $snippet "Agraph_t*" } " (a " { $link c-ptr } " created by " { $link agopen } ")." }
+{ $notes "User code should not call this word directly. Use the " { $vocab-link "graphviz.render" } " vocabulary instead." }
+{ $errors "Throws " { $link non-graph-error } " if applied to anything other than an instance of " { $link graph } "."
+$nl
+"Throws " { $link improper-statement-error } " if any of the " { $link graph } "'s " { $slot "statements" } " is not an instance of:"
+{ $list { $link subgraph } { $link node } { $link edge } { $link graph-attributes } { $link node-attributes } { $link edge-attributes } }
+}
+;
+
+HELP: improper-statement-error
+{ $values
+ { "obj" object }
+}
+{ $error-description "Thrown if, in a call to " { $link build-alien } ", any of a " { $link graph } "'s " { $slot "statements" } " is not an instance of:" { $list { $link subgraph } { $link node } { $link edge } { $link graph-attributes } { $link node-attributes } { $link edge-attributes } } }
+;
+
+HELP: non-graph-error
+{ $values
+ { "obj" object }
+}
+{ $error-description "Thrown if " { $link build-alien } " is applied to an object that is not an instance of " { $link graph } "." } ;
+
+ARTICLE: "graphviz.builder" "Constructing C versions of Graphviz graphs"
+"The " { $vocab-link "graphviz.builder" } " vocabulary implements words to convert a " { $link graph } " object into its equivalent C representation in " { $emphasis "libgvc" } " and " { $emphasis "libgraph" } " (see the " { $vocab-link "graphviz.ffi" } " vocabulary)."
+$nl
+"These are low-level words used to implement the " { $vocab-link "graphviz.render" } " vocabulary. As such, user code should not use " { $vocab-link "graphviz.builder" } " directly."
+$nl
+"The main word:"
+{ $subsections build-alien }
+"Errors that might be thrown:"
+{ $subsections non-graph-error improper-statement-error }
+;
+
+ABOUT: "graphviz.builder"
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors classes classes.tuple combinators kernel
+sequences strings summary words
+graphviz
+graphviz.attributes
+graphviz.ffi
+;
+IN: graphviz.builder
+
+! Errors
+
+ERROR: non-graph-error obj ;
+
+M: non-graph-error summary
+ drop "build-alien must be applied to the root graph" ;
+
+
+ERROR: improper-statement-error obj ;
+
+M: improper-statement-error summary
+ drop "Not a proper Graphviz statement" ;
+
+! Use FFI to construct Agraph_t equivalent of a graph object
+
+<PRIVATE
+
+GENERIC: (build-alien) ( Agraph_t* obj -- )
+
+M: object (build-alien) improper-statement-error ;
+
+! Attributes
+
+: build-alien-attr ( alien attr value -- alien )
+ dup
+ [ [ "" agsafeset drop ] 3keep 2drop ]
+ [ 2drop ]
+ if ; inline
+
+: build-alien-attrs ( alien attrs -- )
+ [ class "slots" word-prop ] [ tuple>array rest ] bi
+ [ [ name>> ] dip build-alien-attr ] 2each drop ;
+
+M: graph-attributes (build-alien)
+ build-alien-attrs ;
+M: node-attributes (build-alien)
+ [ agprotonode ] dip build-alien-attrs ;
+M: edge-attributes (build-alien)
+ [ agprotoedge ] dip build-alien-attrs ;
+
+! Subgraphs
+
+: build-alien-subgraph ( alien-graph subgraph -- alien-subgraph )
+ [ id>> agsubg dup ] [ statements>> ] bi
+ [ (build-alien) ] with each ;
+
+M: subgraph (build-alien) build-alien-subgraph drop ;
+
+! Nodes
+
+M: node (build-alien)
+ [ id>> agnode ]
+ [ attributes>> build-alien-attrs ] bi ;
+
+! Edges
+
+GENERIC: build-alien-endpoint ( Agraph_t* obj -- alien )
+
+M: string build-alien-endpoint agnode ;
+M: subgraph build-alien-endpoint build-alien-subgraph ;
+
+: build-alien-endpoints ( Agraph_t* edge -- Agraph_t* tail head )
+ [ dup ] dip
+ [ tail>> build-alien-endpoint ]
+ [ head>> build-alien-endpoint ] 2bi ;
+
+
+: node->node? ( tail head -- ? )
+ [ string? ] [ string? ] bi* and ; inline
+
+: node->subg? ( tail head -- ? )
+ [ string? ] [ subgraph? ] bi* and ; inline
+
+: subg->node? ( tail head -- ? )
+ [ subgraph? ] [ string? ] bi* and ; inline
+
+: subg->subg? ( tail head -- ? )
+ [ subgraph? ] [ subgraph? ] bi* and ; inline
+
+
+: node->node ( Agraph_t* tail head attrs -- Agraph_t* )
+ [ dup ] 3dip
+ [ agedge ] dip build-alien-attrs ;
+
+: node->subg ( Agraph_t* tail head attrs -- Agraph_t* )
+ [ node->node ] curry with each-node ;
+
+: subg->node ( Agraph_t* tail head attrs -- Agraph_t* )
+ [ node->node ] 2curry each-node ;
+
+: subg->subg ( Agraph_t* tail head attrs -- Agraph_t* )
+ [ node->subg ] 2curry each-node ;
+
+
+M: edge (build-alien)
+ [ build-alien-endpoints ] 2keep nip
+ [ attributes>> ] [ tail>> ] [ head>> ] tri
+ {
+ { [ 2dup node->node? ] [ 2drop node->node ] }
+ { [ 2dup node->subg? ] [ 2drop node->subg ] }
+ { [ 2dup subg->node? ] [ 2drop subg->node ] }
+ { [ 2dup subg->subg? ] [ 2drop subg->subg ] }
+ } cond drop ;
+
+PRIVATE>
+
+! Main word
+
+GENERIC: build-alien ( Agraph_t* graph -- )
+
+M: graph build-alien statements>> [ (build-alien) ] with each ;
+
+M: object build-alien non-graph-error ;
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays help.markup help.syntax kernel math quotations strings ;
+IN: graphviz.ffi
+
+HELP: ffi-errors
+{ $values
+ { "n" number }
+}
+{ $error-description "Thrown by " { $link gvFreeContext } " if the low-level Graphviz libraries (" { $emphasis "libgraph" } " and " { $emphasis "libgvc" } ") encountered one or more errors (specifically " { $slot "n" } " of them) while rendering. The C libraries themselves may print specific error messages to the standard error stream (see " { $url "http://graphviz.org/pdf/libguide.pdf" } "), but these messages will not be captured by " { $vocab-link "graphviz.ffi" } "." } ;
+
+{ supported-engines supported-formats } related-words
+
+HELP: supported-engines
+{ $values
+ { "value" array }
+}
+{ $description "An " { $link array } " of " { $link string } "s representing all valid " { $emphasis "layout engines" } ". For example, the " { $emphasis "dot" } " engine is typically included in a Graphviz installation, so " { $snippet "\"dot\"" } " will be an element of " { $link supported-engines } ". See " { $url "http://graphviz.org/Documentation.php" } " for more details." }
+{ $notes "This constant's definition is determined at parse-time by asking the system's Graphviz installation what engines are supported." }
+;
+
+HELP: supported-formats
+{ $values
+ { "value" array }
+}
+{ $description "An " { $link array } " of " { $link string } "s representing all valid " { $emphasis "layout formats" } ". For example, Graphviz can typically render using the Postscript format, in which case " { $snippet "\"ps\"" } " will be an element of " { $link supported-formats } ". See " { $url "http://graphviz.org/Documentation.php" } " for more details." }
+{ $notes "This constant's definition is determined at parse-time by asking the system's Graphviz installation what formats are supported."
+$nl
+"The Graphviz " { $emphasis "plugin" } " mechanism is not supported, so formats with colons like " { $snippet "\"png:cairo:gd\"" } " are not recognized."
+}
+;
+
+ARTICLE: "graphviz.ffi" "Graphviz C library interface"
+"The " { $vocab-link "graphviz.ffi" } " vocabulary defines words that interface with the low-level Graphviz libraries " { $emphasis "libgraph" } " and " { $emphasis "libgvc" } ", which should come installed with Graphviz."
+$nl
+"User code shouldn't call these words directly. Instead, use the " { $vocab-link "graphviz.render" } " vocabulary."
+$nl
+"User code may, however, encounter the following words exported from the " { $vocab-link "graphviz.ffi" } " vocabulary:"
+{ $subsections ffi-errors supported-engines supported-formats }
+
+{ $curious "Graphviz has documentation for " { $emphasis "libgraph" } " and " { $emphasis "libgvc" } " at " { $url "http://graphviz.org/pdf/libguide.pdf" } "." }
+;
+
+ABOUT: "graphviz.ffi"
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.destructors
+alien.libraries alien.syntax combinators debugger destructors
+fry io kernel literals math prettyprint sequences splitting
+system words.constant
+graphviz
+;
+IN: graphviz.ffi
+
+<<
+"libgraph" {
+ { [ os macosx? ] [ "libgraph.dylib" ] }
+ { [ os unix? ] [ "libgraph.so" ] }
+ { [ os winnt? ] [ "graph.dll" ] }
+} cond cdecl add-library
+
+"libgvc"
+{
+ { [ os macosx? ] [ "libgvc.dylib" ] }
+ { [ os unix? ] [ "libgvc.so" ] }
+ { [ os winnt? ] [ "gvc.dll" ] }
+} cond cdecl add-library
+>>
+
+LIBRARY: libgraph
+
+! Types
+
+C-TYPE: Agraph_t
+C-TYPE: Agnode_t
+C-TYPE: Agedge_t
+
+! Graphs & subgraphs
+
+FUNCTION: Agraph_t* agopen ( c-string name, int kind ) ;
+FUNCTION: Agraph_t* agsubg ( Agraph_t* g, c-string name ) ;
+FUNCTION: void agclose ( Agraph_t* g ) ;
+
+DESTRUCTOR: agclose
+
+: kind ( graph -- magic-constant )
+ [ directed?>> ] [ strict?>> ] bi
+ [ 3 2 ? ] [ 1 0 ? ] if ;
+
+! Nodes
+
+FUNCTION: Agnode_t* agnode ( Agraph_t* g, c-string name ) ;
+FUNCTION: Agnode_t* agfstnode ( Agraph_t* g ) ;
+FUNCTION: Agnode_t* agnxtnode ( Agraph_t* g, Agnode_t* n ) ;
+
+<PRIVATE
+
+: next-node ( g n -- g n' )
+ [ dup ] dip agnxtnode ; inline
+
+: (each-node) ( Agraph_t* Agnode_t* quot -- )
+ '[ [ nip @ ] 2keep next-node dup ] loop 2drop ; inline
+
+PRIVATE>
+
+: each-node ( Agraph_t* quot -- )
+ [ dup agfstnode ] dip
+ over [ (each-node) ] [ 3drop ] if ; inline
+
+! Edges
+
+FUNCTION: Agedge_t* agedge ( Agraph_t* g,
+ Agnode_t* t,
+ Agnode_t* h ) ;
+
+! Attributes
+
+FUNCTION: Agnode_t* agprotonode ( Agraph_t* g ) ;
+FUNCTION: Agedge_t* agprotoedge ( Agraph_t* g ) ;
+
+FUNCTION: c-string agget ( void* obj, c-string name ) ;
+
+FUNCTION: int agsafeset ( void* obj,
+ c-string name,
+ c-string value,
+ c-string default ) ;
+
+
+LIBRARY: libgvc
+
+! Graphviz contexts
+! This must be wrapped in << >> so that GVC_t*, gvContext, and
+! &gvFreeContext can be used to compute the supported-engines
+! and supported-formats constants below.
+
+<<
+C-TYPE: GVC_t
+
+FUNCTION: GVC_t* gvContext ( ) ;
+
+<PRIVATE
+
+FUNCTION-ALIAS: int-gvFreeContext
+ int gvFreeContext ( GVC_t* gvc ) ;
+
+PRIVATE>
+
+ERROR: ffi-errors n ;
+M: ffi-errors error.
+ "Graphviz FFI indicates that " write
+ n>> pprint
+ " error(s) occurred while rendering." print
+ "(The messages were probably printed to STDERR.)" print ;
+
+: gvFreeContext ( gvc -- )
+ int-gvFreeContext dup zero? [ drop ] [ ffi-errors ] if ;
+
+DESTRUCTOR: gvFreeContext
+>>
+
+! Layout
+
+FUNCTION: int gvLayout ( GVC_t* gvc,
+ Agraph_t* g,
+ c-string engine ) ;
+FUNCTION: int gvFreeLayout ( GVC_t* gvc, Agraph_t* g ) ;
+
+! Rendering
+
+FUNCTION: int gvRenderFilename ( GVC_t* gvc,
+ Agraph_t* g,
+ c-string format,
+ c-string filename ) ;
+
+! Supported layout engines (dot, neato, etc.) and output
+! formats (png, jpg, etc.)
+
+<<
+<PRIVATE
+
+ENUM: api_t
+API_render
+API_layout
+API_textlayout
+API_device
+API_loadimage ;
+
+FUNCTION: c-string
+ gvplugin_list
+ ( GVC_t* gvc, api_t api, c-string str ) ;
+
+: plugin-list ( API_t -- seq )
+ '[
+ gvContext &gvFreeContext _ "" gvplugin_list
+ " " split harvest
+ ] with-destructors ;
+
+PRIVATE>
+>>
+
+CONSTANT: supported-engines $[ API_layout plugin-list ]
+CONSTANT: supported-formats $[ API_device plugin-list ]
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays graphviz.attributes help.markup
+help.syntax kernel present sequences strings ;
+IN: graphviz
+
+{ subgraph <subgraph> <anon> <cluster> } related-words
+{ graph <graph> <digraph> <strict-graph> <strict-digraph> } related-words
+{ node <node> add-node add-nodes } related-words
+{ edge <edge> add-edge add-path } related-words
+{ add add-node add-edge add-nodes add-path } related-words
+
+HELP: <anon>
+{ $values
+ { "subgraph" subgraph }
+}
+{ $description
+"Constructs an empty, anonymous " { $link subgraph } " by automatically generating a (somewhat) unique " { $slot "id" } "."
+}
+{ $notes
+"Each " { $slot "id" } " has the form " { $snippet "\"_anonymous_n\"" } ", where " { $snippet "n" } " is a counter incremented by 1 each time an anonymous " { $slot "id" } " is generated (e.g., each time you call " { $link <anon> } " or " { $link <graph> } "). This is also how the Graphviz DOT parser internally handles anonymous graphs and subgraphs."
+$nl
+"Thus, while it's possible to manually create a " { $link subgraph } " whose " { $slot "id" } " conflicts with an " { $link <anon> } "'s , in practice it's unlikely to happen by accident."
+}
+{ $examples
+ "Each " { $link <anon> } " will generate a " { $link subgraph } " with a new " { $slot "id" } ", such as:"
+ { $unchecked-example
+ "USING: graphviz prettyprint ;"
+ "<anon> . <anon> ."
+ "T{ subgraph { id \"_anonymous_5\" } { statements V{ } } }\nT{ subgraph { id \"_anonymous_6\" } { statements V{ } } }"
+ }
+ $nl
+ "More generally, the following should always be the case:"
+ { $example
+ "USING: accessors graphviz kernel prettyprint ;"
+ "<anon> <anon> [ id>> ] bi@ = ."
+ "f"
+ }
+}
+;
+
+HELP: <cluster>
+{ $values
+ { "id" object }
+ { "subgraph" subgraph }
+}
+{ $description
+"Constructs a cluster, which is a " { $link subgraph } " whose " { $slot "id" } " begins with the word " { $emphasis "\"cluster\"" } "."
+$nl
+{ $snippet "id" } " must be an object supported by the " { $link present } " word. The string " { $snippet "\"cluster_\"" } " is automatically prefixed to the " { $slot "id" } " of the resulting " { $link subgraph } "."
+}
+{ $notes
+"Clusters are just a syntactic convention. Not all Graphviz layout engines treat clusters any differently from regular subgraphs. See the Graphviz documentation (" { $url "http://graphviz.org/Documentation.php" } ") for more information."
+}
+{ $examples
+ { $example
+ "USING: graphviz prettyprint ;"
+ "\"foo\" <cluster> ."
+ "T{ subgraph { id \"cluster_foo\" } { statements V{ } } }"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz prettyprint ;"
+ "0 <cluster> id>> ."
+ "\"cluster_0\""
+ }
+}
+;
+
+HELP: <digraph>
+{ $values
+ { "graph" graph }
+}
+{ $description
+"Constructs an empty, non-strict, directed " { $link graph } "."
+}
+{ $notes
+"Because it's rare for " { $link graph } " " { $slot "id" } "s to be meaningful or useful, " { $link <digraph> } " automatically generates one, just as in " { $link <anon> } "."
+
+$nl
+
+"If you want, you can still give the resulting " { $link graph } " a specific " { $slot "id" } " using standard words like " { $link >>id } ". For example,"
+{ $code "<digraph> \"G\" >>id" }
+}
+{ $examples
+ { $example "USING: graphviz prettyprint ;" "<digraph> graph? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint sequences ;" "<digraph> statements>> empty? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<digraph> strict?>> ." "f" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<digraph> directed?>> ." "t" }
+}
+;
+
+HELP: <edge>
+{ $values
+ { "tail" object }
+ { "head" object }
+ { "edge" edge }
+}
+{ $description
+"Constructs an " { $link edge } " with the given " { $slot "tail" } " and " { $slot "head" } ", each of which must be either:"
+{ $list
+ { "an " { $link array } " of objects supported by the " { $link present } " word, which is treated as an anonymous " { $link subgraph } " of " { $link node } "s with corresponding " { $slot "id" } "s;" }
+ { "a " { $link subgraph } "; or" }
+ { "any object supported by the " { $link present } " word, which is taken to be the " { $slot "id" } " of a " { $link node } "." }
+}
+}
+{ $notes
+"There is more detailed information about how different " { $slot "tail" } " and " { $slot "head" } " types interact in the documentation for " { $link edge } "."
+}
+{ $examples
+ { $example
+ "USING: accessors graphviz kernel prettyprint ;"
+ "1 \"one\" <edge>"
+ "[ tail>> . ] [ head>> . ] bi"
+ "\"1\"\n\"one\""
+ }
+ $nl
+ { $example
+ "USING: accessors classes graphviz kernel prettyprint strings ;"
+ "1 { 2 3 4 } <edge>"
+ "[ tail>> class . ] [ head>> class . ] bi"
+ "string\nsubgraph"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz kernel prettyprint ;"
+ "<anon> <anon> <edge>"
+ "[ tail>> id>> ] [ head>> id>> ] bi = ."
+ "f"
+ }
+}
+;
+
+HELP: <graph>
+{ $values
+ { "graph" graph }
+}
+{ $description
+"Constructs an empty, non-strict, undirected " { $link graph } "."
+}
+{ $notes
+"Because it's rare for " { $link graph } " " { $slot "id" } "s to be meaningful or useful, " { $link <graph> } " automatically generates one, just as in " { $link <anon> } "."
+
+$nl
+
+"If you want, you can still give the resulting " { $link graph } " a specific " { $slot "id" } " using standard words like " { $link >>id } ". For example,"
+{ $code "<graph> \"G\" >>id" }
+}
+{ $examples
+ { $example "USING: graphviz prettyprint ;" "<graph> graph? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint sequences ;" "<graph> statements>> empty? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<graph> strict?>> ." "f" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<graph> directed?>> ." "f" }
+}
+;
+
+HELP: <node>
+{ $values
+ { "id" object }
+ { "node" node }
+}
+{ $description
+"Constructs a " { $link node } " with the given " { $slot "id" } ", which must be an object supported by the " { $link present } " word."
+}
+{ $examples
+ { $example
+ "USING: graphviz prettyprint ;"
+ "\"foo\" <node> ."
+ "T{ node { id \"foo\" } }"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz prettyprint ;"
+ "0 <node> id>> ."
+ "\"0\""
+ }
+}
+;
+
+HELP: <strict-digraph>
+{ $values
+ { "graph" graph }
+}
+{ $description
+"Constructs an empty, strict, directed " { $link graph } "."
+}
+{ $notes
+"Because it's rare for " { $link graph } " " { $slot "id" } "s to be meaningful or useful, " { $link <strict-digraph> } " automatically generates one, just as in " { $link <anon> } "."
+
+$nl
+
+"If you want, you can still give the resulting " { $link graph } " a specific " { $slot "id" } " using standard words like " { $link >>id } ". For example,"
+{ $code "<strict-digraph> \"G\" >>id" }
+
+$nl
+
+"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored while rendering. See " { $vocab-link "graphviz.render" } " for more information."
+}
+{ $examples
+ { $example "USING: graphviz prettyprint ;" "<strict-digraph> graph? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint sequences ;" "<strict-digraph> statements>> empty? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<strict-digraph> strict?>> ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<strict-digraph> directed?>> ." "t" }
+}
+;
+
+HELP: <strict-graph>
+{ $values
+ { "graph" graph }
+}
+{ $description
+"Constructs an empty, strict, undirected " { $link graph } "."
+}
+{ $notes
+"Because it's rare for " { $link graph } " " { $slot "id" } "s to be meaningful or useful, " { $link <strict-graph> } " automatically generates one, just as in " { $link <anon> } "."
+
+$nl
+
+"If you want, you can still give the resulting " { $link graph } " a specific " { $slot "id" } " using standard words like " { $link >>id } ". For example,"
+{ $code "<strict-digraph> \"G\" >>id" }
+
+$nl
+
+"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored while rendering. See " { $vocab-link "graphviz.render" } " for more information."
+}
+{ $examples
+ { $example "USING: graphviz prettyprint ;" "<strict-graph> graph? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint sequences ;" "<strict-graph> statements>> empty? ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<strict-graph> strict?>> ." "t" }
+ $nl
+ { $example "USING: accessors graphviz prettyprint ;" "<strict-graph> directed?>> ." "f" }
+}
+;
+
+HELP: <subgraph>
+{ $values
+ { "id" object }
+ { "subgraph" subgraph }
+}
+{ $description
+"Constructs an empty " { $link subgraph } " with the given " { $slot "id" } ", which must be an object supported by the " { $link present } " word."
+}
+{ $notes
+"The empty string, " { $snippet "\"\"" } ", counts as a distinct " { $slot "id" } ". To create an anonymous " { $link subgraph } ", use " { $link <anon> } "."
+}
+{ $examples
+ { $example
+ "USING: graphviz prettyprint ;"
+ "\"subg\" <subgraph> subgraph? ."
+ "t"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz prettyprint ;"
+ "3.14 <subgraph> id>> ."
+ "\"3.14\""
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "\"foo\" <subgraph> statements>> empty? ."
+ "t"
+ }
+}
+;
+
+HELP: add
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "statement" object }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description
+"Adds an arbitrary object to the " { $slot "statements" } " slot of a " { $link graph } " or " { $link subgraph } ", leaving the updated tuple on the stack. This is the most basic way to construct a " { $link graph } "."
+}
+{ $notes ! $warning
+ { $link add } " does not check the type of " { $snippet "statement" } ". You should ensure that " { $link graph } "s and " { $link subgraph } "s only contain instances of:"
+ { $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { $link edge-attributes }
+ }
+}
+{ $examples
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "<graph>"
+ " 1 <node> add"
+ "statements>> [ id>> . ] each"
+ "\"1\""
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "<graph>"
+ " 1 <node> add"
+ " 2 <node> add"
+ "statements>> [ id>> . ] each"
+ "\"1\"\n\"2\""
+ }
+ $nl
+ { $example
+ "USING: accessors classes graphviz prettyprint sequences ;"
+ "<graph>"
+ " 1 <node> add"
+ " 2 <node> add"
+ " 1 2 <edge> add"
+ "statements>> [ class . ] each"
+ "node\nnode\nedge"
+ }
+}
+;
+
+HELP: add-edge
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "tail" object }
+ { "head" object }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description
+"Adds an " { $link edge } " in " { $snippet "graph" } " from " { $slot "tail" } " to " { $slot "head" } ". That is,"
+{ $code "X Y add-edge" }
+"is shorthand for"
+{ $code "X Y <edge> add" }
+}
+{ $examples
+ { $example
+ "USING: accessors graphviz io kernel sequences ;"
+ "<graph>"
+ " 1 2 add-edge"
+ " 3 4 add-edge"
+ " 1 2 add-edge ! duplicate"
+ " 5 6 add-edge"
+ "statements>> [ dup tail>> write \"--\" write head>> print ] each"
+ "1--2\n3--4\n1--2\n5--6"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz io kernel math.combinatorics"
+ "sequences ;"
+ "<graph>"
+ " { \"a\" 2 \"c\" }"
+ " 2 [ first2 add-edge ] each-combination"
+ "statements>> [ dup tail>> write \"--\" write head>> print ] each"
+ "a--2\na--c\n2--c"
+ }
+}
+;
+
+HELP: add-node
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "id" object }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description
+"Adds a " { $link node } " with the given " { $slot "id" } " to " { $snippet "graph" } ". That is,"
+{ $code "X add-node" }
+"is shorthand for"
+{ $code "X <node> add" }
+}
+{ $examples
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "<graph>"
+ " \"foo\" add-node"
+ " \"bar\" add-node"
+ " \"baz\" add-node"
+ "statements>> [ id>> . ] each"
+ "\"foo\"\n\"bar\"\n\"baz\""
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "<graph>"
+ " 5 iota [ add-node ] each"
+ "statements>> [ id>> . ] each"
+ "\"0\"\n\"1\"\n\"2\"\n\"3\"\n\"4\""
+ }
+}
+;
+
+HELP: add-nodes
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "nodes" sequence }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description
+"Adds a " { $link node } " to " { $snippet "graph" } " for each element in " { $snippet "nodes" } ", which must be a " { $link sequence } " of objects that are supported by the " { $link present } " word. Thus, the following two lines are equivalent:"
+{ $code
+ "{ X Y Z } add-nodes"
+ "X add-node Y add-node Z add-node"
+}
+}
+{ $examples
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "<graph>"
+ " { 8 6 7 5 3 0 9 \"Jenny\" \"Jenny\" } add-nodes"
+ "statements>> length ."
+ "9"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz kernel math prettyprint sequences ;"
+ "<graph>"
+ " 100 [ \"spam\" ] replicate add-nodes"
+ "statements>> [ id>> \"spam\" = ] all? ."
+ "t"
+ }
+}
+;
+
+HELP: add-path
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "nodes" sequence }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description
+"Adds " { $link edge } "s to " { $snippet "graph" } " corresponding to a path through " { $snippet "nodes" } "."
+
+$nl
+
+"That is, an " { $link edge } " is added between each object and the one immediately following it in " { $snippet "nodes" } ". Thus, the following two lines are equivalent:"
+{ $code
+ "{ A B C D E } add-path"
+ "A B add-edge B C add-edge C D add-edge D E add-edge"
+}
+}
+{ $examples
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "<graph>"
+ " f add-path"
+ "statements>> empty? ."
+ "t"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz prettyprint sequences ;"
+ "<graph>"
+ " { \"the cheese stands alone\" } add-path"
+ "statements>> empty? ."
+ "t"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz io kernel sequences ;"
+ "<digraph>"
+ " { 1 2 3 4 5 } add-path"
+ "statements>> [ dup tail>> write \" -> \" write head>> print ] each"
+ "1 -> 2\n2 -> 3\n3 -> 4\n4 -> 5"
+ }
+ $nl
+ { $example
+ "USING: accessors graphviz io kernel sequences ;"
+ "<strict-digraph>"
+ " { \"cycle\" \"cycle\" } add-path"
+ "statements>> [ dup tail>> write \" -> \" write head>> print ] each"
+ "cycle -> cycle"
+ }
+}
+;
+
+HELP: edge
+{ $class-description
+"Represents a Graphviz edge. Each " { $link edge } " is defined by its " { $slot "tail" } " slot and its " { $slot "head" } " slot. Each slot must be either"
+{ $list
+ { { $instance string } " representing the " { $slot "id" } " of a " { $link node } " or" }
+ { { $instance subgraph } ", which is a convenient way to represent multiple Graphviz edges." }
+}
+
+"In particular, using " { $link subgraph } "s gives us shorthand forms for the following cases:"
+
+{
+ $table
+ {
+ ""
+ { { $slot "head" } " is a " { $link string } "..." }
+ { { $slot "head" } " is a " { $link subgraph } "..." }
+ }
+ {
+ { { $slot "tail" } " is a " { $link string } "..." }
+ { "edge from " { $slot "tail" } " node\nto " { $slot "head" } " node" }
+ { "edge from " { $slot "tail" } " node\nto each node in " { $slot "head" } }
+ }
+ {
+ { { $slot "tail" } " is a " { $link subgraph } "..." }
+ { "edge from each node in " { $slot "tail" } "\nto " { $slot "head" } " node" }
+ { "edge from each node in " { $slot "tail" } "\nto each node in " { $slot "head" } }
+ }
+}
+"For more details, see " { $vocab-link "graphviz.render" } "."
+$nl
+"In addition, an " { $link edge } " may store local attributes in its " { $slot "attributes" } " slot (" { $instance edge-attributes } " tuple)."
+}
+{ $notes
+"By convention, an " { $link edge } " orders its endpoints \"from\" " { $slot "tail" } " \"to\" " { $slot "head" } ", even if it belongs to an undirected " { $link graph } ", where such a distinction is generally meaningless. See the Graphviz documentation (" { $url "http://graphviz.org/Documentation.php" } "), and specifically the notes about ambiguous attributes (in " { $url "http://graphviz.org/content/attrs" } ") for more information."
+} ;
+
+HELP: graph
+{ $class-description
+"Represents the top-level (or " { $emphasis "root" } ") graph used in Graphviz. Its structure is modeled after the DOT language (see " { $url "http://graphviz.org/Documentation.php" } "):"
+$nl
+{ $table
+ {
+ { $strong "Slot name" }
+ { $strong "Value" }
+ { $strong "Meaning in DOT" }
+ }
+ {
+ { $slot "id" }
+ { $instance string }
+ { "the reference name of a graph, as in " { $strong "graph" } " " { $slot "id" } " " { $strong "{" } " ... " { $strong "}" } }
+ }
+ {
+ { $slot "strict?" }
+ { $instance boolean }
+ { "indicates strictness, as in " { $strong "strict graph {" } " ... " { $strong "}" } }
+ }
+ {
+ { $slot "directed?" }
+ { $instance boolean }
+ { "corresponds to " { $strong "digraph {" } " ... " { $strong "}" } " vs. " { $strong "graph {" } " ... " { $strong "}" } }
+ }
+ {
+ { $slot "statements" }
+ { $instance sequence }
+ { "the defining \"body\", as in " { $strong "graph {" } " ... " { $slot "statements" } " ... " { $strong "}" } }
+ }
+}
+$nl
+"In particular, " { $slot "statements" } " should be a " { $link sequence } " containing only instances of:"
+{ $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { $link edge-attributes }
+}
+} ;
+
+HELP: node
+{ $class-description
+"Represents a single Graphviz node. Each " { $link node } " is uniquely determined by an " { $slot "id" } " (" { $instance string } ") and may have per-node attributes stored in its " { $slot "attributes" } " slot (" { $instance node-attributes } " tuple)." ! TODO see graphviz.attributes
+} ;
+
+HELP: subgraph
+{ $class-description
+"Represents a logical grouping of nodes and edges within a Graphviz graph. See " { $url "http://graphviz.org/Documentation.php" } " for more information."
+$nl
+"Its structure is largely similar to " { $link graph } ", except " { $link subgraph } " only has two slots: " { $slot "id" } " (" { $instance string } ") and " { $slot "statements" } " (" { $instance sequence } "). The " { $slot "strict?" } " and " { $slot "directed?" } " slots of the parent " { $link graph } " are implicitly inherited by a " { $link subgraph } "."
+$nl
+{ $slot "id" } " and " { $slot "statements" } " correspond to the name and defining \"body\" of a subgraph in the DOT language, as in " { $strong "subgraph" } " " { $slot "id" } " " { $strong "{" } " ... " { $slot "statements" } " ... " { $strong "}" } "."
+$nl
+"In particular, " { $slot "statements" } " should be a " { $link sequence } " containing only instances of:"
+{ $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { $link edge-attributes }
+}
+} ;
+
+ARTICLE: { "graphviz" "data" } "Graphviz data structures"
+"To use the " { $vocab-link "graphviz" } " vocabulary, we construct Factor objects that can be converted to data understood by Graphviz (specifically, that " { $emphasis "libgraph" } " and " { $emphasis "libgvc" } " can understand; see " { $vocab-link "graphviz.ffi" } ")."
+$nl
+"The following classes are used to represent their equivalent Graphviz structures:"
+{ $subsections node edge subgraph graph }
+"Several constructor variations exist to make building graphs convenient."
+$nl
+"To construct different sorts of graphs:"
+{ $subsections <graph> <digraph> <strict-graph> <strict-digraph> }
+"To construct different sorts of subgraphs:"
+{ $subsections <subgraph> <anon> <cluster> }
+"To construct nodes and edges:"
+{ $subsections <node> <edge> }
+"Finally, use the following words to combine these objects into a single " { $link graph } ":"
+{ $subsections add add-node add-edge add-nodes add-path }
+;
+
+ARTICLE: { "graphviz" "gallery" "complete" } "Complete graphs"
+"In graph theory, a " { $emphasis "complete graph" } " is one in which there is an edge between each pair of distinct nodes."
+$nl
+{ $code
+"USING: kernel math.combinatorics math.parser sequences"
+"graphviz graphviz.notation graphviz.render ;"
+""
+": K_n ( n -- )"
+" <graph>"
+" node[ \"point\" =shape ]; "
+" graph[ \"t\" =labelloc \"circo\" =layout ];"
+""
+" over number>string \"K \" prepend =label"
+""
+" swap iota 2 [ first2 add-edge ] each-combination"
+" preview ;"
+}
+$nl
+{ $code "5 K_n" }
+{ $image "resource:extra/graphviz/gallery/k5.png" }
+$nl
+{ $code "6 K_n" }
+{ $image "resource:extra/graphviz/gallery/k6.png" }
+$nl
+{ $code "7 K_n" }
+{ $image "resource:extra/graphviz/gallery/k7.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" "bipartite" } "Complete bipartite graphs"
+"In graph theory, a " { $emphasis "bipartite graph" } " is one in which the nodes can be divided into exactly two independent sets (i.e., there are no edges between nodes in the same set)."
+$nl
+{ $code
+"USING: formatting locals math.parser sequences"
+"graphviz graphviz.notation graphviz.render ;"
+""
+":: partite-set ( n color -- cluster )"
+" color <cluster>"
+" color =color"
+" node[ color =color ];"
+" n iota ["
+" number>string color prepend add-node"
+" ] each ;"
+""
+":: K_n,m ( n m -- )"
+" <graph>"
+" node[ \"point\" =shape ];"
+" graph[ \"t\" =labelloc \"dot\" =layout \"LR\" =rankdir ];"
+""
+" n \"#FF0000\" partite-set"
+" m \"#0000FF\" partite-set"
+""
+" add-edge ! between clusters"
+""
+" ! set label last so that clusters don't inherit it"
+" n m \"K %d,%d\" sprintf =label"
+" preview ;"
+}
+$nl
+{ $code "3 3 K_n,m" }
+{ $image "resource:extra/graphviz/gallery/k33.png" }
+$nl
+{ $code "3 4 K_n,m" }
+{ $image "resource:extra/graphviz/gallery/k34.png" }
+$nl
+{ $code "5 4 K_n,m" }
+{ $image "resource:extra/graphviz/gallery/k54.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" "cycle" } "Cycle graphs"
+"In graph theory, a " { $emphasis "cycle graph" } " is one in which all the nodes are connected in a single circle."
+$nl
+{ $code
+"USING: kernel math math.parser sequences"
+"graphviz graphviz.notation graphviz.render ;"
+""
+": add-cycle ( graph n -- graph' )"
+" [ iota add-path ] [ 1 - 0 add-edge ] bi ;"
+""
+": C_n ( n -- )"
+" <graph>"
+" graph[ \"t\" =labelloc \"circo\" =layout ];"
+" node[ \"point\" =shape ];"
+" over number>string \"C \" prepend =label"
+" swap add-cycle"
+" preview ;"
+}
+$nl
+{ $code "5 C_n" }
+{ $image "resource:extra/graphviz/gallery/c5.png" }
+$nl
+{ $code "6 C_n" }
+{ $image "resource:extra/graphviz/gallery/c6.png" }
+$nl
+{ $code "7 C_n" }
+{ $image "resource:extra/graphviz/gallery/c7.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" "wheel" } "Wheel graphs"
+"In graph theory, a " { $emphasis "wheel graph" } " on " { $emphasis "n" } " nodes is composed of a single node connected to each node of a cycle of " { $emphasis "n-1" } " nodes."
+$nl
+{ $code
+"USING: arrays kernel math math.parser sequences"
+"graphviz graphviz.notation graphviz.render ;"
+""
+": add-cycle ( graph n -- graph' )"
+" [ iota add-path ] [ 1 - 0 add-edge ] bi ;"
+""
+": W_n ( n -- )"
+" <graph>"
+" graph[ \"t\" =labelloc \"twopi\" =layout ];"
+" node[ \"point\" =shape ];"
+" over number>string \"W \" prepend =label"
+" over add-node"
+" over 1 - add-cycle"
+" swap [ ] [ 1 - iota >array ] bi add-edge"
+" preview ;"
+}
+$nl
+{ $code "6 W_n" }
+{ $image "resource:extra/graphviz/gallery/w6.png" }
+{ $code "7 W_n" }
+{ $image "resource:extra/graphviz/gallery/w7.png" }
+{ $code "8 W_n" }
+{ $image "resource:extra/graphviz/gallery/w8.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" "cluster" } "Cluster example"
+"This example is adapted from " { $url "http://graphviz.org/content/cluster" } "."
+$nl
+{ $code
+"USING: graphviz graphviz.notation graphviz.render ;"
+""
+"<digraph>"
+" \"dot\" =layout"
+""
+" 0 <cluster>"
+" \"filled\" =style"
+" \"lightgrey\" =color"
+" node[ \"filled\" =style \"white\" =color ];"
+" { \"a0\" \"a1\" \"a2\" \"a3\" } ~->"
+" \"process #1\" =label"
+" add"
+""
+" 1 <cluster>"
+" node[ \"filled\" =style ];"
+" { \"b0\" \"b1\" \"b2\" \"b3\" } ~->"
+" \"process #2\" =label"
+" \"blue\" =color"
+" add"
+""
+" \"start\" \"a0\" ->"
+" \"start\" \"b0\" ->"
+" \"a1\" \"b3\" ->"
+" \"b2\" \"a3\" ->"
+" \"a3\" \"a0\" ->"
+" \"a3\" \"end\" ->"
+" \"b3\" \"end\" ->"
+""
+" \"start\" add-node[ \"Mdiamond\" =shape ];"
+" \"end\" add-node[ \"Msquare\" =shape ];"
+"preview"
+}
+{ $image "resource:extra/graphviz/gallery/cluster.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" "circles" } "Colored circles example"
+"This example was adapted from the \"star\" example in PyGraphviz (" { $url "http://networkx.lanl.gov/pygraphviz/" } ") and modified slightly."
+$nl
+{ $code
+"USING: formatting kernel math sequences"
+"graphviz graphviz.notation graphviz.render ;"
+""
+": colored-circle ( i -- node )"
+" [ <node> ] keep"
+" [ 16.0 / 0.5 + =width ]"
+" [ 16.0 / 0.5 + =height ]"
+" [ 16 * \"#%2x0000\" sprintf =fillcolor ] tri ;"
+""
+"<graph>"
+" graph[ \"3,3\" =size \"circo\" =layout ];"
+""
+" node[ \"filled\" =style"
+" \"circle\" =shape"
+" \"true\" =fixedsize"
+" \"\" =label ];"
+""
+" edge[ \"invis\" =style ];"
+""
+" 0 add-node[ \"invis\" =style \"none\" =shape ];"
+""
+" 16 iota ["
+" [ 0 -- ] [ colored-circle add ] bi"
+" ] each"
+"preview"
+}
+{ $image "resource:extra/graphviz/gallery/circles.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" "fsm" } "Finite state machine example"
+"This example is adapted from " { $url "http://graphviz.org/content/fsm" } "."
+$nl
+{ $code
+"USING: graphviz graphviz.notation graphviz.render ;"
+""
+"<digraph>"
+" \"LR\" =rankdir"
+" \"8,5\" =size"
+" node[ \"doublecircle\" =shape ];"
+" { \"LR_0\" \"LR_3\" \"LR_4\" \"LR_8\" } add-nodes"
+" node[ \"circle\" =shape ];"
+" \"LR_0\" \"LR_2\" ->[ \"SS(B)\" =label ];"
+" \"LR_0\" \"LR_1\" ->[ \"SS(S)\" =label ];"
+" \"LR_1\" \"LR_3\" ->[ \"S($end)\" =label ];"
+" \"LR_2\" \"LR_6\" ->[ \"SS(b)\" =label ];"
+" \"LR_2\" \"LR_5\" ->[ \"SS(a)\" =label ];"
+" \"LR_2\" \"LR_4\" ->[ \"S(A)\" =label ];"
+" \"LR_5\" \"LR_7\" ->[ \"S(b)\" =label ];"
+" \"LR_5\" \"LR_5\" ->[ \"S(a)\" =label ];"
+" \"LR_6\" \"LR_6\" ->[ \"S(b)\" =label ];"
+" \"LR_6\" \"LR_5\" ->[ \"S(a)\" =label ];"
+" \"LR_7\" \"LR_8\" ->[ \"S(b)\" =label ];"
+" \"LR_7\" \"LR_5\" ->[ \"S(a)\" =label ];"
+" \"LR_8\" \"LR_6\" ->[ \"S(b)\" =label ];"
+" \"LR_8\" \"LR_5\" ->[ \"S(a)\" =label ];"
+"preview"
+}
+{ $image "resource:extra/graphviz/gallery/fsm.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" "record" } "Record example"
+"This example is adapted (and slightly altered) from " { $url "http://graphviz.org/content/datastruct" } "."
+$nl
+"As it shows, special label syntax is still parsed, like escape sequences (see " { $url "http://graphviz.org/content/attrs#kescString" } ") or, in this case, record syntax (see " { $url "http://graphviz.org/content/node-shapes#record" } "). However, there is no equivalent to Graphviz's headport/tailport syntax, so we set the " { $link edge } " attributes explicitly."
+$nl
+{ $code
+"USING: graphviz graphviz.notation graphviz.render ;"
+""
+"<digraph>"
+" graph[ \"LR\" =rankdir \"8,8\" =size ];"
+" node[ 8 =fontsize \"record\" =shape ];"
+""
+" \"node0\" add-node["
+" \"<f0> 0x10ba8| <f1>\" =label"
+" ];"
+" \"node1\" add-node["
+" \"<f0> 0xf7fc4380| <f1> | <f2> |-1\" =label"
+" ];"
+" \"node2\" add-node["
+" \"<f0> 0xf7fc44b8| | |2\" =label"
+" ];"
+" \"node3\" add-node["
+" \"<f0> 3.43322790286038071e-06|44.79998779296875|0\" =label"
+" ];"
+" \"node4\" add-node["
+" \"<f0> 0xf7fc4380| <f1> | <f2> |2\" =label"
+" ];"
+" \"node5\" add-node["
+" \"<f0> (nil)| | |-1\" =label"
+" ];"
+" \"node6\" add-node["
+" \"<f0> 0xf7fc4380| <f1> | <f2> |1\" =label"
+" ];"
+" \"node7\" add-node["
+" \"<f0> 0xf7fc4380| <f1> | <f2> |2\" =label"
+" ];"
+" \"node8\" add-node["
+" \"<f0> (nil)| | |-1\" =label"
+" ];"
+" \"node9\" add-node["
+" \"<f0> (nil)| | |-1\" =label"
+" ];"
+" \"node10\" add-node["
+" \"<f0> (nil)| <f1> | <f2> |-1\" =label"
+" ];"
+" \"node11\" add-node["
+" \"<f0> (nil)| <f1> | <f2> |-1\" =label"
+" ];"
+" \"node12\" add-node["
+" \"<f0> 0xf7fc43e0| | |1\" =label"
+" ];"
+""
+" \"node0\" \"node1\" ->[ \"f0\" =tailport \"f0\" =headport ];"
+" \"node0\" \"node2\" ->[ \"f1\" =tailport \"f0\" =headport ];"
+" \"node1\" \"node3\" ->[ \"f0\" =tailport \"f0\" =headport ];"
+" \"node1\" \"node4\" ->[ \"f1\" =tailport \"f0\" =headport ];"
+" \"node1\" \"node5\" ->[ \"f2\" =tailport \"f0\" =headport ];"
+" \"node4\" \"node3\" ->[ \"f0\" =tailport \"f0\" =headport ];"
+" \"node4\" \"node6\" ->[ \"f1\" =tailport \"f0\" =headport ];"
+" \"node4\" \"node10\" ->[ \"f2\" =tailport \"f0\" =headport ];"
+" \"node6\" \"node3\" ->[ \"f0\" =tailport \"f0\" =headport ];"
+" \"node6\" \"node7\" ->[ \"f1\" =tailport \"f0\" =headport ];"
+" \"node6\" \"node9\" ->[ \"f2\" =tailport \"f0\" =headport ];"
+" \"node7\" \"node3\" ->[ \"f0\" =tailport \"f0\" =headport ];"
+" \"node7\" \"node1\" ->[ \"f1\" =tailport \"f0\" =headport ];"
+" \"node7\" \"node8\" ->[ \"f2\" =tailport \"f0\" =headport ];"
+" \"node10\" \"node11\" ->[ \"f1\" =tailport \"f0\" =headport ];"
+" \"node10\" \"node12\" ->[ \"f2\" =tailport \"f0\" =headport ];"
+" \"node11\" \"node1\" ->[ \"f2\" =tailport \"f0\" =headport ];"
+"preview"
+}
+{ $image "resource:extra/graphviz/gallery/record.png" }
+;
+
+ARTICLE: { "graphviz" "gallery" } "Graphviz gallery"
+"Below are some examples of the typical usage of the " { $vocab-link "graphviz" } " vocabulary."
+$nl
+"The images in the gallery were pre-compiled using Graphviz version 2.26.3. Depending on your particular Graphviz installation, these examples may not actually work for you, especially if you have a non-standard installation."
+$nl
+"Also, while most of the images have a reasonable size, some of these examples may be slow to load in the UI listener."
+$nl
+{ $subsections
+ { "graphviz" "gallery" "complete" }
+ { "graphviz" "gallery" "bipartite" }
+ { "graphviz" "gallery" "cycle" }
+ { "graphviz" "gallery" "wheel" }
+ { "graphviz" "gallery" "cluster" }
+ { "graphviz" "gallery" "circles" }
+ { "graphviz" "gallery" "fsm" }
+ { "graphviz" "gallery" "record" }
+}
+;
+
+ARTICLE: "graphviz" "Graphviz"
+"The " { $vocab-link "graphviz" } " vocabulary provides an interface to your existing Graphviz installation, thus allowing you to create, edit, and render Graphviz graphs using Factor. For more information about Graphviz, see " { $url "http://graphviz.org" } "."
+$nl
+"This vocabulary provides the basic tools to construct Factor representations of graphs. For more details, see:"
+{ $subsections { "graphviz" "data" } }
+"Other vocabularies let you change a graph's look & feel, write cleaner code to represent it, and (of course) generate its Graphviz output:"
+{ $vocab-subsection "Graphviz attributes" "graphviz.attributes" }
+{ $vocab-subsection "Graphviz notation" "graphviz.notation" }
+{ $vocab-subsection "Rendering Graphviz output" "graphviz.render" }
+$nl
+"After reading the above, you can see several examples in action:"
+{ $subsections { "graphviz" "gallery" } }
+;
+
+ABOUT: "graphviz"
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays grouping kernel namespaces present
+sequences strings
+graphviz.attributes
+;
+IN: graphviz
+
+TUPLE: graph
+{ id string }
+{ strict? boolean }
+{ directed? boolean }
+statements ;
+
+TUPLE: subgraph
+{ id string }
+statements ;
+
+TUPLE: node
+{ id string }
+{ attributes node-attributes } ;
+
+TUPLE: edge
+tail
+head
+{ attributes edge-attributes } ;
+
+! Constructors
+
+<PRIVATE
+
+: anon-id ( -- id )
+ \ anon-id counter present "_anonymous_" prepend ; inline
+
+PRIVATE>
+
+: <graph> ( -- graph )
+ anon-id f f V{ } clone graph boa ;
+
+: <strict-graph> ( -- graph )
+ <graph> t >>strict? ;
+
+: <digraph> ( -- graph )
+ <graph> t >>directed? ;
+
+: <strict-digraph> ( -- graph )
+ <digraph> t >>strict? ;
+
+: <anon> ( -- subgraph )
+ anon-id V{ } clone subgraph boa ;
+
+: <subgraph> ( id -- subgraph )
+ present V{ } clone subgraph boa ;
+
+: <cluster> ( id -- subgraph )
+ present "cluster_" prepend V{ } clone subgraph boa ;
+
+: <node> ( id -- node )
+ present <node-attributes> node boa ;
+
+DEFER: add-nodes
+
+: <edge> ( tail head -- edge )
+ [
+ dup array?
+ [ <anon> swap add-nodes ]
+ [ dup subgraph? [ present ] unless ]
+ if
+ ] bi@
+ <edge-attributes> edge boa ;
+
+! Building graphs
+
+: add ( graph statement -- graph' )
+ over statements>> push ;
+
+: add-node ( graph id -- graph' )
+ <node> add ; inline
+
+: add-edge ( graph tail head -- graph' )
+ <edge> add ; inline
+
+: add-nodes ( graph nodes -- graph' )
+ [ add-node ] each ;
+
+: add-path ( graph nodes -- graph' )
+ 2 <clumps> [ first2 add-edge ] each ;
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.libraries alien.syntax
+classes.struct combinators system ;
+IN: graphviz.libcgraph
+
+<<
+"libcgraph"
+{
+ { [ os macosx? ] [ "libcgraph.dylib" ] }
+ { [ os unix? ] [ "libcgraph.so" ] }
+ { [ os winnt? ] [ "libcgraph.dll" ] }
+} cond cdecl add-library
+>>
+
+LIBRARY: libcgraph
+
+! Types
+
+STRUCT: Agdesc_s
+{ directed uint bits: 1 }
+{ strict uint bits: 1 }
+{ no_loop uint bits: 1 }
+{ maingraph uint bits: 1 }
+{ flatlock uint bits: 1 }
+{ no_write uint bits: 1 }
+{ has_attrs uint bits: 1 }
+{ has_cmpnd uint bits: 1 } ;
+
+CONSTANT: Agdirected
+ S{ Agdesc_s { directed 1 } { maingraph 1 } }
+CONSTANT: Agstrictdirected
+ S{ Agdesc_s { directed 1 } { strict 1 } { maingraph 1 } }
+CONSTANT: Agundirected
+ S{ Agdesc_s { maingraph 1 } }
+CONSTANT: Agstrictundirected
+ S{ Agdesc_s { strict 1 } { maingraph 1 } }
+
+C-TYPE: Agraph_t
+C-TYPE: Agnode_t
+C-TYPE: Agedge_t
+TYPEDEF: Agdesc_s Agdesc_t
+C-TYPE: Agdisc_t
+
+! Graphs
+
+FUNCTION: Agraph_t* agopen ( c-string name, Agdesc_t kind, Agdisc_t* disc ) ;
+FUNCTION: int agclose ( Agraph_t* g ) ;
+FUNCTION: int agwrite ( Agraph_t* g, void* channel ) ;
+
+! Subgraphs
+
+FUNCTION: Agraph_t* agsubg ( Agraph_t* g, c-string name, int createflag ) ;
+
+! Nodes
+
+FUNCTION: Agnode_t* agnode ( Agraph_t* g, c-string name, int createflag ) ;
+FUNCTION: Agnode_t* agfstnode ( Agraph_t* g ) ;
+FUNCTION: Agnode_t* agnxtnode ( Agraph_t* g, Agnode_t* n ) ;
+
+! Edges
+
+FUNCTION: Agedge_t* agedge ( Agraph_t* g,
+ Agnode_t* t,
+ Agnode_t* h,
+ c-string name,
+ int createflag ) ;
+FUNCTION: Agedge_t* agfstedge ( Agraph_t* g, Agnode_t* n ) ;
+FUNCTION: Agedge_t* agnxtedge ( Agraph_t* g, Agedge_t* e, Agnode_t* n ) ;
+
+! String attributes
+
+FUNCTION: int agsafeset ( void* obj,
+ c-string name,
+ c-string value,
+ c-string default ) ;
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: graphviz graphviz.attributes help.markup help.syntax
+kernel present sequences ;
+IN: graphviz.notation
+
+{ add-edge add-edge[ -- ~-- --[ } related-words
+{ add-edge add-edge[ -> ~-> ->[ } related-words
+{
+ add-node[ add-edge[ --[ ->[ node[ edge[ graph[ ];
+} related-words
+
+HELP: --
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "tail" object }
+ { "head" object }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description "Shorthand for " { $link add-edge } ". Makes undirected " { $link graph } "s read more like graphs in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " 1 2 add-edge"
+ " 3 4 add-edge"
+ " 5 6 add-edge"
+ }
+ "it looks better to write"
+ { $code
+ "<graph>"
+ " 1 2 --"
+ " 3 4 --"
+ " 5 6 --"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "graph {"
+ " 1 -- 2"
+ " 3 -- 4"
+ " 5 -- 6"
+ "}"
+ }
+}
+;
+
+HELP: ->
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "tail" object }
+ { "head" object }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description "Shorthand for " { $link add-edge } ". Makes directed " { $link graph } "s read more like digraphs in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<digraph>"
+ " 1 2 add-edge"
+ " 3 4 add-edge"
+ " 5 6 add-edge"
+ }
+ "it looks better to write"
+ { $code
+ "<digraph>"
+ " 1 2 ->"
+ " 3 4 ->"
+ " 5 6 ->"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "digraph {"
+ " 1 -> 2"
+ " 3 -> 4"
+ " 5 -> 6"
+ "}"
+ }
+}
+;
+
+HELP: --[
+{ $values
+ { "tail" object }
+ { "head" object }
+ { "edge" edge }
+}
+{ $description "Shorthand for " { $link <edge> } " to be used with " { $link ]; } " and attribute-setting generic words (see " { $link { "graphviz.notation" "=attrs" } } ") so that undirected " { $link graph } "s read more like graphs in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " 1 2 <edge> \"red\" =color add"
+ }
+ "it looks better to write"
+ { $code
+ "<graph>"
+ " 1 2 --[ \"red\" =color ];"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "graph {"
+ " 1 -- 2 [ color=\"red\" ];"
+ "}"
+ }
+}
+;
+
+HELP: ->[
+{ $values
+ { "tail" object }
+ { "head" object }
+ { "edge" edge }
+}
+{ $description "Shorthand for " { $link <edge> } " to be used with " { $link ]; } " and attribute-setting generic words (see " { $link { "graphviz.notation" "=attrs" } } ") so that directed " { $link graph } "s read more like digraphs in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<digraph>"
+ " 1 2 <edge> \"red\" =color add"
+ }
+ "it looks better to write"
+ { $code
+ "<digraph>"
+ " 1 2 ->[ \"red\" =color ];"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "digraph {"
+ " 1 -> 2 [ color=\"red\" ];"
+ "}"
+ }
+}
+;
+
+HELP: ];
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "statement" object }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description "Synonym for " { $link add } " meant to be the \"other half\" of various " { $vocab-link "graphviz.notation" } " words like " { $links add-edge[ add-node[ graph[ } ", etc." }
+{ $examples "Refer to the documentation for the complementary words listed below." }
+;
+
+HELP: add-edge[
+{ $values
+ { "tail" object }
+ { "head" object }
+ { "edge" edge }
+}
+{ $description "Shorthand for " { $link <edge> } " to be used with " { $link ]; } " and attribute-setting generic words (see " { $link { "graphviz.notation" "=attrs" } } ") so that setting an " { $link edge } "'s " { $slot "attributes" } " reads more like the equivalent in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " 1 2 <edge> \"red\" =color add"
+ }
+ "it looks better to write"
+ { $code
+ "<graph>"
+ " 1 2 add-edge[ \"red\" =color ];"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "graph {"
+ " 1 -- 2 [ color=\"red\" ];"
+ "}"
+ }
+ $nl
+ "This has the advantage over " { $link --[ } " and " { $link ->[ } " of reading nicely for both directed " { $emphasis "and" } " undirected " { $link graph } "s."
+}
+;
+
+HELP: add-node[
+{ $values
+ { "id" object }
+ { "node" node }
+}
+{ $description "Shorthand for " { $link <node> } " to be used with " { $link ]; } " and attribute-setting generic words (see " { $link { "graphviz.notation" "=attrs" } } ") so that setting a " { $link node } "'s " { $slot "attributes" } " reads more like the equivalent in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " \"foo\" <node> \"red\" =color add"
+ }
+ "it looks better to write"
+ { $code
+ "<graph>"
+ " \"foo\" add-node[ \"red\" =color ];"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "graph {"
+ " foo [ color=\"red\" ];"
+ "}"
+ }
+}
+;
+
+HELP: edge[
+{ $values
+ { "attrs" edge-attributes }
+}
+{ $description "Shorthand for " { $link <edge-attributes> } " to be used with " { $link ]; } " and attribute-setting generic words (see " { $link { "graphviz.notation" "=attrs" } } ") so that adding " { $link edge-attributes } " to a " { $link graph } " or " { $link subgraph } " reads more like the equivalent in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " <edge-attributes> \"red\" =color add"
+ }
+ "it looks better to write"
+ { $code
+ "<graph>"
+ " edge[ \"red\" =color ];"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "graph {"
+ " edge[ color=\"red\" ];"
+ "}"
+ }
+}
+;
+
+HELP: graph[
+{ $values
+ { "attrs" graph-attributes }
+}
+{ $description "Shorthand for " { $link <graph-attributes> } " to be used with " { $link ]; } " and attribute-setting generic words (see " { $link { "graphviz.notation" "=attrs" } } ") so that adding " { $link graph-attributes } " to a " { $link graph } " or " { $link subgraph } " reads more like the equivalent in the DOT language." }
+{ $notes "This word is rendered redundant by the " { $link graph } " and " { $link subgraph } " methods defined by " { $vocab-link "graphviz.notation" } " for setting attributes. Sometimes it still might look better to delineate certain attribute-setting code." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " <graph-attributes> \"LR\" =rankdir \"blah\" =label add"
+ }
+ "it looks better to write"
+ { $code
+ "<graph>"
+ " graph[ \"LR\" =rankdir \"blah\" =label ];"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "graph {"
+ " graph[ rankdir=\"LR\" label=\"blah\" ];"
+ "}"
+ }
+ $nl
+ "Of course, you could just write"
+ { $code
+ "<graph>"
+ " \"LR\" =rankdir"
+ " \"blah\" =label"
+ }
+ "Similarly, in the DOT language you could just write"
+ { $code
+ "graph {"
+ " rankdir=\"LR\""
+ " label=\"blah\""
+ "}"
+ }
+}
+;
+
+HELP: node[
+{ $values
+ { "attrs" node-attributes }
+}
+{ $description "Shorthand for " { $link <node-attributes> } " to be used with " { $link ]; } " and attribute-setting generic words (see " { $link { "graphviz.notation" "=attrs" } } ") so that adding " { $link node-attributes } " to a " { $link graph } " or " { $link subgraph } " reads more like the equivalent in the DOT language." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " <node-attributes> \"red\" =color add"
+ }
+ "it looks better to write"
+ { $code
+ "<graph>"
+ " node[ \"red\" =color ];"
+ }
+ "Compare this with the DOT language, where you'd write"
+ { $code
+ "graph {"
+ " node[ color=\"red\" ];"
+ "}"
+ }
+}
+;
+
+HELP: ~--
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "nodes" sequence }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description "Shorthand for " { $link add-path } ". Meant to be a Factor replacement for the DOT language's more verbose path notation." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<graph>"
+ " 1 2 --"
+ " 2 3 --"
+ " 3 4 --"
+ }
+ "you can write"
+ { $code
+ "<graph>"
+ " { 1 2 3 4 } ~--"
+ }
+ "whereas in the DOT language you'd write"
+ { $code
+ "graph {"
+ " 1 -- 2 -- 3 -- 4"
+ "}"
+ }
+}
+;
+
+HELP: ~->
+{ $values
+ { "graph" { $or graph subgraph } }
+ { "nodes" sequence }
+ { "graph'" { $or graph subgraph } }
+}
+{ $description "Shorthand for " { $link add-path } ". Meant to be a Factor replacement for the DOT language's more verbose path notation." }
+{ $examples
+ "Instead of writing"
+ { $code
+ "<digraph>"
+ " 1 2 ->"
+ " 2 3 ->"
+ " 3 4 ->"
+ }
+ "you can write"
+ { $code
+ "<digraph>"
+ " { 1 2 3 4 } ~->"
+ }
+ "whereas in the DOT language you'd write"
+ { $code
+ "digraph {"
+ " 1 -> 2 -> 3 -> 4"
+ "}"
+ }
+}
+;
+
+ARTICLE: { "graphviz.notation" "=attrs" } "Notation for setting Graphviz attributes"
+"The " { $vocab-link "graphviz.notation" } " vocabulary provides words for setting Graphviz attributes in a way that looks similar to the DOT language (see " { $url "http://graphviz.org/content/dot-language" } ")."
+$nl
+"For every slot named, say, " { $snippet "attr" } " in the " { $link node-attributes } ", " { $link edge-attributes } ", and " { $link graph-attributes } " tuples, a generic word named " { $snippet "=attr" } " is defined with the stack effect " { $snippet "( graphviz-obj val -- graphviz-obj' )" } "."
+$nl
+"In each such " { $snippet "=attr" } " word, " { $snippet "val" } " must be an object supported by the " { $link present } " word, which is always called on " { $snippet "val" } " before it's stored in a slot."
+$nl
+"These generics will \"do the right thing\" in setting the corresponding attribute of " { $snippet "graphviz-obj" } "."
+$nl
+"For example, since " { $link graph-attributes } " has a " { $slot "label" } " slot, the generic " { $link =label } " is defined, along with methods so that if " { $snippet "graphviz-obj" } " is a..."
+{ $list
+ { "..." { $link graph } " or " { $link subgraph } ", a new " { $link graph-attributes } " instance is created, has its " { $slot "label" } " slot is set to " { $snippet "val" } ", and is " { $link add } "ed to " { $snippet "graphviz-obj" } "." }
+ { "..." { $link graph-attributes } " instance, its " { $slot "label" } " slot is set to " { $snippet "val" } "." }
+}
+$nl
+"Since " { $link edge-attributes } " has a " { $slot "label" } " slot, further methods are defined so that if " { $snippet "graphviz-obj" } " is an..."
+{ $list
+ { "..." { $link edge } ", its " { $slot "attributes" } " slot has its " { $slot "label" } " slot set to " { $snippet "val" } "." }
+ { "..." { $link edge-attributes } " instance, its " { $slot "label" } " slot is set to " { $snippet "val" } "." }
+}
+$nl
+"Finally, since " { $link node-attributes } " has a " { $slot "label" } " slot, still more methods are defined so that if " { $snippet "graphviz-obj" } " is a..."
+{ $list
+ { "..." { $link node } ", its " { $slot "attributes" } " slot has its " { $slot "label" } " slot set to " { $snippet "val" } "." }
+ { "..." { $link node-attributes } " instance, its " { $slot "label" } " slot is set to " { $snippet "val" } "." }
+}
+$nl
+"Thus, instead of"
+{ $code
+ "<graph>"
+ " <graph-attributes>"
+ " \"Bad-ass graph\" >>label"
+ " add"
+ " 1 2 <edge> dup attributes>>"
+ " \"This edge is dumb\" swap label<<"
+ " add"
+ " 3 <node> dup attributes>>"
+ " \"This node is cool\" swap label<<"
+ " add"
+}
+"you can simply write"
+{ $code
+ "<graph>"
+ " \"Bad-ass graph\" =label"
+ " 1 2 <edge>"
+ " \"This edge is dumb\" =label"
+ " add"
+ " 3 <node>"
+ " \"This node is cool\" =label"
+ " add"
+}
+$nl
+"However, since the slot " { $slot "labelloc" } " only exists in " { $link graph-attributes } " and " { $link node-attributes } ", there won't be a method for " { $link edge } " or " { $link edge-attributes } " objects:"
+{ $example
+ "USING: continuations graphviz graphviz.notation io kernel ;"
+ "<graph>"
+ " ! This is OK:"
+ " \"t\" =labelloc"
+ ""
+ " ! This is not OK:"
+ " [ 1 2 <edge> \"b\" =labelloc add ]"
+ " [ 2drop \"not for edges!\" write ] recover"
+ "not for edges!"
+}
+$nl
+"For the full list of attribute-setting words, consult the list of generic words for the " { $vocab-link "graphviz.notation" } " vocabulary."
+;
+
+ARTICLE: { "graphviz.notation" "synonyms" } "Aliases that resemble DOT code"
+"The " { $vocab-link "graphviz.notation" } " vocabulary provides aliases for words defined in the " { $vocab-link "graphviz" } " and " { $vocab-link "graphviz.attributes" } " vocabularies. These will make Factor code read more like DOT code (see " { $url "http://graphviz.org/content/dot-language" } ")."
+$nl
+"Notation for edges without attributes:"
+{ $subsections
+ --
+ ->
+ ~--
+ ~->
+}
+"Notation for nodes/edges with local attributes:"
+{ $subsections
+ add-node[
+ add-edge[
+ --[
+ ->[
+}
+"Notation for global attributes:"
+{ $subsections
+ node[
+ edge[
+ graph[
+}
+"Word to \"close off\" notation for attributes:"
+{ $subsections
+ ];
+}
+;
+
+ARTICLE: "graphviz.notation" "Graphviz notation"
+"The " { $vocab-link "graphviz.notation" } " vocabulary provides words for building " { $link graph } "s in a way that looks similar to the DOT language (see " { $url "http://graphviz.org/content/dot-language" } ")."
+$nl
+"The " { $vocab-link "graphviz" } " vocabulary alone already follows the general structure of the DOT language: " { $link graph } "s and " { $link subgraph } "s consist of an ordered sequence of " { $slot "statements" } "; each statement will " { $link add } " either a " { $link node } ", an " { $link edge } ", or some attribute declaration (" { $links graph-attributes node-attributes edge-attributes } "); and " { $slot "attributes" } " may be set on individual " { $link node } "s and " { $link edge } "s. Even some DOT niceties are already supported, like being able to have an " { $link edge } " between anonymous " { $link subgraph } "s. For instance, compare"
+{ $code
+ "<digraph>"
+ " { 1 2 3 } { 4 5 6 } add-edge"
+}
+"with the DOT code"
+{ $code
+ "digraph {"
+ " { 1 2 3 } -> { 4 5 6 }"
+ "}"
+}
+$nl
+"However, there are some rough points that this vocabulary addresses:"
+{ $subsections
+ { "graphviz.notation" "=attrs" }
+ { "graphviz.notation" "synonyms" }
+}
+;
+
+ABOUT: "graphviz.notation"
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors fry generic generic.parser generic.standard
+kernel present quotations sequences slots words
+graphviz
+graphviz.attributes
+;
+IN: graphviz.notation
+
+<<
+
+<PRIVATE
+
+! GENERIC# =attr 1 ( graphviz-obj val -- graphviz-obj' )
+! M: edge/node =attr
+! present over attributes>> attr<< ;
+! M: sub/graph =attr
+! <graph-attributes> swap present >>attr add ;
+! M: edge/node/graph-attributes =attr
+! present >>attr ;
+
+: =attr-generic ( name -- generic )
+ "=" prepend "graphviz.notation" 2dup lookup
+ [ 2nip ] [
+ create dup
+ 1 <standard-combination>
+ (( graphviz-obj val -- graphviz-obj' ))
+ define-generic
+ ] if* ;
+
+: =attr-method ( class name -- method name )
+ [ =attr-generic create-method-in ] keep ;
+
+: sub/graph-=attr ( attr -- )
+ [ graph subgraph ] dip [
+ =attr-method
+ setter-word 1quotation
+ '[ <graph-attributes> swap present @ add ]
+ define
+ ] curry bi@ ;
+
+: edge/node-=attr ( class attr -- )
+ =attr-method
+ writer-word 1quotation '[ present over attributes>> @ ]
+ define ;
+
+: graph-obj-=attr ( class attr -- )
+ over graph =
+ [ nip sub/graph-=attr ]
+ [ edge/node-=attr ] if ;
+
+: attrs-obj-=attr ( class attr -- )
+ =attr-method
+ setter-word 1quotation '[ present @ ]
+ define ;
+
+: define-=attrs ( base-class attrs-class -- )
+ dup "slots" word-prop [
+ name>>
+ [ attrs-obj-=attr ] keep
+ graph-obj-=attr
+ ] with with each ;
+
+PRIVATE>
+
+graph graph-attributes define-=attrs
+edge edge-attributes define-=attrs
+node node-attributes define-=attrs
+
+>>
+
+ALIAS: -> add-edge
+ALIAS: -- add-edge
+ALIAS: ~-> add-path
+ALIAS: ~-- add-path
+
+ALIAS: graph[ <graph-attributes>
+ALIAS: node[ <node-attributes>
+ALIAS: edge[ <edge-attributes>
+
+ALIAS: add-node[ <node>
+ALIAS: add-edge[ <edge>
+ALIAS: ->[ <edge>
+ALIAS: --[ <edge>
+
+ALIAS: ]; add
+
+! Can't really do add-path[ & add-nodes[ this way, since they
+! involve multiple objects.
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: graphviz graphviz.attributes graphviz.builder
+graphviz.ffi help.markup help.syntax images.viewer kernel
+strings ;
+IN: graphviz.render
+
+HELP: default-format
+{ $var-description "Holds a " { $link string } " representing the implicit output format for certain words in the " { $vocab-link "graphviz.render" } " vocabulary." }
+{ $see-also graphviz graphviz* preview preview-window default-layout }
+;
+
+HELP: default-layout
+{ $var-description "Holds a " { $link string } " representing the implicit layout engine for certain words in the " { $vocab-link "graphviz.render" } " vocabulary." }
+{ $see-also graphviz graphviz* preview preview-window default-format }
+;
+
+{ graphviz graphviz* } related-words
+
+HELP: graphviz
+{ $values
+ { "graph" graph }
+ { "-O" string }
+ { "-T" string }
+ { "-K" { $maybe string } }
+}
+{ $description "Renders " { $snippet "graph" } " to a specified output file."
+$nl
+{ $snippet "-O" } " is similar to the command-line argument of the standard Graphviz commands (see " { $url "http://graphviz.org/content/command-line-invocation" } "). It specifies the base name of the " { $strong "o" } "utput file. Like Graphviz tools, the proper extension (if one is known) is automatically added to the file name based on " { $snippet "-T" } "."
+$nl
+{ $snippet "-T" } " specifies the output format " { $strong "t" } "ype (which must be a member of " { $link supported-formats } "). This is, again, akin to the command-line flag in standard Graphviz commands."
+$nl
+{ $snippet "-K" } " specifies the layout engine. If " { $snippet "-K" } " is " { $link f } ", then " { $snippet "graph" } " is checked for a " { $slot "layout" } " attribute (see " { $link graph-attributes } ") and that engine is used; if no such attribute is set, then " { $link default-layout } " is used. Regardless, the resulting engine must be a member of " { $link supported-engines } "."
+}
+{ $errors
+"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
+$nl
+"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
+{ $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { "or " { $link edge-attributes } }
+}
+$nl
+"If " { $snippet "-K" } " (or the inferred layout engine) is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
+$nl
+"If " { $snippet "-T" } " is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
+}
+{ $examples "To render a " { $link graph } " " { $snippet "G" } " using " { $emphasis "circo" } " and save the output to a PNG file, we could write" { $code "G \"foo\" \"png\" \"circo\" graphviz" } "(assuming " { $emphasis "circo" } " and PNG are supported by your Graphviz installation). This will save the output to the file " { $snippet "foo.png" } "." }
+;
+
+HELP: graphviz*
+{ $values
+ { "graph" graph }
+ { "-O" string }
+ { "-T" string }
+}
+{ $description "Renders " { $snippet "graph" } " to a specified output file (" { $snippet "-O" } ") with the specified format type (" { $snippet "-T" } ") using the " { $link default-layout } " (or " { $snippet "graph" } "'s " { $snippet "layout" } " attribute, if set). That is, the following two lines are equivalent:"
+{ $code "-O -T f graphviz" "-O -T graphviz*" }
+}
+{ $errors
+"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
+$nl
+"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
+{ $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { "or " { $link edge-attributes } }
+}
+$nl
+"If the inferred layout engine is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
+$nl
+"If " { $snippet "-T" } " is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
+}
+{ $examples "To render a " { $link graph } " " { $snippet "G" } " when we don't particularly care about the engine but want to save the output to a PNG file, we could write" { $code "G \"foo\" \"png\" graphviz*" } "(assuming the inferred layout and PNG are supported by your Graphviz installation). This will save the output to the file " { $snippet "foo.png" } "." }
+;
+
+HELP: preview
+{ $values
+ { "graph" graph }
+}
+{ $description "Renders " { $snippet "graph" } " to a temporary file of the " { $link default-format } " (assumed to be an image format) using the " { $link default-layout } " (or, if specified, the engine set as the graph's " { $slot "layout" } " attribute). Then, using the " { $vocab-link "images.viewer" } " vocabulary, displays the image in the UI listener." }
+{ $errors
+"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
+$nl
+"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
+{ $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { "or " { $link edge-attributes } }
+}
+$nl
+"If the inferred layout engine is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
+$nl
+"If the inferred output format (i.e., " { $link default-format } ") is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
+}
+{ $see-also image. preview-window }
+;
+
+HELP: preview-window
+{ $values
+ { "graph" graph }
+}
+{ $description "Renders " { $snippet "graph" } " to a temporary file of the " { $link default-format } " (assumed to be an image format) using the " { $link default-layout } " (or, if specified, the engine set as the graph's " { $slot "layout" } " attribute). Then, using the " { $vocab-link "images.viewer" } " vocabulary, opens a new window displaying the image." }
+{ $errors
+"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
+$nl
+"An " { $link improper-statement-error } " is thrown if any element of " { $snippet "graph" } "'s " { $snippet "statements" } " slot is not an instance of:"
+{ $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { "or " { $link edge-attributes } }
+}
+$nl
+"If the inferred layout engine is not a member of " { $link supported-engines } ", an " { $link unsupported-engine } " error is thrown."
+$nl
+"If the inferred output format (i.e., " { $link default-format } ") is not a member of " { $link supported-formats } ", an " { $link unsupported-format } " error is thrown."
+}
+{ $see-also image-window preview }
+;
+
+HELP: unsupported-engine
+{ $values
+ { "engine" object }
+}
+{ $error-description "Thrown if a rendering word tries to use a layout engine that is not a member of " { $link supported-engines } "." }
+{ $see-also unsupported-format }
+;
+
+HELP: unsupported-format
+{ $values
+ { "format" object }
+}
+{ $error-description "Thrown if a rendering word tries to use an output format that is not a member of " { $link supported-formats } "." }
+{ $see-also unsupported-engine }
+;
+
+ARTICLE: { "graphviz.render" "algorithm" "node" } "Rendering nodes"
+"To render a " { $link node } ", a Graphviz equivalent is constructed in memory that is identified by the " { $link node } "'s " { $slot "id" } " slot. Then, any local attributes (as specified in the " { $slot "attributes" } " slot) are set."
+$nl
+"If two " { $link node } " instances have the same " { $slot "id" } ", they will correspond to the same object in the Graphviz representation. Thus, the effect of any local attributes are cumulative. For example,"
+{ $code
+"<graph>"
+" 1 add-node[ \"blue\" =color ];"
+" 1 add-node[ \"red\" =color ];"
+}
+"will render the same way as just"
+{ $code
+"<graph>"
+" 1 add-node[ \"red\" =color ];"
+}
+"because statements are rendered in the order they appear. Even " { $link node } " instances in a " { $link subgraph } " are treated this way, so"
+{ $code
+"<graph>"
+" 1 add-node"
+" <anon>"
+" 1 add-node"
+" add"
+}
+"will only create a single Graphviz node."
+;
+
+ARTICLE: { "graphviz.render" "algorithm" "subgraph" } "Rendering subgraphs"
+"To render a " { $link subgraph } ", a Graphviz equivalent is constructed in memory that is identified by the " { $link subgraph } "'s " { $slot "id" } " slot. This equivalent will inherit any attributes set in its parent graph (see " { $link { "graphviz.render" "algorithm" "attributes" } } ")."
+$nl
+"Each element of the " { $link subgraph } "'s " { $slot "statements" } " slot is recursively rendered in order. Thus, subgraph attributes are set by rendering a " { $link graph-attributes } " object contained in a " { $link subgraph } "'s " { $slot "statements" } "."
+$nl
+"If two " { $link subgraph } " instances have the same " { $slot "id" } ", they will correspond to the same object in the Graphviz representation. (Indeed, the " { $slot "id" } "s even share the same namespace as the root " { $link graph } "; see " { $url "http://graphviz.org/content/dot-language" } " for details.) Thus, the effect of rendering " { $emphasis "any" } " statement is cumulative. For example,"
+{ $code
+"<graph>"
+" { 1 2 3 } add-nodes"
+""
+" 0 <cluster>"
+" 4 add-node"
+" add"
+""
+" 0 <cluster>"
+" 5 add-node"
+" add"
+}
+"will render the same way as just"
+{ $code
+"<graph>"
+" { 1 2 3 } add-nodes"
+""
+" 0 <cluster>"
+" 4 add-node"
+" 5 add-node"
+" add"
+}
+;
+
+ARTICLE: { "graphviz.render" "algorithm" "attributes" } "Rendering attributes"
+"The way " { $link node-attributes } ", " { $link edge-attributes } ", and " { $link graph-attributes } " are rendered varies by context."
+$nl
+"If an instance of " { $link node-attributes } " or " { $link edge-attributes } " appears in the " { $slot "statements" } " of a " { $link graph } " or " { $link subgraph } ", it corresponds to global Graphviz attributes that will be set automatically for any " { $emphasis "future" } " " { $link node } " or " { $link edge } " instances (respectively), just like global attribute statements in the DOT language. Rendering " { $link graph-attributes } " behaves similarly, except that the Graphviz attributes of the containing graph/subgraph will also be altered, in addition to future " { $link subgraph } "s inheriting said attributes."
+$nl
+{ $link node-attributes } " and " { $link edge-attributes } " may also be rendered in the context of a single " { $link node } " or " { $link edge } ", as specified by these objects' " { $slot "attributes" } " slots. They correspond to Graphviz attributes set specifically for the corresponding node/edge, after the defaults are inherited from rendering global statements as in the above."
+$nl
+"For example, setting " { $emphasis "local" } " attributes like"
+{ $code
+"<graph>"
+" 1 add-node[ \"red\" =color ];"
+" 2 add-node[ \"red\" =color ];"
+" 3 add-node[ \"blue\" =color ];"
+" 4 add-node[ \"blue\" =color ];"
+}
+"will render the same way as setting " { $emphasis "global" } " attributes that get inherited, like"
+{ $code
+"<graph>"
+" node[ \"red\" =color ];"
+" 1 add-node"
+" 2 add-node"
+" node[ \"blue\" =color ];"
+" 3 add-node"
+" 4 add-node"
+}
+;
+
+ARTICLE: { "graphviz.render" "algorithm" "edge" } "Rendering edges"
+"Instances of " { $link edge } " are not quite in one-to-one correspondence with Graphviz edges. The latter exist solely between two nodes, whereas an " { $link edge } " instance may have a " { $link subgraph } " as an endpoint."
+$nl
+"To render an " { $link edge } ", first the " { $slot "tail" } " is recursively rendered:"
+{ $list
+ { "If it is a " { $link string } ", then it's taken to identify a node (if one doesn't already exist in the Graphviz representation, it is created)." }
+ { "If it is a " { $link subgraph } ", then it's rendered recursively as per " { $link { "graphviz.render" "algorithm" "subgraph" } } " (thus also creating the Graphviz subgraph if one doesn't already exist)." }
+}
+$nl
+"The " { $slot "head" } " is then rendered in the same way."
+$nl
+"More than one corresponding Graphviz edge may be created at this point. In general, a Graphviz edge is created from each node in the tail (or just the one, if " { $slot "tail" } " was a " { $link string } ") to each node in the head (or just the one, if " { $slot "head" } " was a " { $link string } "). However, a Grapvhiz edge may or may not be solely identified by its endpoints. Either way, whatever Graphviz-equivalent edges wind up being rendered, their attributes will be set according to the " { $link edge } "'s " { $slot "attributes" } " slot."
+$nl
+"In particular, if the root graph is strict, then edges are uniquely identified, so attributes are cumulative (like in " { $link { "graphviz.render" "algorithm" "node" } } " and " { $link { "graphviz.render" "algorithm" "subgraph" } } "). For example,"
+{ $code
+ "<strict-graph>"
+ " 1 2 add-edge[ \"blue\" =color ];"
+ " 1 2 add-edge[ \"red\" =color ];"
+}
+"will render the same way as just"
+{ $code
+ "<strict-graph>"
+ " 1 2 add-edge[ \"red\" =color ];"
+}
+$nl
+"But in a non-strict graph, a new Graphviz edge is created with its own local attributes which are not affected by past edges between the same endpoints. So,"
+{ $code
+ "<graph>"
+ " 1 2 add-edge[ \"blue\" =color ];"
+ " 1 2 add-edge[ \"red\" =color ];"
+}
+"will render " { $emphasis "two" } " separate edges with different colors (one red, one blue)."
+{ $notes
+"Because of the above semantics for edges between subgraphs, the " { $vocab-link "graphviz" } " vocabulary does not support edges betwteen clusters as single entities like certain Graphviz layout engines, specifically " { $emphasis "fdp" } "."
+}
+;
+
+ARTICLE: { "graphviz.render" "algorithm" "error" } "Rendering unexpected objects"
+"If an object in the " { $slot "statements" } " of a " { $link graph } " or " { $link subgraph } " is not an instance of either"
+{ $list
+ { $link subgraph }
+ { $link node }
+ { $link edge }
+ { $link graph-attributes }
+ { $link node-attributes }
+ { "or " { $link edge-attributes } }
+}
+"then it will trigger an " { $link improper-statement-error } "."
+;
+
+ARTICLE: { "graphviz.render" "algorithm" } "Graphviz rendering algorithm"
+"The " { $vocab-link "graphviz.render" } " vocabulary provides words to " { $emphasis "render" } " graphs. That is, it generates Graphviz output from a " { $link graph } " by using the " { $vocab-link "graphviz.ffi" } " and " { $vocab-link "graphviz.builder" } " vocabularies. Intuitively, " { $link graph } "s follow the same rules as in the DOT language (see " { $url "http://graphviz.org/content/dot-language" } " for more information). To render a " { $link graph } ", each element of its " { $slot "statements" } " slot is added to the Graphviz representation in order. The following gives a general overview of how different objects are rendered, with a few points to keep in mind."
+{ $subsections
+ { "graphviz.render" "algorithm" "node" }
+ { "graphviz.render" "algorithm" "edge" }
+ { "graphviz.render" "algorithm" "attributes" }
+ { "graphviz.render" "algorithm" "subgraph" }
+ { "graphviz.render" "algorithm" "error" }
+}
+{ $notes
+"Each call to a rendering word (like " { $links graphviz graphviz* preview preview-window } ", etc.) will go through the process of reconstructing the equivalent Graphviz representation in memory, even if the underlying " { $link graph } " hasn't changed."
+}
+;
+
+ARTICLE: { "graphviz.render" "engines" } "Rendering graphs by layout engine"
+"For each layout engine in " { $link supported-engines } ", the " { $vocab-link "graphviz.render" } " vocabulary defines a corresponding word that calls " { $link graphviz } " with that engine already supplied as an argument. For instance, instead of writing" { $code "graph -O -T \"dot\" graphviz" } "you can simply write" { $code "graph -O -T dot" } "as long as " { $snippet "\"dot\"" } " is a member of " { $link supported-engines } "."
+;
+
+ARTICLE: { "graphviz.render" "formats" } "Rendering graphs by output format"
+"For each output format in " { $link supported-formats } ", the " { $vocab-link "graphviz.render" } " vocabulary defines a corresponding word that calls " { $link graphviz* } " with that format already supplied as an argument. For instance, instead of writing" { $code "graph -O \"png\" graphviz*" } "you can simply write" { $code "graph -O png" } "as long as " { $snippet "\"png\"" } " is a member of " { $link supported-formats } "."
+$nl
+"If any of the formats is also a member of " { $link supported-engines } ", the word is named with a " { $snippet "-file" } " suffix. For instance, the " { $vocab-link "graphviz.render" } " vocabulary may define a word for the " { $snippet "\"dot\"" } " layout engine, so that instead of" { $code "graph -O -T \"dot\" graphviz" } "you can write" { $code "graph -O -T dot" } "But to infer the layout engine and " { $emphasis "output" } " in the " { $snippet "\"dot\"" } " format, instead of" { $code "graph -O \"dot\" graphviz*" } "you can write" { $code "graph -O dot-file" } "as long as " { $snippet "\"dot\"" } " is a member of both " { $link supported-engines } " and " { $link supported-formats } "."
+
+{ $warning "Graphviz may support " { $emphasis "canvas" } " formats, such as " { $snippet "\"xlib\"" } " or " { $snippet "\"gtk\"" } ", that will open windows displaying the graph. However, the listener will not be aware of these windows: when they are closed, the listener will exit as well. You should probably use the " { $link preview-window } " word, instead." }
+;
+
+ARTICLE: "graphviz.render" "Rendering Graphviz output"
+"The " { $vocab-link "graphviz.render" } " vocabulary provides words for converting " { $link graph } " objects into equivalent Graphviz output. The following provides a general overview of how this process works:"
+{ $subsections { "graphviz.render" "algorithm" } }
+
+"Graphviz provides a variety of different layout engines (which give algorithms for placing nodes and edges in a graph) and output formats (e.g., different image filetypes to show the graph structure)."
+$nl
+"The most general words in this vocabulary will have you manually specify the desired engine and/or format, along with a file to which Graphviz should save its output:"
+{ $subsections
+ graphviz
+ graphviz*
+}
+
+"If the graph is small enough, it may be convenient to see an image of it using Factor's UI listener:"
+{ $subsections
+ preview
+ preview-window
+}
+
+"Specialized words are also defined to save on extraneous typing:"
+{ $subsections
+ { "graphviz.render" "engines" }
+ { "graphviz.render" "formats" }
+}
+;
+
+ABOUT: "graphviz.render"
--- /dev/null
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators continuations destructors
+images.viewer io.files.unique kernel locals namespaces parser
+sequences summary unicode.case words
+graphviz.ffi
+graphviz.builder
+;
+IN: graphviz.render
+
+SYMBOL: default-layout
+"dot" default-layout set-global
+
+SYMBOL: default-format
+"png" default-format set-global
+
+ERROR: unsupported-format format ;
+ERROR: unsupported-engine engine ;
+
+M: unsupported-format summary
+ drop "Unsupported layout format; check supported-formats" ;
+
+M: unsupported-engine summary
+ drop "Unsupported layout engine; check supported-engines" ;
+
+<PRIVATE
+
+: default-extension ( format -- extension )
+ >lower {
+ { "bmp" [ ".bmp" ] }
+ { "canon" [ ".dot" ] }
+ { "dot" [ ".dot" ] }
+ { "xdot" [ ".dot" ] }
+ { "eps" [ ".eps" ] }
+ { "fig" [ ".fig" ] }
+ { "gd" [ ".gd" ] }
+ { "gd2" [ ".gd2" ] }
+ { "gif" [ ".gif" ] }
+ { "ico" [ ".ico" ] }
+ { "imap" [ ".map" ] }
+ { "cmapx" [ ".map" ] }
+ { "imap_np" [ ".map" ] }
+ { "cmapx_np" [ ".map" ] }
+ { "ismap" [ ".map" ] }
+ { "jpg" [ ".jpg" ] }
+ { "jpeg" [ ".jpg" ] }
+ { "jpe" [ ".jpg" ] }
+ { "pdf" [ ".pdf" ] }
+ { "plain" [ ".txt" ] }
+ { "plain-ext" [ ".txt" ] }
+ { "png" [ ".png" ] }
+ { "ps" [ ".ps" ] }
+ { "ps2" [ ".ps" ] }
+ { "svg" [ ".svg" ] }
+ { "svgz" [ ".svgz" ] }
+ { "tif" [ ".tif" ] }
+ { "tiff" [ ".tif" ] }
+ { "vml" [ ".vml" ] }
+ { "vmlz" [ ".vmlz" ] }
+ { "vrml" [ ".vrml" ] }
+ { "wbmp" [ ".wbmp" ] }
+ [ drop "" ]
+ } case ;
+
+: check-format ( -T -- )
+ dup supported-formats member?
+ [ drop ] [ unsupported-format ] if ; inline
+
+: check-engine ( -K -- )
+ dup supported-engines member?
+ [ drop ] [ unsupported-engine ] if ; inline
+
+: compute-engine ( Agraph_t* -K -- engine )
+ [ nip ]
+ [
+ "layout" agget
+ [ default-layout get-global ] when-empty
+ ] if* dup check-engine ;
+
+:: (graphviz) ( graph -O -T -K -- -o )
+ -T check-format
+ -O -T default-extension append :> -o
+ [
+ gvContext &gvFreeContext :> gvc
+ graph id>> graph kind agopen &agclose :> g
+ g graph build-alien
+ g -K compute-engine :> engine
+ gvc g engine gvLayout drop
+ [ gvc g -T -o gvRenderFilename drop -o ]
+ [ gvc g gvFreeLayout drop ] [ ] cleanup
+ ] with-destructors ;
+
+: (preview) ( graph -- -o )
+ "preview" unique-file
+ default-format get-global
+ f (graphviz) ; inline
+
+PRIVATE>
+
+: graphviz ( graph -O -T -K -- )
+ (graphviz) drop ; inline
+
+: graphviz* ( graph -O -T -- )
+ f graphviz ; inline
+
+: preview ( graph -- )
+ (preview) image. ; inline
+
+: preview-window ( graph -- )
+ (preview) image-window ; inline
+
+<<
+
+<PRIVATE
+
+: define-graphviz-by-engine ( -K -- )
+ [ create-in dup make-inline ]
+ [ [ graphviz ] curry ] bi
+ (( graph -O -T -- ))
+ define-declared ;
+
+: define-graphviz-by-format ( -T -- )
+ [
+ dup supported-engines member? [ "-file" append ] when
+ create-in dup make-inline
+ ]
+ [ [ graphviz* ] curry ] bi
+ (( graph -O -- ))
+ define-declared ;
+
+PRIVATE>
+
+supported-engines [ define-graphviz-by-engine ] each
+supported-formats [ define-graphviz-by-format ] each
+
+>>
projects / factor.git / commitdiff
