diff --git a/examples/geometry/src/geometry/components.cljs b/examples/geometry/src/geometry/components.cljs index 659834c..6871b50 100644 --- a/examples/geometry/src/geometry/components.cljs +++ b/examples/geometry/src/geometry/components.cljs @@ -19,22 +19,31 @@ :stroke "black" :stroke-width 2}) +(def rect-defaults + {:stroke "black" + :width 10 + :height 30}) + (defn drag-move-fn [on-drag] (fn [evt] (on-drag (.-clientX evt) (.-clientY evt)))) -(defn drag-end-fn [drag-move drag-end] +(defn drag-end-fn [drag-move drag-end on-end] (fn [evt] (events/unlisten js/window EventType.MOUSEMOVE drag-move) - (events/unlisten js/window EventType.MOUSEUP @drag-end))) + (events/unlisten js/window EventType.MOUSEUP @drag-end) + (on-end))) -(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 dragging + ([on-drag] (dragging on-drag (fn []) (fn []))) + ([on-drag on-start on-end] + (let [drag-move (drag-move-fn on-drag) + drag-end-atom (atom nil) + drag-end (drag-end-fn drag-move drag-end-atom on-end)] + (on-start) + (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 @@ -61,3 +70,9 @@ {:cx (x c) :cy (y c) :r (dist c r)})]) + +(defn rect [{:keys [on-drag on-start on-end]} c] + [:rect (merge rect-defaults + {:on-mouse-down #(dragging on-drag on-start on-end) + :x (x c) + :y (- (y c) 15)})]) diff --git a/examples/geometry/src/geometry/core.cljs b/examples/geometry/src/geometry/core.cljs index e3dd427..1b4f58e 100644 --- a/examples/geometry/src/geometry/core.cljs +++ b/examples/geometry/src/geometry/core.cljs @@ -14,19 +14,55 @@ :c (g/point 250 250) :p (g/point 250 300)})) +(defonce slider + (r/atom + {:handle (g/point 500 50) + :history []})) + +(defn record-state [_ _ _ s] + (swap! slider (fn [{:keys [history] :as coll}] + (assoc coll :history (conj history s))))) + +(defn start-recording-history [] + (let [history (:history @slider)] + (add-watch points :record record-state))) + +(defn stop-recording-history [] + (remove-watch points :record)) + +(add-watch points :record record-state) + +(defn get-bcr [svg-root] + (-> svg-root + r/dom-node + .getBoundingClientRect)) + (defn move-point [svg-root p] (fn [x y] - (let [bcr (-> svg-root - r/dom-node - .getBoundingClientRect)] + (let [bcr (get-bcr svg-root)] (swap! points assoc p (g/point (- x (.-left bcr)) (- y (.-top bcr))))))) +(defn move-slider [svg-root p] + (fn [x y] + (let [new-x (-> (- x (.-left (get-bcr svg-root))) + (min 500) + (max 100)) + position (/ (- new-x 100) + (- 500 100)) + history (:history @slider)] + (swap! slider assoc p (g/point new-x 50)) + (reset! points (nth history (int (* (dec (count history)) position))))))) + (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/segment (g/point 100 50) (g/point 500 50)] + [c/rect {:on-drag (move-slider svg-root :handle) + :on-start stop-recording-history + :on-end start-recording-history} (:handle @slider)] [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] @@ -41,7 +77,7 @@ [:text {:style {:-webkit-user-select "none" :-moz-user-select "none"} :x 20 :y 20 :font-size 20} - "The points are draggable"] + "The points are draggable and the slider controls history"] [root (r/current-component)]]) (defn by-id [id]