diff --git a/examples/geometry/src/geometry/components.cljs b/examples/geometry/src/geometry/components.cljs index e7003d9..f8a1a63 100644 --- a/examples/geometry/src/geometry/components.cljs +++ b/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 diff --git a/examples/geometry/src/geometry/core.cljs b/examples/geometry/src/geometry/core.cljs index 167161c..68babf3 100644 --- a/examples/geometry/src/geometry/core.cljs +++ b/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))