Move delete-shape and transfer-shape logic into specific namespace.

This commit is contained in:
Andrey Antukh 2016-02-02 21:32:17 +02:00
parent a0bba85ca9
commit 544cb6a226
3 changed files with 138 additions and 119 deletions

View File

@ -5,6 +5,7 @@
[uxbox.rstore :as rs] [uxbox.rstore :as rs]
[uxbox.router :as r] [uxbox.router :as r]
[uxbox.state :as st] [uxbox.state :as st]
[uxbox.state.shapes :as stsh]
[uxbox.schema :as sc] [uxbox.schema :as sc]
[uxbox.time :as time] [uxbox.time :as time]
[uxbox.xforms :as xf] [uxbox.xforms :as xf]
@ -147,54 +148,11 @@
(defn delete-shape (defn delete-shape
"Remove the shape using its id." "Remove the shape using its id."
[id] [id]
(letfn [(dissoc-group [state {:keys [id] :as shape}] (reify
(let [state (update-in state [:shapes-by-id] dissoc id)] rs/UpdateEvent
(->> (:items shape) (-apply-update [_ state]
(map #(get-in state [:shapes-by-id %])) (let [shape (get-in state [:shapes-by-id id])]
(reduce dissoc-from-index state)))) (stsh/dissoc-shape state shape)))))
(dissoc-icon [state {:keys [id] :as shape}]
(update-in state [:shapes-by-id] dissoc id))
(dissoc-from-group [state {:keys [id group] :as shape}]
(if-let [group' (get-in state [:shapes-by-id group])]
(as-> (:items group') $
(into [] (remove #(= % id) $))
(assoc-in state [:shapes-by-id group :items] $))
state))
(dissoc-from-page [state {:keys [page id] :as shape}]
(as-> (get-in state [:pages-by-id page :shapes]) $
(into [] (remove #(= % id) $))
(assoc-in state [:pages-by-id page :shapes] $)))
(clear-empty-groups [state {:keys [group] :as :shape}]
(if-let [group' (get-in state [:shapes-by-id group])]
(if (empty? (:items group'))
(as-> state $
(dissoc-from-page $ group')
(dissoc-from-group $ group')
(dissoc-from-index $ group')
(clear-empty-groups $ group'))
state)
state))
(dissoc-from-index [state shape]
(case (:type shape)
:builtin/rect (dissoc-icon state shape)
:builtin/circle (dissoc-icon state shape)
:builtin/line (dissoc-icon state shape)
:builtin/icon (dissoc-icon state shape)
:builtin/group (dissoc-group state shape)))]
(reify
rs/UpdateEvent
(-apply-update [_ state]
(let [shape (get-in state [:shapes-by-id id])]
(as-> state $
(dissoc-from-page $ shape)
(dissoc-from-group $ shape)
(dissoc-from-index $ shape)
(clear-empty-groups $ shape)))))))
(defn move-shape (defn move-shape
"Mark a shape selected for drawing in the canvas." "Mark a shape selected for drawing in the canvas."
@ -377,80 +335,22 @@
(rx/from-coll (rx/from-coll
(map unlock-shape (:items shape)))))))) (map unlock-shape (:items shape))))))))
;; FIXME: the impl can be maybe simplified.
(defn transfer-shape (defn transfer-shape
"Event used in drag and drop for transfer shape "Event used in drag and drop for transfer shape
from one position to an other." from one position to an other."
[sid tid type] [sid tid type]
(letfn [(transfer-to-group [state {:keys [id] :as target}] {:pre [(not (nil? tid))
(let [shapes (get-in state [:shapes-by-id id :items]) (not (nil? sid))]}
shapes (conj shapes sid)] (reify
(as-> state $ rs/UpdateEvent
(assoc-in $ [:shapes-by-id id :items] shapes) (-apply-update [_ state]
(update-in $ [:shapes-by-id sid] assoc :group id)))) (if (= tid sid)
state
(transfer-at [index shapes sid] (case type
(let [[fst snd] (split-at index shapes)] :inside (stsh/drop-inside state tid sid)
(concat fst [sid] snd))) :before (stsh/drop-before state tid sid)
:after (stsh/drop-after state tid sid)
(remove-source [state {:keys [id page group] :as source}] (throw (ex-info "Invalid data" {})))))))
(let [shapes (if group
(get-in state [:shapes-by-id group :items])
(get-in state [:pages-by-id page :shapes]))
shapes (remove #(= % id) shapes)]
(if group
(assoc-in state [:shapes-by-id group :items] shapes)
(assoc-in state [:pages-by-id page :shapes] shapes))))
(transfer-after [state {:keys [page group] :as target}]
(let [shapes (if group
(get-in state [:shapes-by-id group :items])
(get-in state [:pages-by-id page :shapes]))
shapes (-> (inc (index-of shapes tid))
(transfer-at shapes sid))]
(if group
(as-> state $
(assoc-in $ [:shapes-by-id group :items] shapes)
(update-in $ [:shapes-by-id sid] assoc :group group))
(as-> state $
(assoc-in $ [:pages-by-id page :shapes] shapes)
(update-in $ [:shapes-by-id sid] dissoc :group)))))
(transfer-before [state {:keys [page group] :as target}]
(let [shapes (if group
(get-in state [:shapes-by-id group :items])
(get-in state [:pages-by-id page :shapes]))
shapes (-> (index-of shapes tid)
(transfer-at shapes sid))]
(if group
(as-> state $
(assoc-in $ [:shapes-by-id group :items] shapes)
(update-in $ [:shapes-by-id sid] assoc :group group))
(as-> state $
(assoc-in $ [:pages-by-id page :shapes] shapes)
(update-in $ [:shapes-by-id sid] dissoc :group)))))]
(reify
rs/UpdateEvent
(-apply-update [_ state]
(if (= tid sid)
state
(let [target (get-in state [:shapes-by-id tid])
source (get-in state [:shapes-by-id sid])
state (remove-source state source)]
(cond
(and (= type :inside)
(= (:type target) :builtin/group))
(transfer-to-group state target)
(= type :before)
(transfer-before state target)
(= type :after)
(transfer-after state target)
:else
(throw (ex-info "Invalid data" {})))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Events (for selected) ;; Events (for selected)

View File

@ -26,7 +26,7 @@
;; Implementation Api ;; Implementation Api
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- dispatch-by-type (defn dispatch-by-type
[shape & params] [shape & params]
(:type shape)) (:type shape))

119
src/uxbox/state/shapes.cljs Normal file
View File

@ -0,0 +1,119 @@
(ns uxbox.state.shapes
"A collection of functions for manage shapes insinde the state."
(:require [uxbox.shapes :as sh]
[uxbox.util.data :refer (index-of)]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Delete Shapes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn dissoc-from-index
"A function that dissoc shape from the indexed
data structure of shapes from the state."
[state {:keys [id type] :as shape}]
(if (= :builtin/group type)
(let [items (map #(get-in state [:shapes-by-id %]) (:items shape))]
(as-> state $
(update-in $ [:shapes-by-id] dissoc id)
(reduce dissoc-from-index $ items)))
(update-in state [:shapes-by-id] dissoc id)))
(defn dissoc-from-page
"Given a shape, try to remove its reference from the
corresponding page."
[state {:keys [id page] :as shape}]
(as-> (get-in state [:pages-by-id page :shapes]) $
(into [] (remove #(= % id) $))
(assoc-in state [:pages-by-id page :shapes] $)))
(defn dissoc-from-group
"Given a shape, try to remove its reference from the
corresponding group (only if it belongs to one group)."
[state {:keys [id group] :as shape}]
(if-let [group' (get-in state [:shapes-by-id group])]
(as-> (:items group') $
(into [] (remove #(= % id) $))
(assoc-in state [:shapes-by-id group :items] $))
state))
(declare dissoc-shape)
(defn clear-empty-groups
"Given the shape, try to clean all empty groups
that this shape belongs to.
The main purpose of this function is remove the
all empty parent groups of recently removed
shape."
[state {:keys [group] :as shape}]
(if-let [group' (get-in state [:shapes-by-id group])]
(if (empty? (:items group'))
(dissoc-shape state group')
state)
state))
(defn dissoc-shape
"Given a shape, removes it from the state."
[state shape]
(as-> state $
(dissoc-from-page $ shape)
(dissoc-from-group $ shape)
(dissoc-from-index $ shape)
(clear-empty-groups $ shape)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shape Movements
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- drop-at-index
[index coll v]
(let [[fst snd] (split-at index coll)]
(into [] (concat fst [v] snd))))
(defn drop-aside
[state loc tid sid]
{:pre [(not= tid sid)
(not (nil? tid))
(not (nil? sid))]}
(let [{:keys [page group]} (get-in state [:shapes-by-id tid])
source (get-in state [:shapes-by-id sid])
state (-> state
(dissoc-from-page source)
(dissoc-from-group source))
shapes (if group
(get-in state [:shapes-by-id group :items])
(get-in state [:pages-by-id page :shapes]))
index (case loc
:after (inc (index-of shapes tid))
:before (index-of shapes tid))
shapes (drop-at-index index shapes sid)]
(if group
(as-> state $
(assoc-in $ [:shapes-by-id group :items] shapes)
(update-in $ [:shapes-by-id sid] assoc :group group)
(clear-empty-groups $ source))
(as-> state $
(assoc-in $ [:pages-by-id page :shapes] shapes)
(update-in $ [:shapes-by-id sid] dissoc :group)
(clear-empty-groups $ source)))))
(def ^:static drop-after #(drop-aside %1 :after %2 %3))
(def ^:static drop-before #(drop-aside %1 :before %2 %3))
(defn drop-inside
[state tid sid]
{:pre [(not= tid sid)]}
(let [source (get-in state [:shapes-by-id sid])
state (-> state
(dissoc-from-page source)
(dissoc-from-group source))
shapes (get-in state [:shapes-by-id tid :items])]
(if (seq shapes)
(as-> state $
(assoc-in $ [:shapes-by-id tid :items] (conj shapes sid))
(update-in $ [:shapes-by-id sid] assoc :group tid))
state)))