extra/graphviz/render/render.factor

   1 ! Copyright (C) 2012 Alex Vondrak.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: calendar combinators compiler.units continuations
   4 graphviz.dot images.viewer io.backend io.directories
   5 io.encodings.8-bit.latin1 io.encodings.utf8 io.files
   6 io.files.temp io.files.unique io.launcher io.standard-paths
   7 kernel locals make namespaces sequences summary system threads
   8 unicode vocabs webbrowser 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-standard-login-path ] map-find drop ;
  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 ( ..a graph quot: ( ..a path -- ..b ) -- ..b )
 119     [
 120         "preview" ".dot" [| code-file |
 121             "preview" preview-extension [| image-file |
 122                 graph code-file ?encoding write-dot
 123                 code-file image-file try-preview-command
 124                 image-file quot call
 125             ] cleanup-unique-file
 126         ] cleanup-unique-file
 127     ] with-temp-directory ; inline
 128
 129 PRIVATE>
 130
 131 : preview ( graph -- )
 132     [ image. ] with-preview ;
 133
 134 : preview-window ( graph -- )
 135     [ image-window ] with-preview ;
 136
 137 : preview-open ( graph -- )
 138     [ open-file 1 seconds sleep ] with-preview ;
 139
 140 <PRIVATE
 141
 142 ! http://graphviz.org/content/output-formats
 143 CONSTANT: standard-formats {
 144     "bmp"
 145     "canon"
 146     "dot"
 147     "xdot"
 148     "cmap"
 149     "eps"
 150     "fig"
 151     "gd"
 152     "gd2"
 153     "gif"
 154     "ico"
 155     "imap"
 156     "cmapx"
 157     "imap_np"
 158     "cmapx_np"
 159     "ismap"
 160     "jpg"
 161     "jpeg"
 162     "jpe"
 163     "pdf"
 164     "plain"
 165     "plain-ext"
 166     "png"
 167     "ps"
 168     "ps2"
 169     "svg"
 170     "svgz"
 171     "tif"
 172     "tiff"
 173     "vml"
 174     "vmlz"
 175     "vrml"
 176     "wbmp"
 177     "webp"
 178     ! ! ! Canvas formats don't actually use path argument...
 179     ! "gtk"
 180     ! "xlib"
 181 }
 182
 183 : define-graphviz-by-layout ( layout -- )
 184     [ "graphviz.render" create-word ]
 185     [ [ graphviz ] curry ] bi
 186     ( graph path format -- )
 187     define-declared ;
 188
 189 : define-graphviz-by-format ( format -- )
 190     [
 191         dup standard-layouts member? [ "-file" append ] when
 192         "graphviz.render" create-word
 193     ]
 194     [ [ graphviz* ] curry ] bi
 195     ( graph path -- )
 196     define-declared ;
 197
 198 PRIVATE>
 199
 200 [
 201     standard-layouts [ define-graphviz-by-layout ] each
 202     standard-formats [ define-graphviz-by-format ] each
 203 ] with-compilation-unit
 204
 205 os windows? [ "graphviz.render.windows" require ] when