steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge avondrak's graphviz branch.

db4
Doug Coleman 2013-11-27 21:36:54 +00:00
parent 2922b1a943
commit d4ff5a42e6
18 changed files with 776 additions and 758 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/compiler/cfg/graphviz/graphviz.factor
View File

@ -101,3 +101,7 @@ SYMBOL: passes
: watch-optimizer ( quot -- )
[ "" ] dip watch-optimizer* ;
: ssa. ( quot -- ) test-ssa [ cfgviz preview ] each ;
: flat. ( quot -- ) test-flat [ cfgviz preview ] each ;
: regs. ( quot -- ) test-regs [ cfgviz preview ] each ;

1
extra/graphviz/attributes/platforms.txt
View File

@ -1 +0,0 @@
unix

123
extra/graphviz/builder/builder.factor
View File

@ -1,123 +0,0 @@
! 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-of "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 ;

1
extra/graphviz/builder/platforms.txt
View File

@ -1 +0,0 @@
unix

31
extra/graphviz/dot/dot-docs.factor Normal file
View File

@ -0,0 +1,31 @@
! Copyright (C) 2012 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
USING: graphviz help.markup help.syntax kernel strings ;
IN: graphviz.dot
HELP: write-dot
{ $values
{ "graph" graph } { "path" "a pathname string" } { "encoding" "a character encoding" }
}
{ $description "Converts " { $snippet "graph" } " into its equivalent DOT code, saving the file to " { $snippet "path" } " using the given character " { $snippet "encoding" } "." } ;
ARTICLE: "graphviz.dot" "Translating Factor graphs into DOT"
"The " { $vocab-link "graphviz.dot" } " vocabulary implements a word to translate Factor " { $link graph } " objects into equivalent DOT code (see " { $url "http://graphviz.org/content/dot-language" } ")."
{ $subsections write-dot }
"Because the data structure of Factor " { $link graph } " objects so closely maps to the DOT language, the translation is straightforward. This also means that rendering Factor " { $link graph } "s using the " { $vocab-link "graphviz.render" } " vocabulary should generally work exactly as though you had written the DOT code to start with."
$nl
"However, there is one limitation. Though Graphviz documentation claims that there's no semantic difference between quoted and unquoted identifiers, there are a few cases that make a difference. " { $link write-dot } " will always quote identifiers, since it's the safest option:"
{ $list
"Quoting prevents clashes with builtin DOT keywords."
"Quoting lets identifiers use whitespace."
}
$nl
"But there are a couple things to keep in mind:"
{ $list
{ "Quotes in " { $link string } "s will be escaped (and null-terminators " { $snippet "\"\\0\"" } " removed), but otherwise Factor strings are printed as usual. So " { $snippet "\"a\\nb\"" } " will print a newline in the DOT code, not a literal 'backslash n'. This is handy anyway, because certain Graphviz layout engines will parse escape codes in DOT that Factor doesn't know about. For instance, to use the Graphviz escape sequence " { $snippet "\"\\l\"" } ", you have to use the Factor string " { $snippet "\"\\\\l\"" } "." }
{ "Node port syntax doesn't work when node names are quoted. Instead, use the edge's " { $snippet "headport" } " and " { $snippet "tailport" } " attributes (see " { $vocab-link "graphviz.attributes" } ")." }
{ "HTML-like labels, which must use angle brackets (" { $snippet "<...>" } ") instead of quotes (" { $snippet "\"...\"" } "), are currently unsupported." }
}
;
ABOUT: "graphviz.dot"

76
extra/graphviz/dot/dot.factor Normal file
View File

@ -0,0 +1,76 @@
! Copyright (C) 2012 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes classes.tuple combinators formatting
graphviz graphviz.attributes io io.files kernel namespaces
sequences splitting strings words ;
IN: graphviz.dot
<PRIVATE
GENERIC: dot. ( obj -- )
! Graphviz docs claim that there's no semantic difference
! between quoted & unquoted IDs, but quoting them is the safest
! option in case there's a keyword clash, spaces in the ID,
! etc. This does mean that HTML labels aren't supported, but
! they don't seem to work using the Graphviz API anyway.
: escape ( str -- str' )
"\"" split "\\\"" join
"\0" split "" join ;
M: string dot. escape "\"%s\" " printf ;
: id. ( obj -- ) id>> dot. ;
M: sequence dot.
"{" print [ dot. ";" print ] each "}" print ;
: statements. ( sub/graph -- ) statements>> dot. ;
SYMBOL: edgeop
: with-edgeop ( graph quot -- )
[
dup directed?>> "-> " "-- " ? edgeop
] dip with-variable ; inline
: ?strict ( graph -- graph )
dup strict?>> [ "strict " write ] when ;
: (di)graph ( graph -- graph )
dup directed?>> "digraph " "graph " ? write ;
M: graph dot.
?strict (di)graph dup id. [ statements. ] with-edgeop ;
M: subgraph dot.
"subgraph " write [ id. ] [ statements. ] bi ;
: attribute, ( attr value -- )
dup [ "%s=\"%s\"," printf ] [ 2drop ] if ;
: attributes. ( attrs -- )
"[" write
[ class-of "slots" word-prop ] [ tuple>array rest ] bi
[ [ name>> ] dip attribute, ] 2each
"]" write ;
M: graph-attributes dot. "graph" write attributes. ;
M: node-attributes dot. "node" write attributes. ;
M: edge-attributes dot. "edge" write attributes. ;
M: node dot.
[ id. ] [ attributes>> attributes. ] bi ;
M: edge dot.
{
[ tail>> dot. ]
[ drop edgeop get write ]
[ head>> dot. ]
[ attributes>> attributes. ]
} cleave ;
PRIVATE>
: write-dot ( graph path encoding -- )
[ dot. ] with-file-writer ;

44
extra/graphviz/ffi/ffi-docs.factor
View File

@ -1,44 +0,0 @@
! 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
{ "seq" 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
{ "seq" 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"

173
extra/graphviz/ffi/ffi.factor
View File

@ -1,173 +0,0 @@
! Copyright (C) 2011 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.data
alien.destructors alien.libraries alien.strings alien.syntax
combinators debugger destructors fry graphviz io
io.encodings.ascii kernel libc literals locals math memoize
prettyprint sequences specialized-arrays splitting system ;
SPECIALIZED-ARRAY: void*
IN: graphviz.ffi
<<
"libgraph" {
{ [ os macosx? ] [ "libgraph.dylib" ] }
{ [ os unix? ] [ "libgraph.so" ] }
{ [ os windows? ] [ "graph.dll" ] }
} cond cdecl add-library
"libgvc"
{
{ [ os macosx? ] [ "libgvc.dylib" ] }
{ [ os unix? ] [ "libgvc.so" ] }
{ [ os windows? ] [ "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
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 ;
: ?ffi-errors ( n -- )
[ ffi-errors ] unless-zero ; inline
: gvFreeContext ( gvc -- )
int-gvFreeContext ?ffi-errors ;
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 ;
! This function doesn't exist on the Linux mason in Graphviz 2.28
FUNCTION: char**
gvPluginList
( GVC_t* gvc, c-string kind, int* size, c-string str ) ;
:: Plugin-list ( kind-string -- seq )
[
gvContext &gvFreeContext
kind-string
0 int <ref> dup :> size*
f
gvPluginList &(free) :> ret
size* int deref :> size
ret size void* <c-direct-array> [
&(free) ascii alien>string
] { } map-as
] with-destructors ;
! This function doesn't exist on the Windows mason in Graphviz 2.28
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>
MEMO: supported-engines ( -- seq ) API_layout plugin-list ;
MEMO: supported-formats ( -- seq ) API_device plugin-list ;

1
extra/graphviz/ffi/platforms.txt
View File

@ -1 +0,0 @@
unix

9
extra/graphviz/graphviz-docs.factor
View File

@ -200,7 +200,7 @@ $nl
$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."
"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored by Graphviz."
}
{ $examples
{ $example "USING: graphviz prettyprint ;" "<strict-digraph> graph? ." "t" }
@ -230,7 +230,7 @@ $nl
$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."
"In " { $emphasis "strict" } " " { $link graph } "s, there is at most one " { $link edge } " between any two " { $link node } "s, so duplicates are ignored by Graphviz."
}
{ $examples
{ $example "USING: graphviz prettyprint ;" "<strict-graph> graph? ." "t" }
@ -507,7 +507,6 @@ HELP: edge
{ "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)."
}
@ -560,7 +559,7 @@ $nl
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
"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)."
} ;
HELP: subgraph
@ -583,7 +582,7 @@ $nl
} ;
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" } ")."
"To use the " { $vocab-link "graphviz" } " vocabulary, we construct Factor objects that can be converted to data understood by Graphviz (see " { $vocab-link "graphviz.dot" } ")."
$nl
"The following classes are used to represent their equivalent Graphviz structures:"
{ $subsections node edge subgraph graph }

200
extra/graphviz/graphviz-tests.factor
View File

@ -1,40 +1,71 @@
USING: arrays formatting graphviz graphviz.ffi
graphviz.notation graphviz.render graphviz.render.private
io.directories io.files io.files.unique kernel locals math
math.combinatorics math.parser sequences sets tools.test ;
IN: graphviz.testing
USING: accessors arrays assocs combinators.short-circuit
continuations formatting graphviz graphviz.attributes
graphviz.dot graphviz.notation graphviz.render
graphviz.render.private images.loader.private io.directories
io.directories.hierarchy io.files io.files.unique io.launcher
io.pathnames kernel locals make math math.combinatorics
math.parser memoize namespaces sequences sequences.extras sets
splitting system tools.test ;
FROM: namespaces => set ;
IN: graphviz.tests
! Don't want to test canvas formats, since they'll open a
! separate window (even if it's closed, that'll call exit() and
! kill the Factor process).
!
! In fact, the exit() issue is why we probably don't even want
! these formats supported in general, and why we have
! graphviz.render:preview & preview-window. Should probably
! gank them out of supported-formats in graphviz.ffi to begin
! with.
CONSTANT: canvas { "gtk" "x11" "xlib" }
! XXX hack
: force-error-message ( flag -- elts )
[
[ default-graphviz-program , , "?" , ] { } make
try-output-process
! To balance the stack height, have to return a default
! 'elts' value, though it shouldn't ever get pushed:
f
] [
nip output>>
"Use one of: " split1 nip "\n" ?tail drop
" " split
] recover ;
! Had some issues with the following formats. Graphviz 2.26.3
! would die with "Error: deflation finish problem -2 cnt=0".
! Could just be my installation, though.
CONSTANT: zlib { "svgz" "vmlz" }
! http://www.graphviz.org/Download_macos.php#comment-474
: remove-sfdp-in-case-homebrew-is-dumb ( seq -- seq' )
os macosx? [ "sfdp" swap remove ] when ;
! These are aliases for the neato flags -n/-n1/-n2, which
! assume that all nodes have already been positioned, and thus
! have "pos" attributes. Since this clearly isn't always the
! case for our tests, we skip them to avoid useless rendering
! errors.
CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
SYMBOLS: supported-layouts supported-formats ;
: init-supported-layouts/formats ( -- )
"-K" force-error-message standard-layouts intersect
remove-sfdp-in-case-homebrew-is-dumb
supported-layouts set-global
"-T" force-error-message standard-formats intersect
supported-formats set-global ;
! Can't use cleanup-unique-working-directory without fixing
! issue #890, so skip the cleanup on Windows.
:: cleanup-unique-working-directory* ( quot -- )
unique-directory :> path
path [ path quot with-temporary-directory ] with-directory
os windows? [ path delete-tree ] unless ; inline
! Can't predict file extension since we use Graphviz's actual
! -O flag, so just look to see that there seems to be some sort
! of output.
: graphviz-output-appears-to-exist? ( base -- ? )
current-directory get directory-files
[ swap head? ] with count 1 = ;
: next! ( seq -- elt ) [ first ] [ 1 rotate! ] bi ;
:: smoke-test ( graph -- pass? )
temporary-file :> -O
supported-formats canvas diff zlib diff [| -T |
supported-engines neato-aliases diff [| -K |
graph -O -T -K (graphviz)
[ exists? ] [ delete-file ] bi
] all?
] all? ;
supported-formats get-global next! :> -T
supported-layouts get-global next! :> -K
[
graph "smoke-test" -T -K graphviz
"smoke-test" graphviz-output-appears-to-exist?
] cleanup-unique-working-directory* ;
: preview-smoke-test ( graph -- pass? )
f "pass?" [
[ exists? "pass?" set ] with-preview
"pass?" get
] with-variable ;
: K_n ( n -- graph )
<graph>
@ -43,10 +74,6 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
over number>string "K " prepend =label
swap iota 2 [ first2 add-edge ] each-combination ;
{ t } [ 5 K_n smoke-test ] unit-test
{ t } [ 6 K_n smoke-test ] unit-test
{ t } [ 7 K_n smoke-test ] unit-test
:: partite-set ( n color -- cluster )
color <cluster>
color =color
@ -64,10 +91,6 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
add-edge
n m "K %d,%d" sprintf =label ;
{ t } [ 3 3 K_n,m smoke-test ] unit-test
{ t } [ 3 4 K_n,m smoke-test ] unit-test
{ t } [ 5 4 K_n,m smoke-test ] unit-test
: add-cycle ( graph n -- graph' )
[ iota add-path ] [ 1 - 0 add-edge ] bi ;
@ -78,10 +101,6 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
over number>string "C " prepend =label
swap add-cycle ;
{ t } [ 5 C_n smoke-test ] unit-test
{ t } [ 6 C_n smoke-test ] unit-test
{ t } [ 7 C_n smoke-test ] unit-test
: W_n ( n -- graph )
<graph>
graph[ "t" =labelloc "twopi" =layout ];
@ -91,10 +110,6 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
over 1 - add-cycle
swap [ ] [ 1 - iota >array ] bi add-edge ;
{ t } [ 6 W_n smoke-test ] unit-test
{ t } [ 7 W_n smoke-test ] unit-test
{ t } [ 8 W_n smoke-test ] unit-test
: cluster-example ( -- graph )
<digraph>
"dot" =layout
@ -122,8 +137,6 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
"end" add-node[ "Msquare" =shape ];
;
{ t } [ cluster-example smoke-test ] unit-test
: colored-circle ( i -- node )
[ <node> ] keep
[ 16.0 / 0.5 + =width ]
@ -143,8 +156,6 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
[ 0 -- ] [ colored-circle add ] bi
] each ;
{ t } [ colored-circles-example smoke-test ] unit-test
: dfa-example ( -- graph )
<digraph>
"LR" =rankdir
@ -168,8 +179,6 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
"LR_8" "LR_5" ->[ "S(a)" =label ];
;
{ t } [ dfa-example smoke-test ] unit-test
: record-example ( -- graph )
<digraph>
graph[ "LR" =rankdir "8,8" =size ];
@ -234,7 +243,84 @@ CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
"node11" "node1" ->[ "f2" =tailport "f0" =headport ];
;
{ t } [ record-example smoke-test ] unit-test
:: with-global-value ( value variable quot -- )
variable get-global "orig" [
[ value variable set-global quot call ]
[ "orig" get variable set-global ] [ ] cleanup
] with-variable ; inline
! TODO add the examples from graphviz's source code (the .gv
! files in graphs/directed/ and graphs/undirected/)
: preview-format-test ( format -- pass? )
preview-format [
<graph> preview-smoke-test
] with-global-value ;
: valid-preview-formats ( -- formats )
types get keys "jpe" suffix
supported-formats get-global intersect ;
: encoding-test ( encoding -- pass? )
graph-encoding [ <graph> smoke-test ] with-global-value ;
default-graphviz-program [
init-supported-layouts/formats
{ t } [ 5 K_n smoke-test ] unit-test
{ t } [ 6 K_n smoke-test ] unit-test
{ t } [ 7 K_n smoke-test ] unit-test
{ t } [ 8 K_n preview-smoke-test ] unit-test
{ t } [ 8 6 K_n,m smoke-test ] unit-test
{ t } [ 7 5 K_n,m smoke-test ] unit-test
{ t } [ 3 9 K_n,m smoke-test ] unit-test
{ t } [ 3 4 K_n,m preview-smoke-test ] unit-test
{ t } [ 5 C_n smoke-test ] unit-test
{ t } [ 6 C_n smoke-test ] unit-test
{ t } [ 7 C_n smoke-test ] unit-test
{ t } [ 8 C_n preview-smoke-test ] unit-test
{ t } [ 5 W_n smoke-test ] unit-test
{ t } [ 6 W_n smoke-test ] unit-test
{ t } [ 7 W_n smoke-test ] unit-test
{ t } [ 8 W_n preview-smoke-test ] unit-test
{ t } [ cluster-example smoke-test ] unit-test
{ t } [ cluster-example preview-smoke-test ] unit-test
{ t } [ colored-circles-example smoke-test ] unit-test
{ t } [ colored-circles-example preview-smoke-test ] unit-test
{ t } [ dfa-example smoke-test ] unit-test
{ t } [ dfa-example preview-smoke-test ] unit-test
{ t } [ record-example smoke-test ] unit-test
{ t } [ record-example preview-smoke-test ] unit-test
{ t } [
valid-preview-formats [ preview-format-test ] all?
] unit-test
[
supported-formats get-global valid-preview-formats diff
[ preview-format-test ] attempt-all
] [ unsupported-preview-format? ] must-fail-with
{ t }
[
USE: io.encodings.8-bit.latin1
latin1 encoding-test
] unit-test
{ t }
[
USE: io.encodings.utf8
utf8 encoding-test
] unit-test
[
USE: io.encodings.ascii
ascii encoding-test
] [ unsupported-encoding? ] must-fail-with
] when

2
extra/graphviz/notation/notation-docs.factor
View File

@ -356,7 +356,7 @@ $nl
$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 } " or " { $link subgraph } ", a new " { $link graph-attributes } " instance is created, has its " { $slot "label" } " slot 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

1
extra/graphviz/notation/platforms.txt
View File

@ -1 +0,0 @@
unix

1
extra/graphviz/platforms.txt
View File

@ -1 +0,0 @@
unix

1
extra/graphviz/render/platforms.txt
View File

@ -1 +0,0 @@
unix

582
extra/graphviz/render/render-docs.factor
View File

@ -1,317 +1,386 @@
! Copyright (C) 2011 Alex Vondrak.
! Copyright (C) 2012 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
USING: graphviz help.markup help.syntax images.viewer
io.encodings.8-bit.latin1 io.encodings.utf8 io.launcher 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 }
;
{ cannot-find-graphviz-installation default-graphviz-program ?default-graphviz-program } related-words
{ unsupported-encoding graph-encoding } related-words
{ unsupported-preview-format preview-format } related-words
{ graphviz graphviz* } related-words
{ preview preview-window } related-words
{ circo dot fdp neato osage sfdp twopi } related-words
{ bmp canon dot-file xdot cmap eps fig gd gd2 gif ico imap cmapx imap_np cmapx_np ismap jpg jpeg jpe pdf plain plain-ext png ps ps2 svg svgz tif tiff vml vmlz vrml wbmp webp } related-words
HELP: cannot-find-graphviz-installation
{ $error-description "Thrown by " { $link ?default-graphviz-program } " if a Graphviz installation cannot be found." } ;
HELP: unsupported-encoding
{ $values
{ "graph-encoding" "a character encoding" }
}
{ $error-description "Thrown by " { $links graphviz graphviz* preview preview-window } ", and related words if " { $link graph-encoding } " has a value other than " { $link utf8 } " or " { $link latin1 } "." } ;
HELP: unsupported-preview-format
{ $values
{ "preview-format" string }
}
{ $error-description "Thrown by " { $link preview } " or " { $link preview-window } " if " { $link preview-format } " has a value that's not supported by " { $vocab-link "images.loader" } "." } ;
HELP: ?default-graphviz-program
{ $values
{ "path" "a pathname string" }
}
{ $description "Searches your computer for the path to a Graphviz executable." }
{ $errors "Throws an error if a Graphviz installation cannot be found." } ;
HELP: default-graphviz-program
{ $values
{ "path/f" { $maybe "a pathname string" } }
}
{ $description "Searches your computer for the path to a Graphviz executable. If one cannot be found, returns " { $link f } "."
$nl
"On a Unix machine, this involves looking for " { $snippet "circo" } ", " { $snippet "dot" } ", " { $snippet "fdp" } ", " { $snippet "neato" } ", " { $snippet "osage" } ", " { $snippet "sfdp" } ", or " { $snippet "twopi" } " somewhere in your " { $snippet "PATH" } "."
$nl
"On Windows, if you have Graphviz installed into a folder whose name begins with " { $snippet "Graphviz" } " in either " { $snippet "Program Files" } " or " { $snippet "Program Files(x86)" } ", that folder will be searched for an executable named " { $snippet "circo.exe" } ", " { $snippet "dot.exe" } ", " { $snippet "fdp.exe" } ", " { $snippet "neato.exe" } ", " { $snippet "osage.exe" } ", " { $snippet "sfdp.exe" } ", or " { $snippet "twopi.exe" } "."
} ;
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 }
;
{ $var-description "A " { $link string } " representing the layout engine implicitly used by " { $links graphviz* preview preview-window } ", and related words." }
{ $notes "Must be an image format supported by " { $vocab-link "images.loader" } "." } ;
{ graphviz graphviz* } related-words
HELP: graph-encoding
{ $var-description "The character encoding used when writing " { $instance graph } " to a DOT file." }
{ $notes "To match Graphviz's valid values for a graph's " { $snippet "charset" } " attribute (see " { $url "http://graphviz.org/content/attrs#dcharset" } "), this global variable must either be " { $link utf8 } " or " { $link latin1 } ". If it does not match your graph's " { $snippet "charset" } ", your output may be incorrect." } ;
HELP: preview-format
{ $var-description "A " { $link string } " representing the output format implicitly used by " { $link preview } " and " { $link preview-window } "." } ;
HELP: graphviz
{ $values
{ "graph" graph }
{ "-O" string }
{ "-T" string }
{ "-K" { $maybe string } }
{ "graph" graph } { "path" "a pathname string" } { "format" string } { "layout" string }
}
{ $description "Renders " { $snippet "graph" } " to a specified output file."
{ $description "Translates " { $snippet "graph" } " into DOT code and invokes Graphviz on the result."
$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" } "."
{ $snippet "path" } " is the location where you want to save your output, " { $emphasis "without" } " a file extension (Graphviz will automatically add one based on " { $snippet "format" } ")."
$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."
{ $snippet "format" } " is the format of your output (e.g., " { $snippet "\"png\"" } ")."
$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 } "."
{ $snippet "layout" } " is the layout engine to use (e.g., " { $snippet "\"dot\"" } ")."
$nl
"Essentially, you can think of it as equivalent to running the Graphviz command \"" { $strong "dot" } " " { $snippet "path" } " " { $strong "-O" } " " { $strong "-T" } { $snippet "format" } " " { $strong "-K" } { $snippet "layout" } "\". See " { $url "http://graphviz.org/content/command-line-invocation" } "."
}
{ $errors
"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
"If the Graphviz process encounters an error, its output will be captured and thrown as " { $instance output-process-error } " by Factor."
$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 } }
"Throws " { $instance unsupported-encoding } " error if " { $link graph-encoding } " isn't one of " { $link utf8 } " or " { $link latin1 } "."
}
$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" } "." }
;
{ $examples "To render a " { $link graph } " " { $snippet "G" } " using circo and save the output to a PNG file, you could write" { $code "G \"foo\" \"png\" \"circo\" graphviz" } "(assuming 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 }
{ "graph" graph } { "path" "a pathname string" } { "format" 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*" }
{ $description "Invokes the " { $link graphviz } " word using the value of " { $link default-layout } " as the layout engine. That is, the following two lines are equivalent:"
{ $code "graph path format default-layout get-global graphviz" "graph path format 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" } "." }
;
{ $examples "To render a " { $link graph } " " { $snippet "G" } " when you don't particularly care about the layout engine but want to save the output to a PNG file, you could write" { $code "G \"foo\" \"png\" graphviz*" } "(assuming that " { $link default-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." }
{ $description "Renders " { $snippet "graph" } " to a temporary file using " { $link preview-format } " and " { $link default-layout } ". Then, using " { $link image. } ", displays the image in the UI listener before deleting the temporary file." }
{ $errors
"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
"Throws " { $instance unsupported-preview-format } " error if " { $link preview-format } " is not supported by " { $vocab-link "images.loader" } "."
$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 } }
}
"If the Graphviz process encounters an error, its output will be captured and thrown as " { $instance output-process-error } " by Factor."
$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 }
;
"Throws " { $instance unsupported-encoding } " error if " { $link graph-encoding } " isn't one of " { $link utf8 } " or " { $link latin1 } "."
} ;
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." }
{ $description "Renders " { $snippet "graph" } " to a temporary file using " { $link preview-format } " and " { $link default-layout } ". Then, using " { $link image-window } ", opens a new window displaying the image before deleting the temporary file." }
{ $errors
"If " { $snippet "graph" } " is not an instance of " { $link graph } ", a " { $link non-graph-error } " is thrown."
"Throws " { $instance unsupported-preview-format } " error if " { $link preview-format } " is not supported by " { $vocab-link "images.loader" } "."
$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 } }
}
"If the Graphviz process encounters an error, its output will be captured and thrown as " { $instance output-process-error } " by Factor."
$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 }
;
"Throws " { $instance unsupported-encoding } " error if " { $link graph-encoding } " isn't one of " { $link utf8 } " or " { $link latin1 } "."
} ;
HELP: unsupported-engine
!
HELP: circo
{ $values
{ "engine" object }
{ "graph" graph } { "path" "a pathname string" } { "format" string }
}
{ $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 }
;
{ $description "Invokes " { $link graphviz } " with " { $snippet "\"circo\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"circo\" graphviz" "graph path format circo" } } ;
HELP: unsupported-format
HELP: dot
{ $values
{ "format" object }
{ "graph" graph } { "path" "a pathname string" } { "format" string }
}
{ $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 }
;
{ $description "Invokes " { $link graphviz } " with " { $snippet "\"dot\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"dot\" graphviz" "graph path format dot" } } ;
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 ];"
HELP: fdp
{ $values
{ "graph" graph } { "path" "a pathname string" } { "format" string }
}
"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."
;
{ $description "Invokes " { $link graphviz } " with " { $snippet "\"fdp\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"fdp\" graphviz" "graph path format fdp" } } ;
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"
HELP: neato
{ $values
{ "graph" graph } { "path" "a pathname string" } { "format" string }
}
"will render the same way as just"
{ $code
"<graph>"
" { 1 2 3 } add-nodes"
""
" 0 <cluster>"
" 4 add-node"
" 5 add-node"
" add"
}
;
{ $description "Invokes " { $link graphviz } " with " { $snippet "\"neato\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"neato\" graphviz" "graph path format neato" } } ;
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 ];"
HELP: osage
{ $values
{ "graph" graph } { "path" "a pathname string" } { "format" string }
}
"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"
}
;
{ $description "Invokes " { $link graphviz } " with " { $snippet "\"osage\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"osage\" graphviz" "graph path format osage" } } ;
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)." }
HELP: sfdp
{ $values
{ "graph" graph } { "path" "a pathname string" } { "format" string }
}
$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" } "."
}
;
{ $description "Invokes " { $link graphviz } " with " { $snippet "\"sfdp\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"sfdp\" graphviz" "graph path format sfdp" } } ;
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 } }
HELP: twopi
{ $values
{ "graph" graph } { "path" "a pathname string" } { "format" string }
}
"then it will trigger an " { $link improper-statement-error } "."
;
{ $description "Invokes " { $link graphviz } " with " { $snippet "\"twopi\"" } " supplied as the layout engine. That is, the following two lines are equivalent:" { $code "graph path format \"twopi\" graphviz" "graph path format twopi" } } ;
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 } "."
;
HELP: bmp
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"bmp\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"bmp\" graphviz*" "graph path bmp" } } ;
HELP: canon
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"canon\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"canon\" graphviz*" "graph path canon" } } ;
HELP: cmap
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"cmap\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"cmap\" graphviz*" "graph path cmap" } } ;
HELP: cmapx
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"cmapx\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"cmapx\" graphviz*" "graph path cmapx" } } ;
HELP: cmapx_np
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"cmapx_np\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"cmapx_np\" graphviz*" "graph path cmapx_np" } } ;
HELP: dot-file
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"dot\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"dot\" graphviz*" "graph path dot-file" } } ;
HELP: eps
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"eps\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"eps\" graphviz*" "graph path eps" } } ;
HELP: fig
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"fig\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"fig\" graphviz*" "graph path fig" } } ;
HELP: gd
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"gd\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"gd\" graphviz*" "graph path gd" } } ;
HELP: gd2
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"gd2\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"gd2\" graphviz*" "graph path gd2" } } ;
HELP: gif
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"gif\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"gif\" graphviz*" "graph path gif" } } ;
HELP: ico
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ico\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ico\" graphviz*" "graph path ico" } } ;
HELP: imap
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"imap\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"imap\" graphviz*" "graph path imap" } } ;
HELP: imap_np
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"imap_np\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"imap_np\" graphviz*" "graph path imap_np" } } ;
HELP: ismap
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ismap\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ismap\" graphviz*" "graph path ismap" } } ;
HELP: jpe
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"jpe\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"jpe\" graphviz*" "graph path jpe" } } ;
HELP: jpeg
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"jpeg\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"jpeg\" graphviz*" "graph path jpeg" } } ;
HELP: jpg
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"jpg\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"jpg\" graphviz*" "graph path jpg" } } ;
HELP: pdf
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"pdf\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"pdf\" graphviz*" "graph path pdf" } } ;
HELP: plain
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"plain\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"plain\" graphviz*" "graph path plain" } } ;
HELP: plain-ext
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"plain-ext\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"plain-ext\" graphviz*" "graph path plain-ext" } } ;
HELP: png
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"png\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"png\" graphviz*" "graph path png" } } ;
HELP: ps
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ps\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ps\" graphviz*" "graph path ps" } } ;
HELP: ps2
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"ps2\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"ps2\" graphviz*" "graph path ps2" } } ;
HELP: svg
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"svg\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"svg\" graphviz*" "graph path svg" } } ;
HELP: svgz
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"svgz\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"svgz\" graphviz*" "graph path svgz" } } ;
HELP: tif
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"tif\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"tif\" graphviz*" "graph path tif" } } ;
HELP: tiff
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"tiff\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"tiff\" graphviz*" "graph path tiff" } } ;
HELP: vml
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"vml\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"vml\" graphviz*" "graph path vml" } } ;
HELP: vmlz
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"vmlz\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"vmlz\" graphviz*" "graph path vmlz" } } ;
HELP: vrml
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"vrml\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"vrml\" graphviz*" "graph path vrml" } } ;
HELP: wbmp
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"wbmp\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"wbmp\" graphviz*" "graph path wbmp" } } ;
HELP: webp
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"webp\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"webp\" graphviz*" "graph path webp" } } ;
HELP: xdot
{ $values
{ "graph" graph } { "path" "a pathname string" }
}
{ $description "Invokes " { $link graphviz* } " with " { $snippet "\"xdot\"" } " supplied as the output format. That is, the following two lines are equivalent:" { $code "graph path \"xdot\" graphviz*" "graph path xdot" } } ;
ARTICLE: { "graphviz.render" "layouts" } "Rendering graphs by layout engine"
"For each \"standard\" layout command listed in " { $url "http://graphviz.org/Documentation.php" } ", the " { $vocab-link "graphviz.render" } " vocabulary defines a corresponding word that calls " { $link graphviz } " with that layout engine already supplied as an argument. For instance, instead of writing" { $code "graph path format \"dot\" graphviz" } "you can simply write" { $code "graph path format dot" }
$nl
"The following words are defined:"
{ $subsections circo dot fdp neato osage sfdp twopi } ;
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 } "."
"For each output format listed in " { $url "http://graphviz.org/content/output-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 path \"png\" graphviz*" } "you can simply write" { $code "graph path png" }
$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." }
;
"In the case of the " { $snippet "dot" } " output format (which already has the " { $link dot } " shortcut defined for the layout engine), the shortcut function is named " { $link dot-file } "."
$nl
"The following words are defined:"
{ $subsections bmp canon dot-file xdot cmap eps fig gd gd2 gif ico imap cmapx imap_np cmapx_np ismap jpg jpeg jpe pdf plain plain-ext png ps ps2 svg svgz tif tiff vml vmlz vrml wbmp webp } ;
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)."
"The " { $vocab-link "graphviz.render" } " vocabulary provides words for converting " { $link graph } " objects into equivalent Graphviz output. This is done by using the " { $vocab-link "graphviz.dot" } " vocabulary to convert the Factor objects into equivalent DOT code, then invoking Graphviz upon the result."
$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:"
"The most general words in this vocabulary will have you manually specify the desired layout engine and/or output format, along with a file to which Graphviz should save its output:"
{ $subsections
graphviz
graphviz*
@ -323,9 +392,16 @@ $nl
preview-window
}
"Specialized words are also defined to save on extraneous typing:"
"A few global variables are used to control the above words:"
{ $subsections
{ "graphviz.render" "engines" }
default-layout
graph-encoding
preview-format
}
"Shortcut words are also defined to save on extra typing:"
{ $subsections
{ "graphviz.render" "layouts" }
{ "graphviz.render" "formats" }
}
;

261
extra/graphviz/render/render.factor
View File

@ -1,131 +1,200 @@
! Copyright (C) 2011 Alex Vondrak.
! Copyright (C) 2012 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators compiler.units continuations
destructors images.viewer io.backend io.files.unique kernel
locals namespaces parser sequences summary unicode.case words
graphviz.ffi graphviz.builder ;
destructors graphviz.dot images.viewer io.backend
io.directories io.encodings.8-bit.latin1 io.encodings.utf8
io.files io.files.unique io.launcher io.standard-paths kernel
locals make namespaces parser sequences summary system
unicode.case vocabs words ;
IN: graphviz.render
<PRIVATE
! "Layout Commands" from http://graphviz.org/Documentation.php
CONSTANT: standard-layouts {
"circo"
"dot"
"fdp"
"neato"
"osage"
"sfdp"
"twopi"
}
PRIVATE>
SYMBOL: default-layout
"dot" default-layout set-global
SYMBOL: default-format
"png" default-format set-global
SYMBOL: preview-format
"png" preview-format set-global
ERROR: unsupported-format format ;
ERROR: unsupported-engine engine ;
ERROR: unsupported-preview-format preview-format ;
M: unsupported-format summary
drop "Unsupported layout format; check supported-formats" ;
M: unsupported-preview-format summary
drop "Unsupported preview format" ;
M: unsupported-engine summary
drop "Unsupported layout engine; check supported-engines" ;
SYMBOL: graph-encoding
utf8 graph-encoding set-global
ERROR: unsupported-encoding graph-encoding ;
M: unsupported-encoding summary
drop "Must use utf8 or latin1 (match the graph's charset attribute)" ;
HOOK: default-graphviz-program os ( -- path/f )
M: object default-graphviz-program ( -- path/f )
standard-layouts [ find-in-path ] find nip ;
ERROR: cannot-find-graphviz-installation ;
M: cannot-find-graphviz-installation summary
drop "Cannot find Graphviz installation" ;
: ?default-graphviz-program ( -- path )
default-graphviz-program
[ cannot-find-graphviz-installation ] unless* ;
<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 ]
: try-graphviz-command ( path format layout -- )
[
"layout" agget
[ default-layout get-global ] when-empty
] if* dup check-engine ;
?default-graphviz-program ,
[ , "-O" , ]
[ "-T" , , ]
[ "-K" , , ] tri*
] { } make try-output-process ;
:: (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 ?ffi-errors
gvc g -T -o gvRenderFilename ?ffi-errors -o
] with-destructors ;
: ?encoding ( -- encoding )
graph-encoding get-global
dup [ utf8? ] [ latin1? ] bi or
[ unsupported-encoding ] unless ;
: (preview) ( graph -- -o )
"preview" unique-file
default-format get-global
f (graphviz) ; inline
: ?delete-file ( path -- )
dup exists? [ delete-file ] [ drop ] if ;
PRIVATE>
: graphviz ( graph -O -T -K -- )
(graphviz) drop ; inline
:: graphviz ( graph path format layout -- )
path normalize-path :> dot-file
[
graph dot-file ?encoding write-dot
dot-file format layout try-graphviz-command
]
[ dot-file ?delete-file ] [ ] cleanup ;
: graphviz* ( graph -O -T -- )
f graphviz ; inline
: preview ( graph -- )
(preview) image. ; inline
: preview-window ( graph -- )
(preview) image-window ; inline
: graphviz* ( graph path format -- )
default-layout get-global graphviz ;
<PRIVATE
: define-graphviz-by-engine ( -K -- )
[ "graphviz.render" create dup make-inline ]
: try-preview-command ( from-path to-path -- )
[
?default-graphviz-program ,
[ , ]
[ "-o" , , ] bi*
"-T" , preview-format get-global ,
"-K" , default-layout get-global ,
] { } make try-output-process ;
! Not only must Graphviz support the image format, but so must
! images.loader
: preview-extension ( -- extension )
preview-format get-global >lower {
{ "bmp" [ ".bmp" ] }
{ "gif" [ ".gif" ] }
{ "ico" [ ".ico" ] }
{ "jpg" [ ".jpg" ] }
{ "jpeg" [ ".jpg" ] }
{ "jpe" [ ".jpg" ] }
{ "png" [ ".png" ] }
{ "tif" [ ".tif" ] }
{ "tiff" [ ".tif" ] }
[ unsupported-preview-format ]
} case ;
:: with-preview ( graph quot: ( path -- ) -- )
"preview" ".dot" [| code-file |
"preview" preview-extension [| image-file |
graph code-file ?encoding write-dot
code-file image-file try-preview-command
image-file quot call( path -- )
] cleanup-unique-file
] cleanup-unique-file ;
PRIVATE>
: preview ( graph -- )
[ image. ] with-preview ;
: preview-window ( graph -- )
[ image-window ] with-preview ;
<PRIVATE
! http://graphviz.org/content/output-formats
CONSTANT: standard-formats {
"bmp"
"canon"
"dot"
"xdot"
"cmap"
"eps"
"fig"
"gd"
"gd2"
"gif"
"ico"
"imap"
"cmapx"
"imap_np"
"cmapx_np"
"ismap"
"jpg"
"jpeg"
"jpe"
"pdf"
"plain"
"plain-ext"
"png"
"ps"
"ps2"
"svg"
"svgz"
"tif"
"tiff"
"vml"
"vmlz"
"vrml"
"wbmp"
"webp"
! ! ! Canvas formats don't actually use path argument...
! "gtk"
! "xlib"
}
: define-graphviz-by-layout ( layout -- )
[ "graphviz.render" create ]
[ [ graphviz ] curry ] bi
( graph -O -T -- )
( graph path format -- )
define-declared ;
: define-graphviz-by-format ( -T -- )
: define-graphviz-by-format ( format -- )
[
dup supported-engines member? [ "-file" append ] when
"graphviz.render" create dup make-inline
dup standard-layouts member? [ "-file" append ] when
"graphviz.render" create
]
[ [ graphviz* ] curry ] bi
( graph -O -- )
( graph path -- )
define-declared ;
PRIVATE>
[
supported-engines [ define-graphviz-by-engine ] each
supported-formats [ define-graphviz-by-format ] each
standard-layouts [ define-graphviz-by-layout ] each
standard-formats [ define-graphviz-by-format ] each
] with-compilation-unit
os windows? [ "graphviz.render.windows" require ] when

23
extra/graphviz/render/windows/windows.factor Normal file
View File

@ -0,0 +1,23 @@
! Copyright (C) 2012 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators.short-circuit graphviz.render
graphviz.render.private io.directories
io.directories.search.windows io.files.info io.standard-paths
kernel sequences system ;
IN: graphviz.render.windows
: graphviz-install-directories ( -- directories )
program-files-directories [
directory-entries [
{
[ directory? ]
[ name>> "Graphviz" head? ]
[ name>> ]
} 1&&
] map sift
] map concat ;
M: windows default-graphviz-program ( -- path/f )
graphviz-install-directories
standard-layouts [ ".exe" append ] map
[ find-in-applications ] with find nip ;