132 lines
3.6 KiB
Factor
132 lines
3.6 KiB
Factor
! Copyright (C) 2011 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 ;
|
|
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 ?ffi-errors
|
|
gvc g -T -o gvRenderFilename ?ffi-errors -o
|
|
] 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 -- )
|
|
[ "graphviz.render" create dup make-inline ]
|
|
[ [ graphviz ] curry ] bi
|
|
( graph -O -T -- )
|
|
define-declared ;
|
|
|
|
: define-graphviz-by-format ( -T -- )
|
|
[
|
|
dup supported-engines member? [ "-file" append ] when
|
|
"graphviz.render" create 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
|
|
] with-compilation-unit
|