extra/graphviz/render/render.factor

   1 ! Copyright (C) 2012 Alex Vondrak.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators compiler.units continuations
   4 destructors graphviz.dot images.viewer io.backend
   5 io.directories io.encodings.8-bit.latin1 io.encodings.utf8
   6 io.files io.files.unique io.launcher io.standard-paths kernel
   7 locals make namespaces parser sequences summary system
   8 unicode.case vocabs words ;
   9 IN: graphviz.render
  10
  11 <PRIVATE
  12
  13 ! "Layout Commands" from http://graphviz.org/Documentation.php
  14 CONSTANT: standard-layouts {
  15     "circo"
  16     "dot"
  17     "fdp"
  18     "neato"
  19     "osage"
  20     "sfdp"
  21     "twopi"
  22 }
  23
  24 PRIVATE>
  25
  26 SYMBOL: default-layout
  27 "dot" default-layout set-global
  28
  29 SYMBOL: preview-format
  30 "png" preview-format set-global
  31
  32 ERROR: unsupported-preview-format preview-format ;
  33
  34 M: unsupported-preview-format summary
  35     drop "Unsupported preview format" ;
  36
  37 SYMBOL: graph-encoding
  38 utf8 graph-encoding set-global
  39
  40 ERROR: unsupported-encoding graph-encoding ;
  41
  42 M: unsupported-encoding summary
  43     drop "Must use utf8 or latin1 (match the graph's charset attribute)" ;
  44
  45 HOOK: default-graphviz-program os ( -- path/f )
  46
  47 M: object default-graphviz-program ( -- path/f )
  48     standard-layouts [ find-in-path ] find nip ;
  49
  50 ERROR: cannot-find-graphviz-installation ;
  51
  52 M: cannot-find-graphviz-installation summary
  53     drop "Cannot find Graphviz installation" ;
  54
  55 : ?default-graphviz-program ( -- path )
  56     default-graphviz-program
  57     [ cannot-find-graphviz-installation ] unless* ;
  58
  59 <PRIVATE
  60
  61 : try-graphviz-command ( path format layout -- )
  62     [
  63         ?default-graphviz-program ,
  64         [ , "-O" , ]
  65         [ "-T" , , ]
  66         [ "-K" , , ] tri*
  67     ] { } make try-output-process ;
  68
  69 : ?encoding ( -- encoding )
  70     graph-encoding get-global
  71     dup [ utf8? ] [ latin1? ] bi or
  72     [ unsupported-encoding ] unless ;
  73
  74 : ?delete-file ( path -- )
  75     dup exists? [ delete-file ] [ drop ] if ;
  76
  77 PRIVATE>
  78
  79 :: graphviz ( graph path format layout -- )
  80     path normalize-path :> dot-file
  81     [
  82         graph dot-file ?encoding write-dot
  83         dot-file format layout try-graphviz-command
  84     ]
  85     [ dot-file ?delete-file ] [ ] cleanup ;
  86
  87 : graphviz* ( graph path format -- )
  88     default-layout get-global graphviz ;
  89
  90 <PRIVATE
  91
  92 : try-preview-command ( from-path to-path -- )
  93     [
  94         ?default-graphviz-program ,
  95         [ , ]
  96         [ "-o" , , ] bi*
  97         "-T" , preview-format get-global ,
  98         "-K" , default-layout get-global ,
  99     ] { } make try-output-process ;
 100
 101 ! Not only must Graphviz support the image format, but so must
 102 ! images.loader
 103
 104 : preview-extension ( -- extension )
 105     preview-format get-global >lower {
 106         { "bmp"  [ ".bmp" ] }
 107         { "gif"  [ ".gif" ] }
 108         { "ico"  [ ".ico" ] }
 109         { "jpg"  [ ".jpg" ] }
 110         { "jpeg" [ ".jpg" ] }
 111         { "jpe"  [ ".jpg" ] }
 112         { "png"  [ ".png" ] }
 113         { "tif"  [ ".tif" ] }
 114         { "tiff" [ ".tif" ] }
 115         [ unsupported-preview-format ]
 116     } case ;
 117
 118 :: with-preview ( graph quot: ( path -- ) -- )
 119     "preview" ".dot" [| code-file |
 120         "preview" preview-extension [| image-file |
 121             graph code-file ?encoding write-dot
 122             code-file image-file try-preview-command
 123             image-file quot call( path -- )
 124         ] cleanup-unique-file
 125     ] cleanup-unique-file ;
 126
 127 PRIVATE>
 128
 129 : preview ( graph -- )
 130     [ image. ] with-preview ;
 131
 132 : preview-window ( graph -- )
 133     [ image-window ] with-preview ;
 134
 135 <PRIVATE
 136
 137 ! http://graphviz.org/content/output-formats
 138 CONSTANT: standard-formats {
 139     "bmp"
 140     "canon"
 141     "dot"
 142     "xdot"
 143     "cmap"
 144     "eps"
 145     "fig"
 146     "gd"
 147     "gd2"
 148     "gif"
 149     "ico"
 150     "imap"
 151     "cmapx"
 152     "imap_np"
 153     "cmapx_np"
 154     "ismap"
 155     "jpg"
 156     "jpeg"
 157     "jpe"
 158     "pdf"
 159     "plain"
 160     "plain-ext"
 161     "png"
 162     "ps"
 163     "ps2"
 164     "svg"
 165     "svgz"
 166     "tif"
 167     "tiff"
 168     "vml"
 169     "vmlz"
 170     "vrml"
 171     "wbmp"
 172     "webp"
 173     ! ! ! Canvas formats don't actually use path argument...
 174     ! "gtk"
 175     ! "xlib"
 176 }
 177
 178 : define-graphviz-by-layout ( layout -- )
 179     [ "graphviz.render" create ]
 180     [ [ graphviz ] curry ] bi
 181     ( graph path format -- )
 182     define-declared ;
 183
 184 : define-graphviz-by-format ( format -- )
 185     [
 186         dup standard-layouts member? [ "-file" append ] when
 187         "graphviz.render" create
 188     ]
 189     [ [ graphviz* ] curry ] bi
 190     ( graph path -- )
 191     define-declared ;
 192
 193 PRIVATE>
 194
 195 [
 196     standard-layouts [ define-graphviz-by-layout ] each
 197     standard-formats [ define-graphviz-by-format ] each
 198 ] with-compilation-unit
 199
 200 os windows? [ "graphviz.render.windows" require ] when