Merge remote-tracking branch 'ajvondrak/graphviz'
John Benediktsson
commit
7225ce1f5e
extra/graphviz
attributes
|
|
@ -0,0 +1,51 @@
|
|||
! 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"
|
||||
|
|
@ -0,0 +1,211 @@
|
|||
! 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 ;
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
! 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"
|
||||
|
|
@ -0,0 +1,123 @@
|
|||
! 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 ;
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
! 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"
|
||||
|
|
@ -0,0 +1,158 @@
|
|||
! 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 ]
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 5.9 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 6.7 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 8.4 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 12 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 40 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 53 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 4.8 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 7.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 9.3 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 10 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 12 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 20 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 44 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 11 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 9.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 13 KiB |
|
|
@ -0,0 +1,938 @@
|
|||
! 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"
|
||||
|
|
@ -0,0 +1,87 @@
|
|||
! 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 ;
|
||||
|
|
@ -0,0 +1,467 @@
|
|||
! 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"
|
||||
|
|
@ -0,0 +1,89 @@
|
|||
! 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.
|
||||
|
|
@ -0,0 +1,333 @@
|
|||
! 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"
|
||||
|
|
@ -0,0 +1,136 @@
|
|||
! Copyright (C) 2011 Alex Vondrak.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators continuations destructors
|
||||
images.viewer io.backend 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 normalize-path :> -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
|
||||
|
||||
>>
|
||||
Loading…
Reference in New Issue