From 49c44766ba1bd4e23cb42bf11e909ad87f2c1848 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Fri, 12 Aug 2016 22:03:55 +0300
Subject: [PATCH] Add the ability to draw freely the path.

The path simplification is implemented but deactivated.
---
 src/uxbox/main/ui/workspace/drawarea.cljs | 57 ++++++++++++++++++++++-
 src/uxbox/util/geom/path.cljs             | 13 ++++++
 2 files changed, 69 insertions(+), 1 deletion(-)
 create mode 100644 src/uxbox/util/geom/path.cljs

diff --git a/src/uxbox/main/ui/workspace/drawarea.cljs b/src/uxbox/main/ui/workspace/drawarea.cljs
index 13c75f5f6..30f24eff9 100644
--- a/src/uxbox/main/ui/workspace/drawarea.cljs
+++ b/src/uxbox/main/ui/workspace/drawarea.cljs
@@ -18,6 +18,7 @@
             [uxbox.main.ui.workspace.rlocks :as rlocks]
             [uxbox.main.geom :as geom]
             [uxbox.util.geom.point :as gpt]
+            [uxbox.util.geom.path :as path]
             [uxbox.util.dom :as dom]))
 
 ;; --- State
@@ -62,6 +63,7 @@
 (declare on-init)
 (declare on-init-draw-icon)
 (declare on-init-draw-path)
+(declare on-init-draw-free-path)
 (declare on-init-draw-generic)
 
 (defn- watch-draw-actions
@@ -77,7 +79,9 @@
   (when-let [shape (:drawing @wb/workspace-ref)]
     (case (:type shape)
       :icon (on-init-draw-icon shape)
-      :path (on-init-draw-path shape)
+      :path (if (:free shape)
+              (on-init-draw-free-path shape)
+              (on-init-draw-path shape))
       (on-init-draw-generic shape))))
 
 (defn- on-init-draw-icon
@@ -170,6 +174,57 @@
       (rx/subscribe ptstream on-click)
       (rx/subscribe stream on-draw nil on-end))))
 
+(defn- on-init-draw-free-path
+  [shape]
+  (let [mouse (->> (rx/sample 10 wb/mouse-viewport-s)
+                   (rx/mapcat (fn [point]
+                                (if @wb/alignment-ref
+                                  (uds/align-point point)
+                                  (rx/of point))))
+                   (rx/map #(gpt/subtract % canvas-coords)))
+        stoper (->> wb/events-s
+                    (rx/map first)
+                    (rx/filter #(= % :mouse/up))
+                    (rx/take 1))
+        stream (rx/take-until stoper mouse)]
+    (letfn [(normalize-shape [{:keys [points] :as shape}]
+              (let [minx (apply min (map :x points))
+                    miny (apply min (map :y points))
+                    maxx (apply max (map :x points))
+                    maxy (apply max (map :y points))
+
+                    dx (- 0 minx)
+                    dy (- 0 miny)
+                    points (mapv #(gpt/add % [dx dy]) points)
+                    ;; points (path/simplify points)
+                    width (- maxx minx)
+                    height (- maxy miny)]
+
+                (assoc shape
+                       :x1 minx
+                       :y1 miny
+                       :x2 maxx
+                       :y2 maxy
+                       :view-box [0 0 width height]
+                       :points points)))
+
+            (on-draw [point]
+              (let [point (gpt/point point)
+                    shape (-> (or @drawing-shape shape)
+                              (update :points conj point))]
+                (reset! drawing-shape shape)))
+
+            (on-end []
+              (let [shape (normalize-shape @drawing-shape)]
+                (rs/emit! (uds/add-shape shape)
+                          (udw/select-for-drawing nil)
+                          (uds/select-first-shape))
+                (reset! drawing-shape nil)
+                (reset! drawing-position nil)
+                (rlocks/release! :ui/draw)))]
+
+      (rx/subscribe stream on-draw nil on-end))))
+
 (defn- on-init-draw-generic
   [shape]
   (let [mouse (->> (rx/sample 10 wb/mouse-viewport-s)
diff --git a/src/uxbox/util/geom/path.cljs b/src/uxbox/util/geom/path.cljs
new file mode 100644
index 000000000..2a0b7f7eb
--- /dev/null
+++ b/src/uxbox/util/geom/path.cljs
@@ -0,0 +1,13 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.geom.path
+  (:require [uxbox.util.geom.path-impl-simplify :as impl-simplify]))
+
+(defn simplify
+  [points]
+  (let [points (into-array points)]
+    (into [] (impl-simplify/simplify points 10 true))))