├── static
├── bulk_link.png
├── bulk_ignore.png
└── bulk_cluster.png
├── src
└── dottask
│ ├── macros.clj
│ ├── macros.cljs
│ ├── help.cljs
│ ├── core.cljs
│ └── graph.cljs
├── README.md
├── help.html
├── project.clj
├── index.html
└── css
└── style.css
/static/bulk_link.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/mattboehm/dottask/HEAD/static/bulk_link.png
--------------------------------------------------------------------------------
/static/bulk_ignore.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/mattboehm/dottask/HEAD/static/bulk_ignore.png
--------------------------------------------------------------------------------
/static/bulk_cluster.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/mattboehm/dottask/HEAD/static/bulk_cluster.png
--------------------------------------------------------------------------------
/src/dottask/macros.clj:
--------------------------------------------------------------------------------
1 | (ns dottask.macros
2 | )
3 | (defmacro let?
4 | "bindings => binding-form test
5 |
6 | When test is true, evaluates body with binding-form bound to the value of test"
7 | [bindings & body]
8 | (let [newbindings (into [] (mapcat (fn [[label bind]] [label `((fn [x#] (.log js/console "LET" '~label x#) x#) ~bind)] )
9 | (partition 2 bindings)))
10 | ]
11 | `(let ~newbindings ~@body)
12 | )
13 | )
14 |
--------------------------------------------------------------------------------
/src/dottask/macros.cljs:
--------------------------------------------------------------------------------
1 | (ns dottask.macros
2 | )
3 | (defmacro let?
4 | "bindings => binding-form test
5 |
6 | When test is true, evaluates body with binding-form bound to the value of test"
7 | [bindings & body]
8 | (let [newbindings (map-indexed (fn [idx bind]
9 | (if (even? idx)
10 | bind
11 | `((fn [x] (.log js/console "LET" ~idx x) x) ~bind)
12 | )
13 | ))]
14 | `(let ~bindings
15 | ~@body
16 | )
17 | )
18 | )
19 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | Dottask: a directed graph editor for making to-do lists.
2 | Built with clojurescript and viz.js. Currently pre-alpha/experimental.
3 |
4 | Give it a try at http://dottask.mattboehm.rocks
5 |
6 | # Developing
7 |
8 | Install leiningen, cd into the repo and run `lein figwheel dev help`. If using the arrow keys in the repl doesn't work, install rlwrap and run `rlwrap lein figwheel dev help` instead.
9 |
10 | Once running, visit `file:///path/to/repo/index.html` to see the site.
11 |
12 | # Building a new release
13 |
14 | This project is designed to be hosted on gh-pages. To make a new build, check out the `gh-pages` branch, merge master into it, run `lein cljsbuild once release help-release`, and commit the changes.
15 |
--------------------------------------------------------------------------------
/help.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 | 
11 |
12 |
13 |
14 |
15 |
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject dottask "0.1.0-SNAPSHOT"
2 | :dependencies [[org.clojure/clojure "1.7.0"]
3 | [org.clojure/clojurescript "1.7.170"]
4 | [binaryage/devtools "0.5.2"]
5 | [funcool/tubax "0.2.0"]
6 | [historian "1.1.1"]
7 | [reagent "0.5.1"]
8 | [sablono "0.3.6"]]
9 | :plugins [[lein-figwheel "0.5.0-1"]
10 | [lein-cljsbuild "1.1.3"]
11 | [lein-gossip "0.1.0-SNAPSHOT"]]
12 | :clean-targets [:target-path "out"]
13 | :cljsbuild {
14 | :builds [{:id "dev"
15 | :source-paths ["src"]
16 | :figwheel {:on-jsload "dottask.graph/render!"}
17 | :compiler {:main "dottask.graph"}
18 | }
19 | {:id "help"
20 | :source-paths ["src"]
21 | :figwheel {:on-jsload "dottask.help/render!"}
22 | :compiler {:main "dottask.help"
23 | :pretty-print false
24 | :output-to "help.js"}
25 | }
26 | {:id "release"
27 | :source-paths ["src"]
28 | :compiler {
29 | :main "dottask.graph"
30 | :output-to "out/main.js"
31 | :output-dir "out"
32 | :optimizations :advanced
33 | :pretty-print false
34 | :source-map "out/main.js.map"}
35 | }
36 | {:id "help-release"
37 | :source-paths ["src"]
38 | :compiler {
39 | :main "dottask.help"
40 | :output-to "out/help.js"
41 | :output-dir "out"
42 | :optimizations :advanced
43 | :pretty-print false
44 | :source-map "out/help.js.map"}
45 | }
46 | ]
47 | }
48 | :figwheel {
49 | :css-dirs ["css"]
50 | }
51 | )
52 |
53 |
--------------------------------------------------------------------------------
/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
22 |
23 |
24 |
25 |
26 |
27 | DotTaska directed graph editor for making to-do lists
28 |
29 |
30 |
31 |
32 |
33 |
--------------------------------------------------------------------------------
/css/style.css:
--------------------------------------------------------------------------------
1 | .logo {
2 | font-size: 36px;
3 | font-family: monospace;
4 | font-weight: bold;
5 | margin-right: 14px;
6 | color: #66a;
7 | }
8 | .desc {
9 | font-family: sans-serif;
10 | font-size: 14px;
11 | font-style: italic;
12 | }
13 | .description {
14 | border-bottom: 1px solid #aaa;
15 | margin-bottom: 3px;
16 | width: calc(100% - 40px);
17 | }
18 | .hidden {
19 | opacity: 0;
20 | display: None;
21 | }
22 | .dotgraph {
23 | position: absolute;
24 | min-width: 100%;
25 | min-height: calc(100% - 63px);
26 | }
27 | .task-text {
28 | margin-top: 8px;
29 | margin-left: 8px;
30 | padding: 5px;
31 | width: calc(100% - 27px);
32 | height: calc( 100% - 27px);
33 | cursor: text;
34 | color: #333;
35 | font-family: sans-serif;
36 | font-size: 11pt;
37 | text-align: center;
38 | background-color: rgba(255, 255, 255, 0.86);
39 | overflow: hidden;
40 | border-radius: 2px;
41 | user-select: none;
42 | }
43 | body {
44 | background-color: #fefefe;
45 | overscroll-behavior: contain;
46 | }
47 | .graph-overlay {
48 | position: absolute;
49 | top: 0px;
50 | left: 0px;
51 | }
52 | #graph0>polygon{
53 | opacity: 0;
54 | }
55 | span.delete, span.collapse, span.copy{
56 | color: #888;
57 | cursor: pointer;
58 | width: 16px;
59 | text-align: center;
60 | font-size: 14px;
61 | opacity: 0;
62 | transition: opacity 0.2s;
63 | }
64 | .node-overlay>span.delete{
65 | position: absolute;
66 | top: 0px;
67 | right: -1px;
68 | }
69 | div:hover>span.delete{
70 | opacity: 1;
71 | }
72 | div:hover>span.copy{
73 | opacity: 1;
74 | }
75 | div:hover>span.collapse{
76 | opacity: 1;
77 | }
78 | .node-topbar>span.delete{
79 | opacity: 1;
80 | position: absolute;
81 | top: -1px;
82 | right: 0px;
83 | }
84 | .node-topbar>span.copy{
85 | opacity: 1;
86 | position: absolute;
87 | top: -1px;
88 | right: 11px;
89 | }
90 |
91 | .node-overlay .node-bar {
92 | position: absolute;
93 | border: 0.5px solid #999;
94 | background-color: #f8f8f8;
95 | opacity: 0;
96 | transition: 0.4s ease-out;
97 | }
98 | .node-overlay:hover .node-bar {
99 | opacity: 1;
100 | z-index: 20;
101 | border-radius: 2px;
102 | }
103 | .node-overlay .node-topbar {
104 | top: -17.5px;
105 | left: -1px;
106 | width: 27px;
107 | width: 100%;
108 | min-width: 106px;
109 | height: 16px;
110 | }
111 | .node-overlay .color-picker {
112 | position: absolute;
113 | line-height: 11px;
114 | width: 77px;
115 | top: 3px;
116 | left: 4px;
117 | opacity: 0.7;
118 | }
119 | .node-overlay .color-swatch {
120 | opacity: 0;
121 | width: 10px;
122 | height: 10px;
123 | margin-right: 1px;
124 | display: inline-block;
125 | border: 0px solid #999;
126 | border-radius: 2px;
127 | cursor: pointer;
128 | }
129 | .node-overlay:hover .color-swatch {
130 | opacity: 0.8;
131 | }
132 | .node-overlay:hover .color-swatch:hover {
133 | opacity: 1;
134 | }
135 |
136 | .node-overlay .node-resize {
137 | position: absolute;
138 | right: 0;
139 | bottom: 0;
140 | width: 12px;
141 | height: 12px;
142 | cursor: nwse-resize;
143 | border-bottom: double #888;
144 | border-right: double #888;
145 | opacity: 0;
146 | transition: opacity 0.2s;
147 | }
148 | .node-overlay:hover .node-resize {
149 | opacity: 0.8;
150 | }
151 | .node-overlay {
152 | transition: 0.4s ease-in, box-shadow 0.1s ease-out, background-color 0.15s ease-out;
153 | position: absolute;
154 | width: 144px;
155 | height: 72px;
156 | background-color: #C9C9C9;
157 | border: 1px solid #888;
158 | border-radius: 3px;
159 | user-select: none;
160 | padding-top: 0px;
161 | }
162 | .resize-overlay {
163 | position: absolute;
164 | border: 2px dashed #111;
165 | box-shadow: inset 0 0 0px 5000px rgba(255, 255, 255, 0.7), 0 0 0px 5000px rgba(255, 255, 255, 0.7);
166 | z-index: 999;
167 | }
168 | .node-overlay.selected {
169 | box-shadow: 0 0 2px 2.5px #66F;
170 | }
171 | .node-overlay.boxed {
172 | box-shadow: 0 0 1px 3.5px #59d45d;
173 | }
174 | .node-overlay.connected {
175 | box-shadow: 0 0 4px 1px #88F !important;
176 | }
177 | .node-overlay.cluster-node {
178 | cursor: zoom-in;
179 | border-radius: 20px;
180 | box-shadow: inset 0 0 10px 1px #666;
181 | }
182 | .node-overlay.cluster-node.selected {
183 | box-shadow: inset 0 0 10px 1px #666, 0 0 2px 2.5px #66F;
184 | }
185 | .node-overlay.cluster-node.boxed {
186 | box-shadow: inset 0 0 10px 1px #666, 0 0 1px 3.5px #59d45d !important;
187 | }
188 | .node-overlay.cluster-node .task-text {
189 | border-radius: 10px;
190 | margin-top: 14px;
191 | margin-left: 14px;
192 | width: calc(100% - 38px);
193 | height: calc(100% - 38px);
194 | }
195 | .cluster-overlay {
196 | transition: 0.5s ease-in, box-shadow 0.1s ease-out;
197 | user-select: none;
198 | font-family: sans-serif;
199 | font-size: 11pt;
200 | color: #333;
201 | box-shadow: 0 0 0 1px rgba(102, 102, 102, 0.75);
202 | position: absolute;
203 | background-color: rgba(255, 255, 255, 0.75);
204 | height: 18px;
205 | padding-top: 1px;
206 | text-align: center;
207 | }
208 | .cluster-overlay.selected {
209 | box-shadow: 0 0 2px 3.5px #66F;
210 | }
211 | .cluster-overlay.boxed {
212 | box-shadow: 0 0 1px 3.5px #59d45d;
213 | }
214 | .cluster-overlay span.delete {
215 | position: absolute;
216 | right: 0px;
217 | top: 0px;
218 | }
219 | .cluster-overlay span.copy {
220 | position: absolute;
221 | right: 12px;
222 | top: 0px;
223 | }
224 | .cluster-overlay span.collapse {
225 | position: absolute;
226 | right: 24px;
227 | top: 0px;
228 | }
229 | .node polygon {
230 | stroke: rgba(0, 0, 0, 0);
231 | }
232 | .modal-backdrop {
233 | z-index: 900;
234 | position: fixed;
235 | height: 100%;
236 | width: 100%;
237 | top: 0;
238 | left: 0;
239 | background-color: rgba(60, 60, 60, 0.7)
240 | }
241 | .modal-backdrop.hidden>.modal {
242 | opacity: 0;
243 | margin-top: 0px;
244 | }
245 | .modal {
246 | z-index: 1000;
247 | background-color: white;
248 | border: 1px solid #333;
249 | position: relative;
250 | /*top: 80px;*/
251 | /*width: 50%;*/
252 | max-width: calc(100% - 60px);
253 | min-width: 400px;
254 | max-height: calc(100% - 60px);
255 | margin-top: 30px;
256 | /*margin-bottom: auto;*/
257 | margin-left: auto;
258 | margin-right: auto;
259 | opacity: 1;
260 | transition: 0.7s ease-out;
261 | }
262 | .modal-title {
263 | font-size: 18pt;
264 | }
265 | .modal-buttons {
266 | height: 20px;
267 | padding-top: 5px;
268 | }
269 | .x-button {
270 | position: absolute;
271 | top: 0px;
272 | right: 4px;
273 | color: #888;
274 | cursor: pointer;
275 | }
276 | .modal.bulk-modal {
277 | padding: 8px;
278 | max-width: 1000px;
279 | }
280 | .bulk-modal textarea {
281 | width: calc(100% - 8px);
282 | }
283 | .toc {
284 | border: 3px double #666;
285 | padding: 8px;
286 | padding-left: 0px;
287 | width: fit-content;
288 | }
289 | .toc-row, .section {
290 | display: block;
291 | padding-left: 10px;
292 | margin-bottom: 2px;
293 | width: fit-content;
294 | }
295 | .header {margin-left: -10px;}
296 | .section p {
297 | -webkit-margin-before: 0.5em;
298 | -webkit-margin-after: 0.5em;
299 | }
300 | .page {
301 | margin-bottom: 400px;
302 | }
303 | .link-preview {
304 | position: absolute;
305 | height: 100%;
306 | width: 100%;
307 | pointer-events: none;
308 | }
309 | .pv-line {
310 | stroke: #007200;
311 | stroke-width: 2px;
312 | }
313 | .edit-overlay {
314 | position: absolute;
315 | height: 0;
316 | top: 0;
317 | left: 0;
318 | opacity: 0;
319 | transition: opacity 0.45s, height 0.1s 0.6s, width 0.1s 0.6s;
320 | /*display:none;*/
321 | width: 100%;
322 | background: rgba(128, 128, 128, 0.1);
323 | }
324 | .dotgraph.editing .edit-overlay {
325 | height: 100%;
326 | opacity: 1;
327 | /*display:block;*/
328 | transition: opacity 0.45s;
329 | }
330 | .edit-overlay textarea {
331 | display: none;
332 | padding-top: 4px;
333 | position: absolute;
334 | font-family: sans-serif;
335 | font-size: 11pt;
336 | text-align: center;
337 | }
338 | .dotgraph.editing .edit-overlay textarea {
339 | display: block;
340 | }
341 | span.button {
342 | cursor: pointer;
343 | /*border: 1px solid #666;*/
344 | display: inline-block;
345 | padding: 2px;
346 | padding-bottom: 0px;
347 | border-radius: 3px;
348 | margin-right: 2px;
349 | }
350 | span.button:hover {
351 | /*background-color: #f4f4f4;*/
352 | }
353 | .button-bar svg {
354 | margin-top: 1px;
355 | fill: #666;
356 | }
357 | span.button:hover svg, .direction-button:hover svg {
358 | fill: #222;
359 | }
360 | .help-drag [data-help-link] {
361 | box-shadow: 0 0 15px blue, inset 0 0 10px blue;
362 | transition: box-shadow 0.5s 0.2s;
363 | }
364 | .hidden-select {
365 | -webkit-appearance: none;
366 | -moz-appearance: none;
367 | appearance: none;
368 | width: 0px;
369 | height: 0px;
370 | padding-top: 21px;
371 | padding-bottom: 12px;
372 | padding-left: 12px;
373 | padding-right: 19px;
374 | border: none;
375 | background-color: white;
376 | }
377 | .direction-button {
378 | position: relative;
379 | display: inline-block;
380 | }
381 | .direction-button svg {
382 | position: absolute;
383 | left: 0px;
384 | top: 1px;
385 | pointer-events: none;
386 | transition: transform 0.6s;
387 | }
388 | .cluster polygon {
389 | fill: rgba(230, 230, 230, 0.25);
390 | stroke-linejoin: round;
391 | stroke-width: 2.5;
392 | stroke: #999;
393 | }
394 | .cluster>text {
395 | display: none;
396 | }
397 |
--------------------------------------------------------------------------------
/src/dottask/help.cljs:
--------------------------------------------------------------------------------
1 | (ns dottask.help
2 | (:require
3 | [reagent.core :as reagent]
4 | [dottask.core :as core]
5 | )
6 | )
7 |
8 | (def dottask-help [
9 | {:id "toolbar-buttons" :title "Toolbar" :contents [
10 | {:id "add-card" :title "Add a card" :contents ["Click the 'Add card' button to add a new blank card"]}
11 | {:id "bulk-add" :title "Bulk Add" :contents [
12 | "If you want to add multiple cards at the same time, click 'Bulk add' and put each node label on a separate line"
13 | "There are three different modes for handling indented lines. For the examples below, let's look at what happens if the following text were used:"
14 | [:pre "1\n 1.1\n 1.2\n 1.2.1\n 1.2.2"]
15 | {:id "bulk-add-ignore" :title "ignore mode" :contents ["Whitespace is trimmed from the ends and ignored" [:img {:src "static/bulk_ignore.png" :style {:zoom 0.6 :max-width "100%"}}]]}
16 | {:id "bulk-add-link" :title "link mode" :contents ["Parents are linked to their children" [:img {:src "static/bulk_link.png" :style {:zoom 0.6}}]]}
17 | {:id "bulk-add-cluster" :title "cluster mode" :contents ["Parents are turned into clusters that contain their children" [:img {:src "static/bulk_cluster.png" :style {:zoom 0.6}}]]}
18 | ]
19 | }
20 | {:id "delete-all" :title "Delete all" :contents ["Click the 'Delete all' button to delete everything from the graph. This change can still be undone."]}
21 | {:id "saving" :title "Saving" :contents [
22 | "When you click 'Save', the graph's state is serialized and saved to the URL hash."
23 | "You can now bookmark the URL, put it in a shortener, send it to a friend, and more."
24 | "If you save to a URL and update the graph, you need to click save again to get a new URL in order to preserve your changes."
25 | "Some browsers have limits on how long the URL can be that may impact saving. I haven't hit the limit in chrome yet, but be forewarned that it may be possible."
26 | ]
27 | }
28 | {:id "undo-button" :title "Undo/Redo" :contents ["Click the undo/redo buttons to undo/redo changes to the graph. This history is not included with saves."]}
29 | {:id "arrow-dir" :title "Change arrow direction" :contents ["Click this to open a menu to change the primary arrow direction. This also changes the direction you must drag from a node to add new nodes (e.g. if you change the direction to 'right', instead of dragging down to make a linked node below, drag right to make one after)"]}
30 | {:id "export-dot" :title "Export Graphviz Code" :contents ["Clicking this opens up a .dot representation of the graph that can be further edited and rendered with the graphviz application or many online renderers. These .dot representations currently can not be imported back into dottask."]}
31 | {:id "help-button" :title "Help" :contents ["This button opens/closes the help sidebar. You can also drag from this button to any highlighted element to jump to that help section"]}
32 | ]}
33 | {:id "cards" :title "Cards" :contents [
34 | [:div {:style {:display "block" :position "relative"} :class "node-overlay"} [:div {:class "task-text"} "sample card"]]
35 | "Cards (or 'nodes') are the basic units of the graph"
36 | {:id "delete-card" :title "Delete a card" :contents ["Hover over it then clicking the x button that appears in the upper right"]}
37 | {:id "copy-card" :title "Copy a card" :contents ["Clicking the + button creates a copy of the card (same color, text, size, and links)"]}
38 | {:id "card-text" :title "Change card text" :contents ["Click on the light box inside the card" "When done editing, hit enter/escape or click on the area outside the textbox to save changes. You can also hit tab or shift-tab to switch to the next/previous card."]}
39 | {:id "card-color" :title "Change card color" :contents ["Hover over it and click a colored square in the right panel"]}
40 | {:id "card-resize" :title "Resize a card" :contents ["Drag the handle in the lower-right corner"]}
41 | {:id "card-clone" :title "Clone a card" :contents ["Hold down alt and drag from a card to a blank space. This makes a duplicate card with the same text/color/size/links/cluster"]}
42 | ]}
43 | {:id "links" :title "Links" :contents [
44 | "Cards can be linked together"
45 | {:id "link-card" :title "Link/unlink cards" :contents ["Drag the mouse from the source to the target" "To link a card to itself, hold the alt key down while dragging"]}
46 | {:id "link-label" :title "Change link label" :contents ["Hold down shift while dragging from source to target cards"]}
47 | ]}
48 | {:id "card-drag" :title "Add cards via dragging" :contents [
49 | [:span {} "If you already have card A and you know you want to create B then link A -> B, you could do this by " (core/a-link "add-card" "adding the card") " and then " (core/a-link "link-card" "creating the link") ". However, using dragging can be much faster"]
50 | {:id "drag-card" :title "Add card and link it to an existing card" :contents ["Click down on the card and drag your mouse to empty space above/below the card to add a linked card before/after."]}
51 | "If your graph has A->C and you want to change this to A->B->C, you can quickly do this by 'splitting' one of the cards"
52 | {:id "split-card" :title "Split a card" :contents ["Hold down shift while dragging from the card to an empty space before/after"]}
53 | ]}
54 | {:id "clusters" :title "Clusters" :contents [
55 | "Cards can be grouped into clusters which appear as a box with a label. If all of a cluster's contents are deleted, it is removed."
56 | {:id "add-cluster-card" :title "Create a cluster around cards" :contents ["Drag a box around the cards you want clustered. You can also double click on the card's border (outside the white text area)"]}
57 | {:id "add-cluster-cluster" :title "Create a cluster around a cluster" :contents ["Drag from the cluster text to empty space above"]}
58 | {:id "toggle-card-cluster" :title "Add/remove card to/from cluster" :contents ["Drag from the card to the cluster text (or vice versa)"]}
59 | {:id "toggle-cluster-cluster" :title "Add/remove cluster to/from cluster" :contents ["Drag from the child cluster text to the parent cluster text"]}
60 | {:id "collapse-cluster" :title "Collapse a cluster" :contents ["Click the minus sign in the upper right. The cluster is shrunk to look like a card, all its contents are hidden, and any links going in/out of contents of the cluster now go in/out of the cluster card."]}
61 | {:id "expand-cluster" :title "Expand a collapsed cluster" :contents ["Click on its dark border"]}
62 | {:id "delete-cluster" :title "Delete a cluster" :contents ["Click the x in the upper right. If it is collapsed, its contents are also deleted."]}
63 | ]}
64 | {:id "keyboard-shortcuts" :title "Keyboard Shortcuts" :contents [
65 | "Many of the site's actions also have keyboard shortcuts, which may sometimes be faster or more convenient than using a mouse"
66 | {:id "shortcut-selecting" :title "Selecting cards" :contents [
67 | "Many of the shortcuts below act on the selected card. You can select a card by using the following keys:"
68 | [:ul
69 | [:li [:b "j: "] "Select next card"]
70 | [:li [:b "k: "] "Select previous card"]
71 | [:li [:b "Esc: "] "De-select card"]
72 |
73 | ]]}
74 | {:id "shortcut-changing" :title "Changing cards" :contents [
75 | "The following keys allow you to change the selected card (highlighted with a yellow border)"
76 | [:ul
77 | [:li [:b "d: "] "Delete card"]
78 | [:li [:b "enter/e: "] "Edit card text"]
79 | [:li "Change card color:"
80 | [:ul
81 | (map (fn [color] [:li [:b (str (:shortcut color) ": ")] (:name color)]) core/colors)
82 | ]
83 | ]
84 | ]]}
85 | {:id "shortcut-adding" :title "Adding items" :contents [
86 | [:ul
87 | [:li [:b "c: "] (core/a-link "copy-card" "Copy") " a card"]
88 | [:li [:b ": "] "Add card before/after selected one (like " (core/a-link "drag-card" "dragging from a card") ")"]
89 | [:li [:b "-: "] "Link/unlink cards. The first time you hit it, it marks that node as the source. Then select the target node and hit it again to mark the target and create the link"]
90 | ]]}
91 | ]}
92 | ])
93 |
94 | ;[{:id "foo" :title "fooing a bar" :contents ["this is how you foo a bar"]}]
95 | ;anchor-link that scrolls to the element with the given ID
96 | (defn toc-row[sect]
97 | [:div {:class "toc-row"}
98 | (core/a-link (:id sect) (:title sect))
99 | (->>
100 | (:contents sect [])
101 | (filter :contents)
102 | (map toc-row)
103 | )
104 | ]
105 | )
106 | (defn section
107 | ([sect]
108 | (section sect 0))
109 | ([sect level]
110 | (let [tag (if (zero? level) :h3 :b)]
111 | [:div {:id (:id sect) :class "section"}
112 | [tag {:class "header"} (:title sect)]
113 | (map (fn [l]
114 | (if (contains? l :contents)
115 | [section l (inc level)]
116 | [:p {} l]
117 | ))
118 | (:contents sect))])
119 | )
120 | )
121 | (defn page [sections]
122 | (let [state (reagent/atom {})]
123 | (fn []
124 | [:div {:class "page"}
125 | [:div {:class "toc"}
126 | (map toc-row sections)
127 | ]
128 | (map section sections)
129 | ]
130 | )))
131 | (defn render! []
132 | (reagent/render
133 | [page dottask-help]
134 | (.getElementById js/document "help")))
135 | (when (core/get-el "#help")
136 | (render!)
137 | )
138 |
--------------------------------------------------------------------------------
/src/dottask/core.cljs:
--------------------------------------------------------------------------------
1 | (ns dottask.core
2 | (:require
3 | [reagent.core :as reagent]
4 | [clojure.string :as string]
5 | [cljs.reader :as reader]
6 | [devtools.core :as devtools]
7 | [goog.dom :as dom]
8 | [goog.dom.classlist :as classlist]
9 | [goog.events :as events]
10 | [goog.html.SafeHtml :as shtml]
11 | [goog.string :as gstring]
12 | [tubax.core :as tbx])
13 | )
14 | ;; Constants
15 | ;Colors for the nodes. :shortcut is the keyboard shortcut to set selected node that color
16 | (def colors [
17 | {:name "white" :hex "#C9C9C9" :shortcut "w"}
18 | ;After each of these shades, I've included a lighter and darker shade in case I want to change them in the future
19 | {:name "red" :hex "#D1686E" :shortcut "r"}
20 | ;{:name "#A7383D" :hex "#A7383D"}
21 | ;{:name "#FBA7AB" :hex "#FBA7AB"}
22 | {:name "orange" :hex "#D4B06A" :shortcut "o"}
23 | ;{:name "#AA8339" :hex "#AA8339"}
24 | ;{:name "#FFE2AA" :hex "#FFE2AA"}
25 | {:name "yellow" :hex "#D4D36A" :shortcut "y"}
26 | ;{:name "#AAA939" :hex "#AAA939"}
27 | ;{:name "#FFFEAA" :hex "#FFFEAA"}
28 | {:name "green" :hex "#5FAE57" :shortcut "g"}
29 | ;{:name "#378B2E" :hex "#378B2E"}
30 | ;{:name "#92D18B" :hex "#92D18B"}
31 | {:name "blue" :hex "#4E638E" :shortcut "b"}
32 | ;{:name "#2D4471" :hex "#2D4471"}
33 | ;{:name "#7788AA" :hex "#7788AA"}
34 | {:name "violet" :hex "#744B8E" :shortcut "v"}
35 | ;{:name "#562A72" :hex "#562A72"}
36 | ;{:name "#9675AB" :hex "#9675AB"}
37 | ])
38 | (def color-keycode-lookup (zipmap (map :shortcut colors) colors))
39 | ;List of edge directions
40 | (def directions {
41 | :up {
42 | :label "up" ;label to use in dropdown
43 | :dot "BT" ;graphviz rankdir
44 | :coord :y ;x/y axis
45 | :before > ;function to compare x/y coordinates. Returns true if first arg is "before" second
46 | :rotation "0deg" ;how much to rotate the arrow icon
47 | }
48 | :down {
49 | :label "down"
50 | :dot "TB"
51 | :coord :y
52 | :before <
53 | :rotation "180deg"
54 | }
55 | :left {
56 | :label "left"
57 | :dot "RL"
58 | :coord :x
59 | :before >
60 | :rotation "270deg"
61 | }
62 | :right {
63 | :label "right"
64 | :dot "LR"
65 | :coord :x
66 | :before <
67 | :rotation "90deg"
68 | }
69 | })
70 | ;; Utils
71 | (defn debug [result] ;log arg to console and return it
72 | (.log js/console "DEBUG" result)
73 | result
74 | )
75 | (defn prompt [message val] ;Present user with a prompt. val is the default value
76 | (js/prompt message val)
77 | )
78 | (defn toggle [dict key] ;Toggle a dict key true/false
79 | (assoc dict key (not (key dict)))
80 | )
81 | (defn toggler [state key] ;return a func that swaps a state key true/false
82 | (fn []
83 | (swap! state toggle key)
84 | )
85 | )
86 | (defn extent [numbers] ;return the min/max numbers in the seq
87 | { :min (apply min numbers)
88 | :max (apply max numbers)
89 | }
90 | )
91 | (defn map-vals [func hmap] ;map func over the vals of a hash-map
92 | (into {}
93 | (for [[k v] hmap]
94 | [k (func v)]
95 | )
96 | )
97 | )
98 | (defn vmap [& args]
99 | (into [] (apply map args))
100 | )
101 | (defn hesc [text] ;escape html
102 | (.getTypedStringValue (shtml/htmlEscape text))
103 | )
104 | (defn arraylike-to-seq
105 | "some things in js like nodelists and touchlists are not seqable"
106 | [arr]
107 | (let [result-seq (map #(.item arr %) (range (.-length arr)))]
108 | (doall result-seq)))
109 | (defn esc [text] ;escape a string
110 | (gstring/escapeString (str text))
111 | )
112 | (defn changed-touch [evt]
113 | (if (some? (.-changedTouches evt))
114 | (-> evt (.-changedTouches) (aget 0))
115 | nil
116 | )
117 | )
118 | (defn changed-touch-by-id [evt id]
119 | (if (some? (.-changedTouches evt))
120 | (-> evt
121 | (.-changedTouches)
122 | (arraylike-to-seq)
123 | ((partial filter #(= (.-identifier %) id)))
124 | (first)
125 | )
126 | nil
127 | )
128 | )
129 | ; get mouse coordinates of event
130 | (defn coords [evt]
131 | (let [base (if (number? (.-clientX evt))
132 | evt
133 | (changed-touch evt))
134 | ]
135 | {
136 | :x (.-clientX base)
137 | :y (.-clientY base)
138 | }
139 | )
140 | )
141 | ;compare two coordinates and return :before/:after
142 | ;this/other are hash-maps with :x and :y keys
143 | ;direction is val from the directions constant
144 | (defn compare-coords [this other direction]
145 | (let [coord (:coord direction)
146 | before (:before direction)]
147 | (if (before (coord this) (coord other)) :before :after)
148 | )
149 | )
150 | (defn coords-dist [this other]
151 | (let [dx (- (:x this) (:x other))
152 | dy (- (:y this) (:y other))
153 | square #(* % %)]
154 | (js/Math.sqrt (+ (square dx) (square dy)))
155 | )
156 | )
157 | (defn bounding-rect [points]
158 | {:x (extent (map :x points))
159 | :y (extent (map :y points))
160 | }
161 | )
162 | (defn ranges-overlap? [range1 range2]
163 | (<= (max (:min range1) (:min range2)) (min (:max range1) (:max range2)))
164 | )
165 | (defn rects-overlap? [r1 r2]
166 | (and
167 | (ranges-overlap? (:x r1) (:x r2))
168 | (ranges-overlap? (:y r1) (:y r2))
169 | )
170 | )
171 | (defn translate-rect [r x y]
172 | {
173 | :x {
174 | :min (+ x (get-in r [:x :min]))
175 | :max (+ x (get-in r [:x :max]))
176 | }
177 | :y {
178 | :min (+ y (get-in r [:y :min]))
179 | :max (+ y (get-in r [:y :max]))
180 | }
181 | }
182 | )
183 | ;take a map of keys to lists of vals and invert to a map of each val to its key
184 | ;{:odd [1 3] :even [2 4]} -> {1 :odd 3 :odd 2 :even 4 :even}
185 | (defn invert-list-map [hmap]
186 | (into
187 | {}
188 | (map
189 | (fn [item]
190 | (map (fn [val] [val (first item)]) (second item))
191 | )
192 | hmap
193 | )
194 | )
195 | )
196 | (defn get-node [nodes id]
197 | (first (filter #(= id (:id %)) nodes))
198 | )
199 | ;get a node's width/height, using the proper defaults if they're not set
200 | (defn get-node-dim [node dim]
201 | (case dim
202 | :width (or (:width node) 2)
203 | :height (or (:height node) 1.2)
204 | )
205 | )
206 | (defn node-in-link? [node-id link]
207 | (contains? (->> (subvec link 0 2) (apply hash-set)) node-id))
208 | (defn get-el [selector]
209 | (.querySelector js/document selector)
210 | )
211 | (defn jump-to-anchor [id]
212 | (js/setTimeout (fn [] (->> (str "#" id) (get-el) (.scrollIntoView) )) 1)
213 | )
214 | ;get the node id off of a clicked element. looks it up via the data-nodeid html attribute
215 | (defn el->nodeid [el]
216 | (let [node (dom/getAncestorByClass el "node-overlay")
217 | node-id (when node (.getAttribute node "data-nodeid"))
218 | ]
219 | node-id
220 | )
221 | )
222 | ;get the cluster id off of a clicked element. looks it up via the data-nodeid html attribute
223 | (defn el->clusterid [el]
224 | (let [cluster (dom/getAncestorByClass el "cluster-overlay")
225 | clusternode (dom/getAncestorByClass el "cluster-node")
226 | cluster-id (or
227 | (when cluster (.getAttribute cluster "data-clusterid"))
228 | (when clusternode (.getAttribute clusternode "data-nodeid"))
229 | )
230 | ]
231 | cluster-id
232 | )
233 | )
234 | (defn center [point]
235 | {:x (/ (+ (get-in point [:x :min]) (get-in point [:x :max])) 2)
236 | :y (/ (+ (get-in point [:y :min]) (get-in point [:y :max])) 2)
237 | }
238 | )
239 | (defn width [rect]
240 | (- (get-in rect [:x :max]) (get-in rect [:x :min])))
241 | (defn height [rect]
242 | (- (get-in rect [:y :max]) (get-in rect [:y :min])))
243 | (defn rad->deg [rad]
244 | (-> rad
245 | (* 180)
246 | (/ Math.PI)))
247 | (defn get-angle [start end]
248 | (->
249 | (Math/atan2 (- (:y end) (:y start)) (- (:x end) (:x start)))
250 | (rad->deg)
251 | )
252 | )
253 | (defn polygon-points
254 | ([start moves]
255 | (polygon-points start moves [start])
256 | )
257 | ([start moves so-far]
258 | (if (not-empty moves)
259 | (polygon-points start (rest moves) (conj so-far (vec (map + (last so-far) (first moves)))))
260 | (clojure.string/join " " (map (partial clojure.string/join ",") (conj so-far start)))
261 | )
262 | )
263 |
264 | )
265 | ;; Basic components
266 | (defn btn [opts contents]
267 | [:span (merge {:class "button"} opts) contents]
268 | )
269 | (defn icon
270 | ([name size]
271 | (icon name size {})
272 | )
273 | ([name size style]
274 | [:svg {:style (merge {:width size :height size} style)} [:use {:href (str "#" name)}]]
275 | ))
276 | (defn modal [is-visible? close! options contents]
277 | [:div {
278 | :on-click (fn [e] (when (classlist/contains (.-target e) "modal-backdrop") (close!)))
279 | :class (str "modal-backdrop" (if (is-visible?) "" " hidden"))}
280 | [:div {:class (str "modal " (:class options ""))}
281 | [:span {:class "x-button" :on-click close!} "×"]
282 | contents
283 | ]
284 | ]
285 | )
286 | (defn keyed-modal [state modal-key options contents]
287 | (modal
288 | (fn [] (modal-key @state))
289 | (toggler state modal-key)
290 | options
291 | contents
292 | )
293 | )
294 | (defn text-area [value attrs]
295 | [:textarea (merge {
296 | :rows 20
297 | :value @value
298 | :on-change #(reset! value (-> % .-target .-value))} attrs)])
299 | (defn a-link
300 | ([id text]
301 | (a-link id text nil)
302 | )
303 | ([id text func]
304 | [:a {
305 | :href "javascript:"
306 | :on-click (fn [] (when func (func)) (jump-to-anchor id))}
307 | text]
308 | ))
309 |
--------------------------------------------------------------------------------
/src/dottask/graph.cljs:
--------------------------------------------------------------------------------
1 | (ns dottask.graph
2 | (:require
3 | [dottask.help :as help]
4 | [dottask.core :as core]
5 | [reagent.core :as reagent]
6 | [clojure.string :as string]
7 | [clojure.set :as cset]
8 | [cljs.reader :as reader]
9 | [devtools.core :as devtools]
10 | [goog.dom :as dom]
11 | [goog.dom.classlist :as classlist]
12 | [goog.events :as events]
13 | [goog.html.SafeHtml :as shtml]
14 | [goog.string :as gstring]
15 | [historian.core :as hist]
16 | [dottask.macros :as macros]
17 | [tubax.core :as tbx])
18 | (:require-macros
19 | [historian.core :as hist]
20 | [dottask.macros :as macros]
21 | )
22 | (:import [goog.events EventType])
23 | )
24 | ;; Constants
25 | (def ppi 72); pixels per inch
26 | ;; State
27 | ;All of the main application state is saved here
28 | ;undo/redo toggles between versions of this state
29 | (defonce app-state (reagent/atom {
30 | :id-counter 6 ;used to genereate unique id's for nodes/clusters
31 | :nodes [
32 | { :id "node1" :text "Drag things" }
33 | { :id "node2" :text "Make nodes" }
34 | { :id "node3" :text "Make links" }
35 | { :id "node4" :text "???" }
36 | { :id "node5" :text "Profit!" }
37 | ]
38 | :direction :down ;link direction. is a key of 'directions' constant.
39 | :clusters {} ;map of cluster id's to the clusters
40 | :selected-node-id nil
41 | :toggle-link-node-id nil
42 | ;list of edges. Edges are a vec of [source_id target_id (label)]
43 | :deps [["node1" "node2"] ["node1" "node3"] ["node2" "node4"] ["node3" "node4"] ["node4" "node5"]]
44 | :dot nil ; graphviz representation
45 | :svg "" ;svg output of graphviz
46 | :gnodes nil;nodes extracted from graphviz
47 | }))
48 | ; Holds the state of the current ui (whether popups are visible, etc)
49 | ; This is separate from the app-state because we don't want undo/redo to toggle popups, only the graph state
50 | (defonce ui-state (reagent/atom {
51 | :bulk-add-modal-visible? false ;setting this to true makes the bulk add modal pop up
52 | :help-visible? false
53 | :resize-points nil ;while dragging the node resize handle, this stores size for the node (upper left corner is node's upper left, bottom right is position of the mouse). When this is set, a preview of the new node is rendered.
54 | ;:resize-points {:x {:min 162, :max 326}, :y {:min -452, :max -316}}
55 | :preview-points nil ;while dragging from a node, the start/end point of the drag. Used to show a preview of the action being taken (link/unlink, new node above/below, add/remove from cluster)
56 | :edit-node-id nil ;node whose text is currently being edited
57 | :connected-nodes #{}
58 | }))
59 | ;; Save/Load state
60 | ;keys of app-state to save in the hash. the rest can be computed from this.
61 | (def state-to-save [:id-counter :direction :clusters :nodes :deps])
62 | ;save the state to the url hash
63 | (defn save-hash [state]
64 | (aset js/window "location" "hash" (js/encodeURIComponent(pr-str(select-keys state state-to-save))))
65 | )
66 | (defn load-hash [state]
67 | ;load the state from the url hash (done on page load)
68 | (merge state (reader/read-string (js/decodeURIComponent (apply str (rest (aget js/window "location" "hash"))))))
69 | )
70 | ;; Make graph
71 | ; get a map of all collapsed cluster id's to their contents
72 | ; we want to figure out all the nodes/clusters that are inside a collapsed cluster
73 | ; to do this, we start with all the nodes/clusters not inside a cluster, then recursively descend inside those clusters' contents and keep going until we've walked everything
74 | (defn get-hidden-ids
75 | ([nodes clusters]
76 | ;we start by looking at all the nodes/clusters that are not inside another cluster, then will be recursively descending into clusters' contents
77 | (get-hidden-ids nodes clusters (group-by :cluster-id nodes) (group-by :cluster-id (vals clusters)) nil nil)
78 | )
79 | ;called once per each cluster
80 | ;cluster-id: current cluster being walked
81 | ;collapsed-parent-id if an ancestor to this cluster is collopsed, set to its id
82 | ([nodes clusters nodes-by-cluster-id clusters-by-cluster-id cluster-id collapsed-parent-id]
83 | (let [
84 | ;collapsed-id is the id of the collapsed parent (nil if no parent cluster is collapsed)
85 | collapsed-id (or collapsed-parent-id (when (and cluster-id (get-in clusters [cluster-id :collapsed])) cluster-id))
86 | ;map of all direct child nodes that are hidden (empty if not collapsed)
87 | hidden-children (if collapsed-id
88 | {collapsed-id (map :id (get nodes-by-cluster-id cluster-id))}
89 | {})
90 | ;map of all deeper descendands (chilren of child clusters) that are hidden
91 | nested-maps (map (fn[child-cluster] (get-hidden-ids nodes clusters nodes-by-cluster-id clusters-by-cluster-id (:id child-cluster) collapsed-id)) (get clusters-by-cluster-id cluster-id))
92 | ;combine direct/deeper children into one map
93 | result (apply merge-with concat hidden-children nested-maps)
94 | ]
95 | result
96 | )
97 | )
98 | )
99 | ;If a cluster is collapsed, all its contents are hidden and any edges to/from those contents should instead be linked to the node that represents the collapsed cluster
100 | (defn fix-deps [deps hidden-ids]
101 | ;rename-lookup maps node id's to the collapsed cluster id's
102 | (let [rename-lookup (core/invert-list-map hidden-ids)]
103 | (->>
104 | deps
105 | (map #(replace rename-lookup %))
106 | ;remove things that link the clusters to themselves
107 | (remove
108 | #(and
109 | (= (first %) (second %))
110 | (get hidden-ids (first %))
111 | )
112 | )
113 | (distinct)
114 | (into [])
115 | )
116 | )
117 | )
118 | ;Get dot representation of the node. label passed separately because sometimes we want to hide labels for nodes (don't want them on the svg layer of the graph)
119 | (defn node->dot
120 | ([node] (node->dot node ""))
121 | ([node label]
122 | (str (:id node) "[label=\"" (core/esc label) "\" color=\"" (or (:color node) "#666666") "\" height=\"" (core/get-node-dim node :height) "\" width=\"" (core/get-node-dim node :width) "\"];")
123 | )
124 | )
125 | ;Get dot representation for a cluster and all of its contents
126 | ;if cluster-id is nil, returns representation of all nodes/clusters in the graph
127 | (defn cluster->dot [cluster-id clusters nodes-by-cluster-id clusters-by-cluster-id hidden-ids]
128 | (let [cluster (get clusters cluster-id)
129 | label (str (:text cluster) " ")]
130 | (if (:collapsed cluster)
131 | (node->dot {:id cluster-id} label)
132 | (str
133 | "\nsubgraph " (or cluster-id "root") "{\n" ;we put all the nodes/clusters inside a 'root' subgraph (mostly because it makes code cleaner)
134 | "label=\"" (core/esc label) "\";\n "
135 | "color=\"#666666\";\n "
136 | "fontsize=\"20\";\n "
137 | ;All the child clusters
138 | (clojure.string/join "\n" (map #(cluster->dot % clusters nodes-by-cluster-id clusters-by-cluster-id hidden-ids) (map :id (get clusters-by-cluster-id cluster-id))))
139 | "\n"
140 | ;All the nodes in this cluster
141 | (clojure.string/join ";\n" (map :id (get nodes-by-cluster-id cluster-id)))
142 | "}\n"
143 | )
144 | )
145 | )
146 | )
147 | ;Convert an entire graph to its dot representation
148 | ;direction: val from 'directions' global
149 | (defn graph->dot [nodes deps clusters direction labels?]
150 | (let [
151 | nodes-by-cluster-id (group-by :cluster-id nodes)
152 | clusters-by-cluster-id (group-by :cluster-id (vals clusters))
153 | hidden-ids (get-hidden-ids nodes clusters)
154 | hidden-id-set (set (flatten (vals hidden-ids)))
155 | ]
156 | (str
157 | "digraph \"\" {\n"
158 | "dpi=" ppi ";\n"
159 | "rankdir=" (:dot direction) ";\n" ;direction
160 | "node [label=\"\" shape=\"rect\" penwidth=\"4\"]\n" ;default node attributes
161 | "edge [color=\"#555555\"]\n" ;default edge attributes
162 | (cluster->dot nil clusters nodes-by-cluster-id clusters-by-cluster-id hidden-ids)
163 | (->>
164 | (concat
165 | (map #(node->dot % (if labels? (:text %) "")) (remove #(contains? hidden-id-set (:id %)) nodes))
166 | (map #(str (first %) "->" (second %) "[label=\"" (nth % 2 nil) "\"];") (fix-deps deps hidden-ids))
167 | )
168 | (interpose "\n")
169 | (apply str)
170 | )
171 | "}"
172 | )
173 | )
174 | )
175 |
176 | ;get the bounding box for points
177 | (defn get-points [cljdotnode]
178 | (let [points
179 | (->>
180 | cljdotnode
181 | :content
182 | second
183 | :attributes
184 | :points
185 | )
186 | ]
187 | (->>
188 | (string/split points #" ")
189 | (map #(string/split % #","))
190 | (map #(map js/parseInt %))
191 | (apply map vector);zip
192 | (map core/extent)
193 | (zipmap [:x :y])
194 | )
195 | )
196 | )
197 | (defn get-cljdot-id [item]
198 | (->>
199 | item
200 | :content
201 | first
202 | :content
203 | first
204 | )
205 | )
206 | ;extract nodes/clusters from the graphviz svg
207 | (defn svg->gdata [svg]
208 | (let [cljdot (tbx/xml->clj svg)
209 | items (->>
210 | cljdot
211 | :content
212 | first
213 | :content
214 | )
215 | clusters (->>
216 | items
217 | (filter #(= (:class(:attributes %)) "cluster"))
218 | (map (fn [cluster]
219 | {
220 | :id (get-cljdot-id cluster)
221 | :points (get-points cluster)
222 | :type :cluster
223 | }
224 | ))
225 | )
226 | ]
227 | (into
228 | (->>
229 | items
230 | (filter #(= (:class(:attributes %)) "node"))
231 | (map (fn [node]
232 | {
233 | :id (get-cljdot-id node)
234 | :points (get-points node)
235 | :type :node
236 | }
237 | ))
238 | )
239 | clusters)
240 | )
241 | )
242 |
243 | (defn dot->svg [dot]
244 | (string/replace;TODO replacing pt with px globally might be too general
245 | (js/Viz dot (js-obj "format" "svg"))
246 | #"pt\""
247 | "px\""
248 | )
249 | )
250 | ;; Rerender/ update state
251 | ;Whenever you change the nodes, deps, etc, you need to re-generate the graph
252 | (defn update-state [state]
253 | (let [
254 | dot (graph->dot (:nodes state) (:deps state) (:clusters state) ((:direction state) core/directions) false)
255 | same-graph (= dot (:dot state));if the dot is the same, don't need to re-calc svg/gdata
256 | svg (if same-graph (:svg state) (dot->svg dot))
257 | gnodes
258 | (if same-graph
259 | (:gnodes state)
260 | (svg->gdata svg)
261 | )
262 | ]
263 | (assoc state :dot dot :svg svg
264 | ;add the nodes from :nodes state to the gdata version.
265 | ;even if the dot representation hasn't changed, we want to always update this.
266 | :gnodes (mapv
267 | #(assoc %
268 | :node (core/get-node (:nodes state) (:id %))
269 | :cluster (get-in state [:clusters (:id %)]) )
270 | gnodes)
271 | )
272 | )
273 | )
274 |
275 | ;Decorate a function to make it update the actual app-state and re-render the whole page
276 | (defn rerender! [updater]
277 | (fn [& args]
278 | (apply (partial swap! app-state (comp update-state updater)) args)
279 | )
280 | )
281 | ;;State changers
282 | (defn set-direction [state dirkey]
283 | (assoc state :direction dirkey)
284 | )
285 | ; util: pass the node with id=node-id through func
286 | (defn update-node [state node-id func]
287 | (assoc state :nodes
288 | (mapv
289 | (fn [node] (if (= (:id node) node-id) (func node) node))
290 | (:nodes state)
291 | )
292 | )
293 | )
294 | (defn rename-node [state node-id text]
295 | (update-node state node-id #(assoc % :text text))
296 | )
297 | (defn resize-node [state node-id width height]
298 | (let [ height-pt (/ height ppi)
299 | width-pt (/ width ppi)
300 | ]
301 | (update-node state node-id #(assoc % :width width-pt :height height-pt))
302 | )
303 | )
304 | (defn recolor-node [state node-id color]
305 | (update-node state node-id #(assoc % :color color))
306 | )
307 | (defn recluster-node [state node-id cluster-id]
308 | (update-node state node-id #(assoc % :cluster-id cluster-id))
309 | )
310 | (defn select-node [state node-id]
311 | (assoc state :selected-node-id node-id)
312 | )
313 | (defn get-next-node-id [state direction current]
314 | (let [gdata (:gnodes state)
315 | positioned-nodes (sort (map (fn [node] ; [[y x id]...]
316 | (vector
317 | (if (= (:type node) :node)
318 | (apply + (vals (get-in node [:points :y]))); nodes sorted by the midpoint for the height
319 | (* 2 (get-in node [:points :y :min])); clusters sorted by top point
320 | )
321 | (get-in node [:points :x :min])
322 | (:id node)
323 | ))
324 | gdata))
325 | node-index (apply hash-map (apply concat (map-indexed (fn [idx node] [(nth node 2) idx]) positioned-nodes)))
326 | old-index (get node-index current)
327 | new-index (if (nil? current) 0 (mod (+ old-index direction) (count positioned-nodes)))
328 | new-node (nth positioned-nodes new-index)
329 | new-node-id (nth new-node 2)
330 | ]
331 | new-node-id
332 | )
333 | )
334 | (defn select-next-node
335 | ([state] (select-next-node state 1))
336 | ;direction = 1/-1 for forwards/backwards
337 | ([state direction]
338 | (assoc state :selected-node-id (get-next-node-id state direction (:selected-node-id state)))
339 | )
340 | )
341 | (defn edit-next [ui-state state direction]
342 | (assoc ui-state :edit-node-id (get-next-node-id state direction (:edit-node-id ui-state)))
343 | )
344 | (defn delete-node [state id]
345 | (let [
346 | new-nodes (filterv #(not= id (:id %)) (:nodes state))
347 | new-deps (filterv (fn [dep] (every? (partial not= id) dep)) (:deps state))
348 | new-state (assoc state :nodes new-nodes :deps new-deps)
349 | ]
350 | (if (= id (:selected-node-id state)) (select-next-node new-state) new-state)
351 | )
352 | )
353 | (defn delete-nodes [state ids]
354 | (reduce delete-node state ids)
355 | )
356 | (defn delete-all [state]
357 | (assoc state :nodes [] :deps [] :clusters {} :selected-node-id nil)
358 | )
359 | ;befores/afters are id's of nodes that should have edges coming into/out of this node
360 | (defn add-node
361 | ( [state befores afters]
362 | (add-node state befores afters "")
363 | )
364 | ( [state befores afters text]
365 | (add-node state befores afters text false)
366 | )
367 | ( [state befores afters text return-id?]
368 | (let [
369 | new_node_id (str "node" (:id-counter state))
370 | new_node {:id new_node_id :text text}
371 | new_nodes (conj (:nodes state) new_node)
372 | all_deps (reduce into (:deps state) [
373 | (map #(vector % (:id new_node)) befores)
374 | (map #(vector (:id new_node) %) afters)
375 | ]
376 | )
377 | new_state (assoc state :nodes new_nodes :deps all_deps :selected-node-id new_node_id :id-counter (inc (:id-counter state)))
378 | ]
379 | (if return-id?
380 | [new_state new_node_id]
381 | new_state
382 | )
383 | )
384 | )
385 | )
386 | (defn clone-node [state node-id]
387 | (let [node (core/get-node (:nodes state) node-id)
388 | new-node-id (str "node" (:id-counter state))
389 | new-node (assoc node :id new-node-id)
390 | sub (fn [id] (if (= id node-id) new-node-id id))
391 | new-deps (->> (:deps state)
392 | (filter (partial core/node-in-link? node-id))
393 | (map #(into (core/vmap sub (take 2 %)) (drop 2 %)))
394 | )
395 | ]
396 | (assoc state :nodes (conj (:nodes state) new-node) :deps (into (:deps state) new-deps) :id-counter (inc (:id-counter state)))))
397 | (defn inside-cluster? [clusters child parent-id]
398 | (cond
399 | (nil? (:cluster-id child)) false
400 | (= parent-id (:cluster-id child)) true
401 | :else (inside-cluster? clusters (get clusters (:cluster-id child)) parent-id)
402 | )
403 | )
404 | ; return true if any of the nodes/clusters in children are inside of parent-id cluster (even if deeply nested)
405 | (defn any-inside-cluster? [clusters children parent-id]
406 | (some #(inside-cluster? clusters % parent-id) children)
407 | )
408 | ; return true if any of the nodes/clusters in children are inside of parent-id cluster (even if deeply nested)
409 | (defn inside-any-cluster? [clusters child parent-ids]
410 | (some #(inside-cluster? clusters child %) parent-ids)
411 | )
412 | ; return a set of clusters containing any of the nodes/clusters in children
413 | (defn clusters-containing [clusters children]
414 | (->>
415 | (keys clusters)
416 | (map #(when (any-inside-cluster? clusters children %) %))
417 | (filter identity)
418 | (into #{})
419 | )
420 | )
421 | ; get all ids for clusters who have all their contained node-ids in `node-ids` (including if it's nested in a deeper cluster)
422 | (defn get-contained-cluster-ids [clusters nodes node-ids]
423 | (let [
424 | collapsed-cluster-ids (->>
425 | node-ids
426 | (map #(get clusters %))
427 | (filter identity)
428 | (map :id)
429 | (into #{}))
430 | collapsed-cluster-nodes (->>
431 | (map :id nodes)
432 | (filter #(inside-any-cluster?
433 | clusters
434 | (core/get-node nodes %)
435 | collapsed-cluster-ids))
436 | (into #{})
437 | )
438 | node-id-set (->>
439 | (clojure.set/difference (set node-ids) collapsed-cluster-ids)
440 | (clojure.set/union collapsed-cluster-nodes)
441 | )
442 | included-nodes (map #(core/get-node nodes %) node-id-set)
443 | other-nodes (->> nodes
444 | (remove #(contains? node-id-set (:id %)))
445 | )
446 | included (clusters-containing clusters included-nodes)
447 | excluded (clusters-containing clusters other-nodes)
448 | ]
449 | (clojure.set/union
450 | (clojure.set/difference included excluded)
451 | collapsed-cluster-ids
452 | )
453 | )
454 | )
455 | (defn clone-cluster [state cluster-id]
456 | (let [{id-counter :id-counter nodes :nodes clusters :clusters deps :deps} state
457 | clusters-to-clone (->>
458 | (vals clusters)
459 | (filter #(inside-cluster? clusters % cluster-id))
460 | (into [(get clusters cluster-id)])
461 | )
462 | cluster-clone-ids (set (map :id clusters-to-clone))
463 | update-id #(str % "_" id-counter)
464 | update-cluster-id #(if (contains? cluster-clone-ids %) (update-id %) %)
465 | new-clusters (->>
466 | clusters-to-clone
467 | (map #(update-in % [:id] update-id))
468 | (map #(update-in % [:cluster-id] update-cluster-id))
469 | )
470 | new-cluster-map (zipmap (map :id new-clusters) new-clusters)
471 | nodes-to-clone (->>
472 | nodes
473 | (filter #(inside-cluster? clusters % cluster-id))
474 | )
475 | new-nodes (->>
476 | nodes-to-clone
477 | (map #(update-in % [:id] update-id))
478 | (map #(update-in % [:cluster-id] update-cluster-id))
479 | )
480 | node-clone-ids (set (map :id nodes-to-clone))
481 | update-node-id #(if (contains? node-clone-ids %) (update-id %) %)
482 | new-deps (->>
483 | deps
484 | (filter #(not-empty (clojure.set/intersection (set (subvec % 0 2)) node-clone-ids)))
485 | (map #(assoc % 0 (update-node-id (first %)) 1 (update-node-id (second %))))
486 | )
487 |
488 | ]
489 | (assoc state
490 | :nodes (into nodes new-nodes)
491 | :deps (into deps new-deps)
492 | :clusters (merge clusters new-cluster-map)
493 | :id-counter (inc id-counter))
494 | )
495 | )
496 | (defn clone-item [state item-id]
497 | (if (get-in state [:clusters item-id])
498 | (clone-cluster state item-id)
499 | (clone-node state item-id)
500 | )
501 | )
502 | ;make the node/cluster a direct child of cluter with id=parent-id.
503 | ;does nothing if the intended parent is already nested inside the child, as this is impossible
504 | ;if the child is already a direct child of parent, remove it from the cluster instead
505 | (defn toggle-cluster-nesting [state child-id parent-id]
506 | (if (inside-cluster? (:clusters state) (get-in state [:clusters parent-id]) child-id)
507 | state ;parent is inside the child; do nothing and return
508 | (assoc-in state [:clusters child-id :cluster-id]
509 | (if (= parent-id (get-in state [:clusters child-id :cluster-id]))
510 | nil
511 | parent-id
512 | )
513 | )
514 | )
515 | )
516 | (defn add-cluster
517 | ([state node-ids]
518 | (add-cluster state (core/prompt "Enter a name for the box" "") node-ids)
519 | )
520 | ([state text node-ids]
521 | (add-cluster state text node-ids false)
522 | )
523 | ([state text node-ids return-id?]
524 | (let [
525 | {id-counter :id-counter clusters :clusters nodes :nodes} state
526 | cluster-id (str "cluster_" id-counter)
527 | contained-cluster-ids (get-contained-cluster-ids clusters nodes node-ids)
528 | cluster-ids-to-recluster (->> contained-cluster-ids
529 | (map #(get clusters %))
530 | (remove #(contains? contained-cluster-ids (:cluster-id %)))
531 | (map :id))
532 | nodes-to-recluster (->> node-ids
533 | (map #(core/get-node nodes %))
534 | (remove #(contains? contained-cluster-ids (:cluster-id %)))
535 | (map :id)
536 | )
537 | new-state (reduce
538 | #(recluster-node %1 %2 cluster-id)
539 | (assoc state :clusters (assoc (:clusters state) cluster-id {:id cluster-id :text text :collapsed false}) :selected-node-id cluster-id :id-counter (inc (:id-counter state)))
540 | nodes-to-recluster
541 | )
542 | new-state-with-clusters (reduce
543 | #(toggle-cluster-nesting %1 %2 cluster-id)
544 | new-state
545 | cluster-ids-to-recluster
546 | )
547 | ]
548 | (if return-id?
549 | [new-state-with-clusters cluster-id]
550 | new-state-with-clusters
551 | )
552 | )
553 | )
554 | )
555 | (defn edit-node! [node-id]
556 | (swap! ui-state assoc :edit-node-id node-id)
557 | (js/setTimeout (fn [] (
558 | (let [textbox (.querySelector js/document ".edit-overlay textarea")]
559 | (.focus textbox)
560 | (.select textbox)
561 | )
562 | )))
563 | )
564 | ;delete a cluster (and its contents if 'delete-contents?')
565 | (defn delete-cluster
566 | ([state id] (delete-cluster state id false))
567 | ([state id delete-contents?]
568 | (let [
569 | parent-id (get-in state [:clusters id :cluster-id]); id of the parent cluster of the one to be deleted
570 | wipe-id #(if (= (:cluster-id %) id) (assoc % :cluster-id parent-id) %)
571 | new-state (assoc state
572 | :nodes (map wipe-id (:nodes state))
573 | :clusters (core/map-vals wipe-id (dissoc (:clusters state) id))
574 | )
575 | nodes-to-delete (when delete-contents? (filter #(inside-cluster? (:clusters state) % id) (:nodes state)))
576 | ]
577 | (delete-nodes new-state (map :id nodes-to-delete))
578 | )
579 | )
580 | )
581 | (defn rename-cluster [state cluster-id name]
582 | (assoc-in state [:clusters cluster-id :text] name)
583 | )
584 | (defn rename-cluster-prompt [state cluster-id]
585 | (if (get-in state [:clusters cluster-id])
586 | (let [new-name (core/prompt "Enter new name" (get-in state [:clusters cluster-id :text]))]
587 | (if new-name
588 | (rename-cluster state cluster-id new-name)
589 | state
590 | )
591 | )
592 | state
593 | )
594 | )
595 | ;make a cluster 'around' the given one (happens when users drag up from a cluster)
596 | (defn outer-cluster-prompt [state inner-cluster-id]
597 | (let [[new-state new-id] (add-cluster state "" [] true)
598 | ]
599 | (edit-node! new-id)
600 | (toggle-cluster-nesting new-state inner-cluster-id (str "cluster_" (:id-counter state)))
601 | )
602 | )
603 | (defn toggle-node-cluster [state node-id cluster-id]
604 | (let [new-cluster-id (if (= cluster-id (:cluster-id (core/get-node (:nodes state) node-id))) "" cluster-id)]
605 | (recluster-node state node-id new-cluster-id)
606 | )
607 | )
608 | ;move the deps from one node to another. called when users shift-drag to split a node into two
609 | ;dep-type can be :before :after or :both
610 | (defn move-deps
611 | ( [deps old-node-id new-node-id dep-type]
612 | (move-deps deps old-node-id new-node-id
613 | (or (= dep-type :before) (= dep-type :both))
614 | (or (= dep-type :after) (= dep-type :both))
615 | )
616 | )
617 | ( [deps old-node-id new-node-id move-befores move-afters]
618 | (map (fn [dep]
619 | (cond
620 | (and move-befores (= (second dep) old-node-id))
621 | [(first dep) new-node-id]
622 | (and move-afters (= (first dep) old-node-id))
623 | [new-node-id (second dep)]
624 | :else
625 | dep
626 | )
627 | )
628 | deps)
629 | ))
630 | ;split a node into two.
631 | ;if you have a->c and realize you want a->b->c, you can either split the a and add b after it or split c and add b before.
632 | ;new-node-pos is :before or :after
633 | (defn split-node [state node-id new-node-pos]
634 | (let [
635 | nodes (:nodes state)
636 | node (core/get-node nodes node-id)
637 | new-node-id (str "node" (:id-counter state))
638 | new_node {:id new-node-id :cluster-id (:cluster-id node) :text ""}
639 | new_nodes (conj nodes new_node)
640 | new_deps (move-deps (:deps state) node-id new-node-id new-node-pos)
641 | final_deps (conj new_deps (if (= new-node-pos :before) [new-node-id node-id] [node-id new-node-id]))
642 | ]
643 | (assoc state :nodes new_nodes :deps final_deps :id-counter (inc (:id-counter state)))
644 | ))
645 | ;add a new node (possibly splitting).
646 | ;called when a user drags from a node and lifts up in a blank area
647 | ;if the user held shift, 'split?' will be true
648 | (defn add-or-split-node [state node-id position split?]
649 | (if split?
650 | (split-node state node-id position)
651 | (if (= position :before)
652 | (add-node state [] [node-id])
653 | (add-node state [node-id] [])
654 | )
655 | )
656 | )
657 | (defn find-dep [state dep]
658 | (first (filter #(= (take 2 %) (take 2 dep)) (:deps state)))
659 | )
660 | ;add/remove a dep
661 | (defn toggle-dep [state dep]
662 | (let [found (find-dep state dep)]
663 | (update-in state [:deps]
664 | (fn [deps]
665 | (if (nth dep 2 nil)
666 | ;The dep has a label, so replace any existing src-tgt dep with this labeled one
667 | (->
668 | (remove #(= % found) deps)
669 | (conj dep)
670 | )
671 | ;No label. Remove the dep if it exists, else add it
672 | (if found
673 | (remove #(= % found) deps)
674 | (conj deps dep)
675 | )
676 | )
677 | )
678 | )
679 | )
680 | )
681 | ;toggle a dep and clear :toggle-link-node-id
682 | (defn toggle-dep-clear [state dep]
683 | (assoc (toggle-dep state dep) :toggle-link-node-id nil)
684 | )
685 | (defn on-toggle-dep-click [state node-id label]
686 | (let [last-clicked-id (:toggle-link-node-id state)]
687 | (if (nil? last-clicked-id)
688 | (assoc state :toggle-link-node-id node-id)
689 | (if (= last-clicked-id node-id)
690 | (assoc state :toggle-link-node-id nil)
691 | (toggle-dep-clear state [last-clicked-id node-id label])
692 | )
693 | )
694 | )
695 | )
696 | ;; Event Handlers
697 | ;when a user lifts their mouse after dragging from a node
698 | ;creates new node, splits node, toggles link, or toggles clustering depending on the target
699 | (defn node-mouseup [src-node-id src-coords direction move-keys]
700 | (fn [e]
701 | (swap! ui-state assoc :preview-points nil)
702 | (when move-keys (doseq [move-key move-keys] (events/unlistenByKey move-key)))
703 | (let [
704 | tgt-coords (core/coords e)
705 | node-id (core/el->nodeid (.elementFromPoint js/document (:x tgt-coords) (:y tgt-coords)))
706 | cluster-id (core/el->clusterid (.elementFromPoint js/document (:x tgt-coords) (:y tgt-coords)))
707 | shift-key (.-shiftKey e)
708 | alt-key (.-altKey e)
709 | ]
710 | (cond
711 | ;On a node that's not a collapsed cluster. link to it.
712 | (and node-id (> (core/coords-dist src-coords tgt-coords) 5) (not= node-id cluster-id))
713 | ((rerender! toggle-dep-clear) [src-node-id node-id (if shift-key (core/prompt "Enter link text:" "") nil)])
714 | ;On a cluster. add/remove node from cluster
715 | cluster-id
716 | ((rerender! toggle-node-cluster) src-node-id cluster-id)
717 | ;On blank space. Add a new node before/after if the drag target is before/after the source
718 | alt-key
719 | ((rerender! clone-node) src-node-id)
720 | (nil? node-id)
721 | ((rerender! add-or-split-node) src-node-id (core/compare-coords tgt-coords src-coords (direction core/directions)) shift-key)
722 | )
723 | )
724 | )
725 | )
726 | (defn add-and-name-node! [state befores afters cluster-id]
727 | (let [[new-state new-id] (add-node state befores afters "" true)]
728 | (edit-node! new-id)
729 | (if cluster-id
730 | (recluster-node new-state new-id cluster-id)
731 | new-state
732 | )
733 | )
734 | )
735 | ;when a user lifts their mouse after dragging from a cluster
736 | (defn cluster-mouseup [src-cluster-id down-event, move-keys]
737 | (let [src-y (.-clientY down-event)]
738 | (fn [e]
739 | (swap! ui-state assoc :preview-points nil)
740 | (when move-keys (doseq [move-key move-keys] (events/unlistenByKey move-key)))
741 | (let [
742 | tgt-coords (core/coords e)
743 | node-id (core/el->nodeid (.elementFromPoint js/document (:x tgt-coords) (:y tgt-coords)))
744 | cluster-id (core/el->clusterid (.elementFromPoint js/document (:x tgt-coords) (:y tgt-coords)))
745 | ;shift-key (.-shiftKey down-event)
746 | ]
747 | (if node-id
748 | ;target is a nede; put that node inside this cluster
749 | ((rerender! toggle-node-cluster) node-id src-cluster-id)
750 | (when (not= cluster-id src-cluster-id);do nothing if on the same cluster the drag started on
751 | (if cluster-id
752 | ;on a different cluster, nest this one inside it
753 | ((rerender! toggle-cluster-nesting) src-cluster-id cluster-id)
754 | ;If not on a node/cluster, make a new node/cluster outside of this one
755 | (if (.-altKey e)
756 | ((rerender! clone-cluster) src-cluster-id)
757 | (if (< (.-clientY e) src-y)
758 | ((rerender! outer-cluster-prompt) src-cluster-id)
759 | ((rerender! add-and-name-node!) [] [] src-cluster-id)
760 | )
761 | )
762 | )
763 | )
764 | )
765 | )
766 | ))
767 | )
768 | (defn resize-mouse [target move-keys]
769 | ;This function is called when the user is dragging/releasing the mouse after clicking the resize handle
770 | ;If this was called on a drag event, move-key will be nil (otherwise it's a seq of IDs of event handlers that should be unregistered)
771 | ;While the mouse is dragging, this updates a placeholder's location by swapping ui-state
772 | ;When the mouse is lifted, this updates the actual node and relays the graph
773 | (fn [e]
774 | (let [ node( dom/getAncestorByClass target "node-overlay")
775 | container (dom/getAncestorByClass target "dotgraph")
776 | bounds (.getBoundingClientRect node)
777 | ctop (.-top (.getBoundingClientRect container))
778 | width (max (- (.-clientX e) (.-left bounds)) 35)
779 | height (max (- (.-clientY e) (.-top bounds)) 35)
780 | node-id (core/el->nodeid target)
781 | ]
782 | (if move-keys
783 | ;Mouse lifted: update actual node and clear the resize placeholder
784 | (do
785 | (doseq [key move-keys] (events/unlistenByKey key))
786 | ((rerender! resize-node) node-id width height)
787 | (swap! ui-state assoc :resize-points nil :resize-label "")
788 | )
789 | ;Mouse dragged: udpate the size of the resize placeholder
790 | (swap! ui-state (fn [state] (-> state (assoc-in [:resize-points :x :max] (+ width (get-in state [:resize-points :x :min]))) (assoc-in [:resize-points :y :max] (+ height (get-in state [:resize-points :y :min]))))))
791 | )
792 | )
793 | )
794 | )
795 | (defn get-textbox-style [gnode x-offset y-offset]
796 |
797 | (let [ width (core/width (:points gnode))
798 | height (core/height (:points gnode))
799 | ]
800 |
801 | (if (= (:type gnode) :node)
802 | {:top (str (+ 8 y-offset (get-in gnode [:points :y :min])) "px")
803 | :left (str (+ 8 x-offset (get-in gnode [:points :x :min])) "px")
804 | :width (str (- width 20) "px")
805 | :height (str (- height 22) "px")
806 | }
807 | {:top (str (+ y-offset 1 (get-in gnode [:points :y :min])) "px")
808 | :left (str (+ x-offset 1 (get-in gnode [:points :x :min])) "px")
809 | :width (str (- width 8) "px")
810 | :height "15px"
811 | :padding-top "0px"
812 | }
813 | )
814 | )
815 | )
816 | (defn graph-coords [target e]
817 | (let [ container (dom/getAncestorByClass target "dotgraph")
818 | bounds (.getBoundingClientRect container)
819 | base (if (number? (.-clientX e))
820 | e
821 | (core/changed-touch e))
822 | ]
823 | {:x (- (.-clientX base) (.-left bounds))
824 | :y (- (.-clientY base) (.-top bounds))}
825 | )
826 | )
827 | (defn link-preview [target start-touch-event]
828 | (fn [e]
829 | (when (or (nil? start-touch-event) (some? (core/changed-touch-by-id (.-event_ e) (.-identifier start-touch-event))))
830 | (let [
831 | tgt-coords (core/coords e)
832 | node-id (core/el->nodeid (.elementFromPoint js/document (:x tgt-coords) (:y tgt-coords)))
833 | cluster-id (core/el->clusterid (.elementFromPoint js/document (:x tgt-coords) (:y tgt-coords)))
834 | ]
835 | (swap! ui-state (fn [state] (->
836 | state
837 | (assoc-in [:preview-points :shift-key] (.-shiftKey e))
838 | (assoc-in [:preview-points :alt-key] (.-altKey e))
839 | (assoc-in [:preview-points :end] (graph-coords target e))
840 | (assoc-in [:preview-points :end-node-id] node-id)
841 | (assoc-in [:preview-points :end-cluster-id] cluster-id))))
842 | )
843 | )
844 | )
845 | )
846 | (defn help-mouseup [e]
847 | (swap! ui-state assoc :help-drag false)
848 | (let [help-node (dom/getAncestor (.-target e) #(and (.-hasAttribute %) (.hasAttribute % "data-help-link")) true)]
849 | (when help-node
850 | (swap! ui-state assoc :help-visible? true)
851 | (core/jump-to-anchor (.getAttribute help-node "data-help-link"))
852 | )
853 | )
854 | )
855 | (defn help-mousedown [e]
856 | (events/listenOnce js/window (array EventType.MOUSEUP EventType.TOUCHEND) help-mouseup)
857 | (swap! ui-state assoc :help-drag true)
858 | )
859 | ;ui-state is the atom
860 | (defn node-mousedown [e state ui-state]
861 | (when (or (= (.-type e) "touchstart") (= (.-button e) 0 ))
862 | (.preventDefault e)
863 | (let [target (.-target e)
864 | node-id (core/el->nodeid target)
865 | gnode (core/get-node (:gnodes state) node-id)
866 | direction (:direction state)
867 | ]
868 | (if (classlist/contains (.-target e) "node-resize")
869 | (let [move-keys (core/vmap #(events/listen js/window % (resize-mouse (.-target e) nil)) [EventType.MOUSEMOVE EventType.TOUCHMOVE])] ;draw a preview of the resized node and register the handler for when the mouse is lifted
870 |
871 | (swap! ui-state assoc :resize-points (:points gnode) :resize-label (get-in gnode [:node :text]))
872 | (events/listenOnce js/window (array EventType.MOUSEUP EventType.TOUCHEND) (resize-mouse target move-keys))
873 | )
874 | (let [move-keys (core/vmap #(events/listen js/window % (link-preview (.-target e) (core/changed-touch e))) [EventType.MOUSEMOVE EventType.TOUCHMOVE])
875 | start-point (graph-coords target e)]
876 | (swap! ui-state assoc :preview-points {:start start-point :end start-point :start-node-id node-id :end-node-id node-id})
877 | (events/listenOnce js/window (array EventType.MOUSEUP EventType.TOUCHEND) (node-mouseup (.getAttribute (dom/getAncestorByClass (.-target e) "node-overlay") "data-nodeid") (core/coords e) direction move-keys))
878 | )
879 | )
880 | )
881 | false
882 | )
883 | )
884 | (defn cluster-mousedown [e]
885 | (when (or (= (.-type e) "touchstart") (= (.-button e) 0 ))
886 | (.preventDefault e)
887 | (let [target (.-target e)
888 | cluster-id (core/el->clusterid target)
889 | move-keys (core/vmap #(events/listen js/window % (link-preview (.-target e) (core/changed-touch e))) [EventType.MOUSEMOVE EventType.TOUCHMOVE])
890 | start-point (graph-coords target e)
891 | ]
892 | (swap! ui-state assoc :preview-points {:start start-point :end start-point :start-cluster-id cluster-id :end-cluster-id cluster-id})
893 | (events/listenOnce
894 | js/window
895 | (array EventType.MOUSEUP EventType.TOUCHEND)
896 | (cluster-mouseup
897 | (.getAttribute (dom/getAncestorByClass (.-target e) "cluster-overlay") "data-clusterid")
898 | e
899 | move-keys
900 | ))
901 | )
902 | false
903 | )
904 | )
905 | (defn graph-mousemove [ui-state]
906 | (fn [e]
907 | (swap! ui-state assoc-in [:cluster-points :end] (graph-coords (.-target e) e))
908 | )
909 | )
910 | (defn graph-mouseup [ui-state move-key]
911 | (fn [e]
912 | (events/unlistenByKey move-key)
913 | (let [
914 | els (core/arraylike-to-seq (.querySelectorAll js/document ".node-overlay.boxed"))
915 | node-ids (map core/el->nodeid els)
916 | pts (:cluster-points @ui-state)
917 | ]
918 | (when (and (not-empty node-ids)
919 | (> (core/coords-dist (:start pts) (:end pts)) 1));Need to do this to prevent expanding clusters from triggering a cluster (graph mouseup handler)
920 | ((rerender! add-cluster) node-ids))
921 | )
922 | (swap! ui-state assoc :cluster-points nil)
923 | )
924 | )
925 | (defn graph-mousedown [e state ui-state]
926 | (when (and
927 | (not (:edit-node-id @ui-state))
928 | (or (= (.-type e) "touchstart") (= (.-button e) 0 )))
929 | (let [coords (graph-coords (.-target e) e)]
930 | (swap! ui-state assoc :cluster-points {:start coords :end coords})
931 | (let [move-key (events/listen js/window EventType.MOUSEMOVE (graph-mousemove ui-state))]
932 | (events/listenOnce js/window EventType.MOUSEUP (graph-mouseup ui-state move-key))
933 | )
934 | )
935 | )
936 | )
937 | (defn edit-done!
938 | ([gnode text]
939 | (edit-done! gnode text nil)
940 | )
941 | ([gnode text select-id]
942 | (edit-node! select-id)
943 | (if (or (= (:type gnode) :cluster) (:cluster gnode))
944 | ((rerender! rename-cluster) (get-in gnode [:cluster :id]) text)
945 | ((rerender! rename-node) (:id gnode) text)
946 | )
947 | )
948 | )
949 | ;; Bulk add
950 | (defn parse-line [index line]
951 | (let [clean (clojure.string/triml line)
952 | indentation (- (count line) (count clean))
953 | ]
954 | {
955 | :idx index
956 | :orig line
957 | :clean clean
958 | :indent indentation
959 | }
960 | ))
961 | (defn add-parents ; go through a seq of parsed lines and for each indented line, add a :parent key with the idx of their parent
962 | ;the parent is the closest line above the current line that is indented at a lower level.
963 | ([parsed-lines]
964 | (let [line (first parsed-lines)]
965 | (add-parents (rest parsed-lines) {(:indent line) (:idx line)} [line])))
966 | ([parsed-lines indent-parents result]
967 | (if (empty? parsed-lines)
968 | result
969 | (let [line (first parsed-lines)
970 | indent (:indent line)
971 | ; get the highest index with a lower indentation
972 | parent (->>
973 | indent-parents
974 | (filter (fn [[k v]] (< k indent)))
975 | (map second)
976 | (apply max)
977 | )
978 | ]
979 | (add-parents
980 | (rest parsed-lines)
981 | (assoc indent-parents indent (:idx line))
982 | (conj result (assoc line :parent parent)
983 | ))))))
984 | (defn mark-parents [parsed]
985 | (let [pars (set (map :parent parsed)) ]
986 | (map (fn [line] (assoc line :is-parent? (contains? pars (:idx line)))) parsed)
987 | )
988 | )
989 | (defn dot->state [state dot]
990 | (let [json (js/Viz dot (js-obj "format" "json"))
991 | data (js->clj (.parse js/JSON json) :keywordize-keys true)
992 | objects (->>
993 | (:objects data)
994 | (filter #(contains? % :_draw_))
995 | )
996 | nodes (->>
997 | objects
998 | (remove #(contains? % :nodes))
999 | (into [])
1000 | )
1001 | [st node-lookup] (reduce (fn [[st lookup] node]
1002 | (let [label (if (= (:label node) "\\N") (:name node) (:label node))
1003 | [newst node-id] (add-node st [] [] label true)
1004 | newlookup (assoc lookup (:_gvid node) node-id)]
1005 | [newst newlookup]))
1006 | [state {}]
1007 | nodes)
1008 | clusters (->>
1009 | objects
1010 | (filter #(or (contains? % :nodes) (contains? % :subgraphs)))
1011 | (sort-by (comp - count :nodes))
1012 | )
1013 | [st2 cluster-lookup] (reduce (fn[[st lookup] cluster]
1014 | (let [[newst cluster-id] (add-cluster st (:label cluster) (map node-lookup (:nodes cluster)) true)
1015 | newlookup (assoc lookup (:_gvid cluster) cluster-id)]
1016 | [newst newlookup] ))
1017 | [st {}]
1018 | clusters)
1019 | cluster-nestings (mapcat #(map (fn [cl] [(:_gvid %) cl]) (:subgraphs %)) clusters)
1020 | st3 (reduce (fn [st [parent-id child-id]]
1021 | (toggle-cluster-nesting st (cluster-lookup child-id) (cluster-lookup parent-id)))
1022 | st2
1023 | cluster-nestings)
1024 | edges (->>
1025 | (:edges data)
1026 | (map (fn [x] [(node-lookup (:tail x)) (node-lookup (:head x))]))
1027 | )
1028 | st4 (assoc st3 :deps (into (:deps st3) edges))
1029 | ]
1030 | st4
1031 | )
1032 | )
1033 | (defn parse-bulk-add [text]
1034 | (let [
1035 | lines (remove empty? (clojure.string/split-lines text))
1036 | parsed (map-indexed parse-line lines)
1037 | ]
1038 | (mark-parents (add-parents parsed))
1039 | )
1040 | )
1041 | ;XXX this algorithm relies on parents appearing before all their children
1042 | ; go through all the parsed lines and add all new nodes/links/clusters to the graph depending on the mode:
1043 | ; "ignore": add all lines as nodes and ignore indentation
1044 | ; "cluster": lines at higher indentation become clusters that contain their children
1045 | ; "link": lines at higher indentation are linked to all their direct children
1046 | (defn add-lines
1047 | ([state lines mode] (add-lines state lines mode {}))
1048 | ([state lines mode id-lookup]
1049 | ; id-lookup maps lines' :idx to the ID's of the nodes/clusters created so we can use that ID for linking/clustering of the children
1050 | (let [
1051 | line (first lines)
1052 | ]
1053 | (if (nil? line) ;if we've gone through all the lines, return
1054 | state
1055 | (let [
1056 | text (:clean line)
1057 | parent-id (get id-lookup (:parent line))
1058 | [new-state new-id] (if (and (= mode "cluster") (:is-parent? line))
1059 | (add-cluster state text [] true) ;in cluster mode, parent lines are clusters
1060 | (add-node state [] [] text true)) ;in all other cases, the current line becomes a node
1061 | final-state (cond ;if this node has a parent, add them to that parent cluster or link to the parent node
1062 | (and (= mode "cluster") parent-id)
1063 | (if (:is-parent? line)
1064 | (toggle-cluster-nesting new-state new-id parent-id)
1065 | (recluster-node new-state new-id parent-id)
1066 | )
1067 | (and (= mode "link") parent-id)
1068 | (toggle-dep new-state [parent-id new-id])
1069 | :else
1070 | new-state
1071 | )
1072 | ]
1073 | (add-lines final-state (rest lines) mode (assoc id-lookup (:idx line) new-id))
1074 | )
1075 | )
1076 | )
1077 | )
1078 | )
1079 | (defn bulk-add-modal [ui-state]
1080 | (let [bulk-text (reagent/atom ""); the text in the textbox
1081 | mode (reagent/atom "")]; how to handle indentation. See parse-bulk-add for a description of the modes
1082 | (fn []
1083 | (core/keyed-modal ui-state :bulk-add-modal-visible? {:class "bulk-modal"}
1084 | [:div
1085 | [:div {:class "modal-title"} "Bulk Add"]
1086 | [:div "Add a line of text for each node you want created " [core/a-link "bulk-add" "help" #(swap! ui-state assoc :help-visible? true)]]
1087 |
1088 | [:select {:value @mode :on-change #(reset! mode (-> % .-target .-value))}
1089 | [:option {:value "ignore"} "ignore"]
1090 | [:option {:value "link"} "link"]
1091 | [:option {:value "cluster"} "cluster"]
1092 | [:option {:value "graphviz"} "graphviz"]
1093 | ]
1094 | [core/text-area bulk-text {}]
1095 | [:div {:class "modal-buttons"}
1096 | [:button
1097 | {
1098 | :style {:display "inline-block" :float "right"}
1099 | :on-click #(
1100 | ((core/toggler ui-state :bulk-add-modal-visible?))
1101 | (if (= @mode "graphviz")
1102 | ((rerender! dot->state) @bulk-text)
1103 | ((rerender! (fn [state] (->
1104 | state
1105 | (add-lines (parse-bulk-add @bulk-text) @mode)
1106 | ))))))}
1107 | "Add nodes"]
1108 | ]
1109 | ]
1110 | )
1111 | )
1112 | )
1113 | )
1114 | (defn toolbar [state ui-state]
1115 | [:div {:class "button-bar"}
1116 | [core/btn {:title "Add node" :data-help-link "add-card" :on-click #((rerender! add-node) [] [])} [core/icon "plus" "30px"]]
1117 | [core/btn {:title "Bulk add" :data-help-link "bulk-add" :on-click (core/toggler ui-state :bulk-add-modal-visible?)} [core/icon "list-alt" "30px"]]
1118 | [core/btn {:title "Delete all" :data-help-link "delete-all" :on-click #((rerender! delete-all))} [core/icon "trash" "30px"]]
1119 | [core/btn {:title "Save" :data-help-link "saving" :on-click #(save-hash state)} [core/icon "save" "30px"]]
1120 | [core/btn {:title "Undo" :data-help-link "undo-button" :on-click hist/undo! :style (when-not (hist/can-undo?) {:cursor "default" :opacity "0.3"})} [core/icon "undo" "30px"]]
1121 | [core/btn {:title "Redo" :data-help-link "undo-button" :on-click hist/redo! :style (when-not (hist/can-redo?) {:cursor "default" :opacity "0.3"})} [core/icon "undo" "30px" {:transform "scale(-1, 1)"}]]
1122 | [:div {:title "Change arrow direction" :class "direction-button" :data-help-link "arrow-dir"}
1123 | [:select {:class "hidden-select" :value (:label ((:direction state) core/directions)) :on-change #((rerender! set-direction) (keyword (-> % .-target .-value)))} (map (fn [[dirkey dir]] [:option {:key dirkey :value dirkey :on-click #((rerender! set-direction) dirkey)} [core/icon "plus" "16px"](:label dir)]) core/directions)]
1124 | [core/icon "arrow-circle-up" "30px" {:transform (str "rotate(" (:rotation ((:direction state) core/directions)) ")")}]
1125 | ]
1126 | [core/btn {:title "Export to dot format" :data-help-link "export-dot" :on-click #(let [w (js/window.open)] (.write (.-document w) (str "" (core/hesc (graph->dot (:nodes state) (:deps state) (:clusters state) ((:direction state) core/directions) true)) "
")))} [core/icon "file-code" "30px"]]
1127 | [core/btn {:title "Help. Try dragging from me to highlighted elements!" :on-touch-start help-mousedown :on-mouse-down help-mousedown :on-click (core/toggler ui-state :help-visible?)} [core/icon "question" "30px"]]
1128 | ]
1129 | )
1130 | (defn graph [state]
1131 | (let [[_ x-offset y-offset]
1132 | (map js/parseInt (re-find #"translate\(([\d.]+) ([\d.]+)\)" (:svg state)))
1133 | cluster-node-ids
1134 | (if (:cluster-points @ui-state)
1135 | (->> (:gnodes state)
1136 | (filter #(= (:type %) :node))
1137 | (filter (fn [node] (core/rects-overlap?
1138 | (core/translate-rect (:points node) x-offset y-offset)
1139 | (core/bounding-rect (-> @ui-state (:cluster-points) (vals) ))))
1140 | )
1141 | (map :id)
1142 | (into #{})
1143 | )
1144 | #{}
1145 | )
1146 | boxed-clusters (get-contained-cluster-ids (:clusters state) (:nodes state) cluster-node-ids)
1147 | ]
1148 | [:div
1149 | {:class (when (:help-drag @ui-state) " help-drag") :on-key-press #(.log js/console %)}
1150 | [toolbar state ui-state]
1151 | [:div {:class (str "help-window" (when-not (:help-visible? @ui-state) " hidden")) :style {:position "fixed" :right "0px" :width "35%" :height "100%" :z-index "99999" :background-color "#f6f6f6" :padding "10px" :box-shadow "0 0 8px 2px #666" :border "1px solid #666"}}
1152 | [:div {:style {:position "relative" :width "100%" :text-align "right" :padding-right "20px"}}
1153 | [:a {:href "./help.html" :target "_blank" :on-click (core/toggler ui-state :help-visible?)} "Pop out"]
1154 | " "
1155 | [:a {:href "javascript:" :on-click (core/toggler ui-state :help-visible?)} "Close"]
1156 | ]
1157 | [:div {:style {:overflow-y "auto" :height "100%"}}
1158 | [help/page help/dottask-help]
1159 | ]
1160 | ]
1161 | [bulk-add-modal ui-state]
1162 | [:div {:class (str "dotgraph" (when (:edit-node-id @ui-state) " editing") )
1163 | ;:on-click #(when (= (.-nodeName (.-target %)) "polygon") ((rerender! add-node) [] []))
1164 | :on-mouse-down #(graph-mousedown % state ui-state)
1165 | }
1166 | [:div {:class "graph-overlay"}
1167 | ;Resize overlay
1168 | (when (:resize-points @ui-state)
1169 | (let [points (:resize-points @ui-state)
1170 | x (+ x-offset (get-in points [:x :min]))
1171 | y (+ y-offset (get-in points [:y :min]))
1172 | width (core/width points)
1173 | height (core/height points)
1174 | ]
1175 | [:div {:class "resize-overlay"
1176 | :style {
1177 | :left (str x "px")
1178 | :top (str y "px")
1179 | :width (str width "px")
1180 | :height (str height "px")}}
1181 | [:div {:class "task-text"} (:resize-label @ui-state)]
1182 | ]
1183 | )
1184 | )
1185 | ;Node overlays
1186 | (map
1187 | (fn [node]
1188 | ;We draw divs on top of where the nodes are in the graphviz svg so that we can do more advanced styling/functionality
1189 | ;Collapsed clusters are also turned into nodes. They have different styling and can be differentiated by a truthy :cluster value
1190 | (when (= (:type node) :node)
1191 | [:div {:class (str
1192 | "node-overlay"
1193 | (when (= (:id node) (:selected-node-id state)) " selected")
1194 | (when (:cluster node) " cluster-node")
1195 | (when (contains? (:connected-nodes state) (:id node)) " connected")
1196 | (when (contains? cluster-node-ids (:id node)) " boxed")
1197 | )
1198 | :key (:id node)
1199 | ;When cluster nodes are clicked on, expand the cluster
1200 | :on-click (when (:cluster node) #((rerender! (fn [state] (assoc-in state [:clusters (:id node) :collapsed] false )))))
1201 | ;When nodes are double-clicked, add a surrounding cluster
1202 | :on-double-click #((rerender! add-cluster) [(:id node)])
1203 | ;Store the node ID as a dom attribute so event handlers can extract it later
1204 | :data-nodeid (:id node)
1205 | ;On mouse down/ touch start, set things up so that when the user stops dragging, we can add the link/node
1206 | :on-mouse-down (when (:node node) #(node-mousedown % state ui-state))
1207 | :on-touch-start (when (:node node) #(node-mousedown % state ui-state))
1208 | :on-mouse-enter (fn [e] (when (.-shiftKey e) (swap! app-state assoc :connected-nodes (->> (:deps state) (filter (partial core/node-in-link? (:id node))) (apply concat) (apply hash-set)))))
1209 | :on-mouse-leave #(when-not (empty? (:connected-nodes state)) (swap! app-state assoc :connected-nodes #{}))
1210 | :style {
1211 | :left (str (+ x-offset (get-in node [:points :x :min])) "px")
1212 | :top (str (+ y-offset (get-in node [:points :y :min])) "px")
1213 | :width (str (* (core/get-node-dim (:node node) :width) ppi) "px")
1214 | :height (str (* (core/get-node-dim (:node node) :height) ppi) "px")
1215 | :background-color (:color (:node node) "")
1216 | }}
1217 | [:div {:class "node-bar node-topbar"}
1218 | [:span
1219 | { :class "delete"
1220 | :title "Delete"
1221 | :data-help-link "delete-card"
1222 | :on-click #(if (:cluster node)
1223 | ((rerender! delete-cluster) (:id node) true)
1224 | ((rerender! delete-node) (:id node)))
1225 | }
1226 | "×"
1227 | ]
1228 | [:span
1229 | { :class "copy"
1230 | :title "Copy"
1231 | :data-help-link "copy-card"
1232 | :on-click #(
1233 | ((rerender! clone-item) (:id node))
1234 | (.preventDefault %)
1235 | false)
1236 | } "+"]
1237 | (when (:node node)
1238 | [:span {:class "color-picker"
1239 | :data-help-link "card-color"}
1240 | (map
1241 | (fn [color]
1242 | [:span
1243 | {:title (str (:name color) " (shortcut " (:shortcut color) ")")
1244 | :class "color-swatch"
1245 | :style {:background-color (:hex color)}
1246 | :key (:name color)
1247 | :on-click #((rerender! recolor-node) (:id node) (:hex color))
1248 | }
1249 | ]
1250 | )
1251 | core/colors)
1252 | ]
1253 | )
1254 | ]
1255 | [:div ;Text box containing node label
1256 | { :class "task-text"
1257 | :data-help-link "card-text"
1258 | :title "Click to Change"
1259 | :on-click (fn [e] (edit-node! (:id node)) false)}
1260 | ;Contents are the node/cluster text
1261 | (or (get-in node [:node :text]) (get-in node [:cluster :text]))
1262 | ]
1263 | (when (:node node)
1264 | [:span ;Nodes have a resize hander in the bottom right
1265 | {:class "draggable node-resize"
1266 | :data-help-link "card-resize"
1267 | }
1268 | ""
1269 | ]
1270 | )
1271 | ]
1272 | )
1273 | )
1274 | (:gnodes state))
1275 | ;Cluster overlays
1276 | (map
1277 | (fn [cluster]
1278 | (when (= (:type cluster) :cluster)
1279 | (let [
1280 | ;top (+ 1 y-offset (get-in cluster [:points :y :min]))
1281 | top (if (= (:direction state) :up)
1282 | (- (+ y-offset (get-in cluster [:points :y :max])) 21)
1283 | (+ 1 y-offset (get-in cluster [:points :y :min])))
1284 | left (+ 1 x-offset (get-in cluster [:points :x :min]))
1285 | right (+ -1 x-offset (get-in cluster [:points :x :max]))
1286 | width (- right left)
1287 | ]
1288 | [:div {:class (str "cluster-overlay"
1289 | (when (= (:id cluster) (:selected-node-id state)) " selected")
1290 | (when (contains? boxed-clusters (:id cluster)) " boxed")
1291 | )
1292 | :key (:id cluster)
1293 | ;Store the cluster ID as a dom attribute so event handlers can extract it later
1294 | :data-clusterid (:id cluster)
1295 | :on-mouse-down cluster-mousedown
1296 | :on-touch-start cluster-mousedown
1297 | ;On click, rename the cluster
1298 | :on-click (fn [e] (edit-node! (:id cluster)) false)
1299 | ;:on-click #((rerender! rename-cluster-prompt) (:id cluster))
1300 | :style {
1301 | :left (str left "px")
1302 | :top (str top "px")
1303 | :width (str width "px")
1304 | }}
1305 | ;Button in top right to collapse cluster into a single node
1306 | [:span
1307 | { :class "collapse"
1308 | :title "Collapse"
1309 | :on-click (fn [e] ((rerender! (fn [state] (assoc-in state [:clusters (:id cluster) :collapsed] true )))) false)
1310 | }
1311 | "-"
1312 | ]
1313 | [:span
1314 | { :class "copy"
1315 | :title "Copy"
1316 | :on-click #(
1317 | ((rerender! clone-cluster) (:id cluster))
1318 | (.preventDefault %)
1319 | false)
1320 | } "+"]
1321 | ;Button in top right to delete cluster
1322 | [:span
1323 | { :class "delete"
1324 | :title "Delete"
1325 | :on-click (fn [e] ((rerender! delete-cluster) (:id cluster)) false)
1326 | }
1327 | "×"
1328 | ]
1329 | (:text (get (:clusters state) (:id cluster)))
1330 | ]))
1331 | )
1332 | (:gnodes state))
1333 | ]
1334 | ; + / - icon by cursor when previewing add/remove link or add to/remove from cluster
1335 | (when (:preview-points @ui-state)
1336 | (let [
1337 | {shift-key :shift-key alt-key :alt-key end :end start-node-id :start-node-id start-cluster-id :start-cluster-id end-node-id :end-node-id end-cluster-id :end-cluster-id} (:preview-points @ui-state)
1338 |
1339 | icon
1340 | (cond
1341 | (and start-node-id end-node-id (not= end-node-id start-node-id))
1342 | (cond
1343 | shift-key "#tag"
1344 | (find-dep state [start-node-id end-node-id]) "#minus"
1345 | :else "#plus"
1346 | )
1347 | (and start-node-id end-cluster-id)
1348 | (if (= (:cluster-id (core/get-node (:nodes state) start-node-id)) end-cluster-id)
1349 | "#minus"
1350 | "#plus"
1351 | )
1352 | (and start-cluster-id end-node-id)
1353 | (if (= (:cluster-id (core/get-node (:nodes state) end-node-id)) start-cluster-id)
1354 | "#minus"
1355 | "#plus"
1356 | )
1357 | (and start-cluster-id end-cluster-id)
1358 | (if (= (:cluster-id (get (:clusters state) start-cluster-id)) end-cluster-id)
1359 | "#minus"
1360 | "#plus"
1361 | )
1362 | )
1363 | ]
1364 | (when icon
1365 | [:svg {:class "link-preview-icon"
1366 | :style {:position "absolute"
1367 | :top (str (- (:y end) 5) "px")
1368 | :left (str (+ 13 (:x end)) "px")
1369 | :width "18px"
1370 | :height "18px"
1371 | :fill ({"#plus" "green" "#minus" "red" "#tag" "green"} icon)
1372 | }}
1373 | ;This is kinda lame, but if we just have 1 use tag and switch the href, React tries to update just the href attribute which is read-only
1374 | [:use {:href "#plus" :style (if (not= icon "#plus") {:display "none"} {})}]
1375 | [:use {:href "#minus" :style (if (not= icon "#minus") {:display "none"} {})}]
1376 | [:use {:href "#tag" :style (if (not= icon "#tag") {:display "none"} {})}]
1377 | ]))
1378 | )
1379 | (when (:cluster-points @ui-state)
1380 | [:svg {:class "link-preview"}
1381 | (let [points (:cluster-points @ui-state)
1382 | rect (core/bounding-rect [(:start points) (:end points)])
1383 | width (core/width rect)
1384 | height (core/height rect)
1385 | ]
1386 | [:rect {:x (get-in rect [:x :min]) :y (get-in rect [:y :min]) :width width :height height :stroke "#666" :stroke-width 2 :stroke-dasharray "8,4" :fill "none"}]
1387 | )
1388 | ]
1389 | )
1390 | ; Arrow when dragging from node (plus node outline if cursor is on blank area)
1391 | (when (:preview-points @ui-state)
1392 | [:svg {:class "link-preview"}
1393 | (let [points (:preview-points @ui-state)
1394 | {start :start end :end start-id :start-node-id start-cluster-id :start-cluster-id end-id :end-node-id end-cluster-id :end-cluster-id alt-key :alt-key} (:preview-points @ui-state)
1395 | color "#666"
1396 | ;point to source node if we're on blank space and above our start point
1397 | point-backwards? (and (not (or end-id end-cluster-id)) (= :before (core/compare-coords end start ((:direction state) core/directions))))
1398 | arrow-point (if point-backwards? start end)
1399 | angle (->
1400 | (core/get-angle start end)
1401 | ;if we're pointing back at the source node, need to flip 180 deg
1402 | (+ (if point-backwards? 180 0))
1403 | )
1404 | ]
1405 | [:g {:class "edge pv-line"}
1406 | ;if on empty space, draw rectangle for placeholder node
1407 | (when-not (or (and start-cluster-id (not alt-key) (< (:y end) (:y start))) end-id end-cluster-id)
1408 | [:g {:transform (str "translate(" (:x end) " " (:y end) ")")}
1409 | [:rect {:x -72 :y -43 :width 144 :height 86 :stroke color :stroke-width 2 :stroke-dasharray "8,4" :fill "none"}]
1410 | (when alt-key [:g {:transform "translate(24 -37) scale(0.02)" :fill "#666"} [:use {:href "#clone"}]])
1411 | ])
1412 | ;preview link line
1413 | [:line {:stroke color :x1 (:x start) :y1 (:y start) :x2 (:x end) :y2 (:y end)}]
1414 | ;arrow head (when not on same node we started on)
1415 | (when (not= start-id end-id)
1416 | [:polygon {:fill color
1417 | :stroke color
1418 | :points (core/polygon-points [(:x arrow-point) (:y arrow-point)] [[-10 -3.5] [0 7]])
1419 | :transform (str "rotate(" angle " " (:x arrow-point) " " (:y arrow-point) ")")}])
1420 | ]
1421 | )
1422 | ]
1423 | )
1424 | ;SVG containing the graphviz graph. Used for edges and clusters
1425 | [:div {:dangerouslySetInnerHTML {:__html
1426 | (:svg state)
1427 | }}]
1428 | ;Overlay when editing the text of a node
1429 | (when (:edit-node-id @ui-state)
1430 | (let [ edit-id (:edit-node-id @ui-state)
1431 | gnode (core/get-node (:gnodes state) edit-id)
1432 | node? (= (:type gnode) :node)
1433 | node-text (reagent/atom (or (get-in gnode [:cluster :text]) (get-in gnode [:node :text]) ))
1434 | ]
1435 | [:div {:class "edit-overlay"
1436 | :on-click (fn [e] (edit-done! gnode @node-text))
1437 | }
1438 | [core/text-area node-text {:on-click (fn [e] false)
1439 | :on-key-down (fn [e]
1440 | (if (contains? #{13 27} (.-which e))
1441 | (edit-done! gnode @node-text) ;enter/escape saves changes
1442 | (when (= 9 (.-which e)) ; tab switches edit focus
1443 | (edit-done! gnode @node-text (get-next-node-id state (if (.-shiftKey e) -1 1) edit-id))
1444 | false
1445 | )))
1446 | :rows (if node? 200 1)
1447 | :style (get-textbox-style gnode x-offset y-offset)} ]
1448 | ]
1449 | )
1450 | )
1451 | ]
1452 | ]
1453 | )
1454 | )
1455 | ;; Init
1456 | (.initializeTouchEvents js/React true)
1457 | ;handle key events
1458 | (set! (.-onkeydown js/document) (fn on-key-press [evt]
1459 | (let [shift (.-shiftKey evt);whether shift key is being held down
1460 | selected (:selected-node-id @app-state)
1461 | selected-gnode (core/get-node (:gnodes @app-state) selected)
1462 | node-selected? (and selected (:node selected-gnode))
1463 | cluster-selected? (and selected (:cluster selected-gnode))
1464 | collapsed-cluster-selected? (and cluster-selected? (= (:type selected-gnode) :node))
1465 | keycode (.-which evt)
1466 | keychar (clojure.string/lower-case (char keycode))
1467 | color (get core/color-keycode-lookup keychar)]
1468 | (when (= (.-body js/document) (.-target evt))
1469 | (case keycode
1470 | ;Esc
1471 | 27 (swap! app-state assoc :selected-node-id nil)
1472 | ;<
1473 | 37 (when shift (hist/undo!))
1474 | ;>
1475 | 39 (when shift (hist/redo!))
1476 | ;c
1477 | 67 (when selected ((rerender! clone-item) selected))
1478 | ;d
1479 | 68 (when selected
1480 | (cond
1481 | node-selected? ((rerender! delete-node) selected)
1482 | collapsed-cluster-selected? ((rerender! delete-cluster) selected true)
1483 | cluster-selected? ((rerender! delete-cluster) selected false)
1484 | )
1485 | )
1486 | ;enter/e
1487 | (13 69) (edit-node! selected)
1488 | ;i
1489 | 73 (when node-selected? ((rerender! add-cluster) [selected]))
1490 | ;j
1491 | 74 (hist/off-the-record ((rerender! select-next-node) 1))
1492 | ;k
1493 | 75 (hist/off-the-record ((rerender! select-next-node) -1))
1494 | ;n
1495 | 78 ((rerender! add-node) [] [] (core/prompt "Enter title for node:" ""))
1496 | ;,/<
1497 | 188 (when (and shift node-selected?) ((rerender! add-and-name-node!) [] [selected] nil))
1498 | ;./>
1499 | 190 (when (and shift node-selected?) ((rerender! add-and-name-node!) [selected] [] nil))
1500 | ;-
1501 | 189 (when node-selected? ((rerender! on-toggle-dep-click) selected (if shift (core/prompt "Enter link text:" "") nil)))
1502 | ""
1503 | )
1504 | (when color ((rerender! recolor-node) selected (:hex color)))
1505 | )
1506 | )))
1507 |
1508 | (defn render! []
1509 | (reagent/render
1510 | [graph @app-state]
1511 | (.getElementById js/document "app")))
1512 |
1513 | ;the first time the page loads, load the app state from the url hash
1514 | (defn on-page-load! []
1515 | (devtools/enable-feature! :sanity-hints)
1516 | (devtools/install!)
1517 | (swap! app-state load-hash)
1518 | )
1519 | (defonce on-page-load (on-page-load!))
1520 |
1521 | ;whenever the app state changes, render the whole page
1522 | (add-watch app-state :on-change (fn [_ _ _ _] (render!)))
1523 | (add-watch ui-state :on-change (fn [_ _ _ _] (render!)))
1524 | (swap! app-state update-state)
1525 | (hist/record! app-state :app-state)
1526 |
--------------------------------------------------------------------------------
