92 |
93 | ; From http://www.graphviz.org/content/cluster
94 | (digraph [
95 | (subgraph :cluster_0 [
96 | {:style :filled, :color :lightgrey, :label "process #1"}
97 | (node-attrs {:style :filled, :color :white})
98 |
99 | [:a0 :> :a1 :> :a2 :> :a3]])
100 |
101 | (subgraph :cluster_1 [
102 | {:color :blue, :label "process #2"}
103 | (node-attrs {:style :filled})
104 |
105 | [:b0 :> :b1 :> :b2 :> :b3]])
106 |
107 | [:start :a0]
108 | [:start :b0]
109 | [:a1 :b3]
110 | [:b2 :a3]
111 | [:a3 :a0]
112 | [:a3 :end]
113 | [:b3 :end]
114 |
115 | [:start {:shape :Mdiamond}]
116 | [:end {:shape :Msquare}]])
117 |
118 |
119 | Similarly for `(graph)` (undirected graph) and `(subgraph)`. A second form of these functions takes an initial option map, or a string or keyword id for the graph:
120 |
121 | (graph :graph-id ...)
122 | ; => graph "graph-id" { ... }
123 |
124 | (digraph { :id :G :strict? true } ...)
125 | ; => strict graph G { ... }
126 |
127 | ## Generate Graphviz dot format
128 |
129 | Given a graph built with the functions described above, use the `(dot)` function to generate Graphviz DOT output.
130 |
131 | (require '[dorothy.core :as dot])
132 | (def g (dot/graph [ ... ]))
133 | (dot/dot g)
134 | "graph { ... }"
135 |
136 | ## Rendering images (ClojureScript)
137 |
138 | Dorothy currently doesn't include any facilities for rendering dot-format output to images. However,
139 | you can pull in [viz.cljc](https://github.com/jebberjeb/viz.cljc) or
140 | [viz.js](https://github.com/mdaines/viz.js), both of which will allow you to produce
141 | png, svg, and other image formats from your dorothy-generated dot-formatted graph content.
142 |
143 | Wanted: pull requests to implement node equivalents to the rendering functions available for Clojure/JVM
144 | in the `dorothy.jvm` namespace. **link to github issue here**
145 |
146 | ## Render images via `graphviz` (Clojure/JVM)
147 |
148 | Once you have DOT language output, you can render it as an image using the `(render)` function:
149 |
150 | (require '[dorothy.jvm :refer (render save! show!)])
151 |
152 | ; This produces a png as an array of bytes
153 | (render graph {:format :png})
154 |
155 | ; This produces an SVG string
156 | (render graph {:format :svg})
157 |
158 | ; A one-liner with a very simple 4 node digraph.
159 | (-> (dot/digraph [ [:a :b :c] [:b :d] ])
160 | dot/dot
161 | (render {:format :svg}))
162 |
163 | *The dot tool executable must be on the system path*
164 |
165 | other formats include `:pdf`, `:gif`, etc. The result will be either a java byte array, or String depending on whether the format is binary or not. `(render)` returns a string or a byte array depending on whether the output format is binary or not.
166 |
167 | Alternatively, use the `(save!)` function to write to a file or output stream.
168 |
169 | ; A one-liner with a very simple 4 node digraph
170 | (-> (dot/digraph [ [:a :b :c] [:b :d] ])
171 | dot/dot
172 | (save! "out.png" {:format :png}))
173 |
174 | Finally, for simple tests, use the `(show!)` function to view the result in a simple Swing viewer:
175 |
176 | ; This opens a simple Swing viewer with the graph
177 | (show! graph)
178 |
179 | ; A one-liner with a very simple 4 node digraph
180 | (-> (dot/digraph [ [:a :b :c] [:b :d] ])
181 | dot/dot
182 | show!)
183 |
184 | which shows:
185 |
186 | 
187 |
188 |
189 | ## License
190 |
191 | Copyright (C) 2011-2017 Dave Ray and contributors
192 |
193 | Distributed under the Eclipse Public License, the same as Clojure.
194 |
--------------------------------------------------------------------------------
/deps.edn:
--------------------------------------------------------------------------------
1 | {}
2 |
--------------------------------------------------------------------------------
/epl-v10.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 | Eclipse Public License - v 1.0
31 | 32 |THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 33 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS 35 | AGREEMENT.
36 | 37 |1. DEFINITIONS
38 | 39 |"Contribution" means:
40 | 41 |a) in the case of the initial Contributor, the initial 42 | code and documentation distributed under this Agreement, and
43 |b) in the case of each subsequent Contributor:
44 |i) changes to the Program, and
45 |ii) additions to the Program;
46 |where such changes and/or additions to the Program 47 | originate from and are distributed by that particular Contributor. A 48 | Contribution 'originates' from a Contributor if it was added to the 49 | Program by such Contributor itself or anyone acting on such 50 | Contributor's behalf. Contributions do not include additions to the 51 | Program which: (i) are separate modules of software distributed in 52 | conjunction with the Program under their own license agreement, and (ii) 53 | are not derivative works of the Program.
54 | 55 |"Contributor" means any person or entity that distributes 56 | the Program.
57 | 58 |"Licensed Patents" mean patent claims licensable by a 59 | Contributor which are necessarily infringed by the use or sale of its 60 | Contribution alone or when combined with the Program.
61 | 62 |"Program" means the Contributions distributed in accordance 63 | with this Agreement.
64 | 65 |"Recipient" means anyone who receives the Program under 66 | this Agreement, including all Contributors.
67 | 68 |2. GRANT OF RIGHTS
69 | 70 |a) Subject to the terms of this Agreement, each 71 | Contributor hereby grants Recipient a non-exclusive, worldwide, 72 | royalty-free copyright license to reproduce, prepare derivative works 73 | of, publicly display, publicly perform, distribute and sublicense the 74 | Contribution of such Contributor, if any, and such derivative works, in 75 | source code and object code form.
76 | 77 |b) Subject to the terms of this Agreement, each 78 | Contributor hereby grants Recipient a non-exclusive, worldwide, 79 | royalty-free patent license under Licensed Patents to make, use, sell, 80 | offer to sell, import and otherwise transfer the Contribution of such 81 | Contributor, if any, in source code and object code form. This patent 82 | license shall apply to the combination of the Contribution and the 83 | Program if, at the time the Contribution is added by the Contributor, 84 | such addition of the Contribution causes such combination to be covered 85 | by the Licensed Patents. The patent license shall not apply to any other 86 | combinations which include the Contribution. No hardware per se is 87 | licensed hereunder.
88 | 89 |c) Recipient understands that although each Contributor 90 | grants the licenses to its Contributions set forth herein, no assurances 91 | are provided by any Contributor that the Program does not infringe the 92 | patent or other intellectual property rights of any other entity. Each 93 | Contributor disclaims any liability to Recipient for claims brought by 94 | any other entity based on infringement of intellectual property rights 95 | or otherwise. As a condition to exercising the rights and licenses 96 | granted hereunder, each Recipient hereby assumes sole responsibility to 97 | secure any other intellectual property rights needed, if any. For 98 | example, if a third party patent license is required to allow Recipient 99 | to distribute the Program, it is Recipient's responsibility to acquire 100 | that license before distributing the Program.
101 | 102 |d) Each Contributor represents that to its knowledge it 103 | has sufficient copyright rights in its Contribution, if any, to grant 104 | the copyright license set forth in this Agreement.
105 | 106 |3. REQUIREMENTS
107 | 108 |A Contributor may choose to distribute the Program in object code 109 | form under its own license agreement, provided that:
110 | 111 |a) it complies with the terms and conditions of this 112 | Agreement; and
113 | 114 |b) its license agreement:
115 | 116 |i) effectively disclaims on behalf of all Contributors 117 | all warranties and conditions, express and implied, including warranties 118 | or conditions of title and non-infringement, and implied warranties or 119 | conditions of merchantability and fitness for a particular purpose;
120 | 121 |ii) effectively excludes on behalf of all Contributors 122 | all liability for damages, including direct, indirect, special, 123 | incidental and consequential damages, such as lost profits;
124 | 125 |iii) states that any provisions which differ from this 126 | Agreement are offered by that Contributor alone and not by any other 127 | party; and
128 | 129 |iv) states that source code for the Program is available 130 | from such Contributor, and informs licensees how to obtain it in a 131 | reasonable manner on or through a medium customarily used for software 132 | exchange.
133 | 134 |When the Program is made available in source code form:
135 | 136 |a) it must be made available under this Agreement; and
137 | 138 |b) a copy of this Agreement must be included with each 139 | copy of the Program.
140 | 141 |Contributors may not remove or alter any copyright notices contained 142 | within the Program.
143 | 144 |Each Contributor must identify itself as the originator of its 145 | Contribution, if any, in a manner that reasonably allows subsequent 146 | Recipients to identify the originator of the Contribution.
147 | 148 |4. COMMERCIAL DISTRIBUTION
149 | 150 |Commercial distributors of software may accept certain 151 | responsibilities with respect to end users, business partners and the 152 | like. While this license is intended to facilitate the commercial use of 153 | the Program, the Contributor who includes the Program in a commercial 154 | product offering should do so in a manner which does not create 155 | potential liability for other Contributors. Therefore, if a Contributor 156 | includes the Program in a commercial product offering, such Contributor 157 | ("Commercial Contributor") hereby agrees to defend and 158 | indemnify every other Contributor ("Indemnified Contributor") 159 | against any losses, damages and costs (collectively "Losses") 160 | arising from claims, lawsuits and other legal actions brought by a third 161 | party against the Indemnified Contributor to the extent caused by the 162 | acts or omissions of such Commercial Contributor in connection with its 163 | distribution of the Program in a commercial product offering. The 164 | obligations in this section do not apply to any claims or Losses 165 | relating to any actual or alleged intellectual property infringement. In 166 | order to qualify, an Indemnified Contributor must: a) promptly notify 167 | the Commercial Contributor in writing of such claim, and b) allow the 168 | Commercial Contributor to control, and cooperate with the Commercial 169 | Contributor in, the defense and any related settlement negotiations. The 170 | Indemnified Contributor may participate in any such claim at its own 171 | expense.
172 | 173 |For example, a Contributor might include the Program in a commercial 174 | product offering, Product X. That Contributor is then a Commercial 175 | Contributor. If that Commercial Contributor then makes performance 176 | claims, or offers warranties related to Product X, those performance 177 | claims and warranties are such Commercial Contributor's responsibility 178 | alone. Under this section, the Commercial Contributor would have to 179 | defend claims against the other Contributors related to those 180 | performance claims and warranties, and if a court requires any other 181 | Contributor to pay any damages as a result, the Commercial Contributor 182 | must pay those damages.
183 | 184 |5. NO WARRANTY
185 | 186 |EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 187 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS 188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, 189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 191 | responsible for determining the appropriateness of using and 192 | distributing the Program and assumes all risks associated with its 193 | exercise of rights under this Agreement , including but not limited to 194 | the risks and costs of program errors, compliance with applicable laws, 195 | damage to or loss of data, programs or equipment, and unavailability or 196 | interruption of operations.
197 | 198 |6. DISCLAIMER OF LIABILITY
199 | 200 |EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT 201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
208 | 209 |7. GENERAL
210 | 211 |If any provision of this Agreement is invalid or unenforceable under 212 | applicable law, it shall not affect the validity or enforceability of 213 | the remainder of the terms of this Agreement, and without further action 214 | by the parties hereto, such provision shall be reformed to the minimum 215 | extent necessary to make such provision valid and enforceable.
216 | 217 |If Recipient institutes patent litigation against any entity 218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 219 | Program itself (excluding combinations of the Program with other 220 | software or hardware) infringes such Recipient's patent(s), then such 221 | Recipient's rights granted under Section 2(b) shall terminate as of the 222 | date such litigation is filed.
223 | 224 |All Recipient's rights under this Agreement shall terminate if it 225 | fails to comply with any of the material terms or conditions of this 226 | Agreement and does not cure such failure in a reasonable period of time 227 | after becoming aware of such noncompliance. If all Recipient's rights 228 | under this Agreement terminate, Recipient agrees to cease use and 229 | distribution of the Program as soon as reasonably practicable. However, 230 | Recipient's obligations under this Agreement and any licenses granted by 231 | Recipient relating to the Program shall continue and survive.
232 | 233 |Everyone is permitted to copy and distribute copies of this 234 | Agreement, but in order to avoid inconsistency the Agreement is 235 | copyrighted and may only be modified in the following manner. The 236 | Agreement Steward reserves the right to publish new versions (including 237 | revisions) of this Agreement from time to time. No one other than the 238 | Agreement Steward has the right to modify this Agreement. The Eclipse 239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may 240 | assign the responsibility to serve as the Agreement Steward to a 241 | suitable separate entity. Each new version of the Agreement will be 242 | given a distinguishing version number. The Program (including 243 | Contributions) may always be distributed subject to the version of the 244 | Agreement under which it was received. In addition, after a new version 245 | of the Agreement is published, Contributor may elect to distribute the 246 | Program (including its Contributions) under the new version. Except as 247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no 248 | rights or licenses to the intellectual property of any Contributor under 249 | this Agreement, whether expressly, by implication, estoppel or 250 | otherwise. All rights in the Program not expressly granted under this 251 | Agreement are reserved.
252 | 253 |This Agreement is governed by the laws of the State of New York and 254 | the intellectual property laws of the United States of America. No party 255 | to this Agreement will bring a legal action under this Agreement more 256 | than one year after the cause of action arose. Each party waives its 257 | rights to a jury trial in any resulting litigation.
258 | 259 | 260 | 261 | 262 | 263 | -------------------------------------------------------------------------------- /notes.txt: -------------------------------------------------------------------------------- 1 | http://www.graphviz.org/content/dot-language 2 | 3 | X graph : [ *strict* ] (*graph* | *digraph*) [ ID ] '{' stmt_list '}' 4 | X stmt_list : [ stmt [ ';' ] [ stmt_list ] ] 5 | X stmt : 6 | X node_stmt 7 | X | edge_stmt 8 | X | attr_stmt 9 | X | ID '=' ID 10 | X | subgraph 11 | X attr_stmt : (*graph* | *node* | *edge*) attr_list 12 | X attr_list : '[' [ a_list ] ']' [ attr_list ] 13 | X a_list : ID [ '=' ID ] [ ',' ] [ a_list ] 14 | X edge_stmt : (node_id | subgraph) edgeRHS [ attr_list ] 15 | X edgeRHS : edgeop (node_id | subgraph) [ edgeRHS ] 16 | X edgeop : '->' | '--' 17 | X node_stmt : node_id [ attr_list ] 18 | X node_id : ID [ port ] 19 | X port : ':' ID [ ':' compass_pt ] 20 | | ':' compass_pt 21 | X subgraph : [ *subgraph* [ ID ] ] '{' stmt_list '}' 22 | X compass_pt : (n | ne | e | se | s | sw | w | nw | c | _) 23 | 24 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject dorothy "0.0.7-SNAPSHOT" 2 | :description "Hiccup-style generation of Graphviz graphs" 3 | :url "https://github.com/daveray/dorothy" 4 | :license {:name "Eclipse Public License - v 1.0" 5 | :url "http://www.eclipse.org/legal/epl-v10.html" 6 | :distribution :repo 7 | :comments "same as Clojure"} 8 | :dependencies [[org.clojure/clojure "1.9.0"]] 9 | :profiles 10 | {:dev {:dependencies [[org.clojure/clojurescript "1.9.908"] 11 | [com.cemerick/piggieback "0.2.2"]] 12 | 13 | :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]} 14 | 15 | :plugins [[lein-cljsbuild "1.1.7" :exclusions [org.clojure/clojure]] 16 | [lein-doo "0.1.7"]] 17 | 18 | :aliases {"cljs-test" ["doo" "node" "node-test"] 19 | "test-all" ["do" "clean," "test" ":all," "cljs-test" "once"]} 20 | 21 | :doo {:build "node-test"} 22 | 23 | :cljsbuild 24 | {:builds 25 | {"node-test" {:source-paths ["src" "test"] 26 | :compiler {:output-to "target/test.js" 27 | :output-dir "target/out-node-test" 28 | :main dorothy.test.doo-runner 29 | :optimizations :advanced 30 | :pretty-print false 31 | :target :nodejs 32 | :language-in :ecmascript5}}}}}}) 33 | -------------------------------------------------------------------------------- /sample.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/daveray/dorothy/207570804dfda2162a15b9ee55b5e76ec6e1ecfa/sample.png -------------------------------------------------------------------------------- /src/dorothy/core.cljc: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Dave Ray, 2014. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | ;; # dorothy 12 | ;; 13 | ;; [Hiccup-style](https://github.com/weavejester/hiccup) generation of [Graphviz](http://www.graphviz.org/) graphs in Clojure. 14 | ;; 15 | ;; *Dorothy is extremely alpha and subject to radical change. [Release Notes Here](https://github.com/daveray/dorothy/wiki)* 16 | ;; 17 | ;; ## Usage 18 | ;; 19 | ;; *Dorothy assumes you have an understanding of Graphviz and DOT. The text below describes the mechanics of Dorothy's DSL, but you'll need to refer to the Graphviz documentation for specifics on node shapes, valid attributes, etc.* 20 | ;; 21 | ;; *The Graphviz `dot` tool executable must be on the system path* 22 | ;; 23 | ;; Dorothy is on Clojars. In Leiningen: 24 | ;; 25 | ;; [dorothy "x.y.z"] 26 | ;; 27 | ;; A graph consists of a vector of *statements*. The following sections describe the format for all the types of statements. If you're bored, skip ahead to the "Defining Graphs" section below. 28 | ;; 29 | ;; ### Node Statement 30 | ;; A *node statement* defines a node in the graph. It can take two forms: 31 | ;; 32 | ;; node-id 33 | ;; 34 | ;; [node-id] 35 | ;; 36 | ;; [node-id { attr map }] 37 | ;; 38 | ;; where `node-id` is a string, number or keyword with optional trailing *port* and *compass-point*. Here are some node statement examples: 39 | ;; 40 | ;; :node0 ; Define a node called "node0" 41 | ;; 42 | ;; :node0:port0 ; Define a node called "node0" with port "port0" 43 | ;; 44 | ;; :node0:port0:sw ; Similarly a node with southwest compass point 45 | ;; 46 | ;; the node's attr map is a map of attributes for the node. For example, 47 | ;; 48 | ;; [:start {:shape :Mdiamond}] 49 | ;; ; => start [shape=Mdiamond]; 50 | ;; 51 | ;; Dorothy will correctly escape and quote node-ids as required by dot. 52 | ;; 53 | ;; A node id can also be auto-generated with `(gen-id object)`. 54 | ;; 55 | ;; [(gen-id some-object) {:label (.getText some-object)}] 56 | ;; 57 | ;; It allows you to use arbitrary objects as nodes. 58 | ;; 59 | ;; ### Edge Statement 60 | ;; An *edge statement* defines an edge in the graph. It is expressed as a vector with two or more node-ids followed optional attribute map: 61 | ;; 62 | ;; [node-id0 node-id1 ... node-idN { attr map }] 63 | ;; ; => "node-id0" -> "node-id1" -> ... -> "node-idN" [attrs ...]; 64 | ;; 65 | ;; In addition to node ids, an edge statement may also contain subgraphs: 66 | ;; 67 | ;; [:start (subgraph [... subgraph statements ...])] 68 | ;; 69 | ;; For readability, `:>` delimiters may be optionally included in an edge statement: 70 | ;; 71 | ;; [:start :> :middle :> :end] 72 | ;; 73 | ;; ### Graph Attribute Statement 74 | ;; 75 | ;; A *graph attribute* statement sets graph-wide attributes. It is expressed as a single map: 76 | ;; 77 | ;; {:label "process #1", :style :filled, :color :lightgrey} 78 | ;; ; => graph [label="process #1",style=filled,color=lightgrey]; 79 | ;; 80 | ;; alternatively, this can be expressed with the `(graph-attrs)` function like this: 81 | ;; 82 | ;; (graph-attrs {:label "process #1", :style :filled, :color :lightgrey}) 83 | ;; ; => graph [label="process #1",style=filled,color=lightgrey]; 84 | ;; 85 | ;; ### Node and Edge Attribute Statement 86 | ;; A *node attribute* or *edge attribute* statement sets node or edge attributes respectively for all nodes and edge statements that follow. It is expressed with `(node-attrs)` and `(edge-attrs)` statements: 87 | ;; 88 | ;; (node-attrs {:style :filled, :color :white}) 89 | ;; ; => node [style=filled,color=white]; 90 | ;; 91 | ;; or: 92 | ;; 93 | ;; (edge-attrs {:color :black}) 94 | ;; ; => edge [color=black]; 95 | ;; 96 | ;; 97 | ;; ## Defining Graphs 98 | ;; As mentioned above, a graph consists of a series of statements. These statements are passed to the `graph`, `digraph`, or `subgraph` functions. Each takes an optional set of attributes followed by a vector of statements: 99 | ;; 100 | ;; 101 | ;; ; From http://www.graphviz.org/content/cluster 102 | ;; (digraph [ 103 | ;; (subgraph :cluster_0 [ 104 | ;; {:style :filled, :color :lightgrey, :label "process #1"} 105 | ;; (node-attrs {:style :filled, :color :white}) 106 | ;; 107 | ;; [:a0 :> :a1 :> :a2 :> :a3]]) 108 | ;; 109 | ;; (subgraph :cluster_1 [ 110 | ;; {:color :blue, :label "process #2"} 111 | ;; (node-attrs {:style :filled}) 112 | ;; 113 | ;; [:b0 :> :b1 :> :b2 :> :b3]]) 114 | ;; 115 | ;; [:start :a0] 116 | ;; [:start :b0] 117 | ;; [:a1 :b3] 118 | ;; [:b2 :a3] 119 | ;; [:a3 :a0] 120 | ;; [:a3 :end] 121 | ;; [:b3 :end] 122 | ;; 123 | ;; [:start {:shape :Mdiamond}] 124 | ;; [:end {:shape :Msquare}]]) 125 | ;; 126 | ;;  127 | ;; 128 | ;; Similarly for `(graph)` (undirected graph) and `(subgraph)`. A second form of these functions takes an initial option map, or a string or keyword id for the graph: 129 | ;; 130 | ;; (graph :graph-id ...) 131 | ;; ; => graph "graph-id" { ... } 132 | ;; 133 | ;; (digraph { :id :G :strict? true } ...) 134 | ;; ; => strict graph G { ... } 135 | ;; 136 | ;; ## Generate Graphviz dot format and rendering images 137 | ;; 138 | ;; Given a graph built with the functions described above, use the `(dot)` function to generate Graphviz DOT output. 139 | ;; 140 | ;; (use 'dorothy.core) 141 | ;; (def g (graph [ ... ])) 142 | ;; (dot g) 143 | ;; "graph { ... }" 144 | ;; 145 | ;; Once you have DOT language output, you can render it as an image using the `(render)` function: 146 | ;; 147 | ;; ; This produces a png as an array of bytes 148 | ;; (render graph {:format :png}) 149 | ;; 150 | ;; ; This produces an SVG string 151 | ;; (render graph {:format :svg}) 152 | ;; 153 | ;; ; A one-liner with a very simple 4 node digraph. 154 | ;; (-> (digraph [ [:a :b :c] [:b :d] ]) dot (render {:format :svg})) 155 | ;; 156 | ;; *The dot tool executable must be on the system path* 157 | ;; 158 | ;; other formats include `:pdf`, `:gif`, etc. The result will be either a java byte array, or String depending on whether the format is binary or not. `(render)` returns a string or a byte array depending on whether the output format is binary or not. 159 | ;; 160 | ;; Alternatively, use the `(save!)` function to write to a file or output stream. 161 | ;; 162 | ;; ; A one-liner with a very simple 4 node digraph 163 | ;; (-> (digraph [ [:a :b :c] [:b :d] ]) dot (save! "out.png" {:format :png})) 164 | ;; 165 | ;; Finally, for simple tests, use the `(show!)` function to view the result in a simple Swing viewer: 166 | ;; 167 | ;; ; This opens a simple Swing viewer with the graph 168 | ;; (show! graph) 169 | ;; 170 | ;; ; A one-liner with a very simple 4 node digraph 171 | ;; (-> (digraph [ [:a :b :c] [:b :d] ]) dot show!) 172 | ;; 173 | ;; which shows: 174 | ;; 175 | ;;  176 | ;; 177 | ;; 178 | ;; ## License 179 | ;; 180 | ;; Copyright (C) 2014 Dave Ray 181 | ;; 182 | ;; Distributed under the Eclipse Public License, the same as Clojure. 183 | 184 | (ns dorothy.core 185 | {:doc "A Hiccup-style library for generating graphs with Graphviz. 186 | The functions you want are (graph), (digraph), (subgraph), (dot), 187 | (render), (save!) and (show!). See https://github.com/daveray/dorothy." 188 | :author "Dave Ray"} 189 | (:require [clojure.string :as cs] 190 | #?(:cljs [goog.string :as gstring]))) 191 | 192 | #?(:clj (set! *warn-on-reflection* true)) 193 | 194 | ;; ---------------------------------------------------------------------- 195 | ;; # Utilities 196 | ;; 197 | ;; You know. 198 | 199 | (defn ^:private error 200 | [fmt & args] 201 | (throw (#?(:clj RuntimeException. :cljs js/Error.) 202 | ^String (apply #?(:clj format :cljs gstring/format) fmt args)))) 203 | 204 | ;; ---------------------------------------------------------------------- 205 | ;; # Id Generation 206 | 207 | (defn gen-id 208 | "Node ids are expected to be keywords or strings. Sometimes you have an object 209 | graph where the nodes don't have obvious keyword or string ids. Pass the object 210 | to (gen-id) and a consisten unique id will be generated for the object when the 211 | graph is generated. 212 | 213 | Notes: 214 | Assume the return value of this function is opaque. The impl will change. 215 | 216 | See: 217 | (dorothy.core/gen-id?) 218 | " 219 | [target] 220 | (constantly target)) 221 | 222 | (defn gen-id? 223 | "Returns true if the target was created with (dorothy.core/gen-id)" 224 | [target] (fn? target)) ; hrmmm. 225 | 226 | (defn ^:private id-generator [] 227 | (let [id-map (atom {})] 228 | (fn [target] 229 | (if-let [id (get @id-map target)] 230 | id 231 | (let [id (str (gensym))] 232 | (swap! id-map assoc target id) 233 | id))))) 234 | 235 | ;; ---------------------------------------------------------------------- 236 | ;; # Graphviz DOT AST 237 | ;; 238 | ;; Dorothy represents the unrendered graph with an Abstract Syntax Tree (AST). 239 | ;; Each node in the tree is a map with a `:type` key and other keys that vary 240 | ;; based on the node type. 241 | 242 | (declare to-ast) 243 | 244 | (defn is-ast? 245 | "Returns true if v is an AST node, i.e. has :type. The second form 246 | checks for a particular type. 247 | 248 | Examples: 249 | 250 | (is-ast? {:type ::node}) 251 | ;=> true 252 | 253 | (is-ast? {:type ::node} ::node) 254 | ;=> true 255 | " 256 | ([v] (and (map? v) (contains? v :type))) 257 | ([v type] 258 | (and (is-ast? v) 259 | (if (set? type) 260 | (type (:type v)) 261 | (= type (:type v)))))) 262 | 263 | (defn ^:private check-ast [v type] 264 | (if-not (is-ast? v type) 265 | (error "Expected AST node of type %s" type))) 266 | 267 | 268 | (def ^:private compass-pts #{"n" "ne" "e" "se" "s" "sw" "w" "nw" "c" "_"}) 269 | (defn ^:private check-compass-pt [pt] 270 | (if (or (nil? pt) (compass-pts (name pt))) 271 | pt 272 | (error "Invalid compass point %s" pt))) 273 | 274 | (defn node-id 275 | "Create a node-id. Creates an AST node with :type ::node-id 276 | 277 | Examples: 278 | 279 | (node-id :foo) 280 | ;=> {:dorothy.core/type :dorothy.core/node-id :id :foo} 281 | " 282 | ([id port compass-pt] 283 | { :type ::node-id :id id :port port :compass-pt (check-compass-pt compass-pt) }) 284 | ([id port] 285 | (node-id id port nil)) 286 | ([id] 287 | (node-id id nil nil))) 288 | 289 | (defn ^:private x-attrs [type attrs] { :type type :attrs attrs}) 290 | 291 | (defn graph-attrs 292 | "Create a graph attribute statement. attrs is the attribute map. 293 | 294 | Examples: 295 | 296 | (graph-attrs {:label \"hi\"}) 297 | ;=> {:dorothy.core/type :dorothy.core/graph-attrs :attrs {:label \"hi\"} 298 | " 299 | [attrs] 300 | { :type ::graph-attrs :attrs attrs }) 301 | 302 | (defn node-attrs 303 | "Create a node attribute statement. attrs is the attribute map. 304 | 305 | Examples: 306 | 307 | (node-attrs {:label \"hi\"}) 308 | ;=> {:dorothy.core/type :dorothy.core/node-attrs :attrs {:label \"hi\"} 309 | " 310 | [attrs] 311 | { :type ::node-attrs :attrs attrs }) 312 | 313 | (defn edge-attrs 314 | "Create a edge attribute statement. attrs is the attribute map. 315 | 316 | Examples: 317 | 318 | (edge-attrs {:label \"hi\"}) 319 | ;=> {:dorothy.core/type :dorothy.core/edge-attrs :attrs {:label \"hi\"} 320 | " 321 | [attrs] 322 | { :type ::edge-attrs :attrs attrs }) 323 | 324 | (defn node 325 | "Create a node in a graph. This is a more structured version of the 326 | :node-id or [:node-id { attrs }] sugar for specifying nodes in a graph. Its 327 | result may be used in place of that sugar within a graph specification. 328 | 329 | attrs is a possibly empty map of attributes for the edge 330 | id is the result of (dorothy.core/node-id)" 331 | [attrs id] 332 | (check-ast id ::node-id) 333 | { :type ::node :attrs attrs :id id }) 334 | 335 | (defn edge 336 | "Create an edge. This is a more structured version of the 337 | [:source :target] sugar for specifying edges. Its result may be used in place 338 | of that sugar within a graph specification. 339 | 340 | attrs is a possibly empty map of attributes for the edge. 341 | node-ids is a seq of 2 or more node identifiers. 342 | 343 | See: 344 | (dorothy.core/node-id) 345 | " 346 | [attrs node-ids] 347 | (doseq [n node-ids] (check-ast n #{::node-id ::subgraph})) 348 | { :type ::edge :attrs attrs :node-ids node-ids }) 349 | 350 | (defn graph* 351 | "Create a graph AST node with type `:dorothy.core/graph`. 352 | 353 | opts is an option map with keys `:id` and `:strict?` 354 | statements is a list of statement AST nodes." 355 | [opts statements] 356 | (let [{:keys [id strict?]} opts] 357 | {:type ::graph 358 | :id id 359 | :strict? (boolean strict?) 360 | :statements statements })) 361 | 362 | (derive ::digraph ::graph) 363 | (derive ::subgraph ::graph) 364 | 365 | (defn digraph* 366 | "Same as `(dorothy.core/graph*)` but has type `:dorothy.core/digraph`" 367 | [opts statements] (assoc (graph* opts statements) :type ::digraph)) 368 | 369 | (defn subgraph* 370 | "Same as `(dorothy.core/graph*)` but has type `:dorothy.core/subgraph`" 371 | [opts statements] 372 | (assoc (graph* opts statements) :type ::subgraph)) 373 | 374 | ;; ---------------------------------------------------------------------- 375 | ;; # Dorothy Graph DSL Processing 376 | ;; 377 | ;; Implements the graph DSL described above. 378 | 379 | (defn ^:private vector-to-ast-edge [v] 380 | (let [end (last v) 381 | attrs? (map? end) 382 | attrs (if attrs? end {}) 383 | parts (if attrs? (butlast v) v) 384 | parts (remove #{:>} parts)] 385 | (edge attrs (map to-ast parts)))) 386 | 387 | (defn ^:private vector-to-ast [[v0 v1 & more :as v]] 388 | (cond 389 | more (vector-to-ast-edge v) 390 | (map? v1) (node v1 (to-ast v0)) 391 | v1 (vector-to-ast-edge v) 392 | (is-ast? v0) v0 393 | (map? v0) (graph-attrs v0) 394 | (gen-id? v0) (node {} (node-id v0)) 395 | v0 (node {} (to-ast v0)))) 396 | 397 | (defn ^:private parse-node-id [v] 398 | (apply node-id (cs/split v #":"))) 399 | 400 | (defn ^:private to-ast [v] 401 | (cond 402 | (is-ast? v) v 403 | (qualified-keyword? v) (parse-node-id (str (namespace v) "/" (name v))) 404 | (keyword? v) (parse-node-id (name v) ) 405 | (string? v) (parse-node-id v) 406 | (number? v) (parse-node-id (str v)) 407 | (gen-id? v) (node-id v) 408 | (map? v) (graph-attrs v) 409 | (vector? v) (vector-to-ast v) 410 | :else (error "Don't know what to do with %s" v))) 411 | 412 | (defn ^:private desugar-graph-options 413 | "Turn first arg of (graph) into something usable" 414 | [options] 415 | (cond 416 | (map? options) options 417 | (keyword? options) {:id options} 418 | (number? options) {:id (str options)} 419 | (string? options) {:id options} 420 | :else (error "Invalid graph arg %s" options))) 421 | 422 | (defn ^:private flatten-statements 423 | [ss] 424 | (let [helper (fn [statement] 425 | (cond 426 | (seq? statement) 427 | (flatten-statements statement) 428 | :else 429 | [statement]))] 430 | (mapcat helper ss))) 431 | 432 | (defn graph 433 | "Construct an undirected graph from the given statements which must be a vector. 434 | See https://github.com/daveray/dorothy or README.md for details of the DSL. 435 | 436 | The returned value may be converted to dot language with (dorothy.core/dot)." 437 | ([handler options statements] 438 | (handler (desugar-graph-options options) 439 | (map to-ast (flatten-statements statements)))) 440 | ([options statements] 441 | (graph graph* options statements)) 442 | ([statements] 443 | (graph {} statements))) 444 | 445 | (defn digraph 446 | "Construct a directed graph from the given statements which must be a vector. 447 | See https://github.com/daveray/dorothy or README.md for details of the DSL. 448 | 449 | The returned value may be converted to dot language with (dorothy.core/dot)." 450 | ([attrs statements] (graph digraph* attrs statements)) 451 | ([statements] (digraph {} statements))) 452 | 453 | (defn subgraph 454 | "Construct a sub-graph from the given statements which must be a vector. 455 | See https://github.com/daveray/dorothy or README.md for details of the DSL. 456 | A subgraph may be used as a statement in a graph, or as a node entry in 457 | an edge statement. 458 | 459 | The returned value may be converted to dot language with (dorothy.core/dot)." 460 | ([attrs statements] (graph subgraph* attrs statements)) 461 | ([statements] (subgraph {} statements))) 462 | 463 | ;; ---------------------------------------------------------------------- 464 | ;; # DOT generation 465 | ;; 466 | ;; Generate DOT language from a graph AST. 467 | 468 | (def ^:dynamic ^:private *options* 469 | {:edge-op "->" 470 | :id-generator #(-> % hash str)}) 471 | 472 | ; id's that don't need quotes 473 | (def ^:private safe-id-pattern #"^[_a-zA-Z\u0080-\u0255][_a-zA-Z0-9\u0080-\u0255]*$") 474 | (def ^:private html-pattern #"^\s*<([a-zA-Z1-9_-]+)(\s|>).*\s*$") 475 | 476 | (defn ^:private safe-id? [s] (re-find safe-id-pattern s)) 477 | (defn ^:private html? [s] (re-find html-pattern s)) 478 | (defn ^:private escape-quotes [s] (cs/replace s "\"" "\\\"")) 479 | (defn ^:private escape-id [id attr-name?] 480 | (cond 481 | (string? id) (cond 482 | (and attr-name? (safe-id? id)) id 483 | (html? id) (str \< id \>) 484 | :else (str \" (escape-quotes id) \")) 485 | (number? id) (str id) 486 | (keyword? id) (escape-id (name id) attr-name?) 487 | (gen-id? id) (escape-id ((:id-generator *options*) (id)) attr-name?) 488 | :else (error "Invalid id: %s - %s" (type id) id))) 489 | 490 | (defmulti dot* :type) 491 | 492 | (defn ^:private dot*-statements [statements] 493 | (apply str (interleave (map dot* statements) (repeat ";\n")))) 494 | 495 | (defmethod dot* ::node-id [{:keys [id port compass-pt]}] 496 | (str 497 | (escape-id id true) 498 | (if port (str ":" (escape-id port true))) 499 | (if compass-pt (str ":" (name compass-pt))))) 500 | 501 | (defn dot*-attrs [attrs] 502 | (cs/join 503 | \, 504 | (for [[k v] attrs] 505 | (str (escape-id k true) \= (escape-id v false))))) 506 | 507 | (defn ^:private dot*-trailing-attrs [attrs] 508 | (if-not (empty? attrs) 509 | (str " [" (dot*-attrs attrs) "]"))) 510 | 511 | (defn dot*-x-attrs [type {:keys [attrs]}] 512 | (str type " [" (dot*-attrs attrs) "]")) 513 | 514 | (defmethod dot* ::graph-attrs [this] (dot*-x-attrs "graph" this)) 515 | (defmethod dot* ::node-attrs [this] (dot*-x-attrs "node" this)) 516 | (defmethod dot* ::edge-attrs [this] (dot*-x-attrs "edge" this)) 517 | 518 | (defmethod dot* ::node [{:keys [attrs id]}] 519 | (str (dot* id) (dot*-trailing-attrs attrs))) 520 | 521 | (defmethod dot* ::edge [{:keys [attrs node-ids]}] 522 | (str 523 | (cs/join (str " " (:edge-op *options*) " ") (map dot* node-ids)) 524 | (dot*-trailing-attrs attrs))) 525 | 526 | (defn ^:private options-for-type [type] 527 | (condp = type 528 | ::graph (assoc *options* :edge-op "--") 529 | ::digraph (assoc *options* :edge-op "->") 530 | ::subgraph *options*)) 531 | 532 | (defmethod dot* ::graph [{:keys [id strict? statements] :as this}] 533 | (binding [*options* (merge 534 | (options-for-type (:type this)) 535 | {:id-generator (id-generator)})] 536 | (str (if strict? "strict ") 537 | (name (:type this)) " " 538 | (if id (str (escape-id id false) " ")) 539 | "{\n" (dot*-statements statements) "} "))) 540 | 541 | (defn dot 542 | "Convert the given Dorothy graph AST to a string suitable for input to 543 | the Graphviz dot tool. 544 | 545 | input can either be the result of (graph) or (digraph), or it can be a vector of 546 | statements (see README.md) in which case (graph) is implied. 547 | 548 | Examples: 549 | 550 | user=> (dot (digraph [[:a :b :c]])) 551 | \"digraph { a -> b -> c; }\" 552 | 553 | See: 554 | * `(dorothy.core/render)` 555 | * `(dorothy.core/show!)` 556 | * `(dorothy.core/save!)` 557 | " 558 | [input] 559 | (cond 560 | (is-ast? input) (dot* input) 561 | (vector? input) (dot* (graph input)) 562 | (seq? input) (dot* (graph input)) 563 | :else (error "Invalid (dot) input: %s" input))) 564 | 565 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 566 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 567 | 568 | ;; ---------------------------------------------------------------------- 569 | ;; # Random tests 570 | 571 | (comment 572 | 573 | (println (dot* (node-id "start" "p" :ne))) 574 | (println (dot* (node-id "start" "p"))) 575 | (println (dot* (node {} (node-id :start)))) 576 | (println (dot* (node {:style :filled :color :blue} (node-id :start) ))) 577 | (println (dot* (edge {} [(node-id :start)(node-id :end)]))) 578 | (println (binding [*options* {:edge-op "--"}] 579 | (dot* (edge {:color :grey} [(node-id :start)(node-id :middle :p :_)(node-id :end)])))) 580 | (println (dot* (graph-attrs {:style :filled}))) 581 | (println (dot* (node-attrs {:style :filled, :color :red}))) 582 | (println (dot* (edge-attrs {:style :filled}))) 583 | 584 | (println (dot 585 | (graph 586 | {:id :G :strict? true} 587 | [(edge nil [(node-id "start") (node-id :a0)]) 588 | (edge {:color :green} 589 | [(node-id :a0) 590 | (subgraph [{:style :filled :color :lightgrey :label "Hello"} 591 | (edge {} [(node-id :a) (node-id :b)]) 592 | (edge {} [(node-id :b) (node-id :c)]) ]) 593 | (node-id :a1)]) 594 | (node {:shape :Mdiamond} (node-id :start))]))) 595 | 596 | (println (dot* 597 | (digraph* 598 | ;{:id :G :strict? true} 599 | {} 600 | [(edge nil [(node-id "start") (node-id :a0)]) 601 | (edge {:color :gre_en :text "hello\"there"} [(node-id :a0) (node-id :a1)]) 602 | (node {:shape :Mdiamond} (node-id :start))]))) 603 | 604 | (-> (digraph :G [(for [i (range 5)] 605 | [i :> (inc i)]) 606 | [5 0]]) 607 | dot 608 | show!) 609 | 610 | (-> (digraph :G [ 611 | (subgraph :cluster_0 [ 612 | {:style :filled, :color :lightgrey, :label "process #1"} 613 | [:node {:style :filled, :color :white}] 614 | 615 | [:a0 :> :a1 :> :a2 :> :a3]]) 616 | 617 | (subgraph :cluster_1 [ 618 | {:color :blue, :label "process #2"} 619 | [:node {:style :filled}] 620 | 621 | [:b0 :> :b1 :> :b2 :> :b3]]) 622 | 623 | [:start :a0] 624 | [:start :b0] 625 | [:a1 :b3] 626 | [:b2 :a3] 627 | [:a3 :a0] 628 | [:a3 :end] 629 | [:b3 :end] 630 | 631 | [:start {:shape :Mdiamond}] 632 | [:end {:shape :Msquare}]]) 633 | 634 | dot 635 | show!)) 636 | -------------------------------------------------------------------------------- /src/dorothy/examples/er.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Dave Ray, 2011. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | ; http://www.graphviz.org/content/ER 12 | (ns dorothy.examples.er 13 | (:use dorothy.core)) 14 | 15 | (defn -main [] 16 | (-> 17 | (graph :ER [ 18 | {:rankdir :LR} 19 | 20 | (node-attrs {:shape :box}) 21 | 22 | :course :institute :student 23 | 24 | (node-attrs {:shape :ellipse}) 25 | 26 | (subgraph [ 27 | [:node {:label "name"}] 28 | :name0 :name1 :name2]) 29 | 30 | :code :grade :number 31 | 32 | (node-attrs {:shape :diamond :style :filled :color :lightgrey}) 33 | "C-I" "S-C" "S-I" 34 | 35 | ; Edges 36 | [:name0 :> :course] 37 | [:code :> :course] 38 | [:course :> "C-I" {:label "n" :len 1.00}] 39 | ["C-I" :> :institute {:label "1" :len 1.00}] 40 | [:institute :> :name1] 41 | [:institute :> "S-I" {:label "1" :len 1.00}] 42 | ["S-I" :> :student {:label "n" :len 1.00}] 43 | [:student :> :grade] 44 | [:student :> :name2] 45 | [:student :> :number] 46 | [:student :> "S-C" {:label "m" :len 1.00}] 47 | ["S-C" :> :course {:label "n" :len 1.00}] 48 | 49 | {:label "\n\nEntity Relation Diagram\ndrawn by NEATO" 50 | :fontsize 20} 51 | ]) 52 | dot 53 | (show! {:layout :neato}))) 54 | 55 | -------------------------------------------------------------------------------- /src/dorothy/examples/swing.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Dave Ray, 2011. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | (ns dorothy.examples.swing 12 | (:use dorothy.core) 13 | (:import [javax.swing JPanel JButton JLabel])) 14 | 15 | ; An example of generating a graph from a swing widget hierarchy. 16 | ; Uses the (gen-id) function to generate ids for swing objects. 17 | 18 | (def widgets 19 | (doto (JPanel.) 20 | (.add (JLabel. "First")) 21 | (.add (JButton. "Second")) 22 | (.add (doto (JPanel. ) 23 | (.add (JLabel. "Nested First")) 24 | (.add (JButton. "Nested Second")))) 25 | (.add (JButton. "Third")) 26 | (.add (JLabel. "Fourth")))) 27 | 28 | (defn label-for [v] 29 | (cond 30 | (instance? JButton v) (.getText v) 31 | (instance? JLabel v) (.getText v) 32 | :else (.getSimpleName (class v)))) 33 | 34 | (defn children [p] 35 | (seq (.getComponents p))) 36 | 37 | (defn node-and-edges [p] 38 | (list 39 | [(gen-id p) {:label (label-for p)}] 40 | (for [c (.getComponents p)] 41 | [(gen-id c) :> (gen-id p)]))) 42 | 43 | (defn -main [& args] 44 | (-> (digraph :Swing 45 | (->> (tree-seq children children widgets) 46 | (map node-and-edges))) 47 | dot 48 | show!)) 49 | 50 | (comment 51 | (-main)) 52 | 53 | -------------------------------------------------------------------------------- /src/dorothy/jvm.clj: -------------------------------------------------------------------------------- 1 | (ns dorothy.jvm 2 | (:require [clojure.java.io :as jio])) 3 | 4 | (set! *warn-on-reflection* true) 5 | 6 | ;; ---------------------------------------------------------------------- 7 | ;; # Graph Rendering 8 | ;; Functions responsible for taking a DOT language graph and rendering it 9 | ;; to an image. 10 | 11 | (defn ^:private build-render-command [{:keys [format layout scale invert-y?]}] 12 | (->> 13 | ["dot" 14 | (if format (str "-T" (name format))) 15 | (if layout (str "-K" (name layout))) 16 | (if scale (str "-s" scale)) 17 | (if invert-y? "-y")] 18 | (remove nil?))) 19 | 20 | (defn ^:private ^java.lang.ProcessBuilder init-process-builder 21 | [{:keys [dir] :as options}] 22 | (let [pb (java.lang.ProcessBuilder. ^java.util.List (build-render-command options))] 23 | (when dir (.directory pb (if (instance? java.io.File dir) 24 | dir 25 | (java.io.File. (str dir))))) 26 | pb)) 27 | 28 | (def ^:private binary-formats 29 | #{:bmp :eps :gif :ico :jpg :jpeg :pdf :png :ps :ps2 :svgz :tif :tiff :vmlz :wbmp}) 30 | 31 | (defn ^:private read-dot-result [input-stream {:keys [format binary?]}] 32 | (if (or binary? (binary-formats format)) 33 | (let [result (java.io.ByteArrayOutputStream.)] 34 | (jio/copy input-stream result) 35 | (.toByteArray result)) 36 | (slurp input-stream))) 37 | 38 | (defn render 39 | "Render the given graph (must be the string result of (dorothy.core/dot)) 40 | using the Graphviz 'dot' tool. The 'dot' executable must be on the system 41 | path. 42 | 43 | Depending on the requested format (see options below), returns either a string 44 | or a Java byte array. 45 | 46 | options is a map with the following options: 47 | 48 | :dir The working directory in which dot is executed. Defaults to '.' 49 | :format The desired output format, e.g. :png, :svg. If the output format 50 | is known to be binary, a byte array is returned. 51 | :layout Dot layout algorithm to use. (-K command-line option) 52 | :scale Input scale, defaults to 72.0. (-s command-line option) 53 | :invert-y? If true, y coordinates in output are inverted. (-y command-line option) 54 | 55 | Examples: 56 | 57 | ; Simple 3 node graph, converted to dot and rendered as SVG. 58 | (-> (digraph [[:a :b :c]]) dot (render {:format :svg)) 59 | 60 | See: 61 | 62 | * (dorothy.core/dot) 63 | * http://www.graphviz.org/content/command-line-invocation 64 | * http://www.graphviz.org/content/output-formats 65 | " 66 | [graph options] 67 | (let [p (.start (init-process-builder options)) 68 | from-dot (future (with-open [from-dot (.getInputStream p)] 69 | (read-dot-result from-dot options)))] 70 | (with-open [to-dot (.getOutputStream p)] 71 | (spit to-dot graph)) 72 | @from-dot)) 73 | 74 | (defn save! 75 | "Render and save the given graph (string result of (dorothy.core/dot)) to an 76 | output stream. f is any argument acceptable to (clojure.java.io/ouput-stream). 77 | 78 | Examples: 79 | 80 | ; Write a graph to a png file 81 | (-> (digraph [[:a :b :c]]) 82 | dot 83 | (save! \"out.png\" {:format :png})) 84 | 85 | See: 86 | 87 | * (dorothy.core/render) 88 | * (dorothy.core/dot) 89 | * http://clojure.github.com/clojure/clojure.java.io-api.html#clojure.java.io/make-output-stream 90 | " 91 | [graph f & [options]] 92 | (let [bytes (render graph (merge options {:binary? true}))] 93 | (with-open [output (jio/output-stream f)] 94 | (jio/copy bytes output))) 95 | graph) 96 | 97 | (defonce ^:private frames (atom {})) 98 | 99 | (defn- get-frame [id options] 100 | ((swap! frames (fn [fs] 101 | (if (contains? fs id) 102 | fs 103 | (let [f (javax.swing.JFrame. "Dorothy")] 104 | (.setLocationByPlatform f true) 105 | (assoc fs id f))))) 106 | id)) 107 | 108 | (defn show! 109 | "Show the given graph (must be the string result of (dorothy.core/dot)) in a 110 | new Swing window with scrollbars. Supports same options as 111 | (dorothy.core/render) except that :format is ignored. 112 | 113 | Examples: 114 | 115 | ; Simple 3 node graph, converted to dot and displayed. 116 | (-> (digraph [[:a :b :c]]) dot show!) 117 | 118 | Additional options: 119 | 120 | * :frame supply to reuse frames. 121 | * :frame-width specify maximum frame width. 122 | * :frame-height specify maximum frame width. 123 | 124 | Notes: 125 | 126 | * Closing the resulting frame will not cause the JVM to exit. 127 | 128 | See: 129 | 130 | * `(dorothy.core/render)` 131 | * `(dorothy.core/dot)` 132 | " 133 | [graph & [options]] 134 | (let [id (:frame options (gensym)) 135 | ^javax.swing.JFrame frame (get-frame id options) 136 | shortcut-mask (int (.. java.awt.Toolkit getDefaultToolkit getMenuShortcutKeyMask)) 137 | close-key (javax.swing.KeyStroke/getKeyStroke java.awt.event.KeyEvent/VK_W shortcut-mask) 138 | ^bytes bytes (render graph (merge options {:format :png})) 139 | icon (javax.swing.ImageIcon. bytes) 140 | max-w (:frame-width options 640) 141 | max-h (:frame-height options 480) 142 | w (.getIconWidth icon) 143 | h (.getIconHeight icon) 144 | lbl (javax.swing.JLabel. icon) 145 | sp (javax.swing.JScrollPane. lbl)] 146 | (.. sp getInputMap (put close-key "closeWindow")) 147 | (.. sp getActionMap (put "closeWindow" (proxy [javax.swing.AbstractAction] [] 148 | (actionPerformed [e] 149 | (.setVisible frame false) 150 | (.dispose frame) 151 | (swap! frames dissoc id))))) 152 | (doto frame 153 | (.setTitle (format "Dorothy %s (%dx%d)" id w h)) 154 | (.setContentPane sp) 155 | (.setSize (min max-w (+ w 50)) (min max-h (+ h 50))) 156 | (.setVisible true)) 157 | nil)) 158 | -------------------------------------------------------------------------------- /test/dorothy/test/core.cljc: -------------------------------------------------------------------------------- 1 | (ns dorothy.test.core 2 | (:require [dorothy.core :as d] 3 | [clojure.test :refer [deftest testing is are]])) 4 | 5 | (deftest test-is-ast? 6 | (testing "Returns true for any map with :type" 7 | (is (d/is-ast? {:type :foo})) 8 | (is (not (d/is-ast? 99))) 9 | (is (not (d/is-ast? {})))) 10 | (testing "Checks for a particular type" 11 | (is (d/is-ast? {:type :foo} :foo)) 12 | (is (not (d/is-ast? {:type :foo} :bar)))) 13 | (testing "Checks for one of several types in a set" 14 | (is (d/is-ast? {:type :foo} #{:foo :bar})) 15 | (is (d/is-ast? {:type :bar} #{:foo :bar})) 16 | (is (not (d/is-ast? {:type :yum} #{:foo :bar}))))) 17 | 18 | (deftest test-escape-id 19 | (testing "does nothing to pure ids" 20 | (is (= "_abc123" (#'dorothy.core/escape-id :_abc123))) 21 | (is (= "_abc123" (#'dorothy.core/escape-id "_abc123")))) 22 | (testing "quotes ids with special chars" 23 | (is (= "\"_abc123!\"" (#'dorothy.core/escape-id :_abc123!))) 24 | (is (= "\"_ab\\\"c123\"" (#'dorothy.core/escape-id "_ab\"c123")))) 25 | (testing "surrounds HTML with <>" 26 | (is (= "<>" (#'dorothy.core/escape-id ""))))) 27 | 28 | (deftest html?-can-detect-html-looking-stuff 29 | (is (#'dorothy.core/html? "")) 30 | (is (#'dorothy.core/html? "