From bbca48a7a2e586a0853f8dcea25a6813a6510b49 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Fri, 29 Jan 2016 19:48:34 +0200 Subject: [PATCH] Add absolute move abstraction. --- src/uxbox/shapes.cljs | 39 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/src/uxbox/shapes.cljs b/src/uxbox/shapes.cljs index 2e04e806f..15aa6fc2b 100644 --- a/src/uxbox/shapes.cljs +++ b/src/uxbox/shapes.cljs @@ -42,6 +42,10 @@ dispatch-by-type :hierarchy #'+hierarchy+) +(defmulti -move' + dispatch-by-type + :hierarchy #'+hierarchy+) + (defmulti -resize dispatch-by-type :hierarchy #'+hierarchy+) @@ -128,23 +132,54 @@ ;; Move (defmethod -move ::rect - [shape {:keys [dx dy] :as opts}] + [shape [dx dy]] (assoc shape :x (+ (:x shape) dx) :y (+ (:y shape) dy))) (defmethod -move :builtin/line - [shape {:keys [dx dy] :as opts}] + [shape [dx dy]] (assoc shape :x1 (+ (:x1 shape) dx) :y1 (+ (:y1 shape) dy) :x2 (+ (:x2 shape) dx) :y2 (+ (:y2 shape) dy))) +(defmethod -move :builtin/circle + [shape [dx dy]] + (assoc shape + :cx (+ (:cx shape) dx) + :cy (+ (:cy shape) dy))) + (defmethod -move :default [shape _] (throw (ex-info "Not implemented" (select-keys shape [:type])))) +(defmethod -move' ::rect + [shape [x y]] + (let [dx (if x (- (:x shape) x) 0) + dy (if y (- (:y shape) y) 0)] + (-move shape [dx dy]))) + +(defmethod -move' :builtin/line + [shape [x y]] + (let [dx (if x (- (:x1 shape) x) 0) + dy (if y (- (:y1 shape) y) 0)] + (-move shape [dx dy]))) + +(defmethod -move' :builtin/circle + [shape [x y]] + (let [{:keys [cx cy rx ry]} shape + x1 (- cx rx) + y1 (- cy ry) + dx (if x (- (:x1 shape) x) 0) + dy (if y (- (:y1 shape) y) 0)] + (-move shape [dx dy]))) + +(defmethod -move' :default + [shape _] + (throw (ex-info "Not implemented" (select-keys shape [:type])))) + (defmethod -rotate ::shape [shape rotation] (assoc shape :rotation rotation))