3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-11 04:06:39 +02:00
Code Issues Projects Releases Packages Wiki Activity

🚧 Initial work on multicanvas feature.

Browse source
This commit is contained in:
Andrey Antukh 2019-08-21 21:09:54 +00:00
parent 176ca590e1
commit 807555d478
32 changed files with 1408 additions and 1495 deletions
Download patch file Download diff file Expand all files Collapse all files

8
frontend/src/uxbox/main/data/history.cljs
View file

@ -12,6 +12,8 @@
[uxbox.util.data :refer [replace-by-id [uxbox.util.data :refer [replace-by-id
index-by]])) index-by]]))
;; TODO: this need refactor (completely broken)
;; --- Initialize History State ;; --- Initialize History State
(declare fetch-history) (declare fetch-history)
@ -52,7 +54,7 @@
(deftype PinnedPageHistoryFetched [items] (deftype PinnedPageHistoryFetched [items]
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [items-map (index-by items :version) (let [items-map (index-by :version items)
items-set (into #{} items)] items-set (into #{} items)]
(update-in state [:workspace :history] (update-in state [:workspace :history]
(fn [history] (fn [history]
@ -164,7 +166,7 @@
(assoc :history true (assoc :history true
:data (:data item)))] :data (:data item)))]
(-> state (-> state
(udp/assoc-page page) (udp/unpack-page page)
(assoc-in [:workspace :history :selected] version))))) (assoc-in [:workspace :history :selected] version)))))
(defn select-page-history (defn select-page-history
@ -203,7 +205,7 @@
(set! noop true) (set! noop true)
state) state)
(let [packed (get-in state [:packed-pages page-id])] (let [packed (get-in state [:packed-pages page-id])]
(-> (udp/assoc-page state packed) (-> (udp/unpack-page state packed)
(assoc-in [:workspace :history :deselecting] true) (assoc-in [:workspace :history :deselecting] true)
(assoc-in [:workspace :history :selected] nil)))))) (assoc-in [:workspace :history :selected] nil))))))

78
frontend/src/uxbox/main/data/pages.cljs
View file

@ -5,18 +5,17 @@
;; Copyright (c) 2015-2017 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2015-2017 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.main.data.pages (ns uxbox.main.data.pages
(:require [cljs.spec.alpha :as s] (:require
[cuerdas.core :as str] [beicon.core :as rx]
[beicon.core :as rx] [cljs.spec.alpha :as s]
[lentes.core :as l] [cuerdas.core :as str]
[potok.core :as ptk] [lentes.core :as l]
[uxbox.main.store :as st] [potok.core :as ptk]
[uxbox.main.repo :as rp] [uxbox.main.repo :as rp]
[uxbox.main.lenses :as ul] [uxbox.main.store :as st]
[uxbox.util.spec :as us] [uxbox.util.spec :as us]
[uxbox.util.router :as r] [uxbox.util.timers :as ts]
[uxbox.util.timers :as ts] [uxbox.util.data :refer [index-by-id]]))
[uxbox.util.time :as dt]))
;; --- Specs ;; --- Specs
@ -77,50 +76,43 @@
;; --- Helpers ;; --- Helpers
;; TODO: make sure remove all :tmp-* related attrs from shape
(defn pack-page-shapes
"Create a hash-map of shapes indexed by their id that belongs
to the provided page."
[state page]
(let [lookup-shape-xf (map #(get-in state [:shapes %]))]
(reduce (fn reducer [acc {:keys [id type items] :as shape}]
(let [shape (assoc shape :page (:id page))]
(cond
(= type :group)
(reduce reducer
(assoc acc id shape)
(sequence lookup-shape-xf items))
(uuid? id)
(assoc acc id shape)
:else acc)))
{}
(sequence lookup-shape-xf (:shapes page)))))
(defn pack-page (defn pack-page
"Return a packed version of page object ready "Return a packed version of page object ready
for send to remore storage service." for send to remore storage service."
[state id] [state id]
(let [page (get-in state [:pages id]) (letfn [(get-shape [id]
shapes (pack-page-shapes state page)] (get-in state [:shapes id]))
(-> page (pack-shapes [ids]
(assoc-in [:data :shapes] (vec (:shapes page))) (reduce #(assoc %1 %2 (get-shape %2)) {} ids))
(assoc-in [:data :shapes-map] shapes) (pack-canvas [ids]
(dissoc :shapes)))) (mapv #(get-in state [:canvas %]) ids))]
(let [page (get-in state [:pages id])
data {:canvas (pack-canvas (:canvas page))
:shapes (vec (:shapes page))
:shapes-map (pack-shapes (:shapes page))}]
(-> page
(assoc :data data)
(dissoc :shapes :canvas)))))
(defn assoc-page (defn unpack-page
"Unpacks packed page object and assocs it to the "Unpacks packed page object and assocs it to the
provided state." provided state."
[state {:keys [id data] :as page}] [state {:keys [id data] :as page}]
(let [shapes (:shapes data) (let [shapes (:shapes data)
shapes-map (:shapes-map data) shapes-map (:shapes-map data)
canvas-data (:canvas data [])
canvas (mapv :id canvas-data)
canvas-map (index-by-id canvas-data)
page (-> page page (-> page
(dissoc :data) (dissoc :data)
(assoc :canvas canvas)
(assoc :shapes shapes))] (assoc :shapes shapes))]
(-> state (-> state
(update :shapes merge shapes-map) (update :shapes merge shapes-map)
(update :canvas merge canvas-map)
(update :pages assoc id page)))) (update :pages assoc id page))))
(defn purge-page (defn purge-page
@ -160,7 +152,7 @@
(assoc-in $ [:projects id :pages] page-ids) (assoc-in $ [:projects id :pages] page-ids)
;; TODO: this is a workaround ;; TODO: this is a workaround
(assoc-in $ [:projects id :page-id] (first page-ids)) (assoc-in $ [:projects id :page-id] (first page-ids))
(reduce assoc-page $ pages) (reduce unpack-page $ pages)
(reduce assoc-packed-page $ pages))))) (reduce assoc-packed-page $ pages)))))
(defn pages-fetched (defn pages-fetched
@ -194,7 +186,7 @@
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(-> state (-> state
(assoc-page data) (unpack-page data)
(assoc-packed-page data))) (assoc-packed-page data)))
ptk/WatchEvent ptk/WatchEvent

874
frontend/src/uxbox/main/data/shapes.cljs
View file

@ -2,527 +2,537 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2015-2017 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2015-2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.main.data.shapes (ns uxbox.main.data.shapes
(:require [cljs.spec.alpha :as s] (:require [cljs.spec.alpha :as s]
[lentes.core :as l]
[beicon.core :as rx]
[potok.core :as ptk]
[uxbox.main.store :as st]
[uxbox.main.constants :as c]
[uxbox.main.refs :as refs]
[uxbox.main.lenses :as ul]
[uxbox.main.geom :as geom] [uxbox.main.geom :as geom]
[uxbox.main.workers :as uwrk]
[uxbox.main.data.pages :as udp]
[uxbox.main.data.shapes-impl :as impl]
[uxbox.main.user-events :as uev]
[uxbox.util.data :refer [dissoc-in]]
[uxbox.util.forms :as sc]
[uxbox.util.spec :as us]
[uxbox.util.geom.point :as gpt]
[uxbox.util.geom.matrix :as gmt] [uxbox.util.geom.matrix :as gmt]
[uxbox.util.router :as r] [uxbox.util.uuid :as uuid]
[uxbox.util.uuid :as uuid])) [uxbox.util.data :refer [index-of]]))
;; --- Specs ;; --- Specs
(s/def ::blocked boolean?)
(s/def ::collapsed boolean?)
(s/def ::content string?)
(s/def ::fill-color string?) (s/def ::fill-color string?)
(s/def ::fill-opacity number?) (s/def ::fill-opacity number?)
(s/def ::line-height number?)
(s/def ::letter-spacing number?)
(s/def ::text-align #{"left" "right" "center" "justify"})
(s/def ::font-family string?) (s/def ::font-family string?)
(s/def ::font-size number?)
(s/def ::font-style string?) (s/def ::font-style string?)
(s/def ::font-weight string?) (s/def ::font-weight string?)
(s/def ::font-size number?) (s/def ::height number?)
(s/def ::stroke-style #{:none :solid :dotted :dashed :mixed}) (s/def ::hidden boolean?)
(s/def ::stroke-width number?) (s/def ::id uuid?)
(s/def ::stroke-color string?) (s/def ::letter-spacing number?)
(s/def ::stroke-opacity number?) (s/def ::line-height number?)
(s/def ::rx number?) (s/def ::locked boolean?)
(s/def ::ry number?) (s/def ::name string?)
(s/def ::page uuid?)
(s/def ::proportion number?) (s/def ::proportion number?)
(s/def ::proportion-lock boolean?) (s/def ::proportion-lock boolean?)
(s/def ::collapsed boolean?) (s/def ::rx number?)
(s/def ::hidden boolean?) (s/def ::ry number?)
(s/def ::blocked boolean?) (s/def ::stroke-color string?)
(s/def ::locked boolean?) (s/def ::stroke-opacity number?)
(s/def ::stroke-style #{:none :solid :dotted :dashed :mixed})
(s/def ::stroke-width number?)
(s/def ::text-align #{"left" "right" "center" "justify"})
(s/def ::type #{:rect :path :circle :image :text})
(s/def ::width number?) (s/def ::width number?)
(s/def ::height number?)
(s/def ::x1 number?) (s/def ::x1 number?)
(s/def ::y1 number?)
(s/def ::x2 number?) (s/def ::x2 number?)
(s/def ::y1 number?)
(s/def ::y2 number?) (s/def ::y2 number?)
(s/def ::id uuid?)
(s/def ::page uuid?)
(s/def ::type #{:rect
:group
:path
:circle
:image
:text})
(s/def ::attributes (s/def ::attributes
(s/keys :opt-un [::fill-color (s/keys :opt-un [::blocked
::collapsed
::conent
::fill-color
::fill-opacity ::fill-opacity
::line-height
::letter-spacing
::text-align
::font-family ::font-family
::font-size
::font-style ::font-style
::font-weight ::font-weight
::font-size ::hidden
::stroke-style ::letter-spacing
::stroke-width ::line-height
::locked
::proportion
::proportion-lock
::rx ::ry
::stroke-color ::stroke-color
::stroke-opacity ::stroke-opacity
::rx ::ry ::stroke-style
::stroke-width
::text-align
::x1 ::x2 ::x1 ::x2
::y1 ::y2 ::y1 ::y2]))
::proportion-lock
::proportion (s/def ::minimal-shape
::collapsed (s/keys ::req-un [::id ::page ::type ::name]))
::hidden
::blocked
::locked]))
(s/def ::shape (s/def ::shape
(s/merge (s/keys ::req-un [::id ::page ::type]) ::attributes)) (s/merge ::minimal-shape ::attributes))
(s/def ::rect-like-shape (s/def ::rect-like-shape
(s/keys :req-un [::x1 ::y1 ::x2 ::y2 ::type])) (s/keys :req-un [::x1 ::y1 ::x2 ::y2 ::type]))
;; --- Shapes CRUD ;; --- Shape Creation
(deftype AddShape [data] (defn retrieve-used-names
udp/IPageUpdate "Returns a set of already used names by shapes
ptk/UpdateEvent in the current page."
(update [_ state] [{:keys [shapes] :as state}]
(let [shape (geom/setup-proportions data) (let [pid (get-in state [:workspace :current])
page-id (get-in state [:workspace :current])] xf (comp (filter #(= pid (:page %)))
(impl/assoc-shape-to-page state shape page-id)))) (map :name))]
(into #{} xf (vals shapes))))
(defn add-shape (defn generate-unique-name
[data] "A unique name generator based on the previous
{:pre [(us/valid? ::shape data)]} state of the used names."
(AddShape. data)) [state basename]
(let [used (retrieve-used-names state)]
(loop [counter 1]
(let [candidate (str basename "-" counter)]
(if (contains? used candidate)
(recur (inc counter))
candidate)))))
;; --- Delete Shape (defn assoc-shape-to-page
[state shape page]
(let [shape-id (uuid/random)
shape-name (generate-unique-name state (:name shape))
shape (assoc shape
:page page
:id shape-id
:name shape-name)]
(-> state
(update-in [:pages page :shapes] #(into [] (cons shape-id %)))
(assoc-in [:shapes shape-id] shape))))
(deftype DeleteShape [id] (defn duplicate-shapes'
udp/IPageUpdate ([state shapes page]
ptk/UpdateEvent (duplicate-shapes' state shapes page nil))
(update [_ state] ([state shapes page group]
(let [shape (get-in state [:shapes id])] (letfn [(duplicate-shape [state shape page group]
(impl/dissoc-shape state shape)))) (if (= (:type shape) :group)
(let [id (uuid/random)
items (:items shape)
name (generate-unique-name state (str (:name shape) "-copy"))
shape (assoc shape
:id id
:page page
:items []
:name name)
state (if (nil? group)
(-> state
(update-in [:pages page :shapes]
#(into [] (cons id %)))
(assoc-in [:shapes id] shape))
(-> state
(update-in [:shapes group :items]
#(into [] (cons id %)))
(assoc-in [:shapes id] shape)))]
(->> (map #(get-in state [:shapes %]) items)
(reverse)
(reduce #(duplicate-shape %1 %2 page id) state)))
(let [id (uuid/random)
name (generate-unique-name state (str (:name shape) "-copy"))
shape (-> (dissoc shape :group)
(assoc :id id :page page :name name)
(merge (when group {:group group})))]
(if (nil? group)
(-> state
(update-in [:pages page :shapes] #(into [] (cons id %)))
(assoc-in [:shapes id] shape))
(-> state
(update-in [:shapes group :items] #(into [] (cons id %)))
(assoc-in [:shapes id] shape))))))]
(reduce #(duplicate-shape %1 %2 page group) state shapes))))
(defn delete-shape (defn duplicate-shapes
"Remove the shape using its id." ([state shapes]
[id] (duplicate-shapes state shapes nil))
{:pre [(uuid? id)]} ([state shapes page]
(DeleteShape. id)) (letfn [(all-toplevel? [coll]
(every? #(nil? (:group %)) coll))
(all-same-group? [coll]
(let [group (:group (first coll))]
(every? #(= group (:group %)) coll)))]
(let [shapes (reverse (mapv #(get-in state [:shapes %]) shapes))]
(cond
(all-toplevel? shapes)
(let [page (or page (:page (first shapes)))]
(duplicate-shapes' state shapes page))
;; --- Rename Shape (all-same-group? shapes)
(let [page (or page (:page (first shapes)))
group (:group (first shapes))]
(duplicate-shapes' state shapes page group))
(deftype RenameShape [id name] :else
udp/IPageUpdate (let [page (or page (:page (first shapes)))]
ptk/UpdateEvent (duplicate-shapes' state shapes page)))))))
(update [_ state]
(assoc-in state [:shapes id :name] name)))
(defn rename-shape ;; --- Delete Shapes
[id name]
{:pre [(uuid? id) (string? name)]}
(RenameShape. id name))
;; --- Update Rotation (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 (= :group type)
(let [items (map #(get-in state [:shapes %]) (:items shape))]
(as-> state $
(update-in $ [:shapes] dissoc id)
(reduce dissoc-from-index $ items)))
(update-in state [:shapes] dissoc id)))
(deftype UpdateShapeRotation [id rotation] (defn dissoc-from-page
udp/IPageUpdate "Given a shape, try to remove its reference from the
ptk/UpdateEvent corresponding page."
(update [_ state] [state {:keys [id page] :as shape}]
(assoc-in state [:shapes id :rotation] rotation))) (as-> (get-in state [:pages page :shapes]) $
(into [] (remove #(= % id) $))
(assoc-in state [:pages page :shapes] $)))
(defn update-rotation (defn dissoc-from-group
[id rotation] "Given a shape, try to remove its reference from the
{:pre [(uuid? id) corresponding group (only if it belongs to one group)."
(number? rotation) [state {:keys [id group] :as shape}]
(>= rotation 0) (if-let [group' (get-in state [:shapes group])]
(>= 360 rotation)]} (as-> (:items group') $
(UpdateShapeRotation. id rotation)) (into [] (remove #(= % id) $))
(assoc-in state [:shapes group :items] $))
state))
;; --- Update Dimensions (declare dissoc-shape)
(deftype UpdateDimensions [id dimensions] (defn clear-empty-groups
udp/IPageUpdate "Given the shape, try to clean all empty groups
ptk/UpdateEvent that this shape belongs to.
(update [_ state]
(update-in state [:shapes id] geom/resize-dim dimensions)))
(s/def ::update-dimensions-opts The main purpose of this function is remove the
(s/keys :opt-un [::width ::height])) all empty parent groups of recently removed
shape."
[state {:keys [group] :as shape}]
(if-let [group' (get-in state [:shapes group])]
(if (empty? (:items group'))
(-> (dissoc-shape state group')
(update-in [:workspace :selected] disj (:id group')))
state)
state))
(defn update-dimensions (defn dissoc-shape
"A helper event just for update the position "Given a shape, removes it from the state."
of the shape using the width and height attrs [state shape]
instread final point of coordinates." (as-> state $
[id opts] (dissoc-from-page $ shape)
{:pre [(uuid? id) (us/valid? ::update-dimensions-opts opts)]} (dissoc-from-group $ shape)
(UpdateDimensions. id opts)) (dissoc-from-index $ shape)
(clear-empty-groups $ shape)))
;; --- Update Shape Position ;; --- Shape Movements
(deftype UpdateShapePosition [id point] (defn- drop-at-index
udp/IPageUpdate [index coll v]
ptk/UpdateEvent (let [[fst snd] (split-at index coll)]
(update [_ state] (into [] (concat fst [v] snd))))
(update-in state [:shapes id] geom/absolute-move point)))
(defn update-position (defn drop-relative
"Update the start position coordenate of the shape." [state loc sid]
[id point] {:pre [(not (nil? sid))]}
{:pre [(uuid? id) (gpt/point? point)]} (let [shape (get-in state [:shapes (first sid)])
(UpdateShapePosition. id point)) {:keys [page group]} shape
sid (:id shape)
;; --- Update Shape Text shapes (if group
(get-in state [:shapes group :items])
(get-in state [:pages page :shapes]))
(deftype UpdateShapeTextContent [id text] index (case loc
udp/IPageUpdate :first 0
ptk/UpdateEvent :after (min (- (count shapes) 1) (inc (index-of shapes sid)))
(update [_ state] :before (max 0 (- (index-of shapes sid) 1))
(assoc-in state [:shapes id :content] text))) :last (- (count shapes) 1))
(defn update-text state (-> state
[id text] (dissoc-from-page shape)
{:pre [(uuid? id) (string? text)]} (dissoc-from-group shape))
(UpdateShapeTextContent. id text))
;; --- Update Shape Attrs shapes (if group
(get-in state [:shapes group :items])
(get-in state [:pages page :shapes]))
(declare UpdateAttrs) shapes (drop-at-index index shapes sid)]
;; TODO: moved
(deftype UpdateAttrs [id attrs]
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [type] :as shape} (get-in state [:shapes id])]
(if (= type :group)
(rx/from-coll (map #(UpdateAttrs. % attrs) (:items shape)))
(rx/of #(update-in % [:shapes id] merge attrs))))))
(defn update-attrs (if group
[id attrs] (as-> state $
{:pre [(uuid? id) (us/valid? ::attributes attrs)]} (assoc-in $ [:shapes group :items] shapes)
(let [atts (us/extract attrs ::attributes)] (update-in $ [:shapes sid] assoc :group group)
(UpdateAttrs. id attrs))) (clear-empty-groups $ shape))
(as-> state $
(assoc-in $ [:pages page :shapes] shapes)
(update-in $ [:shapes sid] dissoc :group)
(clear-empty-groups $ shape)))))
;; --- Shape Proportions (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 tid])
source (get-in state [:shapes sid])
(deftype LockShapeProportions [id] state (-> state
udp/IPageUpdate (dissoc-from-page source)
ptk/UpdateEvent (dissoc-from-group source))
(update [_ state]
(let [[width height] (-> (get-in state [:shapes id])
(geom/size)
(keep [:width :height]))
proportion (/ width height)]
(update-in state [:shapes id] assoc
:proportion proportion
:proportion-lock true))))
(defn lock-proportions shapes (if group
"Mark proportions of the shape locked and save the current (get-in state [:shapes group :items])
proportion as additional precalculated property." (get-in state [:pages page :shapes]))
[id]
{:pre [(uuid? id)]}
(LockShapeProportions. id))
(deftype UnlockShapeProportions [id] index (case loc
udp/IPageUpdate :after (inc (index-of shapes tid))
ptk/UpdateEvent :before (index-of shapes tid))
(update [_ state]
(assoc-in state [:shapes id :proportion-lock] false)))
(defn unlock-proportions shapes (drop-at-index index shapes sid)]
[id] (if group
{:pre [(uuid? id)]} (as-> state $
(UnlockShapeProportions. id)) (assoc-in $ [:shapes group :items] shapes)
(update-in $ [:shapes sid] assoc :group group)
(clear-empty-groups $ source))
(as-> state $
(assoc-in $ [:pages page :shapes] shapes)
(update-in $ [:shapes sid] dissoc :group)
(clear-empty-groups $ source)))))
;; --- Group Collapsing (def drop-after #(drop-aside %1 :after %2 %3))
(def drop-before #(drop-aside %1 :before %2 %3))
(deftype CollapseGroupShape [id] (defn drop-inside
udp/IPageUpdate [state tid sid]
ptk/UpdateEvent {:pre [(not= tid sid)]}
(update [_ state] (let [source (get-in state [:shapes sid])
(update-in state [:shapes id] assoc :collapsed true))) state (-> state
(dissoc-from-page source)
(defn collapse-shape (dissoc-from-group source))
[id] shapes (get-in state [:shapes tid :items])]
{:pre [(uuid? id)]} (if (seq shapes)
(CollapseGroupShape. id)) (as-> state $
(assoc-in $ [:shapes tid :items] (conj shapes sid))
(deftype UncollapseGroupShape [id] (update-in $ [:shapes sid] assoc :group tid))
udp/IPageUpdate state)))
ptk/UpdateEvent
(update [_ state]
(update-in state [:shapes id] assoc :collapsed false)))
(defn uncollapse-shape
[id]
{:pre [(uuid? id)]}
(UncollapseGroupShape. id))
;; --- Shape Visibility
(deftype HideShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-hidden [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :hidden] true)
(reduce mark-hidden $ (:items shape)))
(assoc-in state [:shapes id :hidden] true))))]
(mark-hidden state id))))
(defn hide-shape
[id]
{:pre [(uuid? id)]}
(HideShape. id))
(deftype ShowShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-visible [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :hidden] false)
(reduce mark-visible $ (:items shape)))
(assoc-in state [:shapes id :hidden] false))))]
(mark-visible state id))))
(defn show-shape
[id]
{:pre [(uuid? id)]}
(ShowShape. id))
;; --- Shape Blocking
(deftype BlockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-blocked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :blocked] true)
(reduce mark-blocked $ (:items shape)))
(assoc-in state [:shapes id :blocked] true))))]
(mark-blocked state id))))
(defn block-shape
[id]
{:pre [(uuid? id)]}
(BlockShape. id))
(deftype UnblockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-unblocked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :blocked] false)
(reduce mark-unblocked $ (:items shape)))
(assoc-in state [:shapes id :blocked] false))))]
(mark-unblocked state id))))
(defn unblock-shape
[id]
{:pre [(uuid? id)]}
(UnblockShape. id))
;; --- Shape Locking
(deftype LockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-locked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :locked] true)
(reduce mark-locked $ (:items shape)))
(assoc-in state [:shapes id :locked] true))))]
(mark-locked state id))))
(defn lock-shape
[id]
{:pre [(uuid? id)]}
(LockShape. id))
(deftype UnlockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-unlocked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :locked] false)
(reduce mark-unlocked $ (:items shape)))
(assoc-in state [:shapes id :locked] false))))]
(mark-unlocked state id))))
(defn unlock-shape
[id]
{:pre [(uuid? id)]}
(UnlockShape. id))
;; --- Drop Shape
(deftype DropShape [sid tid loc]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(impl/drop-shape state sid tid loc)))
(defn drop-shape (defn drop-shape
"Event used in drag and drop for transfer shape [state sid tid loc]
from one position to an other." (if (= tid sid)
[sid tid loc] state
{:pre [(uuid? sid) (case loc
(uuid? tid) :inside (drop-inside state tid sid)
(keyword? loc)]} :before (drop-before state tid sid)
(DropShape. sid tid loc)) :after (drop-after state tid sid)
(throw (ex-info "Invalid data" {})))))
;; --- Update Interaction (defn move-layer
[state shape loc]
(case loc
:up (drop-relative state :before shape)
:down (drop-relative state :after shape)
:top (drop-relative state :first shape)
:bottom (drop-relative state :last shape)
(throw (ex-info "Invalid data" {}))))
(deftype UpdateInteraction [shape interaction] ;; --- Shape Selection
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(let [id (or (:id interaction)
(uuid/random))
data (assoc interaction :id id)]
(assoc-in state [:shapes shape :interactions id] data))))
(defn update-interaction (defn- try-match-shape
[shape interaction] [xf selrect acc {:keys [type id items] :as shape}]
(UpdateInteraction. shape interaction)) (cond
(geom/contained-in? shape selrect)
(conj acc id)
;; --- Delete Interaction (geom/overlaps? shape selrect)
(conj acc id)
(deftype DeleteInteracton [shape id] (:locked shape)
udp/IPageUpdate acc
ptk/UpdateEvent
(update [_ state]
(update-in state [:shapes shape :interactions] dissoc id)))
(defn delete-interaction (= type :group)
[shape id] (reduce (partial try-match-shape xf selrect)
{:pre [(uuid? id) (uuid? shape)]} acc (sequence xf items))
(DeleteInteracton. shape id))
;; --- Path Modifications :else
acc))
(deftype UpdatePath [id index delta] (defn match-by-selrect
ptk/UpdateEvent [state page-id selrect]
(update [_ state] (let [xf (comp (map #(get-in state [:shapes %]))
(update-in state [:shapes id :segments index] gpt/add delta))) (remove :hidden)
(remove :blocked)
(map geom/selection-rect))
match (partial try-match-shape xf selrect)
shapes (get-in state [:pages page-id :shapes])]
(reduce match #{} (sequence xf shapes))))
(defn update-path (defn group-shapes
"Update a concrete point in the path shape." [state shapes page]
[id index delta] (letfn [(replace-first-item [pred coll replacement]
{:pre [(uuid? id) (number? index) (gpt/point? delta)]} (into []
(UpdatePath. id index delta)) (concat
(take-while #(not (pred %)) coll)
[replacement]
(drop 1 (drop-while #(not (pred %)) coll)))))
(deftype InitialPathPointAlign [id index] (move-shapes-to-new-group [state page shapes new-group]
ptk/WatchEvent (reduce (fn [state {:keys [id group] :as shape}]
(watch [_ state s] (-> state
(let [shape (get-in state [:shapes id]) (update-in [:shapes group :items] #(remove (set [id]) %))
point (get-in shape [:segments index])] (update-in [:pages page :shapes] #(remove (set [id]) %))
(->> (uwrk/align-point point) (clear-empty-groups shape)
(rx/map #(update-path id index %)))))) (assoc-in [:shapes id :group] new-group)
))
state
shapes))
(defn initial-path-point-align (update-shapes-on-page [state page shapes group]
"Event responsible of align a specified point of the (as-> (get-in state [:pages page :shapes]) $
shape by `index` with the grid." (replace-first-item (set shapes) $ group)
[id index] (remove (set shapes) $)
{:pre [(uuid? id) (into [] $)
(number? index) (assoc-in state [:pages page :shapes] $)))
(not (neg? index))]}
(InitialPathPointAlign. id index))
;; --- Events (implicit) (for selected) (update-shapes-on-group [state parent-group shapes group]
(as-> (get-in state [:shapes parent-group :items]) $
(replace-first-item (set shapes) $ group)
(remove (set shapes) $)
(into [] $)
(assoc-in state [:shapes parent-group :items] $)))
;; NOTE: moved to workspace (update-shapes-on-index [state shapes group]
(deftype DeselectAll [] (reduce (fn [state {:keys [id] :as shape}]
ptk/UpdateEvent (as-> shape $
(update [_ state] (assoc $ :group group)
(assoc-in state [:workspace :selected] #{})) (assoc-in state [:shapes id] $)))
state
shapes))]
(let [sid (uuid/random)
shapes' (map #(get-in state [:shapes %]) shapes)
distinct-groups (distinct (map :group shapes'))
parent-group (cond
(not= 1 (count distinct-groups)) :multi
(nil? (first distinct-groups)) :page
:else (first distinct-groups))
name (generate-unique-name state "Group")
group {:type :group
:name name
:items (into [] shapes)
:id sid
:page page}]
(as-> state $
(update-shapes-on-index $ shapes' sid)
(cond
(= :multi parent-group)
(-> $
(move-shapes-to-new-group page shapes' sid)
(update-in [:pages page :shapes] #(into [] (cons sid %))))
(= :page parent-group)
(update-shapes-on-page $ page shapes sid)
:else
(update-shapes-on-group $ parent-group shapes sid))
(update $ :shapes assoc sid group)
(cond
(= :multi parent-group) $
(= :page parent-group) $
:else (assoc-in $ [:shapes sid :group] parent-group))
(update $ :workspace assoc :selected #{sid})))))
ptk/WatchEvent (defn degroup-shapes
(watch [_ state stream] [state shapes page-id]
(rx/just ::uev/interrupt))) (letfn [(get-relocation-position [state {id :id parent-id :group}]
(if (nil? parent-id)
(index-of (get-in state [:pages page-id :shapes]) id)
(index-of (get-in state [:shapes parent-id :items]) id)))
(defn deselect-all (relocate-shape [state shape-id parent-id position]
"Clear all possible state of drawing, edition (if (nil? parent-id)
or any similar action taken by the user." (-> state
[] (update-in [:pages page-id :shapes] #(drop-at-index position % shape-id))
(DeselectAll.)) (update-in [:shapes shape-id] dissoc :group))
(-> state
(update-in [:shapes parent-id :items] #(drop-at-index position % shape-id))
(assoc-in [:shapes shape-id :group] parent-id))))
;; --- Group Selected Shapes (remove-group [state {id :id parent-id :group}]
(let [xform (remove #{id})]
(as-> state $
(update $ :shapes dissoc id)
(if (nil? parent-id)
(update-in $ [:pages page-id :shapes] #(into [] xform %))
(update-in $ [:shapes parent-id :items] #(into [] xform %))))))
(deftype GroupSelectedShapes [] (relocate-group-items [state {id :id parent-id :group items :items :as group}]
udp/IPageUpdate (let [position (get-relocation-position state group)]
ptk/UpdateEvent (as-> state $
(update [_ state] (reduce #(relocate-shape %1 %2 parent-id position) $ (reverse items))
(let [id (get-in state [:workspace :page]) (remove-group $ group))))
selected (get-in state [:workspace :selected])]
(assert (not (empty? selected)) "selected set is empty")
(assert (uuid? id) "selected page is not an uuid")
(impl/group-shapes state selected id))))
(defn group-selected (select-degrouped [state groups]
[] (let [items (into #{} (mapcat :items groups))]
(GroupSelectedShapes.)) (assoc-in state [:workspace :selected] items)))
;; --- Ungroup Selected Shapes (remove-from-parent [state id parent-id]
(assert (not (nil? parent-id)) "parent-id should never be nil here")
(update-in state [:shapes parent-id :items] #(into [] (remove #{id}) %)))
(deftype UngroupSelectedShapes [] (strip-empty-groups [state parent-id]
udp/IPageUpdate (if (nil? parent-id)
ptk/UpdateEvent state
(update [_ state] (let [group (get-in state [:shapes parent-id])]
(let [id (get-in state [:workspace :page]) (if (empty? (:items group))
selected (get-in state [:workspace :selected])] (-> state
(assert (not (empty? selected)) "selected set is empty") (remove-group group)
(assert (uuid? id) "selected page is not an uuid") (strip-empty-groups (:group group)))
(impl/degroup-shapes state selected id)))) state))))
(defn ungroup-selected (selective-degroup [state [shape & rest :as shapes]]
[] (let [group (get-in state [:shapes (:group shape)])
(UngroupSelectedShapes.)) position (get-relocation-position state group)
parent-id (:group group)]
(as-> state $
(assoc-in $ [:workspace :selected] (into #{} (map :id shapes)))
(reduce (fn [state {shape-id :id}]
(-> state
(relocate-shape shape-id parent-id position)
(remove-from-parent shape-id (:id group))))
$ (reverse shapes))
(strip-empty-groups $ (:id group)))))]
;; --- Duplicate Selected (let [shapes (into #{} (map #(get-in state [:shapes %])) shapes)
groups (into #{} (filter #(= (:type %) :group)) shapes)
parents (into #{} (map :group) shapes)]
(cond
(and (= (count shapes) (count groups))
(= 1 (count parents))
(not (empty? groups)))
(as-> state $
(reduce relocate-group-items $ groups)
(reduce remove-group $ groups)
(select-degrouped $ groups))
(deftype DuplicateSelected [] (and (empty? groups)
udp/IPageUpdate (= 1 (count parents))
ptk/UpdateEvent (not (nil? (first parents))))
(update [_ state] (selective-degroup state shapes)
(let [selected (get-in state [:workspace :selected])]
(impl/duplicate-shapes state selected))))
(defn duplicate-selected
[]
(DuplicateSelected.))
:else
(throw (ex-info "invalid condition for degrouping" {}))))))
(defn materialize-xfmt
[state id xfmt]
(let [{:keys [type items] :as shape} (get-in state [:shapes id])]
(if (= type :group)
(reduce #(materialize-xfmt %1 %2 xfmt) state items)
(update-in state [:shapes id] geom/transform xfmt))))

470
frontend/src/uxbox/main/data/shapes_impl.cljs
View file

@ -1,470 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2015-2017 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.main.data.shapes-impl
(:require [lentes.core :as l]
[uxbox.main.geom :as geom]
[uxbox.main.lenses :as ul]
[uxbox.util.geom.matrix :as gmt]
[uxbox.util.uuid :as uuid]
[uxbox.util.data :refer (index-of)]))
;; --- Shape Creation
(defn retrieve-used-names
"Returns a set of already used names by shapes
in the current page."
[{:keys [shapes] :as state}]
(let [page (l/focus ul/selected-page state)
xform (comp (map second)
(filter #(= page (:page %)))
(map :name))]
(into #{} xform shapes)))
(defn generate-unique-name
"A unique name generator based on the previous
state of the used names."
[state basename]
(let [used (retrieve-used-names state)]
(loop [counter 1]
(let [candidate (str basename "-" counter)]
(if (contains? used candidate)
(recur (inc counter))
candidate)))))
(defn assoc-shape-to-page
[state shape page]
(let [shape-id (uuid/random)
shape-name (generate-unique-name state (:name shape))
shape (assoc shape
:page page
:id shape-id
:name shape-name)]
(-> state
(update-in [:pages page :shapes] #(into [] (cons shape-id %)))
(assoc-in [:shapes shape-id] shape))))
(defn duplicate-shapes'
([state shapes page]
(duplicate-shapes' state shapes page nil))
([state shapes page group]
(letfn [(duplicate-shape [state shape page group]
(if (= (:type shape) :group)
(let [id (uuid/random)
items (:items shape)
name (generate-unique-name state (str (:name shape) "-copy"))
shape (assoc shape
:id id
:page page
:items []
:name name)
state (if (nil? group)
(-> state
(update-in [:pages page :shapes]
#(into [] (cons id %)))
(assoc-in [:shapes id] shape))
(-> state
(update-in [:shapes group :items]
#(into [] (cons id %)))
(assoc-in [:shapes id] shape)))]
(->> (map #(get-in state [:shapes %]) items)
(reverse)
(reduce #(duplicate-shape %1 %2 page id) state)))
(let [id (uuid/random)
name (generate-unique-name state (str (:name shape) "-copy"))
shape (-> (dissoc shape :group)
(assoc :id id :page page :name name)
(merge (when group {:group group})))]
(if (nil? group)
(-> state
(update-in [:pages page :shapes] #(into [] (cons id %)))
(assoc-in [:shapes id] shape))
(-> state
(update-in [:shapes group :items] #(into [] (cons id %)))
(assoc-in [:shapes id] shape))))))]
(reduce #(duplicate-shape %1 %2 page group) state shapes))))
(defn duplicate-shapes
([state shapes]
(duplicate-shapes state shapes nil))
([state shapes page]
(letfn [(all-toplevel? [coll]
(every? #(nil? (:group %)) coll))
(all-same-group? [coll]
(let [group (:group (first coll))]
(every? #(= group (:group %)) coll)))]
(let [shapes (reverse (mapv #(get-in state [:shapes %]) shapes))]
(cond
(all-toplevel? shapes)
(let [page (or page (:page (first shapes)))]
(duplicate-shapes' state shapes page))
(all-same-group? shapes)
(let [page (or page (:page (first shapes)))
group (:group (first shapes))]
(duplicate-shapes' state shapes page group))
:else
(let [page (or page (:page (first shapes)))]
(duplicate-shapes' state shapes page)))))))
;; --- 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 (= :group type)
(let [items (map #(get-in state [:shapes %]) (:items shape))]
(as-> state $
(update-in $ [:shapes] dissoc id)
(reduce dissoc-from-index $ items)))
(update-in state [:shapes] 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 page :shapes]) $
(into [] (remove #(= % id) $))
(assoc-in state [:pages 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 group])]
(as-> (:items group') $
(into [] (remove #(= % id) $))
(assoc-in state [:shapes 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 group])]
(if (empty? (:items group'))
(-> (dissoc-shape state group')
(update-in [:workspace :selected] disj (:id 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-relative
[state loc sid]
{:pre [(not (nil? sid))]}
(let [shape (get-in state [:shapes (first sid)])
{:keys [page group]} shape
sid (:id shape)
shapes (if group
(get-in state [:shapes group :items])
(get-in state [:pages page :shapes]))
index (case loc
:first 0
:after (min (- (count shapes) 1) (inc (index-of shapes sid)))
:before (max 0 (- (index-of shapes sid) 1))
:last (- (count shapes) 1))
state (-> state
(dissoc-from-page shape)
(dissoc-from-group shape))
shapes (if group
(get-in state [:shapes group :items])
(get-in state [:pages page :shapes]))
shapes (drop-at-index index shapes sid)]
(if group
(as-> state $
(assoc-in $ [:shapes group :items] shapes)
(update-in $ [:shapes sid] assoc :group group)
(clear-empty-groups $ shape))
(as-> state $
(assoc-in $ [:pages page :shapes] shapes)
(update-in $ [:shapes sid] dissoc :group)
(clear-empty-groups $ shape)))))
(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 tid])
source (get-in state [:shapes sid])
state (-> state
(dissoc-from-page source)
(dissoc-from-group source))
shapes (if group
(get-in state [:shapes group :items])
(get-in state [:pages 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 group :items] shapes)
(update-in $ [:shapes sid] assoc :group group)
(clear-empty-groups $ source))
(as-> state $
(assoc-in $ [:pages page :shapes] shapes)
(update-in $ [:shapes sid] dissoc :group)
(clear-empty-groups $ source)))))
(def drop-after #(drop-aside %1 :after %2 %3))
(def drop-before #(drop-aside %1 :before %2 %3))
(defn drop-inside
[state tid sid]
{:pre [(not= tid sid)]}
(let [source (get-in state [:shapes sid])
state (-> state
(dissoc-from-page source)
(dissoc-from-group source))
shapes (get-in state [:shapes tid :items])]
(if (seq shapes)
(as-> state $
(assoc-in $ [:shapes tid :items] (conj shapes sid))
(update-in $ [:shapes sid] assoc :group tid))
state)))
(defn drop-shape
[state sid tid loc]
(if (= tid sid)
state
(case loc
:inside (drop-inside state tid sid)
:before (drop-before state tid sid)
:after (drop-after state tid sid)
(throw (ex-info "Invalid data" {})))))
(defn move-layer
[state shape loc]
(case loc
:up (drop-relative state :before shape)
:down (drop-relative state :after shape)
:top (drop-relative state :first shape)
:bottom (drop-relative state :last shape)
(throw (ex-info "Invalid data" {}))))
;; --- Shape Selection
(defn- try-match-shape
[xf selrect acc {:keys [type id items] :as shape}]
(cond
(geom/contained-in? shape selrect)
(conj acc id)
(geom/overlaps? shape selrect)
(conj acc id)
(:locked shape)
acc
(= type :group)
(reduce (partial try-match-shape xf selrect)
acc (sequence xf items))
:else
acc))
(defn match-by-selrect
[state page-id selrect]
(let [xf (comp (map #(get-in state [:shapes %]))
(remove :hidden)
(remove :blocked)
(map geom/selection-rect))
match (partial try-match-shape xf selrect)
shapes (get-in state [:pages page-id :shapes])]
(reduce match #{} (sequence xf shapes))))
(defn group-shapes
[state shapes page]
(letfn [(replace-first-item [pred coll replacement]
(into []
(concat
(take-while #(not (pred %)) coll)
[replacement]
(drop 1 (drop-while #(not (pred %)) coll)))))
(move-shapes-to-new-group [state page shapes new-group]
(reduce (fn [state {:keys [id group] :as shape}]
(-> state
(update-in [:shapes group :items] #(remove (set [id]) %))
(update-in [:pages page :shapes] #(remove (set [id]) %))
(clear-empty-groups shape)
(assoc-in [:shapes id :group] new-group)
))
state
shapes))
(update-shapes-on-page [state page shapes group]
(as-> (get-in state [:pages page :shapes]) $
(replace-first-item (set shapes) $ group)
(remove (set shapes) $)
(into [] $)
(assoc-in state [:pages page :shapes] $)))
(update-shapes-on-group [state parent-group shapes group]
(as-> (get-in state [:shapes parent-group :items]) $
(replace-first-item (set shapes) $ group)
(remove (set shapes) $)
(into [] $)
(assoc-in state [:shapes parent-group :items] $)))
(update-shapes-on-index [state shapes group]
(reduce (fn [state {:keys [id] :as shape}]
(as-> shape $
(assoc $ :group group)
(assoc-in state [:shapes id] $)))
state
shapes))]
(let [sid (uuid/random)
shapes' (map #(get-in state [:shapes %]) shapes)
distinct-groups (distinct (map :group shapes'))
parent-group (cond
(not= 1 (count distinct-groups)) :multi
(nil? (first distinct-groups)) :page
:else (first distinct-groups))
name (generate-unique-name state "Group")
group {:type :group
:name name
:items (into [] shapes)
:id sid
:page page}]
(as-> state $
(update-shapes-on-index $ shapes' sid)
(cond
(= :multi parent-group)
(-> $
(move-shapes-to-new-group page shapes' sid)
(update-in [:pages page :shapes] #(into [] (cons sid %))))
(= :page parent-group)
(update-shapes-on-page $ page shapes sid)
:else
(update-shapes-on-group $ parent-group shapes sid))
(update $ :shapes assoc sid group)
(cond
(= :multi parent-group) $
(= :page parent-group) $
:else (assoc-in $ [:shapes sid :group] parent-group))
(update $ :workspace assoc :selected #{sid})))))
(defn degroup-shapes
[state shapes page-id]
(letfn [(get-relocation-position [state {id :id parent-id :group}]
(if (nil? parent-id)
(index-of (get-in state [:pages page-id :shapes]) id)
(index-of (get-in state [:shapes parent-id :items]) id)))
(relocate-shape [state shape-id parent-id position]
(if (nil? parent-id)
(-> state
(update-in [:pages page-id :shapes] #(drop-at-index position % shape-id))
(update-in [:shapes shape-id] dissoc :group))
(-> state
(update-in [:shapes parent-id :items] #(drop-at-index position % shape-id))
(assoc-in [:shapes shape-id :group] parent-id))))
(remove-group [state {id :id parent-id :group}]
(let [xform (remove #{id})]
(as-> state $
(update $ :shapes dissoc id)
(if (nil? parent-id)
(update-in $ [:pages page-id :shapes] #(into [] xform %))
(update-in $ [:shapes parent-id :items] #(into [] xform %))))))
(relocate-group-items [state {id :id parent-id :group items :items :as group}]
(let [position (get-relocation-position state group)]
(as-> state $
(reduce #(relocate-shape %1 %2 parent-id position) $ (reverse items))
(remove-group $ group))))
(select-degrouped [state groups]
(let [items (into #{} (mapcat :items groups))]
(assoc-in state [:workspace :selected] items)))
(remove-from-parent [state id parent-id]
(assert (not (nil? parent-id)) "parent-id should never be nil here")
(update-in state [:shapes parent-id :items] #(into [] (remove #{id}) %)))
(strip-empty-groups [state parent-id]
(if (nil? parent-id)
state
(let [group (get-in state [:shapes parent-id])]
(if (empty? (:items group))
(-> state
(remove-group group)
(strip-empty-groups (:group group)))
state))))
(selective-degroup [state [shape & rest :as shapes]]
(let [group (get-in state [:shapes (:group shape)])
position (get-relocation-position state group)
parent-id (:group group)]
(as-> state $
(assoc-in $ [:workspace :selected] (into #{} (map :id shapes)))
(reduce (fn [state {shape-id :id}]
(-> state
(relocate-shape shape-id parent-id position)
(remove-from-parent shape-id (:id group))))
$ (reverse shapes))
(strip-empty-groups $ (:id group)))))]
(let [shapes (into #{} (map #(get-in state [:shapes %])) shapes)
groups (into #{} (filter #(= (:type %) :group)) shapes)
parents (into #{} (map :group) shapes)]
(cond
(and (= (count shapes) (count groups))
(= 1 (count parents))
(not (empty? groups)))
(as-> state $
(reduce relocate-group-items $ groups)
(reduce remove-group $ groups)
(select-degrouped $ groups))
(and (empty? groups)
(= 1 (count parents))
(not (nil? (first parents))))
(selective-degroup state shapes)
:else
(throw (ex-info "invalid condition for degrouping" {}))))))
(defn materialize-xfmt
[state id xfmt]
(let [{:keys [type items] :as shape} (get-in state [:shapes id])]
(if (= type :group)
(reduce #(materialize-xfmt %1 %2 xfmt) state items)
(update-in state [:shapes id] geom/transform xfmt))))

414
frontend/src/uxbox/main/data/workspace.cljs
View file

@ -7,24 +7,21 @@
(ns uxbox.main.data.workspace (ns uxbox.main.data.workspace
(:require (:require
[beicon.core :as rx] [beicon.core :as rx]
;; [uxbox.main.data.workspace.ruler :as wruler]
[cljs.spec.alpha :as s] [cljs.spec.alpha :as s]
[potok.core :as ptk] [potok.core :as ptk]
[uxbox.config :as cfg] [uxbox.config :as cfg]
[uxbox.main.constants :as c] [uxbox.main.constants :as c]
[uxbox.main.data.history :as udh] [uxbox.main.data.history :as udh]
[uxbox.main.data.icons :as udi] [uxbox.main.data.icons :as udi]
[uxbox.main.data.lightbox :as udl]
[uxbox.main.data.pages :as udp] [uxbox.main.data.pages :as udp]
[uxbox.main.data.projects :as dp] [uxbox.main.data.projects :as dp]
[uxbox.main.data.shapes :as uds] [uxbox.main.data.shapes :as ds]
[uxbox.main.data.shapes-impl :as simpl]
[uxbox.main.data.workspace.ruler :as wruler]
[uxbox.main.geom :as geom] [uxbox.main.geom :as geom]
[uxbox.main.lenses :as ul]
[uxbox.main.refs :as refs] [uxbox.main.refs :as refs]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.workers :as uwrk] [uxbox.main.workers :as uwrk]
[uxbox.util.data :refer [dissoc-in index-of]] [uxbox.util.data :refer [dissoc-in index-of seek]]
[uxbox.util.forms :as sc] [uxbox.util.forms :as sc]
[uxbox.util.geom.matrix :as gmt] [uxbox.util.geom.matrix :as gmt]
[uxbox.util.geom.point :as gpt] [uxbox.util.geom.point :as gpt]
@ -35,8 +32,10 @@
;; --- Expose inner functions ;; --- Expose inner functions
(def start-ruler wruler/start-ruler) (def start-ruler nil)
(def clear-ruler wruler/clear-ruler) (def clear-ruler nil)
(defn interrupt? [e] (= e :interrupt))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; General workspace events ;; General workspace events
@ -258,7 +257,7 @@
(->> (:clipboard state) (->> (:clipboard state)
(filter #(= id (:id %))) (filter #(= id (:id %)))
(first)))] (first)))]
(simpl/duplicate-shapes state (:items selected) page-id)))) (ds/duplicate-shapes state (:items selected) page-id))))
(defn paste-from-clipboard (defn paste-from-clipboard
"Copy selected shapes to clipboard." "Copy selected shapes to clipboard."
@ -327,18 +326,51 @@
{:pre [(uuid? id)]} {:pre [(uuid? id)]}
(InitializeAlignment. id)) (InitializeAlignment. id))
;; --- Duplicate Selected
(def duplicate-selected
(reify
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(let [selected (get-in state [:workspace :selected])]
(ds/duplicate-shapes state selected)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shapes on Workspace events ;; Shapes events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn add-shape
[data]
{:pre [(us/valid? ::ds/shape data)]}
(reify
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
;; TODO: revisit the `setup-proportions` seems unnecesary
(let [shape (assoc (geom/setup-proportions data)
:id (uuid/random))
pid (get-in state [:workspace :current])]
(ds/assoc-shape-to-page state shape pid)))))
(defn delete-shape
[id]
{:pre [(uuid? id)]}
(reify
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(let [shape (get-in state [:shapes id])]
(ds/dissoc-shape state shape)))))
(defrecord SelectShape [id] (defrecord SelectShape [id]
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [page-id (get-in state [:workspace :current]) (let [pid (get-in state [:workspace :current])
selected (get-in state [:workspace page-id :selected])] selected (get-in state [:workspace pid :selected])]
(if (contains? selected id) (if (contains? selected id)
(update-in state [:workspace page-id :selected] disj id) (update-in state [:workspace pid :selected] disj id)
(update-in state [:workspace page-id :selected] conj id)))) (update-in state [:workspace pid :selected] conj id))))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
@ -353,9 +385,10 @@
(defrecord DeselectAll [] (defrecord DeselectAll []
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [page-id (get-in state [:workspace :current])] (let [pid (get-in state [:workspace :current])]
(assoc-in state [:workspace page-id :selected] #{}))) (update-in state [:workspace pid] #(-> %
(assoc :selected #{})
(dissoc :selected-canvas)))))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(rx/just :interrupt))) (rx/just :interrupt)))
@ -388,7 +421,7 @@
(update [_ state] (update [_ state]
(let [pid (get-in state [:workspace :current]) (let [pid (get-in state [:workspace :current])
selrect (get-in state [:workspace pid :selrect]) selrect (get-in state [:workspace pid :selrect])
shapes (simpl/match-by-selrect state pid selrect)] shapes (ds/match-by-selrect state pid selrect)]
(assoc-in state [:workspace pid :selected] shapes))))) (assoc-in state [:workspace pid :selected] shapes)))))
;; --- Update Shape Attrs ;; --- Update Shape Attrs
@ -400,8 +433,8 @@
(defn update-shape-attrs (defn update-shape-attrs
[id attrs] [id attrs]
{:pre [(uuid? id) (us/valid? ::uds/attributes attrs)]} {:pre [(uuid? id) (us/valid? ::ds/attributes attrs)]}
(let [atts (us/extract attrs ::uds/attributes)] (let [atts (us/extract attrs ::ds/attributes)]
(UpdateShapeAttrs. id attrs))) (UpdateShapeAttrs. id attrs)))
;; --- Update Selected Shapes attrs ;; --- Update Selected Shapes attrs
@ -416,7 +449,7 @@
(defn update-selected-shapes-attrs (defn update-selected-shapes-attrs
[attrs] [attrs]
{:pre [(us/valid? ::uds/attributes attrs)]} {:pre [(us/valid? ::ds/attributes attrs)]}
(UpdateSelectedShapesAttrs. attrs)) (UpdateSelectedShapesAttrs. attrs))
@ -486,27 +519,49 @@
(update [_ state] (update [_ state]
(let [id (get-in state [:workspace :current]) (let [id (get-in state [:workspace :current])
selected (get-in state [:workspace id :selected])] selected (get-in state [:workspace id :selected])]
(simpl/move-layer state selected loc)))) (ds/move-layer state selected loc))))
(defn move-selected-layer (defn move-selected-layer
[loc] [loc]
{:pre [(us/valid? ::direction loc)]} {:pre [(us/valid? ::direction loc)]}
(MoveSelectedLayer. loc)) (MoveSelectedLayer. loc))
;; --- Update Shape Position
(deftype UpdateShapePosition [id point]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(update-in state [:shapes id] geom/absolute-move point)))
(defn update-position
"Update the start position coordenate of the shape."
[id point]
{:pre [(uuid? id) (gpt/point? point)]}
(UpdateShapePosition. id point))
;; --- Delete Selected ;; --- Delete Selected
(defrecord DeleteSelected [] (def delete-selected
ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace :current])
selected (get-in state [:workspace id :selected])]
(rx/from-coll
(into [(deselect-all)] (map #(uds/delete-shape %) selected))))))
(defn delete-selected
"Deselect all and remove all selected shapes." "Deselect all and remove all selected shapes."
[] (reify
(DeleteSelected.)) ptk/WatchEvent
(watch [_ state stream]
(let [id (get-in state [:workspace :current])
selected (get-in state [:workspace id :selected])]
(rx/from-coll
(into [(deselect-all)] (map #(delete-shape %) selected)))))))
;; --- Rename Shape
(defn rename-shape
[id name]
{:pre [(uuid? id) (string? name)]}
(reify
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:shapes id :name] name))))
;; --- Change Shape Order (Ordering) ;; --- Change Shape Order (Ordering)
@ -563,7 +618,7 @@
(let [pid (get-in state [:workspace :current]) (let [pid (get-in state [:workspace :current])
displacement (get-in state [:workspace pid :modifiers id :displacement])] displacement (get-in state [:workspace pid :modifiers id :displacement])]
(if (gmt/matrix? displacement) (if (gmt/matrix? displacement)
(rx/of #(simpl/materialize-xfmt % id displacement) (rx/of #(ds/materialize-xfmt % id displacement)
#(update-in % [:workspace pid :modifiers id] dissoc :displacement) #(update-in % [:workspace pid :modifiers id] dissoc :displacement)
::udp/page-update) ::udp/page-update)
(rx/empty))))) (rx/empty)))))
@ -595,7 +650,7 @@
(let [pid (get-in state [:workspace :current]) (let [pid (get-in state [:workspace :current])
resize (get-in state [:workspace pid :modifiers id :resize])] resize (get-in state [:workspace pid :modifiers id :resize])]
(if (gmt/matrix? resize) (if (gmt/matrix? resize)
(rx/of #(simpl/materialize-xfmt % id resize) (rx/of #(ds/materialize-xfmt % id resize)
#(update-in % [:workspace pid :modifiers id] dissoc :resize) #(update-in % [:workspace pid :modifiers id] dissoc :resize)
::udp/page-update) ::udp/page-update)
(rx/empty))))) (rx/empty)))))
@ -627,19 +682,252 @@
;; --- Select for Drawing ;; --- Select for Drawing
(defn select-for-drawing (def clear-drawing
[shape]
(reify (reify
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [pid (get-in state [:workspace :current]) (let [pid (get-in state [:workspace :current])]
current (get-in state [:workspace pid :drawing-tool])] (update-in state [:workspace pid] dissoc :drawing-tool :drawing)))))
(if (or (nil? shape)
(= shape current)) (defn select-for-drawing?
(update-in state [:workspace pid] dissoc :drawing :drawing-tool) [e]
(update-in state [:workspace pid] assoc (= (::type (meta e)) ::select-for-drawing))
:drawing shape
:drawing-tool shape)))))) (defn select-for-drawing
[tool]
(reify
IMeta
(-meta [_] {::type ::select-for-drawing})
ptk/UpdateEvent
(update [_ state]
(prn "select-for-drawing" tool)
(let [pid (get-in state [:workspace :current])]
(update-in state [:workspace pid] assoc :drawing-tool tool)))))
;; --- Shape Proportions
(deftype LockShapeProportions [id]
ptk/UpdateEvent
(update [_ state]
(let [[width height] (-> (get-in state [:shapes id])
(geom/size)
(keep [:width :height]))
proportion (/ width height)]
(update-in state [:shapes id] assoc
:proportion proportion
:proportion-lock true))))
(defn lock-proportions
"Mark proportions of the shape locked and save the current
proportion as additional precalculated property."
[id]
{:pre [(uuid? id)]}
(LockShapeProportions. id))
(deftype UnlockShapeProportions [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:shapes id :proportion-lock] false)))
(defn unlock-proportions
[id]
{:pre [(uuid? id)]}
(UnlockShapeProportions. id))
;; --- Update Dimensions
(deftype UpdateDimensions [id dimensions]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(update-in state [:shapes id] geom/resize-dim dimensions)))
(s/def ::update-dimensions-opts
(s/keys :opt-un [::width ::height]))
(defn update-dimensions
"A helper event just for update the position
of the shape using the width and height attrs
instread final point of coordinates."
[id opts]
{:pre [(uuid? id) (us/valid? ::update-dimensions-opts opts)]}
(UpdateDimensions. id opts))
;; --- Update Interaction
(deftype UpdateInteraction [shape interaction]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(let [id (or (:id interaction)
(uuid/random))
data (assoc interaction :id id)]
(assoc-in state [:shapes shape :interactions id] data))))
(defn update-interaction
[shape interaction]
(UpdateInteraction. shape interaction))
;; --- Delete Interaction
(deftype DeleteInteracton [shape id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(update-in state [:shapes shape :interactions] dissoc id)))
(defn delete-interaction
[shape id]
{:pre [(uuid? id) (uuid? shape)]}
(DeleteInteracton. shape id))
;; --- Path Modifications
(deftype UpdatePath [id index delta]
ptk/UpdateEvent
(update [_ state]
(update-in state [:shapes id :segments index] gpt/add delta)))
(defn update-path
"Update a concrete point in the path shape."
[id index delta]
{:pre [(uuid? id) (number? index) (gpt/point? delta)]}
(UpdatePath. id index delta))
;; --- Initial Path Point Alignment
(deftype InitialPathPointAlign [id index]
ptk/WatchEvent
(watch [_ state s]
(let [shape (get-in state [:shapes id])
point (get-in shape [:segments index])]
(->> (uwrk/align-point point)
(rx/map #(update-path id index %))))))
(defn initial-path-point-align
"Event responsible of align a specified point of the
shape by `index` with the grid."
[id index]
{:pre [(uuid? id)
(number? index)
(not (neg? index))]}
(InitialPathPointAlign. id index))
;; --- Shape Visibility
(deftype HideShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-hidden [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :hidden] true)
(reduce mark-hidden $ (:items shape)))
(assoc-in state [:shapes id :hidden] true))))]
(mark-hidden state id))))
(defn hide-shape
[id]
{:pre [(uuid? id)]}
(HideShape. id))
(deftype ShowShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-visible [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :hidden] false)
(reduce mark-visible $ (:items shape)))
(assoc-in state [:shapes id :hidden] false))))]
(mark-visible state id))))
(defn show-shape
[id]
{:pre [(uuid? id)]}
(ShowShape. id))
;; --- Shape Blocking
(deftype BlockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-blocked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :blocked] true)
(reduce mark-blocked $ (:items shape)))
(assoc-in state [:shapes id :blocked] true))))]
(mark-blocked state id))))
(defn block-shape
[id]
{:pre [(uuid? id)]}
(BlockShape. id))
(deftype UnblockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-unblocked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :blocked] false)
(reduce mark-unblocked $ (:items shape)))
(assoc-in state [:shapes id :blocked] false))))]
(mark-unblocked state id))))
(defn unblock-shape
[id]
{:pre [(uuid? id)]}
(UnblockShape. id))
;; --- Shape Locking
(deftype LockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-locked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :locked] true)
(reduce mark-locked $ (:items shape)))
(assoc-in state [:shapes id :locked] true))))]
(mark-locked state id))))
(defn lock-shape
[id]
{:pre [(uuid? id)]}
(LockShape. id))
(deftype UnlockShape [id]
udp/IPageUpdate
ptk/UpdateEvent
(update [_ state]
(letfn [(mark-unlocked [state id]
(let [shape (get-in state [:shapes id])]
(if (= :group (:type shape))
(as-> state $
(assoc-in $ [:shapes id :locked] false)
(reduce mark-unlocked $ (:items shape)))
(assoc-in state [:shapes id :locked] false))))]
(mark-unlocked state id))))
(defn unlock-shape
[id]
{:pre [(uuid? id)]}
(UnlockShape. id))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Selection Rect IMPL ;; Selection Rect IMPL
@ -662,6 +950,42 @@
:y2 end-y :y2 end-y
:type :rect))) :type :rect)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Canvas Interactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;; --- Group Collapsing
;; (deftype CollapseGroupShape [id]
;; udp/IPageUpdate
;; ptk/UpdateEvent
;; (update [_ state]
;; (update-in state [:shapes id] assoc :collapsed true)))
;; (defn collapse-shape
;; [id]
;; {:pre [(uuid? id)]}
;; (CollapseGroupShape. id))
;; (deftype UncollapseGroupShape [id]
;; udp/IPageUpdate
;; ptk/UpdateEvent
;; (update [_ state]
;; (update-in state [:shapes id] assoc :collapsed false)))
;; (defn uncollapse-shape
;; [id]
;; {:pre [(uuid? id)]}
;; (UncollapseGroupShape. id))
(defn select-canvas
[id]
(reify
ptk/UpdateEvent
(update [_ state]
(let [pid (get-in state [:workspace :current])]
(update-in state [:workspace pid] assoc :selected-canvas id)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Server Interactions ;; Server Interactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

128
frontend/src/uxbox/main/data/workspace/ruler.cljs
View file

@ -7,7 +7,7 @@
(ns uxbox.main.data.workspace.ruler (ns uxbox.main.data.workspace.ruler
"Workspace ruler related events. Mostly or all events "Workspace ruler related events. Mostly or all events
are related to UI logic." are related to UI logic."
(:require [beicon.core :as rx] #_(:require [beicon.core :as rx]
[potok.core :as ptk] [potok.core :as ptk]
[uxbox.main.refs :as refs] [uxbox.main.refs :as refs]
[uxbox.main.streams :as streams] [uxbox.main.streams :as streams]
@ -17,79 +17,79 @@
;; --- Constants ;; --- Constants
(declare stop-ruler?) ;; (declare stop-ruler?)
(declare clear-ruler) ;; (declare clear-ruler)
(declare update-ruler) ;; (declare update-ruler)
(def ^:private immanted-zones ;; (def ^:private immanted-zones
(let [transform #(vector (- % 7) (+ % 7) %) ;; (let [transform #(vector (- % 7) (+ % 7) %)
right (map transform (range 0 181 15)) ;; right (map transform (range 0 181 15))
left (map (comp transform -) (range 0 181 15))] ;; left (map (comp transform -) (range 0 181 15))]
(vec (concat right left)))) ;; (vec (concat right left))))
(defn- align-position ;; (defn- align-position
[pos] ;; [pos]
(let [angle (gpt/angle pos)] ;; (let [angle (gpt/angle pos)]
(reduce (fn [pos [a1 a2 v]] ;; (reduce (fn [pos [a1 a2 v]]
(if (< a1 angle a2) ;; (if (< a1 angle a2)
(reduced (gpt/update-angle pos v)) ;; (reduced (gpt/update-angle pos v))
pos)) ;; pos))
pos ;; pos
immanted-zones))) ;; immanted-zones)))
;; --- Start Ruler ;; ;; --- Start Ruler
(deftype StartRuler [] ;; (deftype StartRuler []
ptk/UpdateEvent ;; ptk/UpdateEvent
(update [_ state] ;; (update [_ state]
(let [pid (get-in state [:workspace :current]) ;; (let [pid (get-in state [:workspace :current])
pos (get-in state [:workspace :pointer :viewport])] ;; pos (get-in state [:workspace :pointer :viewport])]
(assoc-in state [:workspace pid :ruler] {:start pos :end pos}))) ;; (assoc-in state [:workspace pid :ruler] {:start pos :end pos})))
ptk/WatchEvent ;; ptk/WatchEvent
(watch [_ state stream] ;; (watch [_ state stream]
(let [stoper (->> (rx/filter #(= ::uev/interrupt %) stream) ;; (let [stoper (->> (rx/filter #(= ::uev/interrupt %) stream)
(rx/take 1))] ;; (rx/take 1))]
(->> streams/mouse-position ;; (->> streams/mouse-position
(rx/take-until stoper) ;; (rx/take-until stoper)
(rx/map (juxt :viewport :ctrl)) ;; (rx/map (juxt :viewport :ctrl))
(rx/map (fn [[pt ctrl?]] ;; (rx/map (fn [[pt ctrl?]]
(update-ruler pt ctrl?))))))) ;; (update-ruler pt ctrl?)))))))
(defn start-ruler ;; (defn start-ruler
[] ;; []
(StartRuler.)) ;; (StartRuler.))
;; --- Update Ruler ;; ;; --- Update Ruler
(deftype UpdateRuler [point ctrl?] ;; (deftype UpdateRuler [point ctrl?]
ptk/UpdateEvent ;; ptk/UpdateEvent
(update [_ state] ;; (update [_ state]
(let [pid (get-in state [:workspace :current]) ;; (let [pid (get-in state [:workspace :current])
ruler (get-in state [:workspace pid :ruler])] ;; ruler (get-in state [:workspace pid :ruler])]
(if-not ctrl? ;; (if-not ctrl?
(assoc-in state [:workspace pid :ruler :end] point) ;; (assoc-in state [:workspace pid :ruler :end] point)
(let [start (get-in state [:workspace pid :ruler :start]) ;; (let [start (get-in state [:workspace pid :ruler :start])
end (-> (gpt/subtract point start) ;; end (-> (gpt/subtract point start)
(align-position) ;; (align-position)
(gpt/add start))] ;; (gpt/add start))]
(assoc-in state [:workspace pid :ruler :end] end)))))) ;; (assoc-in state [:workspace pid :ruler :end] end))))))
(defn update-ruler ;; (defn update-ruler
[point ctrl?] ;; [point ctrl?]
{:pre [(gpt/point? point) ;; {:pre [(gpt/point? point)
(boolean? ctrl?)]} ;; (boolean? ctrl?)]}
(UpdateRuler. point ctrl?)) ;; (UpdateRuler. point ctrl?))
;; --- Clear Ruler ;; ;; --- Clear Ruler
(deftype ClearRuler [] ;; (deftype ClearRuler []
ptk/UpdateEvent ;; ptk/UpdateEvent
(update [_ state] ;; (update [_ state]
(let [pid (get-in state [:workspace :current])] ;; (let [pid (get-in state [:workspace :current])]
(update-in state [:workspace pid] dissoc :ruler)))) ;; (update-in state [:workspace pid] dissoc :ruler))))
(defn clear-ruler ;; (defn clear-ruler
[] ;; []
(ClearRuler.)) ;; (ClearRuler.))

24
frontend/src/uxbox/main/data/workspace_drawing.cljs
View file

@ -6,23 +6,7 @@
;; TODO: DEPRECTATED, maintained just for temporal documentation, delete on near future ;; TODO: DEPRECTATED, maintained just for temporal documentation, delete on near future
(ns uxbox.main.data.workspace-drawing (ns uxbox.main.data.workspace-drawing)
"Workspace drawing data events and impl."
(:require [beicon.core :as rx]
[potok.core :as ptk]
[lentes.core :as l]
[uxbox.main.store :as st]
[uxbox.main.constants :as c]
[uxbox.main.refs :as refs]
[uxbox.main.streams :as streams]
[uxbox.main.data.shapes :as uds]
[uxbox.main.data.workspace :as udw]
[uxbox.main.geom :as geom]
[uxbox.main.workers :as uwrk]
[uxbox.main.user-events :as uev]
[uxbox.main.lenses :as ul]
[uxbox.util.geom.path :as pth]
[uxbox.util.geom.point :as gpt]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data Events ;; Data Events
@ -234,7 +218,7 @@
;; (rx/filter uev/mouse-up?) ;; (rx/filter uev/mouse-up?)
;; (rx/take 1))) ;; (rx/take 1)))
;; start? (volatile! true) ;; start? (volatile! true)
;; mouse (->> streams/viewport-mouse-position ;; mouse (->> streams/mouse-position
;; (rx/take-until stoper) ;; (rx/take-until stoper)
;; (rx/mapcat conditional-align) ;; (rx/mapcat conditional-align)
;; (rx/map translate-to-canvas) ;; (rx/map translate-to-canvas)
@ -325,7 +309,7 @@
;; (defn- on-init-draw-free-path ;; (defn- on-init-draw-free-path
;; [shape stoper] ;; [shape stoper]
;; (let [stoper (get-path-stoper-stream stoper true) ;; (let [stoper (get-path-stoper-stream stoper true)
;; mouse (->> streams/viewport-mouse-position ;; mouse (->> streams/mouse-position
;; (rx/mapcat conditional-align) ;; (rx/mapcat conditional-align)
;; (rx/map translate-to-canvas)) ;; (rx/map translate-to-canvas))
@ -341,7 +325,7 @@
;; [shape stoper] ;; [shape stoper]
;; (let [last-point (volatile! @refs/canvas-mouse-position) ;; (let [last-point (volatile! @refs/canvas-mouse-position)
;; stoper (get-path-stoper-stream stoper) ;; stoper (get-path-stoper-stream stoper)
;; mouse (->> (rx/sample 10 streams/viewport-mouse-position) ;; mouse (->> (rx/sample 10 streams/mouse-position)
;; (rx/mapcat conditional-align) ;; (rx/mapcat conditional-align)
;; (rx/map translate-to-canvas)) ;; (rx/map translate-to-canvas))
;; points (->> (get-path-point-stream) ;; points (->> (get-path-point-stream)

6
frontend/src/uxbox/main/geom.cljs
View file

@ -26,6 +26,7 @@
:image (move-rect shape dpoint) :image (move-rect shape dpoint)
:rect (move-rect shape dpoint) :rect (move-rect shape dpoint)
:text (move-rect shape dpoint) :text (move-rect shape dpoint)
:curve (move-path shape dpoint)
:path (move-path shape dpoint) :path (move-path shape dpoint)
:circle (move-circle shape dpoint) :circle (move-circle shape dpoint)
:group (move-group shape dpoint))) :group (move-group shape dpoint)))
@ -125,12 +126,12 @@
"Calculate the size of the shape." "Calculate the size of the shape."
[shape] [shape]
(case (:type shape) (case (:type shape)
:group (assoc shape :width 100 :height 100)
:circle (size-circle shape) :circle (size-circle shape)
:text (size-rect shape) :text (size-rect shape)
:rect (size-rect shape) :rect (size-rect shape)
:icon (size-rect shape) :icon (size-rect shape)
:image (size-rect shape) :image (size-rect shape)
:curve (size-path shape)
:path (size-path shape))) :path (size-path shape)))
(defn- size-path (defn- size-path
@ -184,6 +185,7 @@
:icon (setup-proportions-image shape) :icon (setup-proportions-image shape)
:image (setup-proportions-image shape) :image (setup-proportions-image shape)
:text shape :text shape
:curve (setup-proportions-rect shape)
:path (setup-proportions-rect shape))) :path (setup-proportions-rect shape)))
(defn setup-proportions-image (defn setup-proportions-image
@ -461,6 +463,7 @@
(case type (case type
:circle (circle->rect-shape state shape) :circle (circle->rect-shape state shape)
:path (path->rect-shape state shape) :path (path->rect-shape state shape)
:curve (path->rect-shape state shape)
shape))) shape)))
(defn shapes->rect-shape (defn shapes->rect-shape
@ -517,6 +520,7 @@
:text (transform-rect shape xfmt) :text (transform-rect shape xfmt)
:image (transform-rect shape xfmt) :image (transform-rect shape xfmt)
:path (transform-path shape xfmt) :path (transform-path shape xfmt)
:curve (transform-path shape xfmt)
:circle (transform-circle shape xfmt))) :circle (transform-circle shape xfmt)))
(defn- transform-rect (defn- transform-rect

13
frontend/src/uxbox/main/lenses.cljs
View file

@ -1,13 +0,0 @@
(ns uxbox.main.lenses
(:require [lentes.core :as l]))
;; --- Workspace
;; --- FIXME: remove this ns
(def workspace (l/key :workspace))
(def workspace-flags (comp workspace (l/key :flags)))
(def selected-drawing (comp workspace (l/key :drawing)))
(def selected-shapes (comp workspace (l/key :selected)))
(def selected-page (comp workspace (l/key :page)))
(def selected-project (comp workspace (l/key :project)))

26
frontend/src/uxbox/main/refs.cljs
View file

@ -52,6 +52,10 @@
(-> (l/key :selected) (-> (l/key :selected)
(l/derive workspace))) (l/derive workspace)))
(def selected-canvas
(-> (l/key :selected-canvas)
(l/derive workspace)))
(def toolboxes (def toolboxes
(-> (l/key :toolboxes) (-> (l/key :toolboxes)
(l/derive workspace))) (l/derive workspace)))
@ -100,28 +104,6 @@
(l/lens alignment-activated?)) (l/lens alignment-activated?))
(l/derive workspace))) (l/derive workspace)))
;; ...
(def mouse-position
(-> (l/in [:workspace :pointer])
(l/derive st/state)))
(def canvas-mouse-position
(-> (l/key :canvas)
(l/derive mouse-position)))
(def viewport-mouse-position
(-> (l/key :viewport)
(l/derive mouse-position)))
(def window-mouse-position
(-> (l/key :window)
(l/derive mouse-position)))
(def workspace-scroll
(-> (l/in [:workspace :scroll])
(l/derive st/state)))
(def shapes-by-id (def shapes-by-id
(-> (l/key :shapes) (-> (l/key :shapes)
(l/derive st/state))) (l/derive st/state)))

9
frontend/src/uxbox/main/repo/pages.cljs
View file

@ -2,14 +2,13 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.main.repo.pages (ns uxbox.main.repo.pages
"A main interface for access to remote resources." "A main interface for access to remote resources."
(:require [beicon.core :as rx] (:require
[uxbox.config :refer (url)] [uxbox.config :refer [url]]
[uxbox.main.repo.impl :refer (request send!)] [uxbox.main.repo.impl :refer [request send!]]))
[uxbox.util.transit :as t]))
(defmethod request :fetch/pages (defmethod request :fetch/pages
[type data] [type data]

65
frontend/src/uxbox/main/streams.cljs
View file

@ -1,65 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2017 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.main.streams
"A collection of derived streams."
(:require [beicon.core :as rx]
[uxbox.main.store :as st]
[uxbox.main.user-events :as uev]
[uxbox.main.refs :as refs]
[uxbox.main.workers :as uwrk]
[uxbox.util.geom.point :as gpt]))
;; --- Events
(defn- user-interaction-event?
[event]
(or (uev/keyboard-event? event)
(uev/mouse-event? event)))
(defonce events
(rx/filter user-interaction-event? st/stream))
;; --- Mouse Position Stream
(defonce mouse-position
(rx/filter uev/pointer-event? st/stream))
(defonce canvas-mouse-position
(->> mouse-position
(rx/map :canvas)
(rx/share)))
(defonce viewport-mouse-position
(->> mouse-position
(rx/map :viewport)
(rx/share)))
(defonce window-mouse-position
(->> mouse-position
(rx/map :window)
(rx/share)))
(defonce mouse-position-ctrl
(->> mouse-position
(rx/map :ctrl)
(rx/share)))
(defn- coords-delta
[[old new]]
(gpt/subtract new old))
(defonce mouse-position-deltas
(->> viewport-mouse-position
(rx/sample 10)
(rx/map #(gpt/divide % @refs/selected-zoom))
(rx/mapcat (fn [point]
(if @refs/selected-alignment
(uwrk/align-point point)
(rx/of point))))
(rx/buffer 2 1)
(rx/map coords-delta)
(rx/share)))

1
frontend/src/uxbox/main/ui/shapes.cljs
View file

@ -20,6 +20,7 @@
[shape] [shape]
(mf/html (mf/html
(case (:type shape) (case (:type shape)
:curve [:& path/path-component {:shape shape}]
:text [:& text/text-component {:shape shape}] :text [:& text/text-component {:shape shape}]
:icon [:& icon/icon-component {:shape shape}] :icon [:& icon/icon-component {:shape shape}]
:rect [:& rect/rect-component {:shape shape}] :rect [:& rect/rect-component {:shape shape}]

5
frontend/src/uxbox/main/ui/shapes/common.cljs
View file

@ -25,7 +25,7 @@
(watch [_ state stream] (watch [_ state stream]
(let [pid (get-in state [:workspace :current]) (let [pid (get-in state [:workspace :current])
wst (get-in state [:workspace pid]) wst (get-in state [:workspace pid])
stoper (->> ws/interaction-events stoper (->> stream
(rx/filter ws/mouse-up?) (rx/filter ws/mouse-up?)
(rx/take 1)) (rx/take 1))
stream (->> ws/mouse-position-deltas stream (->> ws/mouse-position-deltas
@ -58,7 +58,8 @@
(and (not selected?) (empty? selected)) (and (not selected?) (empty? selected))
(do (do
(dom/stop-propagation event) (dom/stop-propagation event)
(st/emit! (dw/select-shape id) (st/emit! (dw/deselect-all)
(dw/select-shape id)
(start-move-selected))) (start-move-selected)))
(and (not selected?) (not (empty? selected))) (and (not selected?) (not (empty? selected)))

2
frontend/src/uxbox/main/ui/shapes/text.cljs
View file

@ -126,7 +126,7 @@
style (make-style shape) style (make-style shape)
on-input (fn [ev] on-input (fn [ev]
(let [content (dom/event->inner-text ev)] (let [content (dom/event->inner-text ev)]
(st/emit! (uds/update-text id content))))] (st/emit! (udw/update-shape-attrs id {:content content}))))]
[:foreignObject {:x x1 :y y1 :width width :height height} [:foreignObject {:x x1 :y y1 :width width :height height}
[:div {:style (normalize-props style) [:div {:style (normalize-props style)
:ref (::container own) :ref (::container own)

4
frontend/src/uxbox/main/ui/workspace.cljs
View file

@ -52,7 +52,7 @@
(let [prev-zoom @refs/selected-zoom (let [prev-zoom @refs/selected-zoom
dom (mf/ref-node canvas) dom (mf/ref-node canvas)
scroll-position (scroll/get-current-position-absolute dom) scroll-position (scroll/get-current-position-absolute dom)
mouse-point @uws/viewport-mouse-position] mouse-point @uws/mouse-position]
(dom/prevent-default event) (dom/prevent-default event)
(dom/stop-propagation event) (dom/stop-propagation event)
(if (pos? (.-deltaY event)) (if (pos? (.-deltaY event))
@ -62,7 +62,7 @@
(defn- subscribe (defn- subscribe
[canvas page] [canvas page]
(scroll/scroll-to-page-center (mf/ref-node canvas) page) ;; (scroll/scroll-to-page-center (mf/ref-node canvas) page)
(st/emit! (udp/watch-page-changes (:id page)) (st/emit! (udp/watch-page-changes (:id page))
(udu/watch-page-changes (:id page))) (udu/watch-page-changes (:id page)))
(let [sub (shortcuts/init)] (let [sub (shortcuts/init)]

65
frontend/src/uxbox/main/ui/workspace/canvas.cljs
View file

@ -8,45 +8,46 @@
(ns uxbox.main.ui.workspace.canvas (ns uxbox.main.ui.workspace.canvas
(:require (:require
[rumext.alpha :as mf] [rumext.alpha :as mf]
[lentes.core :as l]
[uxbox.main.constants :as c] [uxbox.main.constants :as c]
[uxbox.main.refs :as refs]
[uxbox.main.data.workspace :as dw]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.ui.keyboard :as kbd]
[uxbox.main.ui.shapes :as uus] [uxbox.main.ui.shapes :as uus]
[uxbox.main.ui.workspace.drawarea :refer [draw-area]] [uxbox.main.ui.workspace.drawarea :refer [draw-area]]
[uxbox.main.ui.workspace.selection :refer [selection-handlers]] [uxbox.main.ui.workspace.selection :refer [selection-handlers]]
[uxbox.main.ui.workspace.streams :as uws]
[uxbox.util.data :refer [parse-int]]
[uxbox.util.dom :as dom]
[uxbox.util.geom.point :as gpt])) [uxbox.util.geom.point :as gpt]))
;; --- Background (def selected-canvas
(-> (l/key :selected-canvas)
(l/derive refs/workspace)))
(mf/def background (defn- make-canvas-iref
:mixins [mf/memo] [id]
:render (-> (l/in [:canvas id])
(fn [own {:keys [background] :as metadata}] (l/derive st/state)))
[:rect
{:x 0 :y 0
:width "100%"
:height "100%"
:fill (or background "#ffffff")}]))
;; --- Canvas
(mf/defc canvas (mf/defc canvas
[{:keys [page wst] :as props}] [{:keys [id] :as props}]
(let [{:keys [metadata id]} page (letfn [(on-double-click [event]
zoom (:zoom wst 1) ;; NOTE: maybe forward wst to draw-area (dom/prevent-default event)
width (:width metadata) (st/emit! (dw/select-canvas id)))]
height (:height metadata)] (let [canvas-iref (mf/use-memo #(make-canvas-iref id) #js [id])
[:svg.page-canvas {:x c/canvas-start-x canvas (mf/deref canvas-iref)
:y c/canvas-start-y selected (mf/deref selected-canvas)
:width width selected? (= id selected)]
:height height} [:rect.page-canvas
[:& background metadata] {:x (:x canvas)
#_[:svg.page-layout :class (when selected? "selected")
[:g.main :y (:y canvas)
(for [id (reverse (:shapes page))] :fill (:background canvas "#ffffff")
[:& uus/shape-component {:id id :key id}]) :width (:width canvas)
(when (seq (:selected wst)) :height (:height canvas)
[:& selection-handlers {:wst wst}]) :on-double-click on-double-click}])))
(when-let [dshape (:drawing wst)]
[:& draw-area {:shape dshape
:zoom (:zoom wst)
:modifiers (:modifiers wst)}])]]]))

123
frontend/src/uxbox/main/ui/workspace/drawarea.cljs
View file

@ -21,19 +21,27 @@
[uxbox.main.workers :as uwrk] [uxbox.main.workers :as uwrk]
[uxbox.util.math :as mth] [uxbox.util.math :as mth]
[uxbox.util.dom :as dom] [uxbox.util.dom :as dom]
[uxbox.util.data :refer [seek]]
[uxbox.util.geom.path :as path] [uxbox.util.geom.path :as path]
[uxbox.util.geom.point :as gpt])) [uxbox.util.geom.point :as gpt]
[uxbox.util.uuid :as uuid]))
(defn- rxfinalize
[f ob]
(.pipe ob (.finalize js/rxjs.operators f)))
;; --- Events ;; --- Events
(declare handle-drawing) (declare handle-drawing)
(declare handle-drawing-generic) (declare handle-drawing-generic)
(declare handle-drawing-path) (declare handle-drawing-path)
(declare handle-drawing-free-path) (declare handle-drawing-curve)
(declare handle-finish-drawing) (declare handle-finish-drawing)
(declare conditional-align)
(defn start-drawing (defn start-drawing
[object] [type]
{:pre [(keyword? type)]}
(let [id (gensym "drawing")] (let [id (gensym "drawing")]
(reify (reify
ptk/UpdateEvent ptk/UpdateEvent
@ -42,35 +50,65 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [lock (get-in state [:workspace :drawing-lock])] (let [pid (get-in state [:workspace :current])
lock (get-in state [:workspace :drawing-lock])]
(if (= lock id) (if (= lock id)
(rx/merge (->> stream (rx/merge
(rx/filter #(= % handle-finish-drawing)) (->> (rx/filter #(= % handle-finish-drawing) stream)
(rx/take 1) (rx/take 1)
(rx/map (fn [_] #(update % :workspace dissoc :drawing-lock)))) (rx/map (fn [_] #(update % :workspace dissoc :drawing-lock))))
(rx/of (handle-drawing object))) (rx/of (handle-drawing type)))
(rx/empty))))))) (rx/empty)))))))
(defn- conditional-align [point align?] (def ^:private minimal-shapes
(if align? [{:type :rect
(uwrk/align-point point) :name "Rect"
(rx/of point))) :stroke-color "#000000"}
{:type :circle
:name "Circle"}
{:type :path
:name "Path"
:stroke-style :solid
:stroke-color "#000000"
:stroke-width 2
:fill-color "#000000"
:fill-opacity 0
:segments []}
{:type :curve
:name "Path"
:stroke-style :solid
:stroke-color "#000000"
:stroke-width 2
:fill-color "#000000"
:fill-opacity 0
:segments []}
{:type :text
:name "Text"
:content "Type your text here"}])
(defn- make-minimal-shape
[type]
(let [tool (seek #(= type (:type %)) minimal-shapes)]
(assert tool "unexpected drawing tool")
(assoc tool :id (uuid/random))))
;; TODO: maybe this should be a simple function
(defn handle-drawing (defn handle-drawing
[shape] [type]
(reify (reify
ptk/UpdateEvent
(update [_ state]
(let [pid (get-in state [:workspace :current])
shape (make-minimal-shape type)]
(assoc-in state [:workspace pid :drawing] shape)))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(rx/of (case type
(if (= :path (:type shape)) :path (rx/of handle-drawing-path)
(if (:free shape) :curve (rx/of handle-drawing-curve)
(handle-drawing-free-path shape) (rx/of handle-drawing-generic)))))
(handle-drawing-path shape))
(handle-drawing-generic shape))))))
(defn- handle-drawing-generic (def handle-drawing-generic
[shape]
(letfn [(initialize-drawing [state point] (letfn [(initialize-drawing [state point]
(let [pid (get-in state [:workspace :current]) (let [pid (get-in state [:workspace :current])
shape (get-in state [:workspace pid :drawing]) shape (get-in state [:workspace pid :drawing])
@ -114,11 +152,11 @@
stoper (->> (rx/filter #(or (uws/mouse-up? %) (= % :interrupt)) stream) stoper (->> (rx/filter #(or (uws/mouse-up? %) (= % :interrupt)) stream)
(rx/take 1)) (rx/take 1))
mouse (->> uws/viewport-mouse-position mouse (->> uws/mouse-position
(rx/mapcat #(conditional-align % align?)) (rx/mapcat #(conditional-align % align?))
(rx/with-latest vector uws/mouse-position-ctrl))] (rx/with-latest vector uws/mouse-position-ctrl))]
(rx/concat (rx/concat
(->> uws/viewport-mouse-position (->> uws/mouse-position
(rx/take 1) (rx/take 1)
(rx/mapcat #(conditional-align % align?)) (rx/mapcat #(conditional-align % align?))
(rx/map (fn [pt] #(initialize-drawing % pt)))) (rx/map (fn [pt] #(initialize-drawing % pt))))
@ -127,8 +165,7 @@
(rx/take-until stoper)) (rx/take-until stoper))
(rx/of handle-finish-drawing))))))) (rx/of handle-finish-drawing)))))))
(defn handle-drawing-path (def handle-drawing-path
[shape]
(letfn [(stoper-event? [{:keys [type shift] :as event}] (letfn [(stoper-event? [{:keys [type shift] :as event}]
(or (= event :interrupt) (or (= event :interrupt)
(and (uws/mouse-event? event) (and (uws/mouse-event? event)
@ -166,12 +203,12 @@
flags (get-in state [:workspace pid :flags]) flags (get-in state [:workspace pid :flags])
align? (refs/alignment-activated? flags) align? (refs/alignment-activated? flags)
last-point (volatile! @uws/viewport-mouse-position) last-point (volatile! @uws/mouse-position)
stoper (->> (rx/filter stoper-event? stream) stoper (->> (rx/filter stoper-event? stream)
(rx/take 1)) (rx/share))
mouse (->> (rx/sample 10 uws/viewport-mouse-position) mouse (->> (rx/sample 10 uws/mouse-position)
(rx/mapcat #(conditional-align % align?))) (rx/mapcat #(conditional-align % align?)))
points (->> stream points (->> stream
@ -186,7 +223,6 @@
(rx/with-latest vector counter) (rx/with-latest vector counter)
(rx/map flatten)) (rx/map flatten))
imm-transform #(vector (- % 7) (+ % 7) %) imm-transform #(vector (- % 7) (+ % 7) %)
immanted-zones (vec (concat immanted-zones (vec (concat
(map imm-transform (range 0 181 15)) (map imm-transform (range 0 181 15))
@ -205,8 +241,8 @@
(->> points (->> points
(rx/take-until stoper) (rx/take-until stoper)
(rx/map (fn [pt] (rx/map (fn [pt]#(insert-point-segment % pt))))
#(insert-point-segment % pt))))
(rx/concat (rx/concat
(->> stream' (->> stream'
(rx/map (fn [[point ctrl? index :as xxx]] (rx/map (fn [[point ctrl? index :as xxx]]
@ -221,8 +257,7 @@
(rx/of remove-dangling-segmnet (rx/of remove-dangling-segmnet
handle-finish-drawing)))))))) handle-finish-drawing))))))))
(defn- handle-drawing-free-path (def handle-drawing-curve
[shape]
(letfn [(stoper-event? [{:keys [type shift] :as event}] (letfn [(stoper-event? [{:keys [type shift] :as event}]
(or (= event :interrupt) (or (= event :interrupt)
(and (uws/mouse-event? event) (= type :up)))) (and (uws/mouse-event? event) (= type :up))))
@ -249,7 +284,7 @@
stoper (->> (rx/filter stoper-event? stream) stoper (->> (rx/filter stoper-event? stream)
(rx/take 1)) (rx/take 1))
mouse (->> (rx/sample 10 uws/viewport-mouse-position) mouse (->> (rx/sample 10 uws/mouse-position)
(rx/mapcat #(conditional-align % align?)))] (rx/mapcat #(conditional-align % align?)))]
(rx/concat (rx/concat
(rx/of initialize-drawing) (rx/of initialize-drawing)
@ -275,10 +310,11 @@
#(update-in % [:workspace pid :modifiers] dissoc (:id shape)) #(update-in % [:workspace pid :modifiers] dissoc (:id shape))
;; Unselect the drawing tool ;; Unselect the drawing tool
#(update-in % [:workspace pid] dissoc :drawing :drawing-tool) ;; TODO; maybe a specific event for clear draw-tool
dw/clear-drawing
;; Add & select the cred shape to the workspace ;; Add & select the cred shape to the workspace
(ds/add-shape shape) (dw/add-shape (dissoc shape ::initialized?))
(dw/select-first-shape))) (dw/select-first-shape)))
(rx/of #(update-in % [:workspace pid] dissoc :drawing :drawing-tool))))))) (rx/of #(update-in % [:workspace pid] dissoc :drawing :drawing-tool)))))))
@ -296,8 +332,8 @@
(mf/defc draw-area (mf/defc draw-area
[{:keys [zoom shape modifiers] :as props}] [{:keys [zoom shape modifiers] :as props}]
(if (= (:type shape) :path) (case (:type shape)
[:& path-draw-area {:shape shape}] (:path :curve) [:& path-draw-area {:shape shape}]
[:& generic-draw-area {:shape (assoc shape :modifiers modifiers) [:& generic-draw-area {:shape (assoc shape :modifiers modifiers)
:zoom zoom}])) :zoom zoom}]))
@ -328,7 +364,7 @@
(when-let [{:keys [x y] :as segment} (first (:segments shape))] (when-let [{:keys [x y] :as segment} (first (:segments shape))]
[:g [:g
(shapes/render-shape shape) (shapes/render-shape shape)
(when-not (:free shape) (when (not= :curve (:type shape))
[:circle.close-bezier [:circle.close-bezier
{:cx x {:cx x
:cy y :cy y
@ -336,3 +372,8 @@
:on-click on-click :on-click on-click
:on-mouse-enter on-mouse-enter :on-mouse-enter on-mouse-enter
:on-mouse-leave on-mouse-leave}])]))) :on-mouse-leave on-mouse-leave}])])))
(defn- conditional-align [point align?]
(if align?
(uwrk/align-point point)
(rx/of point)))

25
frontend/src/uxbox/main/ui/workspace/selection.cljs
View file

@ -11,9 +11,7 @@
[beicon.core :as rx] [beicon.core :as rx]
[lentes.core :as l] [lentes.core :as l]
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.main.constants :as c] [uxbox.main.data.workspace :as dw]
[uxbox.main.data.shapes :as uds]
[uxbox.main.data.workspace :as udw]
[uxbox.main.geom :as geom] [uxbox.main.geom :as geom]
[uxbox.main.refs :as refs] [uxbox.main.refs :as refs]
[uxbox.main.store :as st] [uxbox.main.store :as st]
@ -42,11 +40,11 @@
(let [result (geom/resize-shape vid shape point lock?) (let [result (geom/resize-shape vid shape point lock?)
scale (geom/calculate-scale-ratio shape result) scale (geom/calculate-scale-ratio shape result)
mtx (geom/generate-resize-matrix vid shape scale) mtx (geom/generate-resize-matrix vid shape scale)
xfm (map #(udw/apply-temporal-resize % mtx))] xfm (map #(dw/apply-temporal-resize % mtx))]
(apply st/emit! (sequence xfm ids)))) (apply st/emit! (sequence xfm ids))))
(on-end [] (on-end []
(apply st/emit! (map udw/apply-resize ids))) (apply st/emit! (map dw/apply-resize ids)))
;; Unifies the instantaneous proportion lock modifier ;; Unifies the instantaneous proportion lock modifier
;; activated by Ctrl key and the shapes own proportion ;; activated by Ctrl key and the shapes own proportion
@ -68,10 +66,10 @@
(let [shape (->> (geom/shape->rect-shape shape) (let [shape (->> (geom/shape->rect-shape shape)
(geom/size)) (geom/size))
stoper (->> ws/interaction-events stoper (->> st/stream
(rx/filter ws/mouse-up?) (rx/filter ws/mouse-up?)
(rx/take 1)) (rx/take 1))
stream (->> ws/viewport-mouse-position stream (->> ws/mouse-position
(rx/take-until stoper) (rx/take-until stoper)
(rx/map apply-zoom) (rx/map apply-zoom)
(rx/mapcat apply-grid-alignment) (rx/mapcat apply-grid-alignment)
@ -160,22 +158,23 @@
(letfn [(on-mouse-down [event index] (letfn [(on-mouse-down [event index]
(dom/stop-propagation event) (dom/stop-propagation event)
(let [stoper (get-edition-stream-stoper ws/interaction-events) ;; TODO: this need code ux refactor
(let [stoper (get-edition-stream-stoper)
stream (rx/take-until stoper ws/mouse-position-deltas)] stream (rx/take-until stoper ws/mouse-position-deltas)]
(when @refs/selected-alignment (when @refs/selected-alignment
(st/emit! (uds/initial-path-point-align (:id shape) index))) (st/emit! (dw/initial-path-point-align (:id shape) index)))
(rx/subscribe stream #(on-handler-move % index)))) (rx/subscribe stream #(on-handler-move % index))))
(get-edition-stream-stoper [stream] (get-edition-stream-stoper []
(let [stoper? #(and (ws/mouse-event? %) (= (:type %) :up))] (let [stoper? #(and (ws/mouse-event? %) (= (:type %) :up))]
(rx/merge (rx/merge
(rx/filter stoper? stream) (rx/filter stoper? st/stream)
(->> stream (->> st/stream
(rx/filter #(= % :interrupt)) (rx/filter #(= % :interrupt))
(rx/take 1))))) (rx/take 1)))))
(on-handler-move [delta index] (on-handler-move [delta index]
(st/emit! (uds/update-path (:id shape) index delta)))] (st/emit! (dw/update-path (:id shape) index delta)))]
(let [displacement (:displacement modifiers) (let [displacement (:displacement modifiers)
segments (cond->> (:segments shape) segments (cond->> (:segments shape)

23
frontend/src/uxbox/main/ui/workspace/shortcuts.cljs
View file

@ -12,10 +12,7 @@
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.data.lightbox :as dl] [uxbox.main.data.lightbox :as dl]
[uxbox.main.data.workspace :as dw] [uxbox.main.data.workspace :as dw]
[uxbox.main.data.shapes :as uds] [uxbox.main.data.undo :as du])
[uxbox.main.data.undo :as udu]
[uxbox.main.data.history :as udh]
[uxbox.main.ui.workspace.sidebar.drawtools :as wsd])
(:import goog.events.EventType (:import goog.events.EventType
goog.events.KeyCodes goog.events.KeyCodes
goog.ui.KeyboardShortcutHandler goog.ui.KeyboardShortcutHandler
@ -27,26 +24,24 @@
(defonce +shortcuts+ (defonce +shortcuts+
{:shift+g #(st/emit! (dw/toggle-flag :grid)) {:shift+g #(st/emit! (dw/toggle-flag :grid))
:ctrl+g #(st/emit! (uds/group-selected))
:ctrl+shift+g #(st/emit! (uds/ungroup-selected))
:ctrl+shift+m #(st/emit! (dw/toggle-flag :sitemap)) :ctrl+shift+m #(st/emit! (dw/toggle-flag :sitemap))
:ctrl+shift+f #(st/emit! (dw/toggle-flag :drawtools)) :ctrl+shift+f #(st/emit! (dw/toggle-flag :drawtools))
:ctrl+shift+i #(st/emit! (dw/toggle-flag :icons)) :ctrl+shift+i #(st/emit! (dw/toggle-flag :icons))
:ctrl+shift+l #(st/emit! (dw/toggle-flag :layers)) :ctrl+shift+l #(st/emit! (dw/toggle-flag :layers))
:ctrl+0 #(st/emit! (dw/reset-zoom)) :ctrl+0 #(st/emit! (dw/reset-zoom))
:ctrl+r #(st/emit! (dw/toggle-flag :ruler)) :ctrl+r #(st/emit! (dw/toggle-flag :ruler))
:ctrl+d #(st/emit! (uds/duplicate-selected)) :ctrl+d #(st/emit! dw/duplicate-selected)
:ctrl+c #(st/emit! (dw/copy-to-clipboard)) :ctrl+c #(st/emit! (dw/copy-to-clipboard))
:ctrl+v #(st/emit! (dw/paste-from-clipboard)) :ctrl+v #(st/emit! (dw/paste-from-clipboard))
:ctrl+shift+v #(dl/open! :clipboard) :ctrl+shift+v #(dl/open! :clipboard)
:ctrl+z #(st/emit! (udu/undo)) :ctrl+z #(st/emit! (du/undo))
:ctrl+shift+z #(st/emit! (udu/redo)) :ctrl+shift+z #(st/emit! (du/redo))
:ctrl+y #(st/emit! (udu/redo)) :ctrl+y #(st/emit! (du/redo))
:ctrl+b #(st/emit! (dw/select-for-drawing wsd/+draw-tool-rect+)) :ctrl+b #(st/emit! (dw/select-for-drawing :rect))
:ctrl+e #(st/emit! (dw/select-for-drawing wsd/+draw-tool-circle+)) :ctrl+e #(st/emit! (dw/select-for-drawing :circle))
:ctrl+t #(st/emit! (dw/select-for-drawing wsd/+draw-tool-text+)) :ctrl+t #(st/emit! (dw/select-for-drawing :text))
:esc #(st/emit! (dw/deselect-all)) :esc #(st/emit! (dw/deselect-all))
:delete #(st/emit! (dw/delete-selected)) :delete #(st/emit! dw/delete-selected)
:ctrl+up #(st/emit! (dw/move-selected-layer :up)) :ctrl+up #(st/emit! (dw/move-selected-layer :up))
:ctrl+down #(st/emit! (dw/move-selected-layer :down)) :ctrl+down #(st/emit! (dw/move-selected-layer :down))
:ctrl+shift+up #(st/emit! (dw/move-selected-layer :top)) :ctrl+shift+up #(st/emit! (dw/move-selected-layer :top))

26
frontend/src/uxbox/main/ui/workspace/sidebar.cljs
View file

@ -21,17 +21,16 @@
(mf/defc left-sidebar (mf/defc left-sidebar
{:wrap [mf/wrap-memo]} {:wrap [mf/wrap-memo]}
[{:keys [flags page] :as props}] [{:keys [flags page] :as props}]
[:aside#settings-bar.settings-bar.settings-bar-left [:aside.settings-bar.settings-bar-left
[:> rdnd/provider {:backend rdnd/html5} [:div.settings-bar-inside
[:div.settings-bar-inside (when (contains? flags :sitemap)
(when (contains? flags :sitemap) [:& sitemap-toolbox {:project-id (:project page)
[:& sitemap-toolbox {:project-id (:project page) :current-page-id (:id page)
:current-page-id (:id page) :page page}])
:page page}]) #_(when (contains? flags :document-history)
#_(when (contains? flags :document-history) (history-toolbox page-id))
(history-toolbox page-id)) (when (contains? flags :layers)
(when (contains? flags :layers) [:& layers-toolbox {:page page}])]])
[:& layers-toolbox {:page page}])]]])
;; --- Right Sidebar (Component) ;; --- Right Sidebar (Component)
@ -43,6 +42,5 @@
[:& draw-toolbox {:flags flags}]) [:& draw-toolbox {:flags flags}])
(when (contains? flags :element-options) (when (contains? flags :element-options)
[:& options-toolbox {:page page}]) [:& options-toolbox {:page page}])
(when (contains? flags :icons) #_(when (contains? flags :icons)
#_(icons-toolbox))]]) (icons-toolbox))]])

111
frontend/src/uxbox/main/ui/workspace/sidebar/drawtools.cljs
View file

@ -17,96 +17,69 @@
;; --- Constants ;; --- Constants
(def +draw-tool-rect+
{:type :rect
:id (uuid/random)
:name "Rect"
:stroke-color "#000000"})
(def +draw-tool-circle+
{:type :circle
:id (uuid/random)
:name "Circle"})
(def +draw-tool-path+
{:type :path
:id (uuid/random)
:name "Path"
:stroke-style :solid
:stroke-color "#000000"
:stroke-width 2
:fill-color "#000000"
:fill-opacity 0
;; :close? true
:points []})
(def +draw-tool-curve+
(assoc +draw-tool-path+
:id (uuid/random)
:free true))
(def +draw-tool-text+
{:type :text
:id (uuid/random)
:name "Text"
:content "Hello world"})
(def +draw-tools+ (def +draw-tools+
[{:icon i/box [{:icon i/box
:help "ds.help.rect" :help "ds.help.rect"
:shape +draw-tool-rect+ :type :rect
:priority 1} :priority 1}
{:icon i/circle {:icon i/circle
:help "ds.help.circle" :help "ds.help.circle"
:shape +draw-tool-circle+ :type :circle
:priority 2} :priority 2}
{:icon i/text {:icon i/text
:help "ds.help.text" :help "ds.help.text"
:shape +draw-tool-text+ :type :text
:priority 4} :priority 4}
{:icon i/curve {:icon i/curve
:help "ds.help.path" :help "ds.help.path"
:shape +draw-tool-path+ :type :path
:priority 5} :priority 5}
{:icon i/pencil {:icon i/pencil
:help "ds.help.curve" :help "ds.help.curve"
:shape +draw-tool-curve+ :type :curve
:priority 6}]) :priority 6}
;; TODO: we need an icon for canvas creation
{:icon i/box
:help "ds.help.canvas"
:type :canvas
:priority 7}])
;; --- Draw Toolbox (Component) ;; --- Draw Toolbox (Component)
(mf/defc draw-toolbox (mf/defc draw-toolbox
{:wrap [mf/wrap-memo]} {:wrap [mf/wrap-memo]}
[{:keys [flags] :as props}] [{:keys [flags] :as props}]
(let [close #(st/emit! (dw/toggle-flag :drawtools)) (letfn [(close [event]
dtool (mf/deref refs/selected-drawing-tool) (st/emit! (dw/deactivate-flag :drawtools)))
tools (->> (into [] +draw-tools+) (select [event tool]
(sort-by (comp :priority second))) (st/emit! :interrupt
(dw/deactivate-ruler)
(dw/select-for-drawing tool)))
(toggle-ruler [event]
(st/emit! (dw/select-for-drawing nil)
(dw/deselect-all)
(dw/toggle-ruler)))]
select-drawtool #(st/emit! :interrupt (let [selected (mf/deref refs/selected-drawing-tool)
(dw/deactivate-ruler) tools (sort-by (comp :priority second) +draw-tools+)]
(dw/select-for-drawing %)) [:div.tool-window.drawing-tools
toggle-ruler #(st/emit! (dw/select-for-drawing nil) [:div.tool-window-bar
(dw/deselect-all) [:div.tool-window-icon i/window]
(dw/toggle-ruler))] [:span (tr "ds.draw-tools")]
[:div.tool-window-close {:on-click close} i/close]]
[:div.tool-window-content
(for [item tools]
(let [selected? (= (:type item) selected)]
[:div.tool-btn.tooltip.tooltip-hover
{:alt (tr (:help item))
:class (when selected? "selected")
:key (:type item)
:on-click #(select % (:type item))}
(:icon item)]))
[:div#form-tools.tool-window.drawing-tools #_[:div.tool-btn.tooltip.tooltip-hover
[:div.tool-window-bar {:alt (tr "ds.help.ruler")
[:div.tool-window-icon i/window] :on-click toggle-ruler
[:span (tr "ds.draw-tools")] :class (when (contains? flags :ruler) "selected")}
[:div.tool-window-close {:on-click close} i/close]] i/ruler-tool]]])))
[:div.tool-window-content
(for [[i props] (map-indexed vector tools)]
(let [selected? (= dtool (:shape props))]
[:div.tool-btn.tooltip.tooltip-hover
{:alt (tr (:help props))
:class (when selected? "selected")
:key i
:on-click (partial select-drawtool (:shape props))}
(:icon props)]))
[:div.tool-btn.tooltip.tooltip-hover
{:alt (tr "ds.help.ruler")
:on-click toggle-ruler
:class (when (contains? flags :ruler) "selected")}
i/ruler-tool]]]))

76
frontend/src/uxbox/main/ui/workspace/sidebar/layers.cljs
View file

@ -11,8 +11,7 @@
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.builtins.icons :as i] [uxbox.builtins.icons :as i]
[uxbox.main.data.pages :as udp] [uxbox.main.data.pages :as udp]
[uxbox.main.data.shapes :as uds] [uxbox.main.data.workspace :as dw]
[uxbox.main.data.workspace :as udw]
[uxbox.main.refs :as refs] [uxbox.main.refs :as refs]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.ui.keyboard :as kbd] [uxbox.main.ui.keyboard :as kbd]
@ -44,9 +43,10 @@
on-blur (fn [event] on-blur (fn [event]
(let [target (dom/event->target event) (let [target (dom/event->target event)
parent (.-parentNode target) parent (.-parentNode target)
parent (.-parentNode parent)
name (dom/get-value target)] name (dom/get-value target)]
(set! (.-draggable parent) true) (set! (.-draggable parent) true)
(st/emit! (uds/rename-shape (:id shape) name)) (st/emit! (dw/rename-shape (:id shape) name))
(swap! local assoc :edition false))) (swap! local assoc :edition false)))
on-key-down (fn [event] on-key-down (fn [event]
(js/console.log event) (js/console.log event)
@ -54,7 +54,8 @@
(on-blur event))) (on-blur event)))
on-click (fn [event] on-click (fn [event]
(dom/prevent-default event) (dom/prevent-default event)
(let [parent (.-parentNode (.-target event))] (let [parent (.-parentNode (.-target event))
parent (.-parentNode parent)]
(set! (.-draggable parent) false)) (set! (.-draggable parent) false))
(swap! local assoc :edition true))] (swap! local assoc :edition true))]
(if (:edition @local) (if (:edition @local)
@ -77,18 +78,18 @@
(let [id (:id shape) (let [id (:id shape)
blocked? (:blocked shape)] blocked? (:blocked shape)]
(if blocked? (if blocked?
(st/emit! (uds/unblock-shape id)) (st/emit! (dw/unblock-shape id))
(st/emit! (uds/block-shape id))))) (st/emit! (dw/block-shape id)))))
(toggle-visibility [event] (toggle-visibility [event]
(dom/stop-propagation event) (dom/stop-propagation event)
(let [id (:id shape) (let [id (:id shape)
hidden? (:hidden shape)] hidden? (:hidden shape)]
(if hidden? (if hidden?
(st/emit! (uds/show-shape id)) (st/emit! (dw/show-shape id))
(st/emit! (uds/hide-shape id))) (st/emit! (dw/hide-shape id)))
(when (contains? selected id) (when (contains? selected id)
(st/emit! (udw/select-shape id))))) (st/emit! (dw/select-shape id)))))
(select-shape [event] (select-shape [event]
(dom/prevent-default event) (dom/prevent-default event)
@ -99,24 +100,20 @@
nil nil
(.-ctrlKey event) (.-ctrlKey event)
(st/emit! (udw/select-shape id)) (st/emit! (dw/select-shape id))
(> (count selected) 1) (> (count selected) 1)
(st/emit! (udw/deselect-all) (st/emit! (dw/deselect-all)
(udw/select-shape id)) (dw/select-shape id))
(contains? selected id)
(st/emit! (udw/select-shape id))
:else :else
(st/emit! (udw/deselect-all) (st/emit! (dw/deselect-all)
(udw/select-shape id))))) (dw/select-shape id)))))
(on-drop [item monitor] (on-drop [item monitor]
(st/emit! (udp/persist-page (:page shape)))) (st/emit! (udp/persist-page (:page shape))))
(on-hover [item monitor] (on-hover [item monitor]
(st/emit! (udw/change-shape-order {:id (:shape-id item) (st/emit! (dw/change-shape-order {:id (:shape-id item)
:index index})))] :index index})))]
(let [selected? (contains? selected (:id shape)) (let [selected? (contains? selected (:id shape))
[dprops dnd-ref] (use-sortable [dprops dnd-ref] (use-sortable
@ -132,8 +129,7 @@
:dragging-TODO (:dragging? dprops))} :dragging-TODO (:dragging? dprops))}
[:div.element-list-body {:class (classnames :selected selected?) [:div.element-list-body {:class (classnames :selected selected?)
:on-click select-shape :on-click select-shape
:on-double-click #(dom/stop-propagation %) :on-double-click #(dom/stop-propagation %)}
:draggable true}
[:div.element-actions [:div.element-actions
[:div.toggle-element {:class (when-not (:hidden shape) "selected") [:div.toggle-element {:class (when-not (:hidden shape) "selected")
:on-click toggle-visibility} :on-click toggle-visibility}
@ -144,20 +140,52 @@
[:div.element-icon (element-icon shape)] [:div.element-icon (element-icon shape)]
[:& layer-name {:shape shape}]]]))) [:& layer-name {:shape shape}]]])))
;; --- Layer Canvas
;; (mf/defc layer-canvas
;; [{:keys [canvas selected index] :as props}]
;; (letfn [(select-shape [event]
;; (dom/prevent-default event)
;; (st/emit! (dw/select-canvas (:id canvas))))
;; (let [selected? (contains? selected (:id shape))]
;; [:li {:class (classnames
;; :selected selected?)}
;; [:div.element-list-body {:class (classnames :selected selected?)
;; :on-click select-shape
;; :on-double-click #(dom/stop-propagation %)
;; :draggable true}
;; [:div.element-actions
;; [:div.toggle-element {:class (when-not (:hidden shape) "selected")
;; :on-click toggle-visibility}
;; i/eye]
;; [:div.block-element {:class (when (:blocked shape) "selected")
;; :on-click toggle-blocking}
;; i/lock]]
;; [:div.element-icon (element-icon shape)]
;; [:& layer-name {:shape shape}]]])))
;; --- Layers List ;; --- Layers List
(def ^:private shapes-iref (def ^:private shapes-iref
(-> (l/key :shapes) (-> (l/key :shapes)
(l/derive st/state))) (l/derive st/state)))
(def ^:private canvas-iref
(-> (l/key :canvas)
(l/derive st/state)))
(mf/defc layers-list (mf/defc layers-list
[{:keys [shapes selected] :as props}] [{:keys [shapes selected] :as props}]
(let [shapes-map (mf/deref shapes-iref)] (let [shapes-map (mf/deref shapes-iref)
canvas-map (mf/deref canvas-iref)
selected-shapes (mf/deref refs/selected-shapes)
selected-canvas (mf/deref refs/selected-canvas)]
[:div.tool-window-content [:div.tool-window-content
[:ul.element-list [:ul.element-list
(for [[index id] (map-indexed vector shapes)] (for [[index id] (map-indexed vector shapes)]
[:& layer-item {:shape (get shapes-map id) [:& layer-item {:shape (get shapes-map id)
:selected selected :selected selected-shapes
:index index :index index
:key id}])]])) :key id}])]]))
@ -165,7 +193,7 @@
(mf/defc layers-toolbox (mf/defc layers-toolbox
[{:keys [page selected] :as props}] [{:keys [page selected] :as props}]
(let [on-click #(st/emit! (udw/toggle-flag :layers)) (let [on-click #(st/emit! (dw/toggle-flag :layers))
selected (mf/deref refs/selected-shapes)] selected (mf/deref refs/selected-shapes)]
[:div#layers.tool-window [:div#layers.tool-window
[:div.tool-window-bar [:div.tool-window-bar

10
frontend/src/uxbox/main/ui/workspace/sidebar/options/circle_measures.cljs
View file

@ -93,14 +93,14 @@
value (parse-int value 0) value (parse-int value 0)
sid (:id shape) sid (:id shape)
props {attr value}] props {attr value}]
(st/emit! (uds/update-dimensions sid props)))) (st/emit! (udw/update-dimensions sid props))))
(defn- on-rotation-change (defn- on-rotation-change
[event shape] [event shape]
(let [value (dom/event->value event) (let [value (dom/event->value event)
value (parse-int value 0) value (parse-int value 0)
sid (:id shape)] sid (:id shape)]
(st/emit! (uds/update-rotation sid value)))) (st/emit! (udw/update-shape-attrs sid {:rotation value}))))
(defn- on-position-change (defn- on-position-change
[event shape attr] [event shape attr]
@ -108,11 +108,11 @@
value (parse-int value nil) value (parse-int value nil)
sid (:id shape) sid (:id shape)
point (gpt/point {attr value})] point (gpt/point {attr value})]
(st/emit! (uds/update-position sid point)))) (st/emit! (udw/update-position sid point))))
(defn- on-proportion-lock-change (defn- on-proportion-lock-change
[event shape] [event shape]
(if (:proportion-lock shape) (if (:proportion-lock shape)
(st/emit! (uds/unlock-proportions (:id shape))) (st/emit! (udw/unlock-proportions (:id shape)))
(st/emit! (uds/lock-proportions (:id shape))))) (st/emit! (udw/lock-proportions (:id shape)))))

13
frontend/src/uxbox/main/ui/workspace/sidebar/options/icon_measures.cljs
View file

@ -90,14 +90,13 @@
value (parse-int value 0) value (parse-int value 0)
sid (:id shape) sid (:id shape)
props {attr value}] props {attr value}]
(st/emit! (uds/update-dimensions sid props)))) (st/emit! (udw/update-dimensions sid props))))
(defn- on-rotation-change (defn- on-rotation-change
[event shape] [event shape]
(let [value (dom/event->value event) (let [value (dom/event->value event)
value (parse-int value 0) value (parse-int value 0)]
sid (:id shape)] (st/emit! (udw/update-shape-attrs (:id shape) {:rotation value}))))
(st/emit! (uds/update-rotation sid value))))
(defn- on-position-change (defn- on-position-change
[event shape attr] [event shape attr]
@ -105,11 +104,11 @@
value (parse-int value nil) value (parse-int value nil)
sid (:id shape) sid (:id shape)
point (gpt/point {attr value})] point (gpt/point {attr value})]
(st/emit! (uds/update-position sid point)))) (st/emit! (udw/update-position sid point))))
(defn- on-proportion-lock-change (defn- on-proportion-lock-change
[event shape] [event shape]
(if (:proportion-lock shape) (if (:proportion-lock shape)
(st/emit! (uds/unlock-proportions (:id shape))) (st/emit! (udw/unlock-proportions (:id shape)))
(st/emit! (uds/lock-proportions (:id shape))))) (st/emit! (udw/lock-proportions (:id shape)))))

15
frontend/src/uxbox/main/ui/workspace/sidebar/options/image_measures.cljs
View file

@ -9,8 +9,7 @@
(:require (:require
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.builtins.icons :as i] [uxbox.builtins.icons :as i]
[uxbox.main.data.shapes :as uds] [uxbox.main.data.workspace :as dw]
[uxbox.main.data.workspace :as udw]
[uxbox.main.geom :as geom] [uxbox.main.geom :as geom]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.util.data :refer (parse-int parse-float read-string)] [uxbox.util.data :refer (parse-int parse-float read-string)]
@ -106,30 +105,30 @@
(let [value (dom/event->value event) (let [value (dom/event->value event)
value (parse-int value 0) value (parse-int value 0)
props {attr value}] props {attr value}]
(st/emit! (uds/update-dimensions (:id shape) props)))) (st/emit! (dw/update-dimensions (:id shape) props))))
(defn- on-rotation-change (defn- on-rotation-change
[event shape] [event shape]
(let [value (dom/event->value event) (let [value (dom/event->value event)
value (parse-int value 0)] value (parse-int value 0)]
(st/emit! (uds/update-rotation (:id shape) value)))) (st/emit! (dw/update-shape-attrs (:id shape) {:rotation value}))))
(defn- on-opacity-change (defn- on-opacity-change
[event shape] [event shape]
(let [value (dom/event->value event) (let [value (dom/event->value event)
value (parse-float value 1) value (parse-float value 1)
value (/ value 10000)] value (/ value 10000)]
(st/emit! (uds/update-attrs (:id shape) {:opacity value})))) (st/emit! (dw/update-shape-attrs (:id shape) {:opacity value}))))
(defn- on-position-change (defn- on-position-change
[event shape attr] [event shape attr]
(let [value (dom/event->value event) (let [value (dom/event->value event)
value (parse-int value nil) value (parse-int value nil)
point (gpt/point {attr value})] point (gpt/point {attr value})]
(st/emit! (uds/update-position (:id shape) point)))) (st/emit! (dw/update-position (:id shape) point))))
(defn- on-proportion-lock-change (defn- on-proportion-lock-change
[event shape] [event shape]
(if (:proportion-lock shape) (if (:proportion-lock shape)
(st/emit! (uds/unlock-proportions (:id shape))) (st/emit! (dw/unlock-proportions (:id shape)))
(st/emit! (uds/lock-proportions (:id shape))))) (st/emit! (dw/lock-proportions (:id shape)))))

6
frontend/src/uxbox/main/ui/workspace/sidebar/options/interactions.cljs
View file

@ -10,7 +10,7 @@
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.builtins.icons :as i] [uxbox.builtins.icons :as i]
[uxbox.main.data.lightbox :as udl] [uxbox.main.data.lightbox :as udl]
[uxbox.main.data.shapes :as uds] [uxbox.main.data.workspace :as dw]
[uxbox.main.refs :as refs] [uxbox.main.refs :as refs]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.ui.colorpicker :as cp] [uxbox.main.ui.colorpicker :as cp]
@ -59,7 +59,7 @@
(delete [item] (delete [item]
(let [sid (:id shape) (let [sid (:id shape)
id (:id item)] id (:id item)]
(st/emit! (uds/delete-interaction sid id)))) (st/emit! (dw/delete-interaction sid id))))
(on-delete [item event] (on-delete [item event]
(dom/prevent-default event) (dom/prevent-default event)
(let [delete (partial delete item)] (let [delete (partial delete item)]
@ -455,7 +455,7 @@
(dom/prevent-default event) (dom/prevent-default event)
(let [sid (:id shape) (let [sid (:id shape)
data (deref form)] data (deref form)]
(st/emit! (uds/update-interaction sid data)) (st/emit! (dw/update-interaction sid data))
(reset! form nil))) (reset! form nil)))
(on-cancel [event] (on-cancel [event]
(dom/prevent-default event) (dom/prevent-default event)

14
frontend/src/uxbox/main/ui/workspace/sidebar/options/rect_measures.cljs
View file

@ -87,23 +87,23 @@
[event shape attr] [event shape attr]
(let [value (-> (dom/event->value event) (let [value (-> (dom/event->value event)
(parse-int 0))] (parse-int 0))]
(st/emit! (uds/update-dimensions (:id shape) {attr value})))) (st/emit! (udw/update-dimensions (:id shape) {attr value}))))
(defn- on-rotation-change (defn- on-rotation-change
[event shape] [event shape]
(let [value (-> (dom/event->value event) (let [value (dom/event->value event)
(parse-int 0))] value (parse-int value 0)]
(st/emit! (uds/update-rotation (:id shape) value)))) (st/emit! (udw/update-shape-attrs (:id shape) {:rotation value}))))
(defn- on-position-change (defn- on-position-change
[event shape attr] [event shape attr]
(let [value (-> (dom/event->value event) (let [value (-> (dom/event->value event)
(parse-int nil)) (parse-int nil))
point (gpt/point {attr value})] point (gpt/point {attr value})]
(st/emit! (uds/update-position (:id shape) point)))) (st/emit! (udw/update-position (:id shape) point))))
(defn- on-proportion-lock-change (defn- on-proportion-lock-change
[event shape] [event shape]
(if (:proportion-lock shape) (if (:proportion-lock shape)
(st/emit! (uds/unlock-proportions (:id shape))) (st/emit! (udw/unlock-proportions (:id shape)))
(st/emit! (uds/lock-proportions (:id shape))))) (st/emit! (udw/lock-proportions (:id shape)))))

2
frontend/src/uxbox/main/ui/workspace/sidebar/options/text.cljs
View file

@ -30,7 +30,7 @@
{:mixins [mx/static]} {:mixins [mx/static]}
[menu {:keys [id] :as shape}] [menu {:keys [id] :as shape}]
(letfn [(update-attrs [attrs] (letfn [(update-attrs [attrs]
(st/emit! (uds/update-attrs id attrs))) (st/emit! (udw/update-shape-attrs id attrs)))
(on-font-family-change [event] (on-font-family-change [event]
(let [value (dom/event->value event) (let [value (dom/event->value event)
attrs {:font-family (read-string value) attrs {:font-family (read-string value)

41
frontend/src/uxbox/main/ui/workspace/streams.cljs
View file

@ -52,21 +52,7 @@
(and (mouse-event? v) (and (mouse-event? v)
(= :click (:type v)))) (= :click (:type v))))
(defrecord PointerEvent [window (defrecord PointerEvent [source pt ctrl shift])
viewport
ctrl
shift])
(defn pointer-event
[window viewport ctrl shift]
{:pre [(gpt/point? window)
(gpt/point? viewport)
(boolean? ctrl)
(boolean? shift)]}
(PointerEvent. window
viewport
ctrl
shift))
(defn pointer-event? (defn pointer-event?
[v] [v]
@ -90,23 +76,14 @@
;; --- Derived streams ;; --- Derived streams
;; TODO: this shoul be DEPRECATED
(defonce interaction-events
(rx/filter interaction-event? st/stream))
(defonce mouse-position (defonce mouse-position
(rx/filter pointer-event? st/stream)) (let [sub (rx/behavior-subject nil)
ob (->> st/stream
(defonce viewport-mouse-position (rx/filter pointer-event?)
(let [sub (rx/behavior-subject nil)] (rx/filter #(= :viewport (:source %)))
(-> (rx/map :viewport mouse-position) (rx/map :pt)
(rx/subscribe-with sub)) )]
sub)) (rx/subscribe-with ob sub)
(defonce window-mouse-position
(let [sub (rx/behavior-subject nil)]
(-> (rx/map :window mouse-position)
(rx/subscribe-with sub))
sub)) sub))
(defonce mouse-position-ctrl (defonce mouse-position-ctrl
@ -116,7 +93,7 @@
sub)) sub))
(defonce mouse-position-deltas (defonce mouse-position-deltas
(->> viewport-mouse-position (->> mouse-position
(rx/sample 10) (rx/sample 10)
(rx/map #(gpt/divide % @refs/selected-zoom)) (rx/map #(gpt/divide % @refs/selected-zoom))
(rx/mapcat (fn [point] (rx/mapcat (fn [point]

222
frontend/src/uxbox/main/ui/workspace/viewport.cljs
View file

@ -37,7 +37,7 @@
(mf/defc coordinates (mf/defc coordinates
[{:keys [zoom] :as props}] [{:keys [zoom] :as props}]
(let [coords (some-> (use-rxsub uws/viewport-mouse-position) (let [coords (some-> (use-rxsub uws/mouse-position)
(gpt/divide zoom) (gpt/divide zoom)
(gpt/round 0))] (gpt/round 0))]
[:ul.coordinates [:ul.coordinates
@ -60,16 +60,16 @@
:circle "Drag to draw a Circle" :circle "Drag to draw a Circle"
nil)) nil))
(mf/defc cursor-tooltip ;; (mf/defc cursor-tooltip
{:wrap [mf/wrap-memo]} ;; {:wrap [mf/wrap-memo]}
[{:keys [tooltip]}] ;; [{:keys [tooltip]}]
(let [coords (mf/deref refs/window-mouse-position)] ;; (let [coords (mf/deref refs/window-mouse-position)]
[:span.cursor-tooltip ;; [:span.cursor-tooltip
{:style ;; {:style
{:position "fixed" ;; {:position "fixed"
:left (str (+ (:x coords) 5) "px") ;; :left (str (+ (:x coords) 5) "px")
:top (str (- (:y coords) 25) "px")}} ;; :top (str (- (:y coords) 25) "px")}}
tooltip])) ;; tooltip]))
;; --- Selection Rect ;; --- Selection Rect
@ -89,15 +89,13 @@
(reify (reify
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [stoper (->> (rx/merge (rx/filter #(= % :interrupt) stream) (let [stoper (rx/filter #(or (dw/interrupt? %) (uws/mouse-up? %)) stream)]
(rx/filter uws/mouse-up? stream))
(rx/take 1))]
(rx/concat (rx/concat
(->> uws/viewport-mouse-position (rx/of (dw/deselect-all))
(->> uws/mouse-position
(rx/map (fn [pos] #(update-state % pos))) (rx/map (fn [pos] #(update-state % pos)))
(rx/take-until stoper)) (rx/take-until stoper))
(rx/of (dw/deselect-all) (rx/of dw/select-shapes-by-current-selrect
dw/select-shapes-by-current-selrect
clear-state))))))) clear-state)))))))
(mf/defc selrect (mf/defc selrect
@ -115,33 +113,187 @@
;; --- Viewport Positioning ;; --- Viewport Positioning
(def handle-viewport-positioning (def handle-viewport-positioning
(reify (letfn [(on-point [dom reference point]
ptk/WatchEvent (let [{:keys [x y]} (gpt/subtract point reference)
(watch [_ state stream] cx (.-scrollLeft dom)
(let [stoper (->> (rx/filter #(= ::finish-positioning %) stream) cy (.-scrollTop dom)]
(rx/take 1)) (set! (.-scrollLeft dom) (- cx x))
reference @uws/viewport-mouse-position (set! (.-scrollTop dom) (- cy y))))]
dom (dom/get-element "workspace-viewport")] (reify
(->> uws/viewport-mouse-position ptk/EffectEvent
(rx/map (fn [point] (effect [_ state stream]
(let [{:keys [x y]} (gpt/subtract point reference) (let [stoper (rx/filter #(= ::finish-positioning %) stream)
cx (.-scrollLeft dom) reference @uws/mouse-position
cy (.-scrollTop dom)] dom (dom/get-element "workspace-viewport")]
(set! (.-scrollLeft dom) (- cx x)) (-> (rx/take-until stoper uws/mouse-position)
(set! (.-scrollTop dom) (- cy y))))) (rx/subscribe #(on-point dom reference %))))))))
(rx/take-until stoper)
(rx/ignore))))))
;; --- Viewport ;; --- Viewport
(mf/def viewport (mf/defc viewport
[{:keys [page] :as props}]
(let [{:keys [drawing-tool tooltip zoom flags edition] :as wst} (mf/deref refs/workspace)
viewport-ref (mf/use-ref nil)
tooltip (or tooltip (get-shape-tooltip drawing-tool))
zoom (or zoom 1)]
(letfn [(on-mouse-down [event]
(dom/stop-propagation event)
(let [ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
opts {:shift? shift?
:ctrl? ctrl?}]
(st/emit! (uws/mouse-event :down ctrl? shift?)))
(when (not edition)
(if drawing-tool
(st/emit! (start-drawing drawing-tool))
(st/emit! :interrupt handle-selrect))))
(on-context-menu [event]
(dom/prevent-default event)
(dom/stop-propagation event)
(let [ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
opts {:shift? shift?
:ctrl? ctrl?}]
(st/emit! (uws/mouse-event :context-menu ctrl? shift?))))
(on-mouse-up [event]
(dom/stop-propagation event)
(let [ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
opts {:shift? shift?
:ctrl? ctrl?}]
(st/emit! (uws/mouse-event :up ctrl? shift?))))
(on-click [event]
(dom/stop-propagation event)
(let [ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
opts {:shift? shift?
:ctrl? ctrl?}]
(st/emit! (uws/mouse-event :click ctrl? shift?))))
(on-double-click [event]
(dom/stop-propagation event)
(let [ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
opts {:shift? shift?
:ctrl? ctrl?}]
(st/emit! (uws/mouse-event :double-click ctrl? shift?))))
(translate-point-to-viewport [pt]
(let [viewport (mf/ref-node viewport-ref)
brect (.getBoundingClientRect viewport)
brect (gpt/point (parse-int (.-left brect))
(parse-int (.-top brect)))]
(gpt/subtract pt brect)))
(on-key-down [event]
(let [bevent (.getBrowserEvent event)
key (.-keyCode event)
ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
opts {:key key
:shift? shift?
:ctrl? ctrl?}]
(when-not (.-repeat bevent)
(st/emit! (uws/keyboard-event :down key ctrl? shift?))
(when (kbd/space? event)
(st/emit! handle-viewport-positioning)
#_(st/emit! (dw/start-viewport-positioning))))))
(on-key-up [event]
(let [key (.-keyCode event)
ctrl? (kbd/ctrl? event)
shift? (kbd/shift? event)
opts {:key key
:shift? shift?
:ctrl? ctrl?}]
(when (kbd/space? event)
(st/emit! ::finish-positioning #_(dw/stop-viewport-positioning)))
(st/emit! (uws/keyboard-event :up key ctrl? shift?))))
(on-mouse-move [event]
(let [pt (gpt/point (.-clientX event)
(.-clientY event))
pt (translate-point-to-viewport pt)]
;; (prn "viewport:on-mouse-move" pt)
(st/emit! (uws/->PointerEvent :viewport pt (kbd/ctrl? event) (kbd/shift? event)))))
;; ;; ctrl? (kbd/ctrl? event)
;; ;; shift? (kbd/shift? event)
;; ;; event {:ctrl ctrl?
;; ;; :shift shift?
;; ;; :window-coords wpt
;; ;; :viewport-coords vpt}
;; ]
;; #_(st/emit! (uws/pointer-event wpt vpt ctrl? shift?))))
(on-mount []
(prn "viewport.on-mount" (:id page))
(let [
;; key1 (events/listen js/document EventType.MOUSEMOVE on-mousemove)
key2 (events/listen js/document EventType.KEYDOWN on-key-down)
key3 (events/listen js/document EventType.KEYUP on-key-up)]
(fn []
;; (events/unlistenByKey key1)
(events/unlistenByKey key2)
(events/unlistenByKey key3))))]
(mf/use-effect on-mount)
;; (prn "viewport.render" (:id page))
[:*
[:& coordinates {:zoom zoom}]
#_[:div.tooltip-container
(when tooltip
[:& cursor-tooltip {:tooltip tooltip}])]
[:svg.viewport {:width (* c/viewport-width zoom)
:height (* c/viewport-height zoom)
:ref viewport-ref
:class (when drawing-tool "drawing")
:on-context-menu on-context-menu
:on-click on-click
:on-double-click on-double-click
:on-mouse-move on-mouse-move
:on-mouse-down on-mouse-down
:on-mouse-up on-mouse-up}
[:g.zoom {:transform (str "scale(" zoom ", " zoom ")")}
(when page
[:*
(for [id (:canvas page)]
[:& canvas {:key id :id id}])
(for [id (reverse (:shapes page))]
[:& uus/shape-component {:id id :key id}])
(when (seq (:selected wst))
[:& selection-handlers {:wst wst}])
(when-let [dshape (:drawing wst)]
[:& draw-area {:shape dshape
:zoom (:zoom wst)
:modifiers (:modifiers wst)}])])
(if (contains? flags :grid)
[:& grid {:page page}])]
(when (contains? flags :ruler)
[:& ruler {:zoom zoom :ruler (:ruler wst)}])
[:& selrect {:data (:selrect wst)}]]])))
#_(mf/def viewport
:init :init
(fn [own props] (fn [own props]
(assoc own ::viewport (mf/create-ref))) (assoc own ::viewport (mf/create-ref)))
:did-mount :did-mount
(fn [own] (fn [own]
(letfn [(translate-point-to-viewport [pt] (letfn [
(translate-point-to-viewport [pt]
(let [viewport (mf/ref-node (::viewport own)) (let [viewport (mf/ref-node (::viewport own))
brect (.getBoundingClientRect viewport) brect (.getBoundingClientRect viewport)
brect (gpt/point (parse-int (.-left brect)) brect (gpt/point (parse-int (.-left brect))

4
frontend/src/uxbox/util/data.cljs
View file

@ -17,11 +17,11 @@
"Return a indexed map of the collection "Return a indexed map of the collection
keyed by the result of executing the getter keyed by the result of executing the getter
over each element of the collection." over each element of the collection."
[coll getter] [getter coll]
(persistent! (persistent!
(reduce #(assoc! %1 (getter %2) %2) (transient {}) coll))) (reduce #(assoc! %1 (getter %2) %2) (transient {}) coll)))
(def index-by-id #(index-by % :id)) (def index-by-id #(index-by :id %))
(defn remove-nil-vals (defn remove-nil-vals
"Given a map, return a map removing key-value "Given a map, return a map removing key-value