refactor geometry example

examples/geometry/src/geometry/components.cljs

@@ -1,6 +1,8 @@
 (ns geometry.components
   (:require [reagent.core :as r]
-            [geometry.geometry :refer [x y dist] :as g]))
+            [goog.events :as events]
+            [geometry.geometry :refer [x y dist] :as g])
+  (:import [goog.events EventType]))
 
 (def point-defaults
   {:stroke "black"
@@ -17,27 +19,29 @@
    :stroke "black"
    :stroke-width 2})
 
-(defn point [p]
-  [:circle
-   (merge point-defaults
-          {:cx (x p) :cy (y p)})])
+(defn drag-move-fn [on-drag]
+  (fn [evt]
+    (on-drag (.-clientX evt) (.-clientY evt))))
 
-(defn drag [mouse-info p]
-  (when (:mouse-down? @mouse-info)
-    (reset! p (g/point (:x @mouse-info)
-                       (:y @mouse-info)))
-    (r/next-tick
-     (fn []
-       (drag mouse-info p)))))
+(defn drag-end-fn [drag-move drag-end]
+  (fn [evt]
+    (events/unlisten js/window EventType/MOUSEMOVE drag-move)
+    (events/unlisten js/window EventType/MOUSEUP @drag-end)))
 
-(defn draggable-point [p mouse-info]
+(defn dragging [on-drag]
+  (let [drag-move (drag-move-fn on-drag)
+        drag-end-atom (atom nil)
+        drag-end (drag-end-fn drag-move drag-end-atom)]
+    (reset! drag-end-atom drag-end)
+    (events/listen js/window EventType/MOUSEMOVE drag-move)
+    (events/listen js/window EventType/MOUSEUP drag-end)))
+
+(defn point [{:keys [on-drag]} p]
   [:circle 
    (merge point-defaults
-          {:on-mouse-down #(do 
-                             (swap! mouse-info assoc :mouse-down? true)
-                             (drag mouse-info p))
-           :cx (x @p)
-           :cy (y @p)})])
+          {:on-mouse-down #(dragging on-drag)
+           :cx (x p)
+           :cy (y p)})])
 
 (defn segment [from to]
   [:line 

examples/geometry/src/geometry/core.cljs

@@ -6,54 +6,43 @@
 
 (enable-console-print!)
 
-;; "Global" mouse events
-(def mouse-info 
-  (r/atom {:x 0
-           :y 0
-           :mouse-down? false}))
+(def points 
+  (r/atom
+   {:p1 (g/point 100 100)
+    :p2 (g/point 200 200)
+    :p3 (g/point 100 200)
+    :c (g/point 250 250)
+    :p (g/point 250 300)}))
 
-(defn on-mouse-move [evt node]
-  (let [bcr (-> node .getBoundingClientRect)]
-    (swap! mouse-info assoc
-           :x (- (.-clientX evt) (.-left bcr))
-           :y (- (.-clientY evt) (.-top bcr)))))
+(defn move-point [svg-root p]
+  (fn [x y]
+    (let [bcr (-> svg-root
+                  r/dom-node
+                  .getBoundingClientRect)]
+      (swap! points assoc p (g/point (- x (.-left bcr)) (- y (.-top bcr)))))))
 
-(defn on-mouse-up [evt]
-  (swap! mouse-info assoc :mouse-down? false))
-
-(defn on-mouse-down [evt]
-  (swap! mouse-info assoc :mouse-down? true))
-
-(def p1 (r/atom (g/point 100 100)))
-(def p2 (r/atom (g/point 200 200)))
-(def p3 (r/atom (g/point 100 200)))
-(def c (r/atom (g/point 250 250)))
-(def p (r/atom (g/point 250 300)))
-
-(defn root []
-  [:g
-   [c/triangle @p1 @p2 @p3]
-   [c/circle @p @c]
-   [c/segment @p @c]
-   [c/draggable-point c mouse-info]
-   [c/draggable-point p mouse-info]
-   [c/draggable-point p1 mouse-info]
-   [c/draggable-point p2 mouse-info]
-   [c/draggable-point p3 mouse-info]])
+(defn root [svg-root]
+  (let [{:keys [p1 p2 p3 p c]} @points]
+    [:g
+     [c/triangle p1 p2 p3]
+     [c/circle p c]
+     [c/segment p c]
+     [c/point {:on-drag (move-point svg-root :c)} c]
+     [c/point {:on-drag (move-point svg-root :p)} p]
+     [c/point {:on-drag (move-point svg-root :p1)} p1]
+     [c/point {:on-drag (move-point svg-root :p2)} p2]
+     [c/point {:on-drag (move-point svg-root :p3)} p3]]))
 
 (defn main [{:keys [width height]}]
-  (let [this (r/current-component)]
-    [:svg {:on-mouse-down on-mouse-down
-           :on-mouse-up on-mouse-up
-           :on-mouse-move #(on-mouse-move % (r/dom-node this))
-           :width (or width 800)
-           :height (or height 600)
-           :style {:border "1px solid black"}}
-     [:text {:style {:-webkit-user-select "none"
-                     :-moz-user-select "none"}
-             :x 20 :y 20 :font-size 20}
-      "The points are draggable"]
-     [root]]))
+  [:svg 
+   {:width width
+    :height height
+    :style {:border "1px solid black"}}
+   [:text {:style {:-webkit-user-select "none"
+                   :-moz-user-select "none"}
+           :x 20 :y 20 :font-size 20}
+    "The points are draggable"]
+   [root (r/current-component)]])
 
 (defn by-id [id]
   (.getElementById js/document id))