extra/graphviz/render/render.factor

   1 ! Copyright (C) 2011 Alex Vondrak.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators compiler.units continuations
   4 destructors images.viewer io.backend io.files.unique kernel
   5 locals namespaces parser sequences summary unicode.case words
   6 graphviz.ffi graphviz.builder ;
   7 IN: graphviz.render
   8
   9 SYMBOL: default-layout
  10 "dot" default-layout set-global
  11
  12 SYMBOL: default-format
  13 "png" default-format set-global
  14
  15 ERROR: unsupported-format format ;
  16 ERROR: unsupported-engine engine ;
  17
  18 M: unsupported-format summary
  19     drop "Unsupported layout format; check supported-formats" ;
  20
  21 M: unsupported-engine summary
  22     drop "Unsupported layout engine; check supported-engines" ;
  23
  24 <PRIVATE
  25
  26 : default-extension ( format -- extension )
  27     >lower {
  28         { "bmp"       [ ".bmp"  ] }
  29         { "canon"     [ ".dot"  ] }
  30         { "dot"       [ ".dot"  ] }
  31         { "xdot"      [ ".dot"  ] }
  32         { "eps"       [ ".eps"  ] }
  33         { "fig"       [ ".fig"  ] }
  34         { "gd"        [ ".gd"   ] }
  35         { "gd2"       [ ".gd2"  ] }
  36         { "gif"       [ ".gif"  ] }
  37         { "ico"       [ ".ico"  ] }
  38         { "imap"      [ ".map"  ] }
  39         { "cmapx"     [ ".map"  ] }
  40         { "imap_np"   [ ".map"  ] }
  41         { "cmapx_np"  [ ".map"  ] }
  42         { "ismap"     [ ".map"  ] }
  43         { "jpg"       [ ".jpg"  ] }
  44         { "jpeg"      [ ".jpg"  ] }
  45         { "jpe"       [ ".jpg"  ] }
  46         { "pdf"       [ ".pdf"  ] }
  47         { "plain"     [ ".txt"  ] }
  48         { "plain-ext" [ ".txt"  ] }
  49         { "png"       [ ".png"  ] }
  50         { "ps"        [ ".ps"   ] }
  51         { "ps2"       [ ".ps"   ] }
  52         { "svg"       [ ".svg"  ] }
  53         { "svgz"      [ ".svgz" ] }
  54         { "tif"       [ ".tif"  ] }
  55         { "tiff"      [ ".tif"  ] }
  56         { "vml"       [ ".vml"  ] }
  57         { "vmlz"      [ ".vmlz" ] }
  58         { "vrml"      [ ".vrml" ] }
  59         { "wbmp"      [ ".wbmp" ] }
  60         [ drop "" ]
  61     } case ;
  62
  63 : check-format ( -T -- )
  64     dup supported-formats member?
  65     [ drop ] [ unsupported-format ] if ; inline
  66
  67 : check-engine ( -K -- )
  68     dup supported-engines member?
  69     [ drop ] [ unsupported-engine ] if ; inline
  70
  71 : compute-engine ( Agraph_t* -K -- engine )
  72     [ nip ]
  73     [
  74         "layout" agget
  75         [ default-layout get-global ] when-empty
  76     ] if* dup check-engine ;
  77
  78 :: (graphviz) ( graph -O -T -K -- -o )
  79     -T check-format
  80     -O -T default-extension append normalize-path :> -o
  81     [
  82         gvContext &gvFreeContext :> gvc
  83         graph id>> graph kind agopen &agclose :> g
  84         g graph build-alien
  85         g -K compute-engine :> engine
  86         gvc g engine gvLayout drop
  87         [ gvc g -T -o gvRenderFilename drop -o ]
  88         [ gvc g gvFreeLayout drop ] [ ] cleanup
  89     ] with-destructors ;
  90
  91 : (preview) ( graph -- -o )
  92     "preview" unique-file
  93     default-format get-global
  94     f (graphviz) ; inline
  95
  96 PRIVATE>
  97
  98 : graphviz ( graph -O -T -K -- )
  99     (graphviz) drop ; inline
 100
 101 : graphviz* ( graph -O -T -- )
 102     f graphviz ; inline
 103
 104 : preview ( graph -- )
 105     (preview) image. ; inline
 106
 107 : preview-window ( graph -- )
 108     (preview) image-window ; inline
 109
 110 <PRIVATE
 111
 112 : define-graphviz-by-engine ( -K -- )
 113     [ "graphviz.render" create dup make-inline ]
 114     [ [ graphviz ] curry ] bi
 115     (( graph -O -T -- ))
 116     define-declared ;
 117
 118 : define-graphviz-by-format ( -T -- )
 119     [
 120         dup supported-engines member? [ "-file" append ] when
 121         "graphviz.render" create dup make-inline
 122     ]
 123     [ [ graphviz* ] curry ] bi
 124     (( graph -O -- ))
 125     define-declared ;
 126
 127 PRIVATE>
 128
 129 [
 130     supported-engines [ define-graphviz-by-engine ] each
 131     supported-formats [ define-graphviz-by-format ] each
 132 ] with-compilation-unit