Merge branch 'staging' into main

This commit is contained in:
Andrey Antukh 2021-07-14 11:32:09 +02:00
commit a6d156438f
468 changed files with 16810 additions and 8136 deletions

View file

@ -6,9 +6,8 @@
(ns app.config
(:require
[app.common.data :as d]
[app.common.uri :as u]
[app.common.spec :as us]
[app.common.uri :as u]
[app.common.version :as v]
[app.util.avatars :as avatars]
[app.util.dom :as dom]
@ -54,6 +53,11 @@
:browser
:webworker))
(defn- parse-flags
[global]
(let [flags (obj/get global "penpotFlags" "")]
(into #{} (map keyword) (str/words flags))))
(defn- parse-version
[global]
(-> (obj/get global "penpotVersion")
@ -78,6 +82,8 @@
(def themes (obj/get global "penpotThemes"))
(def analytics (obj/get global "penpotAnalyticsEnabled" false))
(def flags (delay (parse-flags global)))
(def version (delay (parse-version global)))
(def target (delay (parse-target global)))
(def browser (delay (parse-browser)))

View file

@ -0,0 +1,87 @@
;; 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) UXBOX Labs SL
(ns app.libs.file-builder
(:require
[app.common.data :as d]
[app.common.file-builder :as fb]
[cuerdas.core :as str]))
(defn parse-data [data]
(as-> data $
(js->clj $ :keywordize-keys true)
;; Transforms camelCase to kebab-case
(d/deep-mapm
(fn [[key value]]
(let [value (if (= (type value) js/Symbol)
(keyword (js/Symbol.keyFor value))
value)
key (-> key d/name str/kebab keyword)]
[key value])) $)))
(deftype File [^:mutable file]
Object
(addPage [_ name]
(set! file (fb/add-page file {:name name}))
(str (:current-page-id file)))
(addPage [_ name options]
(set! file (fb/add-page file {:name name :options options}))
(str (:current-page-id file)))
(closePage [_]
(set! file (fb/close-page file)))
(addArtboard [_ data]
(set! file (fb/add-artboard file (parse-data data)))
(str (:last-id file)))
(closeArtboard [_]
(set! file (fb/close-artboard file)))
(addGroup [_ data]
(set! file (fb/add-group file (parse-data data)))
(str (:last-id file)))
(closeGroup [_]
(set! file (fb/close-group file)))
(createRect [_ data]
(set! file (fb/create-rect file (parse-data data)))
(str (:last-id file)))
(createCircle [_ data]
(set! file (fb/create-circle file (parse-data data)))
(str (:last-id file)))
(createPath [_ data]
(set! file (fb/create-path file (parse-data data)))
(str (:last-id file)))
(createText [_ data]
(set! file (fb/create-text file (parse-data data)))
(str (:last-id file)))
(createImage [_ data]
(set! file (fb/create-image file (parse-data data)))
(str (:last-id file)))
(createSVG [_ data]
(set! file (fb/create-svg-raw file (parse-data data)))
(str (:last-id file)))
(closeSVG [_]
(set! file (fb/close-svg-raw file)))
(asMap [_]
(clj->js file)))
(defn create-file-export [^string name]
(File. (fb/create-file name)))
(defn exports []
#js { :createFile create-file-export })

View file

@ -0,0 +1,28 @@
;; 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) UXBOX Labs SL
(ns app.libs.render
(:require
[app.common.uuid :as uuid]
[app.main.render :as r]
[beicon.core :as rx]
[promesa.core :as p]))
(defn render-page-export
[file ^string page-id]
;; Better to expose the api as a promise to be consumed from JS
(let [page-id (uuid/uuid page-id)
file-data (.-file file)
data (get-in file-data [:data :pages-index page-id])]
(p/create
(fn [resolve reject]
(->> (r/render-page data)
(rx/take 1)
(rx/subs resolve reject))) )))
(defn exports []
#js {:renderPage render-page-export})

View file

@ -12,7 +12,6 @@
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.users :as du]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui :as ui]
[app.main.ui.confirm]
@ -21,11 +20,9 @@
[app.util.dom :as dom]
[app.util.i18n :as i18n]
[app.util.logging :as log]
[app.util.object :as obj]
[app.util.router :as rt]
[app.util.storage :refer [storage]]
[app.util.theme :as theme]
[app.util.timers :as ts]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]
@ -81,7 +78,7 @@
(defn initialize
[]
(letfn [(on-profile [profile]
(letfn [(on-profile [_profile]
(rx/of (rt/initialize-router ui/routes)
(rt/initialize-history on-navigate)))]
(ptk/reify ::initialize
@ -90,7 +87,7 @@
(assoc state :session-id (uuid/next)))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(rx/merge
(rx/of
(ptk/event ::ev/initialize)

View file

@ -6,29 +6,11 @@
(ns app.main.data.comments
(:require
[cuerdas.core :as str]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.constants :as c]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.worker :as uw]
[app.util.router :as rt]
[app.util.timers :as ts]
[app.util.transit :as t]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]))
(s/def ::content ::us/string)
@ -92,7 +74,7 @@
(ptk/reify ::create-thread
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation :create-comment-thread params)
(rx/mapcat #(rp/query :comment-thread {:file-id (:file-id %) :id (:id %)}))
(rx/map #(partial created %)))))))
@ -102,7 +84,7 @@
(us/assert ::comment-thread thread)
(ptk/reify ::update-comment-thread-status
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [done #(d/update-in-when % [:comment-threads id] assoc :count-unread-comments 0)]
(->> (rp/mutation :update-comment-thread-status {:id id})
(rx/map (constantly done)))))))
@ -118,7 +100,7 @@
(d/update-in-when state [:comment-threads id] assoc :is-resolved is-resolved))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation :update-comment-thread {:id id :is-resolved is-resolved})
(rx/ignore)))))
@ -131,7 +113,7 @@
(update-in state [:comments (:id thread)] assoc (:id comment) comment))]
(ptk/reify ::create-comment
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(rx/concat
(->> (rp/mutation :add-comment {:thread-id (:id thread) :content content})
(rx/map #(partial created %)))
@ -146,7 +128,7 @@
(d/update-in-when state [:comments thread-id id] assoc :content content))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation :update-comment {:id id :content content})
(rx/ignore)))))
@ -161,7 +143,7 @@
(update :comment-threads dissoc id)))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation :delete-comment-thread {:id id})
(rx/ignore)))))
@ -174,7 +156,7 @@
(d/update-in-when state [:comments thread-id] dissoc id))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation :delete-comment {:id id})
(rx/ignore)))))
@ -185,7 +167,7 @@
(assoc-in state [:comment-threads id] thread))]
(ptk/reify ::refresh-comment-thread
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :comment-thread {:file-id file-id :id id})
(rx/map #(partial fetched %)))))))
@ -196,7 +178,7 @@
(assoc state :comment-threads (d/index-by :id data)))]
(ptk/reify ::retrieve-comment-threads
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :comment-threads {:file-id file-id})
(rx/map #(partial fetched %)))))))
@ -207,7 +189,7 @@
(update state :comments assoc thread-id (d/index-by :id comments)))]
(ptk/reify ::retrieve-comments
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :comments {:thread-id thread-id})
(rx/map #(partial fetched %)))))))
@ -217,7 +199,7 @@
(us/assert ::us/uuid team-id)
(ptk/reify ::retrieve-unread-comment-threads
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [fetched #(assoc %2 :comment-threads (d/index-by :id %1))]
(->> (rp/query :unread-comment-threads {:team-id team-id})
(rx/map #(partial fetched %)))))))
@ -321,7 +303,7 @@
(defn apply-filters
[cstate profile threads]
(let [{:keys [show mode open]} cstate]
(let [{:keys [show mode]} cstate]
(cond->> threads
(= :pending show)
(filter (comp not :is-resolved))

View file

@ -7,23 +7,16 @@
(ns app.main.data.dashboard
(:require
[app.common.data :as d]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.repo :as rp]
[app.main.data.events :as ev]
[app.main.data.users :as du]
[app.main.data.fonts :as df]
[app.main.data.media :as di]
[app.main.data.users :as du]
[app.main.repo :as rp]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[app.util.time :as dt]
[app.util.timers :as ts]
[app.util.avatars :as avatars]
[app.main.data.media :as di]
[app.main.data.messages :as dm]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]))
;; --- Specs
@ -44,13 +37,12 @@
::modified-at]))
(s/def ::project
(s/keys ::req-un [::id
::name
::team-id
::profile-id
::created-at
::modified-at
::is-pinned]))
(s/keys :req-un [::id
::name
::team-id
::created-at
::modified-at
::is-pinned]))
(s/def ::file
(s/keys :req-un [::id
@ -80,6 +72,7 @@
(-> (assoc :current-team-id id)
(dissoc :dashboard-files)
(dissoc :dashboard-projects)
(dissoc :dashboard-shared-files)
(dissoc :dashboard-recent-files)
(dissoc :dashboard-team-members)
(dissoc :dashboard-team-stats)))))
@ -109,7 +102,7 @@
[]
(ptk/reify ::fetch-team-members
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query :team-members {:team-id team-id})
(rx/map team-members-fetched))))))
@ -127,7 +120,7 @@
[]
(ptk/reify ::fetch-team-stats
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query :team-stats {:team-id team-id})
(rx/map team-stats-fetched))))))
@ -146,7 +139,7 @@
[]
(ptk/reify ::fetch-projects
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query :projects {:team-id team-id})
(rx/map projects-fetched))))))
@ -173,7 +166,7 @@
(dissoc state :dashboard-search-result))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)
params (assoc params :team-id team-id)]
(->> (rp/query :search-files params)
@ -202,7 +195,7 @@
(us/assert ::us/uuid project-id)
(ptk/reify ::fetch-files
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :project-files {:project-id project-id})
(rx/map #(files-fetched project-id %))))))
@ -213,13 +206,16 @@
(ptk/reify ::shared-files-fetched
ptk/UpdateEvent
(update [_ state]
(assoc state :dashboard-shared-files (d/index-by :id files)))))
(let [files (d/index-by :id files)]
(-> state
(assoc :dashboard-shared-files files)
(update :dashboard-files d/merge files))))))
(defn fetch-shared-files
[]
(ptk/reify ::fetch-shared-files
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query :team-shared-files {:team-id team-id})
(rx/map shared-files-fetched))))))
@ -240,7 +236,7 @@
[]
(ptk/reify ::fetch-recent-files
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/query :team-recent-files {:team-id team-id})
(rx/map recent-files-fetched))))))
@ -293,7 +289,7 @@
(us/assert string? name)
(ptk/reify ::create-team
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
@ -313,7 +309,7 @@
(assoc-in state [:teams id :name] name))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation! :update-team params)
(rx/ignore)))))
@ -322,7 +318,7 @@
(us/assert ::di/file file)
(ptk/reify ::update-team-photo
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [on-success di/notify-finished-loading
on-error #(do (di/notify-finished-loading)
(di/process-error %))
@ -344,7 +340,7 @@
(us/assert ::us/keyword role)
(ptk/reify ::update-team-member-role
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)
params (assoc params :team-id team-id)]
(->> (rp/mutation! :update-team-member-role params)
@ -357,7 +353,7 @@
(us/assert ::us/uuid member-id)
(ptk/reify ::delete-team-member
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)
params (assoc params :team-id team-id)]
(->> (rp/mutation! :delete-team-member params)
@ -370,7 +366,7 @@
(us/assert (s/nilable ::us/uuid) reassign-to)
(ptk/reify ::leave-team
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)
@ -391,7 +387,7 @@
(us/assert ::us/keyword role)
(ptk/reify ::invite-team-member
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)
@ -408,7 +404,7 @@
(us/assert ::team params)
(ptk/reify ::delete-team
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
@ -434,7 +430,7 @@
[]
(ptk/reify ::create-project
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [name (name (gensym (str (tr "dashboard.new-project-prefix") " ")))
team-id (:current-team-id state)
params {:name name
@ -461,7 +457,7 @@
(us/assert ::us/uuid id)
(ptk/reify ::duplicate-project
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)
@ -480,7 +476,7 @@
(us/assert ::us/uuid team-id)
(ptk/reify ::move-project
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
@ -491,7 +487,7 @@
(rx/catch on-error))))))
(defn toggle-project-pin
[{:keys [id is-pinned team-id] :as project}]
[{:keys [id is-pinned] :as project}]
(us/assert ::project project)
(ptk/reify ::toggle-project-pin
ptk/UpdateEvent
@ -499,7 +495,7 @@
(assoc-in state [:dashboard-projects id :is-pinned] (not is-pinned)))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [project (get-in state [:dashboard-projects id])
params (select-keys project [:id :is-pinned :team-id])]
(->> (rp/mutation :update-project-pin params)
@ -508,7 +504,7 @@
;; --- EVENT: rename-project
(defn rename-project
[{:keys [id name team-id] :as params}]
[{:keys [id name] :as params}]
(us/assert ::project params)
(ptk/reify ::rename-project
ptk/UpdateEvent
@ -518,7 +514,7 @@
(update :dashboard-local dissoc :project-for-edit)))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [params {:id id :name name}]
(->> (rp/mutation :rename-project params)
(rx/ignore))))))
@ -526,7 +522,7 @@
;; --- EVENT: delete-project
(defn delete-project
[{:keys [id team-id] :as params}]
[{:keys [id] :as params}]
(us/assert ::project params)
(ptk/reify ::delete-project
ptk/UpdateEvent
@ -534,14 +530,14 @@
(update state :dashboard-projects dissoc id))
ptk/WatchEvent
(watch [_ state s]
(watch [_ _ _]
(->> (rp/mutation :delete-project {:id id})
(rx/ignore)))))
;; --- EVENT: delete-file
(defn file-deleted
[team-id project-id]
[_team-id project-id]
(ptk/reify ::file-deleted
ptk/UpdateEvent
(update [_ state]
@ -555,10 +551,11 @@
(update [_ state]
(-> state
(d/update-when :dashboard-files dissoc id)
(d/update-when :dashboard-shared-files dissoc id)
(d/update-when :dashboard-recent-files dissoc id)))
ptk/WatchEvent
(watch [_ state s]
(watch [_ state _]
(let [team-id (uuid/uuid (get-in state [:route :path-params :team-id]))]
(->> (rp/mutation :delete-file {:id id})
(rx/map #(file-deleted team-id project-id)))))))
@ -573,10 +570,11 @@
(update [_ state]
(-> state
(d/update-in-when [:dashboard-files id :name] (constantly name))
(d/update-in-when [:dashboard-shared-files id :name] (constantly name))
(d/update-in-when [:dashboard-recent-files id :name] (constantly name))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [params (select-keys params [:id :name])]
(->> (rp/mutation :rename-file params)
(rx/ignore))))))
@ -591,10 +589,13 @@
(update [_ state]
(-> state
(d/update-in-when [:dashboard-files id :is-shared] (constantly is-shared))
(d/update-in-when [:dashboard-recent-files id :is-shared] (constantly is-shared))))
(d/update-in-when [:dashboard-recent-files id :is-shared] (constantly is-shared))
(cond->
(not is-shared)
(d/update-when :dashboard-shared-files dissoc id))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [params {:id id :is-shared is-shared}]
(->> (rp/mutation :set-file-shared params)
(rx/ignore))))))
@ -621,7 +622,7 @@
(us/assert ::us/uuid project-id)
(ptk/reify ::create-file
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)
@ -642,7 +643,7 @@
(us/assert ::name name)
(ptk/reify ::duplicate-file
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)
@ -663,7 +664,7 @@
(us/assert ::us/uuid project-id)
(ptk/reify ::move-files
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error rx/throw}} (meta params)]
@ -682,26 +683,32 @@
(us/assert ::file file)
(ptk/reify ::go-to-workspace
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [pparams {:project-id project-id :file-id id}]
(rx/of (rt/nav :workspace pparams))))))
(defn go-to-files
[project-id]
(ptk/reify ::go-to-files
ptk/WatchEvent
(watch [_ state stream]
(let [team-id (:current-team-id state)]
(rx/of (rt/nav :dashboard-files {:team-id team-id
:project-id project-id}))))))
([project-id]
(ptk/reify ::go-to-files
ptk/WatchEvent
(watch [_ state _]
(let [team-id (:current-team-id state)]
(rx/of (rt/nav :dashboard-files {:team-id team-id
:project-id project-id}))))))
([team-id project-id]
(ptk/reify ::go-to-files
ptk/WatchEvent
(watch [_ _ _]
(rx/of (rt/nav :dashboard-files {:team-id team-id
:project-id project-id}))))))
(defn go-to-search
([] (go-to-search nil))
([term]
(ptk/reify ::go-to-search
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(if (empty? term)
(rx/of (rt/nav :dashboard-search
@ -714,13 +721,13 @@
([]
(ptk/reify ::go-to-projects
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(rx/of (rt/nav :dashboard-projects {:team-id team-id}))))))
([team-id]
(ptk/reify ::go-to-projects
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(du/set-current-team! team-id)
(rx/of (rt/nav :dashboard-projects {:team-id team-id}))))))
@ -728,7 +735,7 @@
[]
(ptk/reify ::go-to-team-members
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(rx/of (rt/nav :dashboard-team-members {:team-id team-id}))))))
@ -736,6 +743,6 @@
[]
(ptk/reify ::go-to-team-settings
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(rx/of (rt/nav :dashboard-team-settings {:team-id team-id}))))))

View file

@ -8,14 +8,14 @@
(:require
["ua-parser-js" :as UAParser]
[app.common.data :as d]
[app.main.repo :as rp]
[app.config :as cf]
[app.main.repo :as rp]
[app.util.globals :as g]
[app.util.http :as http]
[app.util.i18n :as i18n]
[app.util.object :as obj]
[app.util.storage :refer [storage]]
[app.util.time :as dt]
[app.util.i18n :as i18n]
[beicon.core :as rx]
[lambdaisland.uri :as u]
[potok.core :as ptk]))
@ -139,7 +139,7 @@
:project-id (:project-id data)}}))
(defn- event->generic-action
[event name]
[_ name]
{:type "action"
:name name
:props {}})
@ -176,7 +176,7 @@
[_ {:keys [buffer] :as params}]
(ptk/reify ::persistence
ptk/EffectEvent
(effect [_ state stream]
(effect [_ state _]
(let [profile-id (:profile-id state)
events (into [] (take max-buffer-size) @buffer)]
(when (seq events)
@ -191,7 +191,7 @@
(let [buffer (atom #queue [])]
(ptk/reify ::initialize
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(->> (rx/merge
(->> (rx/from-atom buffer)
(rx/filter #(pos? (count %)))
@ -202,7 +202,7 @@
(rx/map #(ptk/event ::persistence {:buffer buffer}))))
ptk/EffectEvent
(effect [_ state stream]
(effect [_ _ stream]
(let [events (methods process-event)
session (atom nil)

View file

@ -8,16 +8,14 @@
(:require
["opentype.js" :as ot]
[app.common.data :as d]
[app.common.spec :as us]
[app.common.media :as cm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.fonts :as fonts]
[app.main.repo :as rp]
[app.util.i18n :as i18n :refer [tr]]
[app.util.logging :as log]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[app.util.webapi :as wa]
[beicon.core :as rx]
[cuerdas.core :as str]
[potok.core :as ptk]))
@ -62,7 +60,7 @@
(assoc state :dashboard-fonts (d/index-by :id fonts)))
ptk/EffectEvent
(effect [_ state stream]
(effect [_ _ _]
(let [fonts (->> fonts
(map adapt-font-id)
(group-by :font-id)
@ -73,7 +71,7 @@
[team-id]
(ptk/reify ::load-team-fonts
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :font-variants {:team-id team-id})
(rx/map fonts-fetched)))))
@ -121,7 +119,7 @@
(parse-font [{:keys [data] :as params}]
(try
(assoc params :font (ot/parse data))
(catch :default e
(catch :default _e
(log/warn :msg (str/fmt "skiping file %s, unsupported format" (:name params)))
nil)))
@ -204,7 +202,7 @@
fonts))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/mutation! :update-font {:id id :name name :team-id team-id})
(rx/ignore))))))
@ -218,10 +216,10 @@
(update [_ state]
(update state :dashboard-fonts
(fn [variants]
(d/removem (fn [[id variant]]
(d/removem (fn [[_id variant]]
(= (:font-id variant) font-id)) variants))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/mutation! :delete-font {:id font-id :team-id team-id})
(rx/ignore))))))
@ -238,7 +236,7 @@
(= (:id variant) id))
variants))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(->> (rp/mutation! :delete-font-variant {:id id :team-id team-id})
(rx/ignore))))))

View file

@ -1,270 +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) UXBOX Labs SL
(ns app.main.data.history
(:require
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]
[app.common.spec :as us]
[app.common.pages :as cp]
[app.main.repo :as rp]
[app.util.data :refer [replace-by-id index-by]]))
;; --- Schema
(s/def ::pinned boolean?)
(s/def ::id uuid?)
(s/def ::label string?)
(s/def ::project uuid?)
(s/def ::created-at inst?)
(s/def ::modified-at inst?)
(s/def ::version number?)
(s/def ::user uuid?)
(s/def ::shapes
(s/every ::cp/minimal-shape :kind vector?))
(s/def ::data
(s/keys :req-un [::shapes]))
(s/def ::history-entry
(s/keys :req-un [::id
::pinned
::label
::project
::created-at
::modified-at
::version
::user
::data]))
(s/def ::history-entries
(s/every ::history-entry))
;; --- Initialize History State
(declare fetch-history)
(declare fetch-pinned-history)
(defn initialize
[id]
(us/verify ::us/uuid id)
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace id]
assoc :history {:selected nil
:pinned #{}
:items #{}
:byver {}}))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (fetch-history id)
(fetch-pinned-history id)))))
;; --- Watch Page Changes
(defn watch-page-changes
[id]
(us/verify ::us/uuid id)
(reify
ptk/WatchEvent
(watch [_ state stream]
#_(let [stopper (rx/filter #(= % ::stop-page-watcher) stream)]
(->> stream
(rx/filter dp/page-persisted?)
(rx/debounce 1000)
(rx/flat-map #(rx/of (fetch-history id)
(fetch-pinned-history id)))
(rx/take-until stopper))))))
;; --- Pinned Page History Fetched
(defn pinned-history-fetched
[items]
(us/verify ::history-entries items)
(ptk/reify ::pinned-history-fetched
ptk/UpdateEvent
(update [_ state]
(let [pid (get-in state [:workspace :current])
items-map (index-by :version items)
items-set (into #{} items)]
(update-in state [:workspace pid :history]
(fn [history]
(-> history
(assoc :pinned items-set)
(update :byver merge items-map))))))))
;; --- Fetch Pinned Page History
(defn fetch-pinned-history
[id]
(us/verify ::us/uuid id)
(ptk/reify ::fetch-pinned-history
ptk/WatchEvent
(watch [_ state s]
(let [params {:page id :pinned true}]
#_(->> (rp/req :fetch/page-history params)
(rx/map :payload)
(rx/map pinned-history-fetched))))))
;; --- Page History Fetched
(defn history-fetched
[items]
(us/verify ::history-entries items)
(ptk/reify ::history-fetched
ptk/UpdateEvent
(update [_ state]
(let [pid (get-in state [:workspace :current])
versions (into #{} (map :version) items)
items-map (index-by :version items)
min-version (apply min versions)
max-version (apply max versions)]
(update-in state [:workspace pid :history]
(fn [history]
(-> history
(assoc :min-version min-version)
(assoc :max-version max-version)
(update :byver merge items-map)
(update :items #(reduce conj % items)))))))))
;; --- Fetch Page History
(defn fetch-history
([id]
(fetch-history id nil))
([id {:keys [since max]}]
(us/verify ::us/uuid id)
(ptk/reify ::fetch-history
ptk/WatchEvent
(watch [_ state s]
(let [params (merge {:page id
:max (or max 20)}
(when since
{:since since}))]
#_(->> (rp/req :fetch/page-history params)
(rx/map :payload)
(rx/map history-fetched)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Context Aware Events
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Select Section
(deftype SelectSection [section]
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace :history :section] section)))
(defn select-section
[section]
{:pre [(keyword? section)]}
(SelectSection. section))
;; --- Load More
(def load-more
(ptk/reify ::load-more
ptk/WatchEvent
(watch [_ state stream]
(let [pid (get-in state [:workspace :current])
since (get-in state [:workspace pid :history :min-version])]
(rx/of (fetch-history pid {:since since}))))))
;; --- Select Page History
(defn select
[version]
(us/verify int? version)
(ptk/reify ::select
ptk/UpdateEvent
(update [_ state]
#_(let [pid (get-in state [:workspace :current])
item (get-in state [:workspace pid :history :byver version])
page (-> (get-in state [:pages pid])
(assoc :history true
:data (:data item)))]
(-> state
(dp/unpack-page page)
(assoc-in [:workspace pid :history :selected] version))))))
;; --- Apply Selected History
(def apply-selected
(ptk/reify ::apply-selected
ptk/UpdateEvent
(update [_ state]
(let [pid (get-in state [:workspace :current])]
(-> state
(update-in [:pages pid] dissoc :history)
(assoc-in [:workspace pid :history :selected] nil))))
ptk/WatchEvent
(watch [_ state s]
#_(let [pid (get-in state [:workspace :current])]
(rx/of (dp/persist-page pid))))))
;; --- Deselect Page History
(def deselect
(ptk/reify ::deselect
ptk/UpdateEvent
(update [_ state]
#_(let [pid (get-in state [:workspace :current])
packed (get-in state [:packed-pages pid])]
(-> (dp/unpack-page state packed)
(assoc-in [:workspace pid :history :selected] nil))))))
;; --- Refresh Page History
(def refres-history
(ptk/reify ::refresh-history
ptk/WatchEvent
(watch [_ state stream]
(let [pid (get-in state [:workspace :current])
history (get-in state [:workspace pid :history])
maxitems (count (:items history))]
(rx/of (fetch-history pid {:max maxitems})
(fetch-pinned-history pid))))))
;; --- History Item Updated
(defn history-updated
[item]
(us/verify ::history-entry item)
(ptk/reify ::history-item-updated
ptk/UpdateEvent
(update [_ state]
(let [pid (get-in state [:workspace :current])]
(update-in state [:workspace pid :history]
(fn [history]
(-> history
(update :items #(into #{} (replace-by-id item) %))
(update :pinned #(into #{} (replace-by-id item) %))
(assoc-in [:byver (:version item)] item))))))))
(defn history-updated?
[v]
(= ::history-item-updated (ptk/type v)))
;; --- Update History Item
(defn update-history-item
[item]
(ptk/reify ::update-history-item
ptk/WatchEvent
(watch [_ state stream]
(rx/concat
#_(->> (rp/req :update/page-history item)
(rx/map :payload)
(rx/map history-updated))
(->> (rx/filter history-updated? stream)
(rx/take 1)
(rx/map (constantly refres-history)))))))

View file

@ -6,22 +6,14 @@
(ns app.main.data.media
(:require
[app.common.data :as d]
[app.common.media :as cm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.common.exceptions :as ex]
[app.common.media :as cm]
[app.main.data.messages :as dm]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.i18n :refer [tr]]
[app.util.router :as r]
[app.util.router :as rt]
[app.util.time :as ts]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]))
[cuerdas.core :as str]))
;; --- Predicates

View file

@ -7,10 +7,7 @@
(ns app.main.data.messages
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.config :as cfg]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
@ -54,7 +51,7 @@
(assoc state :message message)))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(when (:timeout data)
(let [stoper (rx/filter (ptk/type? ::show) stream)]
(->> (rx/of hide)
@ -68,7 +65,7 @@
(d/update-when state :message assoc :status :hide))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(let [stoper (rx/filter (ptk/type? ::show) stream)]
(->> (rx/of #(dissoc % :message))
(rx/delay default-animation-timeout)
@ -78,7 +75,7 @@
[tag]
(ptk/reify ::hide-tag
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [message (get state :message)]
(when (= (:tag message) tag)
(rx/of hide))))))
@ -127,7 +124,7 @@
:tag tag})))
(defn assign-exception
[{:keys [type] :as error}]
[error]
(ptk/reify ::assign-exception
ptk/UpdateEvent
(update [_ state]

View file

@ -7,10 +7,10 @@
(ns app.main.data.modal
(:refer-clojure :exclude [update])
(:require
[potok.core :as ptk]
[app.main.store :as st]
[app.common.uuid :as uuid]
[cljs.core :as c]))
[app.main.store :as st]
[cljs.core :as c]
[potok.core :as ptk]))
(defonce components (atom {}))
@ -29,7 +29,7 @@
:allow-click-outside false})))))
(defn update-props
([type props]
([_type props]
(ptk/reify ::update-modal-props
ptk/UpdateEvent
(update [_ state]

View file

@ -8,7 +8,6 @@
(:refer-clojure :exclude [meta reset!])
(:require
["mousetrap" :as mousetrap]
[app.common.data :as d]
[app.common.spec :as us]
[app.config :as cfg]
[app.util.logging :as log]
@ -164,8 +163,8 @@
(update :shortcuts (fnil conj '()) [key shortcuts])))
ptk/EffectEvent
(effect [_ state stream]
(let [[key shortcuts] (peek (:shortcuts state))]
(effect [_ state _]
(let [[_key shortcuts] (peek (:shortcuts state))]
(reset! shortcuts)))))
(defn pop-shortcuts
@ -179,7 +178,7 @@
(pop shortcuts)
shortcuts)))))
ptk/EffectEvent
(effect [_ state stream]
(effect [_ state _]
(let [[key* shortcuts] (peek (:shortcuts state))]
(when (not= key key*)
(reset! shortcuts))))))

View file

@ -6,24 +6,20 @@
(ns app.main.data.users
(:require
[app.config :as cf]
[app.common.data :as d]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.events :as ev]
[app.main.data.media :as di]
[app.main.data.modal :as modal]
[app.main.data.messages :as dm]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.avatars :as avatars]
[app.util.i18n :as i18n :refer [tr]]
[app.util.i18n :as i18n]
[app.util.router :as rt]
[app.util.storage :refer [storage]]
[app.util.theme :as theme]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]))
;; --- COMMON SPECS
@ -75,7 +71,7 @@
[]
(ptk/reify ::fetch-teams
ptk/WatchEvent
(watch [_ state s]
(watch [_ _ _]
(->> (rp/query! :teams)
(rx/map teams-fetched)))))
@ -95,7 +91,7 @@
(assoc :profile profile)))
ptk/EffectEvent
(effect [_ state stream]
(effect [_ state _]
(let [profile (:profile state)]
(when (not= uuid/zero (:id profile))
(swap! storage assoc :profile profile)
@ -107,7 +103,7 @@
[]
(ptk/reify ::fetch-profile
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query! :profile)
(rx/map profile-fetched)))))
@ -120,7 +116,7 @@
[]
(ptk/reify ::initialize-profile
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(rx/merge
(rx/of (fetch-profile))
(->> stream
@ -141,10 +137,8 @@
(-deref [_] profile)
ptk/WatchEvent
(watch [this state stream]
(let [team-id (get-current-team-id profile)
profile (with-meta profile
{::ev/source "login"})]
(watch [_ _ _]
(let [team-id (get-current-team-id profile)]
(->> (rx/concat
(rx/of (profile-fetched profile)
(fetch-teams))
@ -166,7 +160,7 @@
(us/verify ::login-params data)
(ptk/reify ::login
ptk/WatchEvent
(watch [this state s]
(watch [_ _ _]
(let [{:keys [on-error on-success]
:or {on-error rx/throw
on-success identity}} (meta data)
@ -186,11 +180,30 @@
[{:keys [profile] :as tdata}]
(ptk/reify ::login-from-token
ptk/WatchEvent
(watch [this state s]
(watch [_ _ _]
(rx/of (logged-in
(with-meta profile
{::ev/source "login-with-token"}))))))
(defn login-from-register
"Event used mainly for mark current session as logged-in in after the
user sucessfully registred using third party auth provider (in this
case we dont need to verify the email)."
[]
(ptk/reify ::login-from-register
ptk/WatchEvent
(watch [_ _ stream]
(rx/merge
(rx/of (fetch-profile))
(->> stream
(rx/filter (ptk/type? ::profile-fetched))
(rx/take 1)
(rx/map deref)
(rx/map (fn [profile]
(with-meta profile
{::ev/source "register"})))
(rx/map logged-in))))))
;; --- EVENT: logout
(defn logged-out
@ -201,11 +214,11 @@
(select-keys state [:route :router :session-id :history]))
ptk/WatchEvent
(watch [_ state s]
(watch [_ _ _]
(rx/of (rt/nav :auth-login)))
ptk/EffectEvent
(effect [_ state s]
(effect [_ _ _]
(reset! storage {})
(i18n/reset-locale))))
@ -213,7 +226,7 @@
[]
(ptk/reify ::logout
ptk/WatchEvent
(watch [_ state s]
(watch [_ _ _]
(->> (rp/mutation :logout)
(rx/delay-at-least 300)
(rx/catch (constantly (rx/of 1)))
@ -221,6 +234,7 @@
;; --- EVENT: register
;; TODO: remove
(s/def ::invitation-token ::us/not-empty-string)
(s/def ::register
@ -233,7 +247,7 @@
(s/assert ::register data)
(ptk/reify ::register
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-error on-success]
:or {on-error identity
on-success identity}} (meta data)]
@ -248,7 +262,7 @@
(us/assert ::profile data)
(ptk/reify ::update-profile
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(let [mdata (meta data)
on-success (:on-success mdata identity)
on-error (:on-error mdata #(rx/throw %))]
@ -272,7 +286,7 @@
(us/assert ::us/email email)
(ptk/reify ::request-email-change
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-error on-success]
:or {on-error identity
on-success identity}} (meta data)]
@ -285,7 +299,7 @@
(def cancel-email-change
(ptk/reify ::cancel-email-change
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation :cancel-email-change {})
(rx/map (constantly (fetch-profile)))))))
@ -301,7 +315,7 @@
(us/verify ::update-password data)
(ptk/reify ::update-password
ptk/WatchEvent
(watch [_ state s]
(watch [_ _ _]
(let [{:keys [on-error on-success]
:or {on-error identity
on-success identity}} (meta data)
@ -320,7 +334,7 @@
([{:keys [version]}]
(ptk/reify ::mark-oboarding-as-viewed
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [version (or version (:main @cf/version))
props (-> (get-in state [:profile :props])
(assoc :onboarding-viewed true)
@ -335,7 +349,7 @@
(us/verify ::di/blob file)
(ptk/reify ::update-photo
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [on-success di/notify-finished-loading
on-error #(do (di/notify-finished-loading)
(di/process-error %))
@ -363,7 +377,7 @@
(assoc state :users)))]
(ptk/reify ::fetch-team-users
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :team-users {:team-id team-id})
(rx/map #(partial fetched %)))))))
@ -373,7 +387,7 @@
[params]
(ptk/reify ::request-account-deletion
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-error on-success]
:or {on-error rx/throw
on-success identity}} (meta params)]
@ -394,7 +408,7 @@
(us/verify ::request-profile-recovery data)
(ptk/reify ::request-profile-recovery
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-error on-success]
:or {on-error rx/throw
on-success identity}} (meta data)]
@ -410,19 +424,17 @@
(s/keys :req-un [::password ::token]))
(defn recover-profile
[{:keys [token password] :as data}]
[data]
(us/verify ::recover-profile data)
(ptk/reify ::recover-profile
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [{:keys [on-error on-success]
:or {on-error rx/throw
on-success identity}} (meta data)]
(->> (rp/mutation :recover-profile data)
(rx/tap on-success)
(rx/catch (fn [err]
(on-error)
(rx/empty))))))))
(rx/catch on-error))))))
;; --- EVENT: crete-demo-profile
@ -430,7 +442,7 @@
[]
(ptk/reify ::create-demo-profile
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation :create-demo-profile {})
(rx/map login)))))

View file

@ -7,7 +7,6 @@
(ns app.main.data.viewer
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uuid :as uuid]
@ -15,8 +14,6 @@
[app.main.data.comments :as dcm]
[app.main.data.fonts :as df]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.avatars :as avatars]
[app.util.router :as rt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
@ -27,7 +24,7 @@
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::project (s/keys ::req-un [::id ::name]))
(s/def ::project (s/keys :req-un [::id ::name]))
(s/def ::file (s/keys :req-un [::id ::name]))
(s/def ::page ::cp/page)
@ -60,10 +57,10 @@
(s/def ::initialize-params
(s/keys :req-un [::page-id ::file-id]
:opt-in [::token]))
:opt-un [::token]))
(defn initialize
[{:keys [page-id file-id token] :as params}]
[{:keys [page-id file-id] :as params}]
(us/assert ::initialize-params params)
(ptk/reify ::initialize
ptk/UpdateEvent
@ -78,7 +75,7 @@
lstate)))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(rx/of (fetch-bundle params)
(fetch-comment-threads params)))))
@ -86,14 +83,14 @@
(s/def ::fetch-bundle-params
(s/keys :req-un [::page-id ::file-id]
:opt-in [::token]))
:opt-un [::token]))
(defn fetch-bundle
[{:keys [page-id file-id token] :as params}]
(us/assert ::fetch-bundle-params params)
(ptk/reify ::fetch-file
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [params (cond-> {:page-id page-id
:file-id file-id}
(string? token) (assoc :token token))]
@ -145,7 +142,7 @@
(ptk/reify ::fetch-comment-threads
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :comment-threads {:file-id file-id})
(rx/map #(partial fetched %))
(rx/catch on-error))))))
@ -156,7 +153,7 @@
(assoc-in state [:comment-threads id] thread))]
(ptk/reify ::refresh-comment-thread
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :comment-thread {:file-id file-id :id id})
(rx/map #(partial fetched %)))))))
@ -167,7 +164,7 @@
(update state :comments assoc thread-id (d/index-by :id comments)))]
(ptk/reify ::retrieve-comments
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/query :comments {:thread-id thread-id})
(rx/map #(partial fetched %)))))))
@ -175,7 +172,7 @@
[]
(ptk/reify ::create-share-link
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [file-id (:current-file-id state)
page-id (:current-page-id state)]
(->> (rp/mutation! :create-file-share-token {:file-id file-id
@ -187,7 +184,7 @@
[]
(ptk/reify ::delete-share-link
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [file-id (:current-file-id state)
page-id (:current-page-id state)
token (get-in state [:viewer-data :token])
@ -246,7 +243,7 @@
(def select-prev-frame
(ptk/reify ::select-prev-frame
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [route (:route state)
screen (-> route :data :name keyword)
qparams (:query-params route)
@ -260,7 +257,7 @@
(def select-next-frame
(ptk/reify ::select-prev-frame
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [route (:route state)
screen (-> route :data :name keyword)
qparams (:query-params route)
@ -296,7 +293,7 @@
(assoc-in state [:viewer-local :interactions-show?] true))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(let [stopper (rx/filter (ptk/type? ::flash-interactions) stream)]
(->> (rx/of flash-done)
(rx/delay 500)
@ -314,7 +311,7 @@
[index]
(ptk/reify ::go-to-frame
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [route (:route state)
screen (-> route :data :name keyword)
qparams (:query-params route)
@ -326,7 +323,7 @@
(us/verify ::us/uuid frame-id)
(ptk/reify ::go-to-frame
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [frames (get-in state [:viewer-data :frames])
index (d/index-of-pred frames #(= (:id %) frame-id))]
(when index
@ -337,13 +334,11 @@
[section]
(ptk/reify ::go-to-section
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [route (:route state)
screen (-> route :data :name keyword)
pparams (:path-params route)
qparams (:query-params route)]
(rx/of
(rt/nav :viewer pparams (assoc qparams :section section)))))))
(rx/of (rt/nav :viewer pparams (assoc qparams :section section)))))))
(defn set-current-frame [frame-id]
@ -422,6 +417,6 @@
([{:keys [team-id]}]
(ptk/reify ::go-to-dashboard
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [team-id (or team-id (get-in state [:viewer-data :project :team-id]))]
(rx/of (rt/nav :dashboard-projects {:team-id team-id})))))))

View file

@ -6,15 +6,9 @@
(ns app.main.data.viewer.shortcuts
(:require
[app.config :as cfg]
[app.main.data.workspace.colors :as mdc]
[app.main.data.shortcuts :as ds]
[app.main.data.shortcuts :refer [c-mod]]
[app.main.data.viewer :as dv]
[app.main.store :as st]
[app.util.dom :as dom]
[beicon.core :as rx]
[potok.core :as ptk]))
[app.main.store :as st]))
(def shortcuts
{:increase-zoom {:tooltip "+"

View file

@ -15,7 +15,9 @@
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.helpers :as cph]
[app.common.pages.spec :as spec]
[app.common.spec :as us]
[app.common.transit :as t]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.data.messages :as dm]
@ -37,9 +39,7 @@
[app.main.worker :as uw]
[app.util.http :as http]
[app.util.i18n :as i18n]
[app.util.logging :as log]
[app.util.router :as rt]
[app.util.transit :as t]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
@ -134,7 +134,7 @@
(or layout default-layout))))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(if (and layout-name (contains? layout-names layout-name))
(rx/of (ensure-layout layout-name))
(rx/of (ensure-layout :layers))))))
@ -153,7 +153,7 @@
:workspace-presence {}))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ stream]
(rx/merge
(rx/of (dwp/fetch-bundle project-id file-id))
@ -162,7 +162,7 @@
(rx/filter (ptk/type? ::dwp/bundle-fetched))
(rx/take 1)
(rx/map deref)
(rx/mapcat (fn [{:keys [project] :as bundle}]
(rx/mapcat (fn [bundle]
(rx/merge
(rx/of (dwn/initialize file-id)
(dwp/initialize-file-persistence file-id)
@ -188,7 +188,7 @@
:workspace-libraries (d/index-by :id libraries)))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [file-id (:id file)
ignore-until (:ignore-sync-until file)
needs-update? (some #(and (> (:modified-at %) (:synced-at %))
@ -199,7 +199,7 @@
(rx/of (dwl/notify-sync-file file-id)))))))
(defn finalize-file
[project-id file-id]
[_project-id file-id]
(ptk/reify ::finalize
ptk/UpdateEvent
(update [_ state]
@ -210,12 +210,10 @@
:workspace-persistence))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(rx/of (dwn/finalize file-id)
::dwp/finalize))))
(declare go-to-page)
(defn initialize-page
[page-id]
(us/assert ::us/uuid page-id)
@ -264,7 +262,7 @@
{:id id :file-id file-id})
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [pages (get-in state [:workspace-data :pages-index])
unames (dwc/retrieve-used-names pages)
name (dwc/generate-unique-name unames "Page")
@ -282,7 +280,7 @@
[page-id]
(ptk/reify ::duplicate-page
ptk/WatchEvent
(watch [this state stream]
(watch [this state _]
(let [id (uuid/next)
pages (get-in state [:workspace-data :pages-index])
unames (dwc/retrieve-used-names pages)
@ -308,7 +306,7 @@
(us/verify string? name)
(ptk/reify ::rename-page
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page (get-in state [:workspace-data :pages-index id])
rchg {:type :mod-page
:id id
@ -329,7 +327,7 @@
[id]
(ptk/reify ::delete-page
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page (get-in state [:workspace-data :pages-index id])
rchg {:type :del-page
:id id}
@ -355,7 +353,7 @@
(assoc-in state [:workspace-file :name] name))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [params {:id id :name name}]
(->> (rp/mutation :rename-file params)
(rx/ignore))))))
@ -370,7 +368,7 @@
(defn initialize-viewport
[{:keys [width height] :as size}]
(letfn [(update* [{:keys [vbox vport] :as local}]
(letfn [(update* [{:keys [vport] :as local}]
(let [wprop (/ (:width vport) width)
hprop (/ (:height vport) height)]
(-> local
@ -435,7 +433,7 @@
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local
(fn [{:keys [vbox vport left-sidebar? zoom] :as local}]
(fn [{:keys [vport left-sidebar? zoom] :as local}]
(if (or (mth/almost-zero? width) (mth/almost-zero? height))
;; If we have a resize to zero just keep the old value
local
@ -454,7 +452,7 @@
(defn start-panning []
(ptk/reify ::start-panning
ptk/WatchEvent
(watch [it state stream]
(watch [_ state stream]
(let [stopper (->> stream (rx/filter (ptk/type? ::finish-panning)))
zoom (-> (get-in state [:workspace-local :zoom]) gpt/point)]
(when-not (get-in state [:workspace-local :panning])
@ -582,7 +580,7 @@
(mth/nan? (:height srect)))
state
(update state :workspace-local
(fn [{:keys [vbox vport] :as local}]
(fn [{:keys [vport] :as local}]
(let [srect (gal/adjust-to-viewport vport srect {:padding 40})
zoom (/ (:width vport) (:width srect))]
(-> local
@ -602,7 +600,7 @@
(map #(get objects %))
(gsh/selection-rect))]
(update state :workspace-local
(fn [{:keys [vbox vport] :as local}]
(fn [{:keys [vport] :as local}]
(let [srect (gal/adjust-to-viewport vport srect {:padding 40})
zoom (/ (:width vport) (:width srect))]
(-> local
@ -617,7 +615,7 @@
(us/verify ::shape-attrs attrs)
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(rx/of (dch/update-shapes [id] #(merge % attrs))))))
(defn start-rename-shape
@ -633,7 +631,7 @@
(ptk/reify ::end-rename-shape
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local] dissoc :shape-for-rename))))
(update state :workspace-local dissoc :shape-for-rename))))
;; --- Update Selected Shapes attrs
@ -642,45 +640,17 @@
(us/verify ::shape-attrs attrs)
(ptk/reify ::update-selected-shapes
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [selected (wsh/lookup-selected state)]
(rx/from (map #(update-shape % attrs) selected))))))
;; --- Shape Movement (using keyboard shorcuts)
(declare initial-selection-align)
(defn- get-displacement-with-grid
"Retrieve the correct displacement delta point for the
provided direction speed and distances thresholds."
[shape direction options]
(let [grid-x (:grid-x options 10)
grid-y (:grid-y options 10)
x-mod (mod (:x shape) grid-x)
y-mod (mod (:y shape) grid-y)]
(case direction
:up (gpt/point 0 (- (if (zero? y-mod) grid-y y-mod)))
:down (gpt/point 0 (- grid-y y-mod))
:left (gpt/point (- (if (zero? x-mod) grid-x x-mod)) 0)
:right (gpt/point (- grid-x x-mod) 0))))
(defn- get-displacement
"Retrieve the correct displacement delta point for the
provided direction speed and distances thresholds."
[shape direction]
(case direction
:up (gpt/point 0 (- 1))
:down (gpt/point 0 1)
:left (gpt/point (- 1) 0)
:right (gpt/point 1 0)))
;; --- Delete Selected
(def delete-selected
"Deselect all and remove all selected shapes."
(ptk/reify ::delete-selected
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [selected (wsh/lookup-selected state)]
(rx/of (dwc/delete-shapes selected)
(dws/deselect-all))))))
@ -694,7 +664,7 @@
(us/verify ::loc loc)
(ptk/reify ::vertical-order-selected
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
@ -733,7 +703,9 @@
;; --- Change Shape Order (D&D Ordering)
(defn relocate-shapes-changes [objects parents parent-id page-id to-index ids groups-to-delete groups-to-unmask shapes-to-detach shapes-to-reroot shapes-to-deroot]
(defn relocate-shapes-changes [objects parents parent-id page-id to-index ids
groups-to-delete groups-to-unmask shapes-to-detach
shapes-to-reroot shapes-to-deroot shapes-to-unconstraint]
(let [;; Changes to the shapes that are being move
r-mov-change
[{:type :mov-objects
@ -866,6 +838,43 @@
:val nil}]})
shapes-to-reroot)
;; Changes resetting constraints
r-unconstraint-change
(map (fn [id]
(let [obj (get objects id)
parent (get objects parent-id)
frame-id (if (= (:type parent) :frame)
(:id parent)
(:frame-id parent))]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set
:attr :constraints-h
:val (spec/default-constraints-h
(assoc obj :parent-id parent-id :frame-id frame-id))}
{:type :set
:attr :constraints-v
:val (spec/default-constraints-v
(assoc obj :parent-id parent-id :frame-id frame-id))}]}))
shapes-to-unconstraint)
u-unconstraint-change
(map (fn [id]
(let [obj (get objects id)]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set
:attr :constraints-h
:val (:constraints-h obj)}
{:type :set
:attr :constraints-v
:val (:constraints-v obj)}]}))
shapes-to-unconstraint)
r-reg-change
[{:type :reg-objects
:page-id page-id
@ -883,6 +892,7 @@
r-detach-change
r-deroot-change
r-reroot-change
r-unconstraint-change
r-reg-change)
uchanges (d/concat []
@ -892,6 +902,7 @@
u-detach-change
u-mask-change
u-mov-change
u-unconstraint-change
u-reg-change)]
[rchanges uchanges]))
@ -903,7 +914,7 @@
(ptk/reify ::relocate-shapes
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
@ -1002,9 +1013,9 @@
groups-to-unmask
shapes-to-detach
shapes-to-reroot
shapes-to-deroot)
shapes-to-deroot
ids)]
]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
:origin it})
@ -1014,7 +1025,7 @@
[parent-id to-index]
(ptk/reify ::relocate-selected-shapes
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [selected (wsh/lookup-selected state)]
(rx/of (relocate-shapes selected parent-id to-index))))))
@ -1023,7 +1034,7 @@
[]
(ptk/reify ::start-editing-selected
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [selected (wsh/lookup-selected state)]
(if-not (= 1 (count selected))
(rx/empty)
@ -1035,14 +1046,11 @@
:text
(rx/of (dwc/start-edition-mode id))
:path
(rx/of (dwc/start-edition-mode id)
(dwdp/start-path-edit id))
:group
(rx/of (dwc/select-shapes (into (d/ordered-set) [(last shapes)])))
(rx/empty))))))))
(rx/of (dwc/start-edition-mode id)
(dwdp/start-path-edit id)))))))))
;; --- Change Page Order (D&D Ordering)
@ -1051,7 +1059,7 @@
[id index]
(ptk/reify ::relocate-pages
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [cidx (-> (get-in state [:workspace-data :pages])
(d/index-of id))
rchg {:type :mov-page
@ -1074,7 +1082,7 @@
(us/verify ::gal/align-axis axis)
(ptk/reify :align-objects
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
@ -1105,7 +1113,7 @@
(us/verify ::gal/dist-axis axis)
(ptk/reify :align-objects
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
@ -1123,7 +1131,7 @@
[id lock]
(ptk/reify ::set-shape-proportion-lock
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(letfn [(assign-proportions [shape]
(if-not lock
(assoc shape :proportion-lock false)
@ -1131,33 +1139,6 @@
(gpr/assign-proportions))))]
(rx/of (dch/update-shapes [id] assign-proportions))))))
;; --- Update Shape Position
(s/def ::x number?)
(s/def ::y number?)
(s/def ::position
(s/keys :opt-un [::x ::y]))
(defn update-position
[id position]
(us/verify ::us/uuid id)
(us/verify ::position position)
(ptk/reify ::update-position
ptk/WatchEvent
(watch [it state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shape (get objects id)
bbox (-> shape :points gsh/points->selrect)
cpos (gpt/point (:x bbox) (:y bbox))
pos (gpt/point (or (:x position) (:x bbox))
(or (:y position) (:y bbox)))
displ (gmt/translate-matrix (gpt/subtract pos cpos))]
(rx/of (dwt/set-modifiers [id] {:displacement displ})
(dwt/apply-modifiers [id]))))))
;; --- Update Shape Flags
(defn update-shape-flags
@ -1166,7 +1147,7 @@
(s/assert ::shape-attrs flags)
(ptk/reify ::update-shape-flags
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [update-fn
(fn [obj]
(cond-> obj
@ -1186,29 +1167,28 @@
[project-id]
(ptk/reify ::navigate-to-project
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [page-ids (get-in state [:projects project-id :pages])
params {:project project-id :page (first page-ids)}]
(rx/of (rt/nav :workspace/page params))))))
(defn go-to-page
([]
(ptk/reify ::go-to-page
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [project-id (:current-project-id state)
file-id (:current-file-id state)
page-id (get-in state [:workspace-data :pages 0])
pparams {:file-id file-id :project-id project-id}
qparams {:page-id page-id}]
(rx/of (rt/nav :workspace pparams qparams))))))
(rx/of (rt/nav' :workspace pparams qparams))))))
([page-id]
(us/verify ::us/uuid page-id)
(ptk/reify ::go-to-page
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [project-id (:current-project-id state)
file-id (:current-file-id state)
pparams {:file-id file-id :project-id project-id}
@ -1220,10 +1200,10 @@
(us/verify ::layout-flag layout)
(ptk/reify ::go-to-layout
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [project-id (get-in state [:workspace-project :id])
file-id (get-in state [:workspace-file :id])
page-id (get-in state [:current-page-id])
page-id (get state :current-page-id)
pparams {:file-id file-id :project-id project-id}
qparams {:page-id page-id :layout (name layout)}]
(rx/of (rt/nav :workspace pparams qparams))))))
@ -1231,7 +1211,7 @@
(def go-to-file
(ptk/reify ::go-to-file
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [{:keys [id project-id data] :as file} (:workspace-file state)
page-id (get-in data [:pages 0])
pparams {:project-id project-id :file-id id}
@ -1243,19 +1223,19 @@
([{:keys [file-id page-id]}]
(ptk/reify ::go-to-viewer
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [{:keys [current-file-id current-page-id]} state
params {:file-id (or file-id current-file-id)
:page-id (or page-id current-page-id)}]
(rx/of ::dwp/force-persist
(rt/nav :viewer params {:index 0})))))))
(rt/nav-new-window :viewer params {:index 0})))))))
(defn go-to-dashboard
([] (go-to-dashboard nil))
([{:keys [team-id]}]
(ptk/reify ::go-to-dashboard
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(when-let [team-id (or team-id (:current-team-id state))]
(rx/of ::dwp/force-persist
(rt/nav :dashboard-projects {:team-id team-id})))))))
@ -1264,7 +1244,7 @@
[]
(ptk/reify ::go-to-dashboard
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [team-id (:current-team-id state)]
(rx/of ::dwp/force-persist
(rt/nav :dashboard-fonts {:team-id team-id}))))))
@ -1294,7 +1274,7 @@
(us/verify ::cp/minimal-shape shape)
(ptk/reify ::show-shape-context-menu
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [selected (wsh/lookup-selected state)]
(rx/concat
(when-not (selected (:id shape))
@ -1386,7 +1366,7 @@
(ptk/reify ::copy-selected
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
selected (->> (wsh/lookup-selected state)
(cp/clean-loops objects))
@ -1400,7 +1380,7 @@
(rx/merge-map (partial prepare-object objects selected))
(rx/reduce collect-data initial)
(rx/mapcat (partial sort-selected state))
(rx/map t/encode)
(rx/map t/encode-str)
(rx/map wapi/write-to-clipboard)
(rx/catch on-copy-error)
(rx/ignore)))))))
@ -1413,14 +1393,14 @@
(def paste
(ptk/reify ::paste
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(try
(let [clipboard-str (wapi/read-from-clipboard)
paste-transit-str
(->> clipboard-str
(rx/filter t/transit?)
(rx/map t/decode)
(rx/map t/decode-str)
(rx/filter #(= :copied-shapes (:type %)))
(rx/map #(select-keys % [:selected :objects]))
(rx/map paste-shape))
@ -1452,14 +1432,14 @@
[event in-viewport?]
(ptk/reify ::paste-from-event
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(try
(let [objects (wsh/lookup-page-objects state)
paste-data (wapi/read-from-paste-event event)
image-data (wapi/extract-images paste-data)
text-data (wapi/extract-text paste-data)
decoded-data (and (t/transit? text-data)
(t/decode text-data))
(t/decode-str text-data))
edit-id (get-in state [:workspace-local :edition])
is-editing-text? (and edit-id (= :text (get-in objects [edit-id :type])))]
@ -1490,8 +1470,8 @@
(defn selected-frame? [state]
(let [selected (wsh/lookup-selected state)
objects (wsh/lookup-page-objects state)]
(and (and (= 1 (count selected))
(= :frame (get-in objects [(first selected) :type]))))))
(and (= 1 (count selected))
(= :frame (get-in objects [(first selected) :type])))))
(defn- paste-shape
[{:keys [selected objects images] :as data} in-viewport?]
@ -1569,10 +1549,18 @@
(assoc change :index (get map-ids (:old-id change)))
change)))
;; Check if the shape is an instance whose master is defined in a
;; library that is not linked to the current file
(foreign-instance? [shape objects state]
(let [root (cph/get-root-shape shape objects)
root-file-id (:component-file root)]
(and (some? root)
(not= root-file-id (:current-file-id state))
(nil? (get-in state [:workspace-libraries root-file-id])))))
;; Procceed with the standard shape paste procediment.
(do-paste [it state mouse-pos media]
(let [media-idx (d/index-by :prev-id media)
page-id (:current-page-id state)
;; Calculate position for the pasted elements
[frame-id parent-id delta index] (calculate-paste-position state mouse-pos in-viewport?)
@ -1584,8 +1572,8 @@
(assoc :parent-id parent-id)
(cond->
;; Pasting from another file, we deattach components
(not= (:current-file-id state) (:file-id data))
;; if foreign instance, detach the shape
(foreign-instance? shape objects state)
(dissoc :component-id
:component-file
:component-root?
@ -1622,7 +1610,7 @@
(dwc/select-shapes selected))))]
(ptk/reify ::paste-shape
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [file-id (:current-file-id state)
mouse-pos (deref ms/mouse-position)]
(if (= file-id (:file-id data))
@ -1646,7 +1634,7 @@
(s/assert string? text)
(ptk/reify ::paste-text
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [id (uuid/next)
{:keys [x y]} @ms/mouse-position
width (max 8 (min (* 7 (count text)) 700))
@ -1675,7 +1663,7 @@
(s/assert string? text)
(ptk/reify ::paste-svg
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [position (deref ms/mouse-position)
file-id (:current-file-id state)]
(->> (dwp/parse-svg ["svg" text])
@ -1685,7 +1673,7 @@
[image]
(ptk/reify ::paste-bin-impl
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [file-id (get-in state [:workspace-file :id])
params {:file-id file-id
:blobs [image]
@ -1710,7 +1698,7 @@
[]
(ptk/reify ::start-create-interaction
ptk/WatchEvent
(watch [it state stream]
(watch [_ state stream]
(let [initial-pos @ms/mouse-position
selected (wsh/lookup-selected state)
stopper (rx/filter ms/mouse-up? stream)]
@ -1747,7 +1735,7 @@
(assoc-in [:workspace-local :draw-interaction-to-frame] nil)))
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [position @ms/mouse-position
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
@ -1775,7 +1763,7 @@
[color]
(ptk/reify ::change-canvas-color
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (get state :current-page-id)
options (wsh/lookup-page-options state page-id)
previus-color (:background options)]
@ -1790,25 +1778,21 @@
:value previus-color}]
:origin it}))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exports
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Transform
(d/export dwt/start-rotate)
(d/export dwt/start-resize)
(d/export dwt/update-dimensions)
(d/export dwt/start-rotate)
(d/export dwt/increase-rotation)
(d/export dwt/start-move-selected)
(d/export dwt/move-selected)
(d/export dwt/set-rotation)
(d/export dwt/increase-rotation)
(d/export dwt/set-modifiers)
(d/export dwt/apply-modifiers)
(d/export dwt/update-dimensions)
(d/export dwt/update-position)
(d/export dwt/flip-horizontal-selected)
(d/export dwt/flip-vertical-selected)
(d/export dwt/selected-to-path)
;; Persistence
@ -1830,7 +1814,7 @@
(d/export dwc/select-shapes)
(d/export dws/shift-select-shapes)
(d/export dws/duplicate-selected)
(d/export dws/handle-selection)
(d/export dws/handle-area-selection)
(d/export dws/select-inside-group)
(d/export dwd/select-for-drawing)
(d/export dwc/clear-edition-mode)

View file

@ -10,14 +10,13 @@
[app.common.pages :as cp]
[app.common.pages.spec :as spec]
[app.common.spec :as us]
[app.main.data.workspace.undo :as dwu]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.worker :as uw]
[app.main.data.workspace.undo :as dwu]
[app.main.store :as st]
[app.main.worker :as uw]
[app.util.logging :as log]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module
@ -35,45 +34,45 @@
(defn- generate-operation
"Given an object old and new versions and an attribute will append into changes
the set and undo operations"
[changes attr old new]
[changes attr old new ignore-geometry?]
(let [old-val (get old attr)
new-val (get new attr)]
(if (= old-val new-val)
changes
(-> changes
(update :rops conj {:type :set :attr attr :val new-val})
(update :rops conj {:type :set :attr attr :val new-val :ignore-geometry ignore-geometry?})
(update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
(defn- update-shape-changes
"Calculate the changes and undos to be done when a function is applied to a
single object"
[changes page-id objects update-fn attrs id]
[changes page-id objects update-fn attrs id ignore-geometry?]
(let [old-obj (get objects id)
new-obj (update-fn old-obj)
attrs (or attrs (d/concat #{} (keys old-obj) (keys new-obj)))
{rops :rops uops :uops}
(reduce #(generate-operation %1 %2 old-obj new-obj)
(reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)
{:rops [] :uops []}
attrs)
uops (cond-> uops
(not (empty? uops))
(seq uops)
(conj {:type :set-touched :touched (:touched old-obj)}))
change {:type :mod-obj :page-id page-id :id id}]
(cond-> changes
(not (empty? rops))
(seq rops)
(update :redo-changes conj (assoc change :operations rops))
(not (empty? uops))
(seq uops)
(update :undo-changes conj (assoc change :operations uops)))))
(defn update-shapes
([ids f] (update-shapes ids f nil))
([ids f {:keys [reg-objects? save-undo? keys]
([ids f {:keys [reg-objects? save-undo? attrs ignore-tree]
:or {reg-objects? false save-undo? true attrs nil}}]
(us/assert ::coll-of-uuid ids)
@ -81,7 +80,7 @@
(ptk/reify ::update-shapes
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state)
changes {:redo-changes []
@ -91,7 +90,9 @@
ids (into [] (filter some?) ids)
changes (reduce #(update-shape-changes %1 page-id objects f keys %2) changes ids)]
changes (reduce
#(update-shape-changes %1 page-id objects f attrs %2 (get ignore-tree %2))
changes ids)]
(when-not (empty? (:redo-changes changes))
(let [reg-objs {:type :reg-objects
@ -107,7 +108,7 @@
[page-id changes]
(ptk/reify ::update-indices
ptk/EffectEvent
(effect [_ state stream]
(effect [_ _ _]
(uw/ask! {:cmd :update-page-indices
:page-id page-id
:changes changes}))))
@ -147,7 +148,7 @@
state))))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(when-not @error
(let [;; adds page-id to page changes (that have the `id` field instead)
add-page-id
@ -163,7 +164,7 @@
(group-by :page-id))
process-page-changes
(fn [[page-id changes]]
(fn [[page-id _changes]]
(update-indices page-id redo-changes))]
(rx/concat
(rx/from (map process-page-changes changes-by-pages))

View file

@ -7,23 +7,13 @@
(ns app.main.data.workspace.colors
(:require
[app.common.data :as d]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.data.modal :as md]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.texts :as dwt]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.streams :as ms]
[app.util.color :as color]
[app.util.i18n :refer [tr]]
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]))
(def clear-color-for-rename
@ -38,17 +28,16 @@
[file-id color-id name]
(ptk/reify ::rename-color
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(->> (rp/mutation! :rename-color {:id color-id :name name})
(rx/map (partial rename-color-result file-id))))))
(defn rename-color-result
[file-id color]
[_file-id color]
(ptk/reify ::rename-color-result
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:workspace-file :colors] #(d/replace-by-id % color))))))
(update-in state [:workspace-file :colors] #(d/replace-by-id % color)))))
(defn change-palette-size
[size]
@ -125,7 +114,7 @@
[ids color]
(ptk/reify ::change-fill
ptk/WatchEvent
(watch [_ state s]
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
@ -157,32 +146,29 @@
[ids color]
(ptk/reify ::change-stroke
ptk/WatchEvent
(watch [_ state s]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
(watch [_ _ _]
(let [attrs (cond-> {}
(contains? color :color)
(assoc :stroke-color (:color color))
attrs (cond-> {}
(contains? color :color)
(assoc :stroke-color (:color color))
(contains? color :id)
(assoc :stroke-color-ref-id (:id color))
(contains? color :id)
(assoc :stroke-color-ref-id (:id color))
(contains? color :file-id)
(assoc :stroke-color-ref-file (:file-id color))
(contains? color :file-id)
(assoc :stroke-color-ref-file (:file-id color))
(contains? color :gradient)
(assoc :stroke-color-gradient (:gradient color))
(contains? color :gradient)
(assoc :stroke-color-gradient (:gradient color))
(contains? color :opacity)
(assoc :stroke-opacity (:opacity color)))]
(contains? color :opacity)
(assoc :stroke-opacity (:opacity color)))]
(rx/of (dch/update-shapes ids (fn [shape]
(cond-> (d/merge shape attrs)
(= (:stroke-style shape) :none)
(assoc :stroke-style :solid
:stroke-width 1
:stroke-opacity 1)))))))))
(rx/of (dch/update-shapes ids (fn [shape]
(cond-> (d/merge shape attrs)
(= (:stroke-style shape) :none)
(assoc :stroke-style :solid
:stroke-width 1
:stroke-opacity 1)))))))))
(defn picker-for-selected-shape

View file

@ -6,19 +6,14 @@
(ns app.main.data.workspace.comments
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.math :as mth]
[app.common.spec :as us]
[app.main.constants :as c]
[app.main.data.comments :as dcm]
[app.main.data.workspace :as dw]
[app.main.data.workspace.common :as dwc]
[app.main.data.comments :as dcm]
[app.main.store :as st]
[app.main.streams :as ms]
[app.util.router :as rt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(declare handle-interrupt)
@ -29,7 +24,7 @@
(us/assert ::us/uuid file-id)
(ptk/reify ::initialize-comments
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(let [stoper (rx/filter #(= ::finalize %) stream)]
(rx/merge
(rx/of (dcm/retrieve-comment-threads file-id))
@ -47,8 +42,8 @@
[]
(ptk/reify ::handle-interrupt
ptk/WatchEvent
(watch [_ state stream]
(let [local (:comments-local state)]
(watch [_ state _]
(let [local (:comments-local state)]
(cond
(:draft local) (rx/of (dcm/close-thread))
(:open local) (rx/of (dcm/close-thread))
@ -62,7 +57,7 @@
[position]
(ptk/reify ::handle-comment-layer-click
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [local (:comments-local state)]
(if (some? (:open local))
(rx/of (dcm/close-thread))
@ -74,14 +69,13 @@
(rx/of (dcm/create-draft params))))))))
(defn center-to-comment-thread
[{:keys [id position] :as thread}]
[{:keys [position] :as thread}]
(us/assert ::dcm/comment-thread thread)
(ptk/reify :center-to-comment-thread
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local
(fn [{:keys [vbox vport zoom] :as local}]
(prn "center-to-comment-thread" vbox)
(fn [{:keys [vbox zoom] :as local}]
(let [pw (/ 50 zoom)
ph (/ 200 zoom)
nw (mth/round (- (/ (:width vbox) 2) pw))
@ -93,11 +87,11 @@
(update local :vbox assoc :x nx :y ny)))))))
(defn navigate
[{:keys [project-id file-id page-id] :as thread}]
[thread]
(us/assert ::dcm/comment-thread thread)
(ptk/reify ::navigate
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(let [pparams {:project-id (:project-id thread)
:file-id (:file-id thread)}
qparams {:page-id (:page-id thread)}]

View file

@ -40,15 +40,13 @@
[{:keys [file] :as bundle}]
(ptk/reify ::setup-selection-index
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [msg {:cmd :initialize-indices
:file-id (:id file)
:data (:data file)}]
(->> (uw/ask! msg)
(rx/map (constantly ::index-initialized)))))))
;; --- Common Helpers & Events
(defn get-frame-at-point
@ -59,7 +57,7 @@
(defn- extract-numeric-suffix
[basename]
(if-let [[match p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
(if-let [[_ p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
@ -112,7 +110,7 @@
(def undo
(ptk/reify ::undo
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [edition (get-in state [:workspace-local :edition])
drawing (get state :workspace-drawing)]
;; Editors handle their own undo's
@ -131,7 +129,7 @@
(def redo
(ptk/reify ::redo
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [edition (get-in state [:workspace-local :edition])
drawing (get state :workspace-drawing)]
(when-not (or (some? edition) (not-empty drawing))
@ -180,10 +178,10 @@
(assoc-in state [:workspace-local :selected] ids))
ptk/WatchEvent
(watch [it state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)]
(rx/of (expand-all-parents ids objects))))))
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)]
(rx/of (expand-all-parents ids objects))))))
(declare clear-edition-mode)
@ -202,12 +200,11 @@
state)))
ptk/WatchEvent
(watch [it state stream]
(let [objects (wsh/lookup-page-objects state)]
(->> stream
(rx/filter interrupt?)
(rx/take 1)
(rx/map (constantly clear-edition-mode)))))))
(watch [_ _ stream]
(->> stream
(rx/filter interrupt?)
(rx/take 1)
(rx/map (constantly clear-edition-mode))))))
;; If these event change modules review /src/app/main/data/workspace/path/undo.cljs
(def clear-edition-mode
@ -282,7 +279,7 @@
(us/verify ::shape-attrs attrs)
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
@ -313,7 +310,7 @@
(defn move-shapes-into-frame [frame-id shapes]
(ptk/reify ::move-shapes-into-frame
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
to-move-shapes (->> (cp/select-toplevel-shapes objects {:include-frames? false})
@ -341,26 +338,18 @@
:undo-changes uchanges
:origin it}))))))
(s/def ::set-of-uuid
(s/every ::us/uuid :kind set?))
(defn delete-shapes
[ids]
(us/assert (s/coll-of ::us/uuid) ids)
(us/assert ::set-of-uuid ids)
(ptk/reify ::delete-shapes
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
get-empty-parents
(fn [parents]
(->> parents
(map (fn [id]
(let [obj (get objects id)]
(when (and (= :group (:type obj))
(= 1 (count (:shapes obj))))
obj))))
(take-while (complement nil?))
(map :id)))
groups-to-unmask
(reduce (fn [group-ids id]
;; When the shape to delete is the mask of a masked group,
@ -381,90 +370,117 @@
(some ids (map :destination interactions))))
(vals objects))
rchanges
(d/concat
(reduce (fn [res id]
(let [children (cp/get-children id objects)
parents (cp/get-parents id objects)
del-change #(array-map
:type :del-obj
:page-id page-id
:id %)]
(d/concat res
(map del-change (reverse children))
[(del-change id)]
(map del-change (get-empty-parents parents))
[{:type :reg-objects
:page-id page-id
:shapes (vec parents)}])))
[]
ids)
(map #(array-map
:type :mod-obj
:page-id page-id
:id %
:operations [{:type :set
:attr :masked-group?
:val false}])
groups-to-unmask)
(map #(array-map
:type :mod-obj
:page-id page-id
:id (:id %)
:operations [{:type :set
:attr :interactions
:val (vec (remove (fn [interaction]
(contains? ids (:destination interaction)))
(:interactions %)))}])
interacting-shapes))
empty-parents-xform
(comp
(map (fn [id] (get objects id)))
(map (fn [{:keys [shapes type] :as obj}]
(when (and (= :group type)
(zero? (count (remove #(contains? ids %) shapes))))
obj)))
(take-while some?)
(map :id))
all-parents
(reduce (fn [res id]
(into res (cp/get-parents id objects)))
(d/ordered-set)
ids)
all-children
(reduce (fn [res id]
(into res (cp/get-children id objects)))
(d/ordered-set)
ids)
empty-parents
(into (d/ordered-set) empty-parents-xform all-parents)
mk-del-obj-xf
(map (fn [id]
{:type :del-obj
:page-id page-id
:id id}))
mk-add-obj-xf
(map (fn [id]
(let [item (get objects id)]
{:type :add-obj
:id (:id item)
:page-id page-id
:index (cp/position-on-parent id objects)
:frame-id (:frame-id item)
:parent-id (:parent-id item)
:obj item})))
mk-mod-touched-xf
(map (fn [id]
(let [parent (get objects id)]
{:type :mod-obj
:page-id page-id
:id (:id parent)
:operations [{:type :set-touched
:touched (:touched parent)}]})))
mk-mod-int-del-xf
(map (fn [obj]
{:type :mod-obj
:page-id page-id
:id (:id obj)
:operations [{:type :set
:attr :interactions
:val (vec (remove (fn [interaction]
(contains? ids (:destination interaction)))
(:interactions obj)))}]}))
mk-mod-int-add-xf
(map (fn [obj]
{:type :mod-obj
:page-id page-id
:id (:id obj)
:operations [{:type :set
:attr :interactions
:val (:interactions obj)}]}))
mk-mod-unmask-xf
(map (fn [id]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set
:attr :masked-group?
:val false}]}))
mk-mod-mask-xf
(map (fn [id]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set
:attr :masked-group?
:val true}]}))
rchanges
(-> []
(into mk-del-obj-xf all-children)
(into mk-del-obj-xf ids)
(into mk-del-obj-xf empty-parents)
(conj {:type :reg-objects
:page-id page-id
:shapes (vec all-parents)})
(into mk-mod-unmask-xf groups-to-unmask)
(into mk-mod-int-del-xf interacting-shapes))
uchanges
(d/concat
(reduce (fn [res id]
(let [children (cp/get-children id objects)
parents (cp/get-parents id objects)
parent (get objects (first parents))
add-change (fn [id]
(let [item (get objects id)]
{:type :add-obj
:id (:id item)
:page-id page-id
:index (cp/position-on-parent id objects)
:frame-id (:frame-id item)
:parent-id (:parent-id item)
:obj item}))]
(d/concat res
(map add-change (reverse (get-empty-parents parents)))
[(add-change id)]
(map add-change children)
[{:type :reg-objects
:page-id page-id
:shapes (vec parents)}]
(when (some? parent)
[{:type :mod-obj
:page-id page-id
:id (:id parent)
:operations [{:type :set-touched
:touched (:touched parent)}]}]))))
[]
ids)
(map #(array-map
:type :mod-obj
:page-id page-id
:id %
:operations [{:type :set
:attr :masked-group?
:val true}])
groups-to-unmask)
(map #(array-map
:type :mod-obj
:page-id page-id
:id (:id %)
:operations [{:type :set
:attr :interactions
:val (:interactions %)}])
interacting-shapes))]
(-> []
(into mk-add-obj-xf (reverse empty-parents))
(into mk-add-obj-xf (reverse ids))
(into mk-add-obj-xf (reverse all-children))
(conj {:type :reg-objects
:page-id page-id
:shapes (vec all-parents)})
(into mk-mod-touched-xf (reverse all-parents))
(into mk-mod-mask-xf groups-to-unmask)
(into mk-mod-int-add-xf interacting-shapes))
]
;; (println "================ rchanges")
;; (cljs.pprint/pprint rchanges)
@ -485,7 +501,7 @@
[type frame-x frame-y data]
(ptk/reify ::create-and-add-shape
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [{:keys [width height]} data
[vbc-x vbc-y] (viewport-center state)
@ -505,7 +521,7 @@
[image {:keys [x y]}]
(ptk/reify ::image-uploaded
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [{:keys [name width height id mtype]} image
shape {:name name
:width width

View file

@ -7,17 +7,15 @@
(ns app.main.data.workspace.drawing
"Drawing interactions."
(:require
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.spec :as us]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.path :as path]
[app.main.data.workspace.drawing.box :as box]
[app.main.data.workspace.drawing.common :as common]
[app.main.data.workspace.drawing.curve :as curve]
[app.main.data.workspace.drawing.box :as box]))
[app.main.data.workspace.path :as path]
[beicon.core :as rx]
[potok.core :as ptk]))
(declare start-drawing)
(declare handle-drawing)
@ -38,7 +36,7 @@
(update :workspace-layout disj :scale-text)))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(let [stoper (rx/filter (ptk/type? ::clear-drawing) stream)]
(rx/merge
(when (= tool :path)
@ -88,16 +86,17 @@
(update-in state [:workspace-drawing :object] merge data)))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (case type
:path
(path/handle-new-shape)
(watch [_ _ _]
(rx/of
(case type
:path
(path/handle-new-shape)
:curve
(curve/handle-drawing-curve)
:curve
(curve/handle-drawing-curve)
;; default
(box/handle-drawing-box))))))
;; default
(box/handle-drawing-box))))))

View file

@ -21,7 +21,7 @@
(defn truncate-zero [num default]
(if (mth/almost-zero? num) default num))
(defn resize-shape [{:keys [x y width height transform transform-inverse] :as shape} point lock?]
(defn resize-shape [{:keys [x y width height] :as shape} point lock?]
(let [;; The new shape behaves like a resize on the bottom-right corner
initial (gpt/point (+ x width) (+ y height))
shapev (gpt/point width height)
@ -53,9 +53,7 @@
(ptk/reify ::handle-drawing-box
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
stoper? #(or (ms/mouse-up? %) (= % :interrupt))
(let [stoper? #(or (ms/mouse-up? %) (= % :interrupt))
stoper (rx/filter stoper? stream)
initial @ms/mouse-position

View file

@ -6,15 +6,13 @@
(ns app.main.data.workspace.drawing.common
(:require
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.undo :as dwu]
[app.main.streams :as ms]
[app.main.worker :as uw]))
[app.main.worker :as uw]
[beicon.core :as rx]
[potok.core :as ptk]))
(def clear-drawing
(ptk/reify ::clear-drawing
@ -25,7 +23,7 @@
(def handle-finish-drawing
(ptk/reify ::handle-finish-drawing
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [shape (get-in state [:workspace-drawing :object])]
(rx/concat
(when (:initialized? shape)

View file

@ -6,7 +6,6 @@
(ns app.main.data.workspace.drawing.curve
(:require
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.path :as gsp]
[app.common.pages :as cp]
@ -19,7 +18,7 @@
(def simplify-tolerance 0.3)
(defn stoper-event? [{:keys [type shift] :as event}]
(defn stoper-event? [{:keys [type] :as event}]
(ms/mouse-event? event) (= type :up))
(defn initialize-drawing [state]
@ -73,9 +72,8 @@
(defn handle-drawing-curve []
(ptk/reify ::handle-drawing-curve
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
stoper (rx/filter stoper-event? stream)
(watch [_ _ stream]
(let [stoper (rx/filter stoper-event? stream)
mouse (rx/sample 10 ms/mouse-position)]
(rx/concat
(rx/of initialize-drawing)

View file

@ -6,11 +6,11 @@
(ns app.main.data.workspace.grid
(:require
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.data :as d]
[app.common.spec :as us]
[app.main.data.workspace.changes :as dch]))
[app.main.data.workspace.changes :as dch]
[beicon.core :as rx]
[potok.core :as ptk]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Grid
@ -40,7 +40,7 @@
(us/assert ::us/uuid frame-id)
(ptk/reify ::add-frame-grid
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [page-id (:current-page-id state)
data (get-in state [:workspace-data :pages-index page-id])
params (or (get-in data [:options :saved-grids :square])
@ -56,21 +56,21 @@
[frame-id index]
(ptk/reify ::set-frame-grid
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(rx/of (dch/update-shapes [frame-id] (fn [o] (update o :grids (fnil #(d/remove-at-index % index) []))))))))
(defn set-frame-grid
[frame-id index data]
(ptk/reify ::set-frame-grid
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(rx/of (dch/update-shapes [frame-id] #(assoc-in % [:grids index] data))))))
(defn set-default-grid
[type params]
(ptk/reify ::set-default-grid
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [pid (:current-page-id state)
prev-value (get-in state [:workspace-data :pages-index pid :options :saved-grids type])]
(rx/of (dch/commit-changes

View file

@ -1,3 +1,9 @@
;; 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) UXBOX Labs SL
(ns app.main.data.workspace.groups
(:require
[app.common.data :as d]
@ -5,7 +11,6 @@
[app.common.pages :as cp]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -22,7 +27,6 @@
[shapes prefix keep-name]
(let [selrect (gsh/selection-rect shapes)
frame-id (-> shapes first :frame-id)
parent-id (-> shapes first :parent-id)
group-name (if (and keep-name
(= (count shapes) 1)
(= (:type (first shapes)) :group))
@ -166,7 +170,7 @@
(def group-selected
(ptk/reify ::group-selected
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
@ -183,7 +187,7 @@
(def ungroup-selected
(ptk/reify ::ungroup-selected
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
@ -200,7 +204,7 @@
(def mask-group
(ptk/reify ::mask-group
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
@ -257,7 +261,7 @@
(def unmask-group
(ptk/reify ::unmask-group
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)]

View file

@ -27,7 +27,7 @@
[beicon.core :as rx]
[potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
(log/set-level! :warn)
(defn- log-changes
@ -46,7 +46,7 @@
(:component-id change)
:objects
(:id change)])
:default nil))
:else nil))
prefix (if (:component-id change) "[C] " "[P] ")
@ -68,6 +68,13 @@
(update [_ state]
(assoc-in state [:workspace-local :assets-files-open file-id box] open?))))
(defn set-assets-group-open
[file-id box path open?]
(ptk/reify ::set-assets-group-open
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :assets-files-open file-id :groups box path] open?))))
(defn default-color-name [color]
(or (:color color)
(case (get-in color [:gradient :type])
@ -83,7 +90,7 @@
(us/assert ::cp/color color)
(ptk/reify ::add-color
ptk/WatchEvent
(watch [it state s]
(watch [it _ _]
(let [rchg {:type :add-color
:color color}
uchg {:type :del-color
@ -97,7 +104,7 @@
(us/assert ::cp/recent-color color)
(ptk/reify ::add-recent-color
ptk/WatchEvent
(watch [it state s]
(watch [it _ _]
(let [rchg {:type :add-recent-color
:color color}]
(rx/of (dch/commit-changes {:redo-changes [rchg]
@ -116,7 +123,7 @@
(us/assert ::us/uuid file-id)
(ptk/reify ::update-color
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [[path name] (cp/parse-path-name (:name color))
color (assoc color :path path :name name)
prev (get-in state [:workspace-data :colors id])
@ -134,7 +141,7 @@
(us/assert ::us/uuid id)
(ptk/reify ::delete-color
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [prev (get-in state [:workspace-data :colors id])
rchg {:type :del-color
:id id}
@ -149,7 +156,7 @@
(us/assert ::cp/media-object media)
(ptk/reify ::add-media
ptk/WatchEvent
(watch [it state stream]
(watch [it _ _]
(let [obj (select-keys media [:id :name :width :height :mtype])
rchg {:type :add-media
:object obj}
@ -165,7 +172,7 @@
(us/assert ::us/string new-name)
(ptk/reify ::rename-media
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [object (get-in state [:workspace-data :media id])
[path name] (cp/parse-path-name new-name)
@ -188,7 +195,7 @@
(us/assert ::us/uuid id)
(ptk/reify ::delete-media
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [prev (get-in state [:workspace-data :media id])
rchg {:type :del-media
:id id}
@ -205,7 +212,7 @@
(us/assert ::cp/typography typography)
(ptk/reify ::add-typography
ptk/WatchEvent
(watch [it state s]
(watch [it _ _]
(let [rchg {:type :add-typography
:typography typography}
uchg {:type :del-typography
@ -223,7 +230,7 @@
(us/assert ::us/uuid file-id)
(ptk/reify ::update-typography
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [[path name] (cp/parse-path-name (:name typography))
typography (assoc typography :path path :name name)
prev (get-in state [:workspace-data :typographies (:id typography)])
@ -241,7 +248,7 @@
(us/assert ::us/uuid id)
(ptk/reify ::delete-typography
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [prev (get-in state [:workspace-data :typographies id])
rchg {:type :del-typography
:id id}
@ -255,7 +262,7 @@
"Add a new component to current file library, from the currently selected shapes."
(ptk/reify ::add-component
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [file-id (:current-file-id state)
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
@ -278,7 +285,7 @@
(us/assert ::us/string new-name)
(ptk/reify ::rename-component
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [[path name] (cp/parse-path-name new-name)
component (get-in state [:workspace-data :components id])
objects (get component :objects)
@ -308,7 +315,7 @@
[{:keys [id] :as params}]
(ptk/reify ::duplicate-component
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [component (cp/get-component id
(:current-file-id state)
(dwlh/get-local-file state)
@ -317,7 +324,7 @@
unames (set (map :name all-components))
new-name (dwc/generate-unique-name unames (:name component))
[new-shape new-shapes updated-shapes]
[new-shape new-shapes _updated-shapes]
(dwlh/duplicate-component component)
rchanges [{:type :add-component
@ -339,7 +346,7 @@
(us/assert ::us/uuid id)
(ptk/reify ::delete-component
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [component (get-in state [:workspace-data :components id])
rchanges [{:type :del-component
@ -364,7 +371,7 @@
(us/assert ::us/point position)
(ptk/reify ::instantiate-component
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [local-library (dwlh/get-local-file state)
libraries (get state :workspace-libraries)
component (cp/get-component component-id file-id local-library libraries)
@ -442,58 +449,14 @@
(us/assert ::us/uuid id)
(ptk/reify ::detach-component
ptk/WatchEvent
(watch [it state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shapes (cp/get-object-with-children id objects)
(watch [it state _]
(let [local-library (dwlh/get-local-file state)
container (cp/get-container (get state :current-page-id)
:page
local-library)
rchanges (mapv (fn [obj]
{:type :mod-obj
:page-id page-id
:id (:id obj)
:operations [{:type :set
:attr :component-id
:val nil}
{:type :set
:attr :component-file
:val nil}
{:type :set
:attr :component-root?
:val nil}
{:type :set
:attr :remote-synced?
:val nil}
{:type :set
:attr :shape-ref
:val nil}
{:type :set
:attr :touched
:val nil}]})
shapes)
uchanges (mapv (fn [obj]
{:type :mod-obj
:page-id page-id
:id (:id obj)
:operations [{:type :set
:attr :component-id
:val (:component-id obj)}
{:type :set
:attr :component-file
:val (:component-file obj)}
{:type :set
:attr :component-root?
:val (:component-root? obj)}
{:type :set
:attr :remote-synced?
:val (:remote-synced? obj)}
{:type :set
:attr :shape-ref
:val (:shape-ref obj)}
{:type :set
:attr :touched
:val (:touched obj)}]})
shapes)]
[rchanges uchanges]
(dwlh/generate-detach-instance id container)]
(rx/of (dch/commit-changes {:redo-changes rchanges
:undo-changes uchanges
@ -504,13 +467,13 @@
(us/assert ::us/uuid file-id)
(ptk/reify ::nav-to-component-file
ptk/WatchEvent
(watch [it state stream]
(let [file (get-in state [:workspace-libraries file-id])
(watch [_ state _]
(let [file (get-in state [:workspace-libraries file-id])
pparams {:project-id (:project-id file)
:file-id (:id file)}
qparams {:page-id (first (get-in file [:data :pages]))
:layout :assets}]
(st/emit! (rt/nav-new-window :workspace pparams qparams))))))
(rx/of (rt/nav-new-window :workspace pparams qparams))))))
(defn ext-library-changed
[file-id modified-at revn changes]
@ -533,7 +496,7 @@
(us/assert ::us/uuid id)
(ptk/reify ::reset-component
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(log/info :msg "RESET-COMPONENT of shape" :id (str id))
(let [local-library (dwlh/get-local-file state)
libraries (dwlh/get-libraries state)
@ -567,7 +530,7 @@
(us/assert ::us/uuid id)
(ptk/reify ::update-component
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(log/info :msg "UPDATE-COMPONENT of shape" :id (str id))
(let [page-id (get state :current-page-id)
local-library (dwlh/get-local-file state)
@ -635,7 +598,7 @@
state))
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(log/info :msg "SYNC-FILE"
:file (dwlh/pretty-file file-id state)
:library (dwlh/pretty-file library-id state))
@ -695,7 +658,7 @@
(us/assert ::us/uuid library-id)
(ptk/reify ::sync-file-2nd-stage
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(log/info :msg "SYNC-FILE (2nd stage)"
:file (dwlh/pretty-file file-id state)
:library (dwlh/pretty-file library-id state))
@ -720,7 +683,7 @@
(assoc-in state [:workspace-file :ignore-sync-until] (dt/now)))
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(rp/mutation :ignore-sync
{:file-id (get-in state [:workspace-file :id])
:date (dt/now)}))))
@ -730,7 +693,7 @@
(us/assert ::us/uuid file-id)
(ptk/reify ::notify-sync-file
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [libraries-need-sync (filter #(> (:modified-at %) (:synced-at %))
(vals (get state :workspace-libraries)))
do-update #(do (apply st/emit! (map (fn [library]
@ -740,6 +703,7 @@
(st/emit! dm/hide))
do-dismiss #(do (st/emit! ignore-sync)
(st/emit! dm/hide))]
(rx/of (dm/info-dialog
(tr "workspace.updates.there-are-updates")
:inline-actions

View file

@ -17,19 +17,19 @@
[cljs.spec.alpha :as s]
[clojure.set :as set]))
;; Change this to :info :debug or :trace to debug this module
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
(log/set-level! :warn)
(defonce empty-changes [[] []])
(defonce color-sync-attrs
[[:fill-color-ref-id :color :fill-color]
[:fill-color-ref-id :gradient :fill-color-gradient]
[:fill-color-ref-id :opacity :fill-opacity]
[[:fill-color-ref-id :fill-color-ref-file :color :fill-color]
[:fill-color-ref-id :fill-color-ref-file :gradient :fill-color-gradient]
[:fill-color-ref-id :fill-color-ref-file :opacity :fill-opacity]
[:stroke-color-ref-id :color :stroke-color]
[:stroke-color-ref-id :gradient :stroke-color-gradient]
[:stroke-color-ref-id :opacity :stroke-opacity]])
[:stroke-color-ref-id :stroke-color-ref-file :color :stroke-color]
[:stroke-color-ref-id :stroke-color-ref-file :gradient :stroke-color-gradient]
[:stroke-color-ref-id :stroke-color-ref-file :opacity :stroke-opacity]])
(declare generate-sync-container)
(declare generate-sync-shape)
@ -90,7 +90,7 @@
(assert (nil? (:shape-ref shape)))
(let [;; Ensure that the component root is not an instance and
;; it's no longer tied to a frame.
update-new-shape (fn [new-shape original-shape]
update-new-shape (fn [new-shape _original-shape]
(cond-> new-shape
true
(-> (assoc :frame-id nil)
@ -200,6 +200,63 @@
(get component :objects)
identity)))
(defn generate-detach-instance
"Generate changes to remove the links between a shape and all its children
with a component."
[shape-id container]
(let [shapes (cp/get-object-with-children shape-id (:objects container))
rchanges (mapv (fn [obj]
(make-change
container
{:type :mod-obj
:id (:id obj)
:operations [{:type :set
:attr :component-id
:val nil}
{:type :set
:attr :component-file
:val nil}
{:type :set
:attr :component-root?
:val nil}
{:type :set
:attr :remote-synced?
:val nil}
{:type :set
:attr :shape-ref
:val nil}
{:type :set
:attr :touched
:val nil}]}))
shapes)
uchanges (mapv (fn [obj]
(make-change
container
{:type :mod-obj
:id (:id obj)
:operations [{:type :set
:attr :component-id
:val (:component-id obj)}
{:type :set
:attr :component-file
:val (:component-file obj)}
{:type :set
:attr :component-root?
:val (:component-root? obj)}
{:type :set
:attr :remote-synced?
:val (:remote-synced? obj)}
{:type :set
:attr :shape-ref
:val (:shape-ref obj)}
{:type :set
:attr :touched
:val (:touched obj)}]}))
shapes)]
[rchanges uchanges]))
;; ---- General library synchronization functions ----
@ -216,26 +273,20 @@
:file (pretty-file file-id state)
:library (pretty-file library-id state))
(let [file (get-file state file-id)
library (get-file state library-id)
library-items (get library asset-type)]
(if (empty? library-items)
empty-changes
(loop [pages (vals (get file :pages-index))
rchanges []
uchanges []]
(if-let [page (first pages)]
(let [[page-rchanges page-uchanges]
(generate-sync-container asset-type
library-id
state
(cp/make-container page :page))]
(recur (next pages)
(d/concat rchanges page-rchanges)
(d/concat uchanges page-uchanges)))
[rchanges uchanges])))))
(let [file (get-file state file-id)]
(loop [pages (vals (get file :pages-index))
rchanges []
uchanges []]
(if-let [page (first pages)]
(let [[page-rchanges page-uchanges]
(generate-sync-container asset-type
library-id
state
(cp/make-container page :page))]
(recur (next pages)
(d/concat rchanges page-rchanges)
(d/concat uchanges page-uchanges)))
[rchanges uchanges]))))
(defn generate-sync-library
"Generate changes to synchronize all shapes in all components of the
@ -248,27 +299,21 @@
:file (pretty-file file-id state)
:library (pretty-file library-id state))
(let [file (get-file state file-id)
library (get-file state library-id)
library-items (get library asset-type)]
(if (empty? library-items)
empty-changes
(loop [local-components (vals (get file :components))
rchanges []
uchanges []]
(if-let [local-component (first local-components)]
(let [[comp-rchanges comp-uchanges]
(generate-sync-container asset-type
library-id
state
(cp/make-container local-component
:component))]
(recur (next local-components)
(d/concat rchanges comp-rchanges)
(d/concat uchanges comp-uchanges)))
[rchanges uchanges])))))
(let [file (get-file state file-id)]
(loop [local-components (vals (get file :components))
rchanges []
uchanges []]
(if-let [local-component (first local-components)]
(let [[comp-rchanges comp-uchanges]
(generate-sync-container asset-type
library-id
state
(cp/make-container local-component
:component))]
(recur (next local-components)
(d/concat rchanges comp-rchanges)
(d/concat uchanges comp-uchanges)))
[rchanges uchanges]))))
(defn- generate-sync-container
"Generate changes to synchronize all shapes in a particular container (a page
@ -323,7 +368,7 @@
attr-ref-file (keyword (str attr "-ref-file"))]
(and (get shape attr-ref-id)
(= library-id (get shape attr-ref-file))))
(map #(nth % 2) color-sync-attrs))))
(map #(nth % 3) color-sync-attrs))))
:typographies
(fn [shape]
@ -338,10 +383,10 @@
(defmulti generate-sync-shape
"Generate changes to synchronize one shape with all assets of the given type
that is using, in the given library."
(fn [type library-id state container shape] type))
(fn [type _library-id _state _container _shape] type))
(defmethod generate-sync-shape :components
[_ library-id state container shape]
[_ _ state container shape]
(generate-sync-shape-direct container
(:id shape)
(get-local-file state)
@ -385,12 +430,14 @@
:fill-color (:color color)
:fill-opacity (:opacity color)
:fill-color-gradient (:gradient color))
node))]
(assoc node
:fill-color-ref-id nil
:fill-color-ref-file nil)))]
(generate-sync-text-shape shape container update-node))
(loop [attrs (seq color-sync-attrs)
roperations []
uoperations []]
(let [[attr-ref-id color-attr attr] (first attrs)]
(let [[attr-ref-id attr-ref-file color-attr attr] (first attrs)]
(if (nil? attr)
(if (empty? roperations)
empty-changes
@ -410,17 +457,37 @@
roperations
uoperations)
(let [color (get colors (get shape attr-ref-id))
roperation {:type :set
:attr attr
:val (color-attr color)
:ignore-touched true}
uoperation {:type :set
:attr attr
:val (get shape attr)
:ignore-touched true}]
roperations' (if color
[{:type :set
:attr attr
:val (color-attr color)
:ignore-touched true}]
;; If the referenced color does no longer exist in the library,
;; we must unlink the color in the shape
[{:type :set
:attr attr-ref-id
:val nil
:ignore-touched true}
{:type :set
:attr attr-ref-file
:val nil
:ignore-touched true}])
uoperations' (if color
[{:type :set
:attr attr
:val (get shape attr)
:ignore-touched true}]
[{:type :set
:attr attr-ref-id
:val (get shape attr-ref-id)
:ignore-touched true}
{:type :set
:attr attr-ref-file
:val (get shape attr-ref-file)
:ignore-touched true}])]
(recur (next attrs)
(conj roperations roperation)
(conj uoperations uoperation))))))))))
(concat roperations roperations')
(concat uoperations uoperations'))))))))))
(defmethod generate-sync-shape :typographies
[_ library-id state container shape]
@ -432,7 +499,8 @@
update-node (fn [node]
(if-let [typography (get typographies (:typography-ref-id node))]
(merge node (d/without-keys typography [:name :id]))
node))]
(dissoc node :typography-ref-id
:typography-ref-file)))]
(generate-sync-text-shape shape container update-node)))
(defn- get-assets
@ -568,7 +636,9 @@
root-main
reset?
initial-root?)
empty-changes)))
; If the component is not found, because the master component has been
; deleted or the library unlinked, detach the instance.
(generate-detach-instance shape-id container))))
(defn- generate-sync-shape-direct-recursive
[container shape-inst component shape-main root-inst root-main reset? initial-root?]
@ -631,20 +701,14 @@
set-remote-synced?)))
both (fn [child-inst child-main]
(let [sub-root? (and (:component-id shape-inst)
(not (:component-root? shape-inst)))]
(generate-sync-shape-direct-recursive container
child-inst
component
child-main
(if sub-root?
shape-inst
root-inst)
(if sub-root?
shape-main
root-main)
reset?
initial-root?)))
(generate-sync-shape-direct-recursive container
child-inst
component
child-main
root-inst
root-main
reset?
initial-root?))
moved (fn [child-inst child-main]
(move-shape
@ -666,7 +730,7 @@
[(d/concat rchanges child-rchanges)
(d/concat uchanges child-uchanges)]))
(defn- generate-sync-shape-inverse
(defn generate-sync-shape-inverse
"Generate changes to update the component a shape is linked to, from
the values in the shape and all its children."
[page-id shape-id local-library libraries]
@ -752,20 +816,13 @@
false))
both (fn [child-inst child-main]
(let [sub-root? (and (:component-id shape-inst)
(not (:component-root? shape-inst)))]
(generate-sync-shape-inverse-recursive container
child-inst
component
child-main
(if sub-root?
shape-inst
root-inst)
(if sub-root?
shape-main
root-main)
initial-root?)))
(generate-sync-shape-inverse-recursive container
child-inst
component
child-main
root-inst
root-main
initial-root?))
moved (fn [child-inst child-main]
(move-shape
@ -886,10 +943,10 @@
set-remote-synced?
(assoc :remote-synced? true))))
update-original-shape (fn [original-shape new-shape]
update-original-shape (fn [original-shape _new-shape]
original-shape)
[new-shape new-shapes _]
[_ new-shapes _]
(cp/clone-object component-shape
(:id parent-shape)
(get component :objects)
@ -939,7 +996,7 @@
(cp/get-parents (:id component-parent-shape)
(:objects component))))
update-new-shape (fn [new-shape original-shape]
update-new-shape (fn [new-shape _original-shape]
(reposition-shape new-shape
root-instance
root-main))
@ -950,7 +1007,7 @@
:shape-ref (:id new-shape))
original-shape))
[new-shape new-shapes updated-shapes]
[_new-shape new-shapes updated-shapes]
(cp/clone-object shape
(:id component-parent-shape)
(get page :objects)
@ -1141,33 +1198,6 @@
:remote-synced? (:remote-synced? shape)}]})]]
[rchanges uchanges]))))
(defn- set-touched-shapes-group
[shape container]
(if-not (:shape-ref shape)
empty-changes
(do
(log/info :msg (str "SET-TOUCHED-SHAPES-GROUP "
(if (cp/page? container) "[P] " "[C] ")
(:name shape)))
(let [rchanges [(make-change
container
{:type :mod-obj
:id (:id shape)
:operations
[{:type :set-touched
:touched (cp/set-touched-group
(:touched shape)
:shapes-group)}]})]
uchanges [(make-change
container
{:type :mod-obj
:id (:id shape)
:operations
[{:type :set-touched
:touched (:touched shape)}]})]]
[rchanges uchanges]))))
(defn- update-attrs
"The main function that implements the attribute sync algorithm. Copy
attributes that have changed in the origin shape to the dest shape.
@ -1187,6 +1217,8 @@
; sync only the position relative to the origin of the component.
; We solve this by moving the origin shape so it is aligned with
; the dest root before syncing.
; In case of subinstances, the comparison is always done with the
; near component, because this is that we are syncing with.
origin-shape (reposition-shape origin-shape origin-root dest-root)
touched (get dest-shape :touched #{})]

View file

@ -10,18 +10,14 @@
[app.common.geom.point :as gpt]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.transit :as t]
[app.common.uri :as u]
[app.config :as cf]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.persistence :as dwp]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.streams :as ms]
[app.util.avatars :as avatars]
[app.util.i18n :as i18n :refer [tr]]
[app.util.time :as dt]
[app.util.transit :as t]
[app.util.websockets :as ws]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
@ -74,7 +70,7 @@
;; Process all incoming messages.
(->> (ws/-stream wsession)
(rx/filter ws/message?)
(rx/map (comp t/decode :payload))
(rx/map (comp t/decode-str :payload))
(rx/filter #(s/valid? ::message %))
(rx/map process-message))
@ -104,7 +100,7 @@
[file-id]
(ptk/reify ::send-keepalive
ptk/EffectEvent
(effect [_ state stream]
(effect [_ state _]
(when-let [ws (get-in state [:ws file-id])]
(ws/send! ws {:type :keepalive})))))
@ -112,9 +108,8 @@
[file-id point]
(ptk/reify ::handle-pointer-update
ptk/EffectEvent
(effect [_ state stream]
(effect [_ state _]
(let [ws (get-in state [:ws file-id])
sid (:session-id state)
pid (:current-page-id state)
msg {:type :pointer-update
:page-id pid
@ -128,7 +123,7 @@
[file-id]
(ptk/reify ::finalize
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(when-let [ws (get-in state [:ws file-id])]
(ws/-close ws))
(rx/of ::finalize))))
@ -187,7 +182,7 @@
(update state :workspace-presence update-presence))))))
(defn handle-pointer-update
[{:keys [page-id profile-id session-id x y] :as msg}]
[{:keys [page-id session-id x y] :as msg}]
(ptk/reify ::handle-pointer-update
ptk/UpdateEvent
(update [_ state]
@ -213,7 +208,7 @@
(us/assert ::file-change-event msg)
(ptk/reify ::handle-file-change
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(let [changes-by-pages (group-by :page-id changes)
process-page-changes
(fn [[page-id changes]]
@ -239,7 +234,7 @@
(us/assert ::library-change-event msg)
(ptk/reify ::handle-library-change
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(when (contains? (:workspace-libraries state) file-id)
(rx/of (dwl/ext-library-changed file-id modified-at revn changes)
(dwl/notify-sync-file file-id))))))

View file

@ -28,7 +28,7 @@
(d/export edition/move-selected)
;; Selection
(d/export selection/handle-selection)
(d/export selection/handle-area-selection)
(d/export selection/select-node)
(d/export selection/path-handler-enter)
(d/export selection/path-handler-leave)

View file

@ -76,20 +76,21 @@
(ptk/reify ::save-path-content
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state (st/get-path state :content))
(let [content (st/get-path state :content)
content (if (and (not preserve-move-to)
(= (-> content last :command) :move-to))
(into [] (take (dec (count content)) content))
content)]
(assoc-in state (st/get-path state :content) content)))
(-> state
(st/set-content content))))
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [objects (wsh/lookup-page-objects state)
page-id (:current-page-id state)
id (get-in state [:workspace-local :edition])
old-content (get-in state [:workspace-local :edit-path id :old-content])
shape (get-in state (st/get-path state))]
shape (st/get-path state)]
(if (and (some? old-content) (some? (:id shape)))
(let [[rch uch] (generate-path-changes objects page-id shape old-content (:content shape))]
(rx/of (dch/commit-changes {:redo-changes rch

View file

@ -16,7 +16,8 @@
[state]
(dissoc state :last-point :prev-handler :drag-handler :preview))
(defn finish-path [source]
(defn finish-path
[_source]
(ptk/reify ::finish-path
ptk/UpdateEvent
(update [_ state]

View file

@ -9,6 +9,7 @@
[app.common.geom.point :as gpt]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing.common :as dwdc]
[app.main.data.workspace.path.changes :as changes]
@ -17,12 +18,12 @@
[app.main.data.workspace.path.spec :as spec]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.streams :as streams]
[app.main.data.workspace.path.tools :as tools]
[app.main.data.workspace.path.undo :as undo]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.streams :as ms]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[app.util.path.shapes-to-path :as upsp]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -37,7 +38,7 @@
last-point (get-in state [:workspace-local :edit-path id :last-point])
position (cond-> (gpt/point x y)
fix-angle? (helpers/position-fixed-angle last-point))
shape (get-in state (st/get-path state))
shape (st/get-path state)
{:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
command (helpers/next-node shape position last-point prev-handler)]
(assoc-in state [:workspace-local :edit-path id :preview] command)))))
@ -56,19 +57,18 @@
(assoc-in [:workspace-local :edit-path id :last-point] position)
(update-in [:workspace-local :edit-path id] dissoc :prev-handler)
(update-in [:workspace-local :edit-path id] dissoc :preview)
(update-in (st/get-path state) helpers/append-node position last-point prev-handler))
(update-in (st/get-path-location state) helpers/append-node position last-point prev-handler))
state)))))
(defn drag-handler
([{:keys [x y alt? shift?] :as position}]
([position]
(drag-handler nil nil :c1 position))
([position index prefix {:keys [x y alt? shift?]}]
(ptk/reify ::drag-handler
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
index (or index (count content))
prefix (or prefix :c1)
@ -98,19 +98,19 @@
(let [id (st/get-path-id state)
modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
content (-> (get-in state (st/get-path state :content))
content (-> (st/get-path state :content)
(upc/apply-content-modifiers modifiers))
handler (get-in state [:workspace-local :edit-path id :drag-handler])]
(-> state
(assoc-in (st/get-path state :content) content)
(st/set-content content)
(update-in [:workspace-local :edit-path id] dissoc :drag-handler)
(update-in [:workspace-local :edit-path id] dissoc :content-modifiers)
(assoc-in [:workspace-local :edit-path id :prev-handler] handler)
(update-in (st/get-path state) helpers/update-selrect))))
(update-in (st/get-path-location state) helpers/update-selrect))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [id (st/get-path-id state)
handler (get-in state [:workspace-local :edit-path id :prev-handler])]
;; Update the preview because can be outdated after the dragging
@ -124,14 +124,11 @@
ptk/WatchEvent
(watch [_ state stream]
(let [id (st/get-path-id state)
zoom (get-in state [:workspace-local :zoom])
start-position @ms/mouse-position
stop-stream
(->> stream (rx/filter #(or (helpers/end-path-event? %)
(ms/mouse-up? %))))
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
points (upg/content->points content)
@ -166,11 +163,9 @@
(ptk/reify ::start-path-from-point
ptk/WatchEvent
(watch [_ state stream]
(let [start-point @ms/mouse-position
zoom (get-in state [:workspace-local :zoom])
mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %)
(let [mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %)
(ms/mouse-up? %))))
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
points (upg/content->points content)
id (st/get-path-id state)
@ -195,7 +190,7 @@
(rx/merge-map #(rx/empty))))
(defn make-drag-stream
[stream snap-toggled zoom points down-event]
[stream snap-toggled _zoom points down-event]
(let [mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %)
(ms/mouse-up? %))))
@ -211,7 +206,7 @@
(rx/of (finish-drag)))))))
(defn handle-drawing-path
[id]
[_id]
(ptk/reify ::handle-drawing-path
ptk/UpdateEvent
(update [_ state]
@ -225,7 +220,7 @@
mouse-down (->> stream (rx/filter ms/mouse-down?))
end-path-events (->> stream (rx/filter helpers/end-path-event?))
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
points (upg/content->points content)
id (st/get-path-id state)
@ -278,11 +273,11 @@
state)))
ptk/WatchEvent
(watch [_ state stream]
(->> (rx/of (setup-frame-path)
dwdc/handle-finish-drawing
(dwc/start-edition-mode shape-id)
(change-edit-mode :draw))))))
(watch [_ _ _]
(rx/of (setup-frame-path)
dwdc/handle-finish-drawing
(dwc/start-edition-mode shape-id)
(change-edit-mode :draw)))))
(defn handle-new-shape
"Creates a new path shape"
@ -323,6 +318,7 @@
edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(if (= :draw edit-mode)
(rx/concat
(rx/of (dch/update-shapes [id] upsp/convert-to-path))
(rx/of (handle-drawing-path id))
(->> stream
(rx/filter (ptk/type? ::common/finish-path))
@ -333,9 +329,9 @@
(defn check-changed-content []
(ptk/reify ::check-changed-content
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [id (st/get-path-id state)
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
old-content (get-in state [:workspace-local :edit-path id :old-content])
mode (get-in state [:workspace-local :edit-path id :edit-mode])]
@ -354,7 +350,7 @@
id (assoc-in [:workspace-local :edit-path id :edit-mode] mode))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [id (st/get-path-id state)]
(cond
(and id (= :move mode)) (rx/of (common/finish-path "change-edit-mode"))

View file

@ -8,11 +8,9 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.math :as mth]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
[app.main.data.workspace.path.drawing :as drawing]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.selection :as selection]
@ -23,6 +21,7 @@
[app.main.streams :as ms]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[app.util.path.shapes-to-path :as upsp]
[app.util.path.subpaths :as ups]
[app.util.path.tools :as upt]
[beicon.core :as rx]
@ -33,8 +32,7 @@
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state (st/get-path state :content))
(let [content (st/get-path state :content)
modifiers (helpers/move-handler-modifiers content index prefix false match-opposite? dx dy)
[cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])
point (gpt/point (+ (get-in content [index :params cx]) dx)
@ -47,12 +45,12 @@
(defn apply-content-modifiers []
(ptk/reify ::apply-content-modifiers
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [objects (wsh/lookup-page-objects state)
id (st/get-path-id state)
page-id (:current-page-id state)
shape (get-in state (st/get-path state))
shape (st/get-path state)
content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
content (:content shape)
@ -102,7 +100,7 @@
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
modifiers-reducer (partial modify-content-point content move-modifier)
content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers] {})
content-modifiers (->> points
@ -116,7 +114,7 @@
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
delta (gpt/subtract to-point from-point)
modifiers-reducer (partial modify-content-point content delta)
@ -137,28 +135,29 @@
[position shift?]
(ptk/reify ::start-move-path-point
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [id (get-in state [:workspace-local :edition])
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
selected? (contains? selected-points position)]
(streams/drag-stream
(rx/of
(when-not selected? (selection/select-node position shift? "drag"))
(dch/update-shapes [id] upsp/convert-to-path)
(when-not selected? (selection/select-node position shift?))
(drag-selected-points @ms/mouse-position))
(rx/of (selection/select-node position shift? "click")))))))
(rx/of (selection/select-node position shift?)))))))
(defn drag-selected-points
[start-position]
(ptk/reify ::drag-selected-points
ptk/WatchEvent
(watch [it state stream]
(watch [_ state stream]
(let [stopper (->> stream (rx/filter ms/mouse-up?))
id (get-in state [:workspace-local :edition])
snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
points (upg/content->points content)]
(rx/concat
@ -206,7 +205,7 @@
state)))
ptk/WatchEvent
(watch [it state stream]
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
current-move (get-in state [:workspace-local :edit-path id :current-move])]
(if (= same-event current-move)
@ -223,6 +222,7 @@
mov-vec (gpt/multiply (get-displacement direction) scale)]
(rx/concat
(rx/of (dch/update-shapes [id] upsp/convert-to-path))
(rx/merge
(->> move-events
(rx/take-until stopper)
@ -240,7 +240,7 @@
[index prefix]
(ptk/reify ::start-move-handler
ptk/WatchEvent
(watch [it state stream]
(watch [_ state stream]
(let [id (get-in state [:workspace-local :edition])
cx (d/prefix-keyword prefix :x)
cy (d/prefix-keyword prefix :y)
@ -249,7 +249,7 @@
start-delta-x (get-in modifiers [index cx] 0)
start-delta-y (get-in modifiers [index cy] 0)
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
points (upg/content->points content)
point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point))
@ -262,6 +262,7 @@
(streams/drag-stream
(rx/concat
(rx/of (dch/update-shapes [id] upsp/convert-to-path))
(->> (streams/move-handler-stream snap-toggled start-point point handler opposite points)
(rx/take-until (->> stream (rx/filter #(or (ms/mouse-up? %)
(streams/finish-edition? %)))))
@ -286,7 +287,8 @@
ptk/UpdateEvent
(update [_ state]
(let [edit-path (get-in state [:workspace-local :edit-path id])
state (update-in state (st/get-path state :content) ups/close-subpaths)]
content (st/get-path state :content)
state (st/set-content state (ups/close-subpaths content))]
(cond-> state
(or (not edit-path) (= :draw (:edit-mode edit-path)))
(assoc-in [:workspace-local :edit-path id] {:edit-mode :move
@ -297,7 +299,7 @@
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
ptk/WatchEvent
(watch [it state stream]
(watch [_ state stream]
(let [mode (get-in state [:workspace-local :edit-path id :edit-mode])]
(rx/concat
(rx/of (undo/start-path-undo))
@ -315,17 +317,26 @@
(let [id (get-in state [:workspace-local :edition])]
(update state :workspace-local dissoc :edit-path id)))))
(defn create-node-at-position
(defn split-segments
[{:keys [from-p to-p t]}]
(ptk/reify ::create-node-at-position
(ptk/reify ::split-segments
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
old-content (get-in state (st/get-path state :content))]
content (st/get-path state :content)]
(-> state
(assoc-in [:workspace-local :edit-path id :old-content] old-content)
(update-in (st/get-path state :content) upt/split-segments #{from-p to-p} t))))
(assoc-in [:workspace-local :edit-path id :old-content] content)
(st/set-content (-> content (upt/split-segments #{from-p to-p} t))))))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(rx/of (changes/save-path-content {:preserve-move-to true})))))
(defn create-node-at-position
[event]
(ptk/reify ::create-node-at-position
ptk/WatchEvent
(watch [_ state _]
(let [id (st/get-path-id state)]
(rx/of (dch/update-shapes [id] upsp/convert-to-path)
(split-segments event))))))

View file

@ -6,25 +6,23 @@
(ns app.main.data.workspace.path.helpers
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.main.data.workspace.path.common :as common]
[app.main.data.workspace.path.state :refer [get-path]]
[app.main.streams :as ms]
[app.util.path.commands :as upc]
[app.util.path.subpaths :as ups]
[potok.core :as ptk]))
(defn end-path-event? [{:keys [type shift] :as event}]
(defn end-path-event? [event]
(or (= (ptk/type event) ::common/finish-path)
(= (ptk/type event) :esc-pressed)
(= :app.main.data.workspace.common/clear-edition-mode (ptk/type event))
(= :app.main.data.workspace/finalize-page (ptk/type event))
(= event :interrupt) ;; ESC
(and (ms/mouse-double-click? event))))
(ms/mouse-double-click? event)))
(defn content-center
[content]
@ -35,7 +33,6 @@
(defn content->points+selrect
"Given the content of a shape, calculate its points and selrect"
[shape content]
(let [{:keys [flip-x flip-y]} shape
transform
(cond-> (:transform shape (gmt/matrix))

View file

@ -48,7 +48,7 @@
(update [_ state]
(let [selrect (get-in state [:workspace-local :selrect])
id (get-in state [:workspace-local :edition])
content (get-in state (st/get-path state :content))
content (st/get-path state :content)
selected-point? #(gsh/has-point-rect? selrect %)
selected-points (get-in state [:workspace-local :edit-path id :selected-points])
positions (into (if shift? selected-points #{})
@ -60,7 +60,7 @@
(some? id)
(assoc-in [:workspace-local :edit-path id :selected-points] positions))))))
(defn select-node [position shift? kk]
(defn select-node [position shift?]
(ptk/reify ::select-node
ptk/UpdateEvent
(update [_ state]
@ -79,38 +79,6 @@
(some? id)
(assoc-in [:workspace-local :edit-path id :selected-points] selected-points))))))
(defn deselect-node [position shift?]
(ptk/reify ::deselect-node
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(-> state
(update-in [:workspace-local :edit-path id :selected-points] (fnil disj #{}) position))))))
(defn add-to-selection-handler [index type]
(ptk/reify ::add-to-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn add-to-selection-node [index]
(ptk/reify ::add-to-selection-node
ptk/UpdateEvent
(update [_ state]
state)))
(defn remove-from-selection-handler [index]
(ptk/reify ::remove-from-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn remove-from-selection-node [index]
(ptk/reify ::remove-from-selection-handler
ptk/UpdateEvent
(update [_ state]
state)))
(defn deselect-all []
(ptk/reify ::deselect-all
ptk/UpdateEvent
@ -133,14 +101,14 @@
(update [_ state]
(update state :workspace-local dissoc :selrect))))
(defn handle-selection
(defn handle-area-selection
[shift?]
(letfn [(valid-rect? [{width :width height :height}]
(or (> width 10) (> height 10)))]
(ptk/reify ::handle-selection
(ptk/reify ::handle-area-selection
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
(let [stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event)))
stoper (->> stream (rx/filter stop?))
from-p @ms/mouse-position]

View file

@ -22,7 +22,7 @@
(defn esc-pressed []
(ptk/reify :esc-pressed
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
;; Not interrupt when we're editing a path
(let [edition-id (or (get-in state [:workspace-drawing :object :id])
(get-in state [:workspace-local :edition]))

View file

@ -40,8 +40,8 @@
(s/def ::content-entry
(s/keys :req-un [::command]
:req-opt [::params
::relative?]))
:opt-un [::params
::relative?]))
(s/def ::content
(s/coll-of ::content-entry :kind vector?))

View file

@ -6,7 +6,8 @@
(ns app.main.data.workspace.path.state
(:require
[app.common.data :as d]))
[app.common.data :as d]
[app.util.path.shapes-to-path :as upsp]))
(defn get-path-id
"Retrieves the currently editing path id"
@ -14,16 +15,30 @@
(or (get-in state [:workspace-local :edition])
(get-in state [:workspace-drawing :object :id])))
(defn get-path
"Retrieves the location of the path object and additionaly can pass
the arguments. This location can be used in get-in, assoc-in... functions"
[state & path]
(let [edit-id (get-in state [:workspace-local :edition])
page-id (:current-page-id state)]
(defn get-path-location
[state & ks]
(let [edit-id (get-in state [:workspace-local :edition])
page-id (:current-page-id state)]
(d/concat
(if edit-id
[:workspace-data :pages-index page-id :objects edit-id]
[:workspace-drawing :object])
path)))
ks)))
(defn get-path
"Retrieves the location of the path object and additionaly can pass
the arguments. This location can be used in get-in, assoc-in... functions"
[state & ks]
(let [path-loc (get-path-location state)
shape (-> (get-in state path-loc)
(upsp/convert-to-path))]
(if (empty? ks)
shape
(get-in shape ks))))
(defn set-content
[state content]
(let [path-loc (get-path-location state :content)]
(-> state
(assoc-in path-loc content))))

View file

@ -6,17 +6,16 @@
(ns app.main.data.workspace.path.streams
(:require
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.state :as state]
[app.common.geom.point :as gpt]
[app.common.math :as mth]
[app.main.data.workspace.path.state :as state]
[app.main.snap :as snap]
[app.main.store :as st]
[app.main.streams :as ms]
[app.util.path.geom :as upg]
[beicon.core :as rx]
[potok.core :as ptk]
[app.common.math :as mth]
[app.main.snap :as snap]
[okulary.core :as l]
[app.util.path.geom :as upg]))
[potok.core :as ptk]))
(defonce drag-threshold 5)
@ -50,7 +49,7 @@
(if (= value ::empty)
not-drag-stream
(rx/empty)))))
(->> position-stream
(rx/merge-map (fn [] to-stream)))))))
@ -107,7 +106,7 @@
(<= (- 180 rot-angle) 5))]
(cond
snap-opposite-angle?
snap-opposite-angle?
(let [rot-handler (gpt/rotate handler node (- 180 (* rot-sign rot-angle)))
snap (gpt/to-vec handler rot-handler)]
(merge position (gpt/add position snap)))
@ -122,11 +121,10 @@
(rx/map check-path-snap))))
(defn position-stream
[snap-toggled points]
[snap-toggled _points]
(let [zoom (get-in @st/state [:workspace-local :zoom] 1)
;; ranges (snap/create-ranges points)
d-pos (/ snap/snap-path-accuracy zoom)
get-content (fn [state] (get-in state (state/get-path state :content)))
get-content #(state/get-path % :content)
content-stream
(-> (l/derived get-content st/state)

View file

@ -6,13 +6,12 @@
(ns app.main.data.workspace.path.tools
(:require
[app.common.geom.point :as gpt]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.state-helpers :as wsh]
[app.util.path.shapes-to-path :as upsp]
[app.util.path.subpaths :as ups]
[app.util.path.tools :as upt]
[beicon.core :as rx]
@ -25,23 +24,25 @@
([points tool-fn]
(ptk/reify ::process-path-tool
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [objects (wsh/lookup-page-objects state)
id (st/get-path-id state)
page-id (:current-page-id state)
shape (get-in state (st/get-path state))
shape (st/get-path state)
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
points (or points selected-points)]
(when (and (not (empty? points)) (some? shape))
(when (and (seq points) (some? shape))
(let [new-content (-> (tool-fn (:content shape) points)
(ups/close-subpaths))
[rch uch] (changes/generate-path-changes objects page-id shape (:content shape) new-content)]
(rx/of (dch/commit-changes {:redo-changes rch
:undo-changes uch
:origin it})
(when (empty? new-content)
dwc/clear-edition-mode)))))))))
(rx/concat
(rx/of (dch/update-shapes [id] upsp/convert-to-path))
(rx/of (dch/commit-changes {:redo-changes rch
:undo-changes uch
:origin it})
(when (empty? new-content)
dwc/clear-edition-mode))))))))))
(defn make-corner
([]

View file

@ -9,8 +9,8 @@
[app.common.data :as d]
[app.common.data.undo-stack :as u]
[app.common.uuid :as uuid]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.state :as st]
[app.main.store :as store]
[beicon.core :as rx]
[okulary.core :as l]
@ -25,21 +25,22 @@
(= :app.main.data.workspace.common/redo (ptk/type event)))
(defn- make-entry [state]
(let [id (st/get-path-id state)]
{:content (get-in state (st/get-path state :content))
:selrect (get-in state (st/get-path state :selrect))
:points (get-in state (st/get-path state :points))
(let [id (st/get-path-id state)
shape (st/get-path state)]
{:content (:content shape)
:selrect (:selrect shape)
:points (:points shape)
:preview (get-in state [:workspace-local :edit-path id :preview])
:last-point (get-in state [:workspace-local :edit-path id :last-point])
:prev-handler (get-in state [:workspace-local :edit-path id :prev-handler])}))
(defn- load-entry [state {:keys [content selrect points preview last-point prev-handler]}]
(let [id (st/get-path-id state)
old-content (get-in state (st/get-path state :content))]
old-content (st/get-path state :content)]
(-> state
(d/assoc-in-when (st/get-path state :content) content)
(d/assoc-in-when (st/get-path state :selrect) selrect)
(d/assoc-in-when (st/get-path state :points) points)
(d/assoc-in-when (st/get-path-location state :content) content)
(d/assoc-in-when (st/get-path-location state :selrect) selrect)
(d/assoc-in-when (st/get-path-location state :points) points)
(d/update-in-when
[:workspace-local :edit-path id]
assoc
@ -64,7 +65,7 @@
undo-stack)))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(rx/of (changes/save-path-content {:preserve-move-to true})))))
(defn redo-path []
@ -82,7 +83,7 @@
undo-stack))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
(rx/of (changes/save-path-content)))))
(defn merge-head
@ -92,10 +93,9 @@
(ptk/reify ::add-undo-entry
ptk/UpdateEvent
(update [_ state]
(let [id (st/get-path-id state)
entry (make-entry state)
(let [id (st/get-path-id state)
stack (get-in state [:workspace-local :edit-path id :undo-stack])
head (u/peek stack)
head (u/peek stack)
stack (-> stack (u/undo) (u/fixup head))]
(-> state
(d/assoc-in-when
@ -129,7 +129,7 @@
(def path-content-ref
(letfn [(selector [state]
(get-in state (st/get-path state :content)))]
(st/get-path state :content))]
(l/derived selector store/state)))
(defn start-path-undo
@ -145,7 +145,7 @@
assoc
:undo-lock lock
:undo-stack (u/make-stack)))))
ptk/WatchEvent
(watch [_ state stream]
(let [undo-lock (get-in state [:workspace-local :edit-path (st/get-path-id state) :undo-lock])]

View file

@ -8,8 +8,6 @@
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.geom.point :as gpt]
[app.common.media :as cm]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.uuid :as uuid]
@ -26,13 +24,10 @@
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.avatars :as avatars]
[app.util.http :as http]
[app.util.i18n :as i18n :refer [tr]]
[app.util.object :as obj]
[app.util.router :as rt]
[app.util.time :as dt]
[app.util.transit :as t]
[app.util.uri :as uu]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
@ -53,7 +48,7 @@
[file-id]
(ptk/reify ::initialize-persistence
ptk/EffectEvent
(effect [_ state stream]
(effect [_ _ stream]
(let [stoper (rx/filter #(= ::finalize %) stream)
forcer (rx/filter #(= ::force-persist %) stream)
notifier (->> stream
@ -121,12 +116,11 @@
(ptk/reify ::persist-changes
ptk/UpdateEvent
(update [_ state]
(let [conj (fnil conj [])
into* (fnil into [])]
(let [into* (fnil into [])]
(update-in state [:workspace-persistence :queue] into* changes)))
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [sid (:session-id state)
file (get state :workspace-file)
queue (get-in state [:workspace-persistence :queue] [])
@ -177,7 +171,7 @@
(us/verify ::us/uuid file-id)
(ptk/reify ::persist-synchronous-changes
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [sid (:session-id state)
file (get-in state [:workspace-libraries file-id])
@ -256,11 +250,11 @@
(declare fetch-libraries-content)
(declare bundle-fetched)
(defn- fetch-bundle
(defn fetch-bundle
[project-id file-id]
(ptk/reify ::fetch-bundle
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(->> (rx/zip (rp/query :file {:id file-id})
(rp/query :team-users {:file-id file-id})
(rp/query :project {:id project-id})
@ -286,7 +280,7 @@
(assoc-in state [:workspace-file :is-shared] is-shared))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [params {:id id :is-shared is-shared}]
(->> (rp/mutation :set-file-shared params)
(rx/ignore))))))
@ -301,7 +295,7 @@
(us/assert ::us/uuid team-id)
(ptk/reify ::fetch-shared-files
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(->> (rp/query :team-shared-files {:team-id team-id})
(rx/map shared-files-fetched)))))
@ -321,7 +315,7 @@
[file-id library-id]
(ptk/reify ::link-file-to-library
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [fetched #(assoc-in %2 [:workspace-libraries (:id %1)] %1)
params {:file-id file-id
:library-id library-id}]
@ -333,7 +327,7 @@
[file-id library-id]
(ptk/reify ::unlink-file-from-library
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [unlinked #(d/dissoc-in % [:workspace-libraries library-id])
params {:file-id file-id
:library-id library-id}]
@ -349,7 +343,7 @@
(->> (rx/of (-> (tubax/xml->clj text)
(assoc :name name))))
(catch :default err
(catch :default _err
(rx/throw {:type :svg-parser}))))
(defn fetch-svg [name uri]
@ -459,7 +453,7 @@
(s/def ::process-media-objects
(s/and
(s/keys :req-un [::file-id ::local?]
:opt-in [::name ::data ::uris ::mtype])
:opt-un [::name ::data ::uris ::mtype])
(fn [props]
(or (contains? props :blobs)
(contains? props :uris)))))
@ -469,7 +463,7 @@
(us/assert ::process-media-objects params)
(ptk/reify ::process-media-objects
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
@ -516,7 +510,7 @@
(us/assert ::clone-media-objects-params params)
(ptk/reify ::clone-media-objects
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
(let [{:keys [on-success on-error]
:or {on-success identity
on-error identity}} (meta params)
@ -549,7 +543,7 @@
[ids]
(ptk/reify ::remove-thumbnails
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ _]
;; Removes the thumbnail while it's regenerated
(rx/of (dch/update-shapes
ids

View file

@ -45,7 +45,7 @@
(update [_ state]
(assoc-in state [:workspace-local :selrect] selrect))))
(defn handle-selection
(defn handle-area-selection
[preserve?]
(letfn [(data->selrect [data]
(let [start (:start data)
@ -59,10 +59,11 @@
:y start-y
:width (mth/abs (- end-x start-x))
:height (mth/abs (- end-y start-y))}))]
(ptk/reify ::handle-selection
(ptk/reify ::handle-area-selection
ptk/WatchEvent
(watch [_ state stream]
(let [stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event)))
(let [zoom (get-in state [:workspace-local :zoom] 1)
stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event)))
stoper (->> stream (rx/filter stop?))]
(rx/concat
(when-not preserve?
@ -74,11 +75,16 @@
{:start pos :stop pos}))
nil)
(rx/map data->selrect)
(rx/filter #(or (> (:width %) 10)
(> (:height %) 10)))
(rx/map update-selrect)
(rx/filter #(or (> (:width %) (/ 10 zoom))
(> (:height %) (/ 10 zoom))))
(rx/flat-map
(fn [selrect]
(rx/of (update-selrect selrect)
(select-shapes-by-current-selrect preserve?))))
(rx/take-until stoper))
(rx/of (select-shapes-by-current-selrect preserve?))))))))
(rx/of (update-selrect nil))))))))
;; --- Toggle shape's selection status (selected or deselected)
@ -100,7 +106,7 @@
(conj selected id))))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)]
(rx/of (dwc/expand-all-parents [id] objects)))))))
@ -136,7 +142,7 @@
(assoc-in state [:workspace-local :selected] ids))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)]
(rx/of (dwc/expand-all-parents ids objects))))))
@ -144,7 +150,7 @@
[]
(ptk/reify ::select-all
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
new-selected (let [selected-objs
@ -204,7 +210,7 @@
[preserve?]
(ptk/reify ::select-shapes-by-current-selrect
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state)
@ -214,34 +220,36 @@
selrect (get-in state [:workspace-local :selrect])
blocked? (fn [id] (get-in objects [id :blocked] false))]
(rx/merge
(rx/of (update-selrect nil))
(when selrect
(->> (uw/ask! {:cmd :selection/query
:page-id page-id
:rect selrect})
:rect selrect
:include-frames? true
:full-frame? true})
(rx/map #(cp/clean-loops objects %))
(rx/map #(into initial-set (filter (comp not blocked?)) %))
(rx/map select-shapes))))))))
(defn select-inside-group
([group-id position] (select-inside-group group-id position false))
([group-id position deep-children]
(ptk/reify ::select-inside-group
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
group (get objects group-id)
children (map #(get objects %) (:shapes group))
[group-id position]
;; We need to reverse the children because if two children
;; overlap we want to select the one that's over (and it's
;; in the later vector position
selected (->> children
reverse
(ptk/reify ::select-inside-group
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
group (get objects group-id)
children (map #(get objects %) (:shapes group))
;; We need to reverse the children because if two children
;; overlap we want to select the one that's over (and it's
;; in the later vector position
selected (->> children
reverse
(d/seek #(geom/has-point? % position)))]
(when selected
(rx/of (select-shape (:id selected)))))))))
(when selected
(rx/of (select-shape (:id selected))))))))
;; --- Duplicate Shapes
@ -322,7 +330,6 @@
name (dwc/generate-unique-name names (:name obj))
renamed-obj (assoc obj :id id :name name)
moved-obj (geom/move renamed-obj delta)
frames (cp/select-frames objects)
parent-id (or parent-id frame-id)
children-changes
@ -379,7 +386,7 @@
(def duplicate-selected
(ptk/reify ::duplicate-selected
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)

View file

@ -10,14 +10,13 @@
[app.main.data.workspace :as dw]
[app.main.data.workspace.colors :as mdc]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.undo :as dwu]
[app.main.data.workspace.drawing :as dwd]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.texts :as dwtxt]
[app.main.data.workspace.transforms :as dwt]
[app.main.data.workspace.undo :as dwu]
[app.main.store :as st]
[app.util.dom :as dom]
[potok.core :as ptk]))
[app.util.dom :as dom]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shortcuts

View file

@ -9,7 +9,6 @@
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.proportions :as gpr]
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
@ -18,14 +17,12 @@
[app.main.data.workspace.state-helpers :as wsh]
[app.main.repo :as rp]
[app.util.color :as uc]
[app.util.object :as obj]
[app.util.path.parser :as upp]
[app.util.svg :as usvg]
[app.util.uri :as uu]
[beicon.core :as rx]
[cuerdas.core :as str]
[potok.core :as ptk]
[promesa.core :as p]))
[potok.core :as ptk]))
(defonce default-rect {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
(defonce default-circle {:r 0 :cx 0 :cy 0})
@ -163,7 +160,7 @@
(gsh/setup-selrect))))
(defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}]
(when (and (contains? attrs :d) (not (empty? (:d attrs)) ))
(when (and (contains? attrs :d) (seq (:d attrs)))
(let [svg-transform (usvg/parse-transform (:transform attrs))
path-content (upp/parse-path (:d attrs))
content (cond-> path-content
@ -387,7 +384,7 @@
[svg-data file-id position]
(ptk/reify ::svg-uploaded
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ _]
;; Once the SVG is uploaded, we need to extract all the bitmap
;; images and upload them separatelly, then proceed to create
;; all shapes.
@ -414,7 +411,7 @@
[svg-data {:keys [x y] :as position}]
(ptk/reify ::create-svg-shapes
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(try
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)

View file

@ -16,17 +16,11 @@
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.transforms :as dwt]
[app.main.data.workspace.undo :as dwu]
[app.main.fonts :as fonts]
[app.util.object :as obj]
[app.util.router :as rt]
[app.util.text-editor :as ted]
[app.util.timers :as ts]
[app.util.router :as rt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[goog.object :as gobj]
[potok.core :as ptk]))
(defn update-editor
@ -42,7 +36,7 @@
[]
(ptk/reify ::focus-editor
ptk/EffectEvent
(effect [_ state stream]
(effect [_ state _]
(when-let [editor (:workspace-editor state)]
(ts/schedule #(.focus ^js editor))))))
@ -59,7 +53,7 @@
[{:keys [id] :as shape}]
(ptk/reify ::finalize-editor-state
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [content (-> (get-in state [:workspace-editor-state id])
(ted/get-editor-current-content))]
@ -74,7 +68,7 @@
(dch/update-shapes [id] #(assoc % :content content))
(dwu/commit-undo-transaction)))))
(rx/of (dws/deselect-shape id)
(dwc/delete-shapes [id])))))))
(dwc/delete-shapes #{id})))))))
(defn initialize-editor-state
[{:keys [id content] :as shape} decorator]
@ -88,7 +82,7 @@
decorator))))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ _ stream]
;; We need to finalize editor on two main events: (1) when user
;; explicitly navigates to other section or page; (2) when user
;; leaves the editor.
@ -149,7 +143,7 @@
[{:keys [id attrs]}]
(ptk/reify ::update-root-attrs
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
shape (get objects id)
@ -168,7 +162,7 @@
(d/update-in-when state [:workspace-editor-state id] ted/update-editor-current-block-data attrs))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(when-not (some? (get-in state [:workspace-editor-state id]))
(let [objects (wsh/lookup-page-objects state)
shape (get objects id)
@ -195,7 +189,7 @@
(d/update-in-when state [:workspace-editor-state id] ted/update-editor-current-inline-styles attrs))
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(when-not (some? (get-in state [:workspace-editor-state id]))
(let [objects (wsh/lookup-page-objects state)
shape (get objects id)
@ -232,7 +226,7 @@
(defn resize-text-batch [changes]
(ptk/reify ::resize-text-batch
ptk/WatchEvent
(watch [_ state stream]
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data :pages-index page-id :objects])]
(if-not (every? #(contains? objects(first %)) changes)

View file

@ -11,7 +11,6 @@
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.main.data.workspace.changes :as dch]
@ -19,28 +18,19 @@
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.main.refs :as refs]
[app.main.snap :as snap]
[app.main.store :as st]
[app.main.streams :as ms]
[app.util.path.shapes-to-path :as ups]
[beicon.core :as rx]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; -- Declarations
(declare set-modifiers)
(declare set-rotation)
(declare apply-modifiers)
;; -- Helpers --------------------------------------------------------
;; -- Helpers
;; For each of the 8 handlers gives the modifier for resize
;; For each of the 8 handlers gives the multiplier for resize
;; for example, right will only grow in the x coordinate and left
;; will grow in the inverse of the x coordinate
(def ^:private handler-modifiers
(def ^:private handler-multipliers
{:right [ 1 0]
:bottom [ 0 1]
:left [-1 0]
@ -50,13 +40,16 @@
:bottom-right [ 1 1]
:bottom-left [-1 1]})
;; Given a handler returns the coordinate origin for resizes
;; this is the opposite of the handler so for right we want the
;; left side as origin of the resize
;; sx, sy => start x/y
;; mx, my => middle x/y
;; ex, ey => end x/y
(defn- handler-resize-origin [{sx :x sy :y :keys [width height]} handler]
(defn- handler-resize-origin
"Given a handler, return the coordinate origin for resizes.
This is the opposite of the handler so for right we want the
left side as origin of the resize.
sx, sy => start x/y
mx, my => middle x/y
ex, ey => end x/y
"
[{sx :x sy :y :keys [width height]} handler]
(let [mx (+ sx (/ width 2))
my (+ sy (/ height 2))
ex (+ sx width)
@ -100,10 +93,195 @@
(update [_ state]
(update state :workspace-local dissoc :transform))))
;; -- RESIZE
;; -- Temporary modifiers -------------------------------------------
;; During an interactive transformation of shapes (e.g. when resizing or rotating
;; a group with the mouse), there are a lot of objects that need to be modified
;; (in this case, the group and all its children).
;;
;; To avoid updating the shapes theirselves, and forcing redraw of all components
;; that depend on the "objects" global state, we set a "modifiers" structure, with
;; the changes that need to be applied, and store it in :workspace-modifiers global
;; variable. The viewport reads this and merges it into the objects list it uses to
;; paint the viewport content, redrawing only the objects that have new modifiers.
;;
;; When the interaction is finished (e.g. user releases mouse button), the
;; apply-modifiers event is done, that consolidates all modifiers into the base
;; geometric attributes of the shapes.
(declare set-modifiers-recursive)
(declare check-delta)
(declare set-local-displacement)
(declare clear-local-transform)
(defn- set-modifiers
([ids] (set-modifiers ids nil))
([ids modifiers]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::set-modifiers
ptk/UpdateEvent
(update [_ state]
(let [modifiers (or modifiers (get-in state [:workspace-local :modifiers] {}))
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (->> ids (into #{} (remove #(get-in objects [% :blocked] false))))]
(reduce (fn [state id]
(update state :workspace-modifiers
#(set-modifiers-recursive %
objects
(get objects id)
modifiers
nil
nil)))
state
ids))))))
;; Rotation use different algorithm to calculate children modifiers (and do not use child constraints).
(defn- set-rotation-modifiers
([angle shapes]
(set-rotation-modifiers angle shapes (-> shapes gsh/selection-rect gsh/center-selrect)))
([angle shapes center]
(ptk/reify ::set-rotation-modifiers
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)
id->obj #(get objects %)
get-children (fn [shape] (map id->obj (cp/get-children (:id shape) objects)))
shapes (->> shapes (into [] (remove #(get % :blocked false))))
shapes (->> shapes (mapcat get-children) (concat shapes))
update-shape
(fn [modifiers shape]
(let [rotate-modifiers (gsh/rotation-modifiers shape center angle)]
(assoc-in modifiers [(:id shape) :modifiers] rotate-modifiers)))]
(-> state
(update :workspace-modifiers
#(reduce update-shape % shapes))))))))
(defn- apply-modifiers
[ids]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::apply-modifiers
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
children-ids (->> ids (mapcat #(cp/get-children % objects)))
ids-with-children (d/concat [] children-ids ids)
object-modifiers (get state :workspace-modifiers)
ignore-tree (d/mapm #(get-in %2 [:modifiers :ignore-geometry?]) object-modifiers)]
(rx/of (dwu/start-undo-transaction)
(dch/update-shapes
ids-with-children
(fn [shape]
(-> shape
(merge (get object-modifiers (:id shape)))
(gsh/transform-shape)))
{:reg-objects? true
:ignore-tree ignore-tree
;; Attributes that can change in the transform. This way we don't have to check
;; all the attributes
:attrs [:selrect :points
:x :y
:width :height
:content
:transform
:transform-inverse
:rotation
:flip-x
:flip-y]})
(clear-local-transform)
(dwu/commit-undo-transaction))))))
(defn- set-modifiers-recursive
[modif-tree objects shape modifiers root transformed-root]
(let [children (->> (get shape :shapes [])
(map #(get objects %)))
transformed-shape (gsh/transform-shape (assoc shape :modifiers modifiers))
[root transformed-root ignore-geometry?]
(check-delta shape root transformed-shape transformed-root objects)
modifiers (assoc modifiers :ignore-geometry? ignore-geometry?)
set-child (fn [modif-tree child]
(let [child-modifiers (gsh/calc-child-modifiers shape
child
modifiers)]
(set-modifiers-recursive modif-tree
objects
child
child-modifiers
root
transformed-root)))]
(reduce set-child
(update-in modif-tree [(:id shape) :modifiers] #(merge % modifiers))
children)))
(defn- check-delta
"If the shape is a component instance, check its relative position respect the
root of the component, and see if it changes after applying a transformation."
[shape root transformed-shape transformed-root objects]
(let [root (cond
(:component-root? shape)
shape
(nil? root)
(cp/get-root-shape shape objects)
:else root)
transformed-root (cond
(:component-root? transformed-shape)
transformed-shape
(nil? transformed-root)
(cp/get-root-shape transformed-shape objects)
:else transformed-root)
shape-delta (when root
(gpt/point (- (:x shape) (:x root))
(- (:y shape) (:y root))))
transformed-shape-delta (when transformed-root
(gpt/point (- (:x transformed-shape) (:x transformed-root))
(- (:y transformed-shape) (:y transformed-root))))
ignore-geometry? (= shape-delta transformed-shape-delta)]
[root transformed-root ignore-geometry?]))
(defn- set-local-displacement [point]
(ptk/reify ::start-local-displacement
ptk/UpdateEvent
(update [_ state]
(let [mtx (gmt/translate-matrix point)]
(-> state
(assoc-in [:workspace-local :modifiers] {:displacement mtx}))))))
(defn- clear-local-transform []
(ptk/reify ::clear-local-transform
ptk/UpdateEvent
(update [_ state]
(-> state
(dissoc :workspace-modifiers)
(update :workspace-local dissoc :modifiers :current-move-selected)))))
;; -- Resize --------------------------------------------------------
(defn start-resize
[handler initial ids shape]
(letfn [(resize [shape initial resizing-shapes layout [point lock? point-snap]]
"Enter mouse resize mode, until mouse button is released."
[handler ids shape]
(letfn [(resize [shape initial layout [point lock? point-snap]]
(let [{:keys [width height]} (:selrect shape)
{:keys [rotation]} shape
rotation (or rotation 0)
@ -118,12 +296,12 @@
lock? (or lock? scale-text)
;; Vector modifiers depending on the handler
handler-modif (let [[x y] (handler-modifiers handler)] (gpt/point x y))
handler-mult (let [[x y] (handler-multipliers handler)] (gpt/point x y))
;; Difference between the origin point in the coordinate system of the rotation
deltav (-> (gpt/to-vec initial (if (= rotation 0) point-snap point))
(gpt/transform (gmt/rotate-matrix (- rotation)))
(gpt/multiply handler-modif))
(gpt/multiply handler-mult))
;; Resize vector
scalev (gpt/divide (gpt/add shapev deltav) shapev)
@ -151,8 +329,7 @@
:resize-origin origin
:resize-transform shape-transform
:resize-scale-text scale-text
:resize-transform-inverse shape-transform-inverse}
false))))
:resize-transform-inverse shape-transform-inverse}))))
;; Unifies the instantaneous proportion lock modifier
;; activated by Shift key and the shapes own proportion
@ -186,13 +363,48 @@
(rx/switch-map (fn [[point :as current]]
(->> (snap/closest-snap-point page-id resizing-shapes layout zoom point)
(rx/map #(conj current %)))))
(rx/mapcat (partial resize shape initial-position resizing-shapes layout))
(rx/mapcat (partial resize shape initial-position layout))
(rx/take-until stoper))
(rx/of (apply-modifiers ids)
(finish-transform))))))))
(defn update-dimensions
"Change size of shapes, from the sideber options form."
[ids attr value]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify #{:width :height} attr)
(us/verify ::us/number value)
(ptk/reify ::update-dimensions
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (get-in state [:workspace-data :pages-index page-id :objects])]
(reduce (fn [state id]
(let [shape (get objects id)
modifiers (gsh/resize-modifiers shape attr value)]
(update state :workspace-modifiers
#(set-modifiers-recursive %
objects
shape
modifiers
nil
nil))))
state
ids)))
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (d/concat [] ids (mapcat #(cp/get-children % objects) ids))]
(rx/of (apply-modifiers ids))))))
;; -- Rotate --------------------------------------------------------
(defn start-rotate
"Enter mouse rotate mode, until mouse button is released."
[shapes]
(ptk/reify ::start-rotate
ptk/UpdateEvent
@ -201,7 +413,7 @@
(assoc-in [:workspace-local :transform] :rotate)))
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ stream]
(let [stoper (rx/filter ms/mouse-up? stream)
group (gsh/selection-rect shapes)
group-center (gsh/center-selrect group)
@ -224,23 +436,41 @@
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/map (fn [[pos ctrl?]]
(let [delta-angle (calculate-angle pos ctrl?)]
(set-rotation delta-angle shapes group-center))))
(set-rotation-modifiers delta-angle shapes group-center))))
(rx/take-until stoper))
(rx/of (apply-modifiers (map :id shapes))
(finish-transform)))))))
;; -- MOVE
(defn increase-rotation
"Rotate shapes a fixed angle, from a keyboard action."
[ids rotation]
(ptk/reify ::increase-rotation
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
rotate-shape (fn [shape]
(let [delta (- rotation (:rotation shape))]
(set-rotation-modifiers delta [shape])))]
(rx/concat
(rx/from (->> ids (map #(get objects %)) (map rotate-shape)))
(rx/of (apply-modifiers ids)))))))
;; -- Move ----------------------------------------------------------
(declare start-move)
(declare start-move-duplicate)
(declare start-local-displacement)
(declare clear-local-transform)
(declare calculate-frame-for-move)
(declare get-displacement)
(defn start-move-selected
"Enter mouse move mode, until mouse button is released."
[]
(ptk/reify ::start-move-selected
ptk/WatchEvent
(watch [it state stream]
(watch [_ state stream]
(let [initial (deref ms/mouse-position)
selected (wsh/lookup-selected state {:omit-blocked? true})
stopper (rx/filter ms/mouse-up? stream)]
@ -261,19 +491,141 @@
;; Otherwise just plain old move
(rx/of (start-move initial selected)))))))))))
(defn start-move-duplicate [from-position]
(defn- start-move-duplicate
[from-position]
(ptk/reify ::start-move-selected
ptk/WatchEvent
(watch [it state stream]
(watch [_ _ stream]
(->> stream
(rx/filter (ptk/type? ::dws/duplicate-selected))
(rx/first)
(rx/map #(start-move from-position))))))
(defn calculate-frame-for-move [ids]
(defn- start-move
([from-position] (start-move from-position nil))
([from-position ids]
(ptk/reify ::start-move
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:workspace-local :transform] :move)))
ptk/WatchEvent
(watch [_ state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state {:omit-blocked? true})
ids (if (nil? ids) selected ids)
shapes (mapv #(get objects %) ids)
stopper (rx/filter ms/mouse-up? stream)
layout (get state :workspace-layout)
zoom (get-in state [:workspace-local :zoom] 1)
position (->> ms/mouse-position
(rx/take-until stopper)
(rx/map #(gpt/to-vec from-position %)))
snap-delta (rx/concat
;; We send the nil first so the stream is not waiting for the first value
(rx/of nil)
(->> position
(rx/throttle 20)
(rx/switch-map
(fn [pos]
(->> (snap/closest-snap-move page-id shapes objects layout zoom pos)
(rx/map #(vector pos %)))))))]
(if (empty? shapes)
(rx/empty)
(rx/concat
(->> position
(rx/with-latest vector snap-delta)
(rx/map snap/correct-snap-point)
(rx/map set-local-displacement))
(rx/of (set-modifiers ids)
(apply-modifiers ids)
(calculate-frame-for-move ids)
(finish-transform)))))))))
(s/def ::direction #{:up :down :right :left})
(defn move-selected
"Move shapes a fixed increment in one direction, from a keyboard action."
[direction shift?]
(us/verify ::direction direction)
(us/verify boolean? shift?)
(let [same-event (js/Symbol "same-event")]
(ptk/reify ::move-selected
IDeref
(-deref [_] direction)
ptk/UpdateEvent
(update [_ state]
(if (nil? (get-in state [:workspace-local :current-move-selected]))
(-> state
(assoc-in [:workspace-local :transform] :move)
(assoc-in [:workspace-local :current-move-selected] same-event))
state))
ptk/WatchEvent
(watch [_ state stream]
(if (= same-event (get-in state [:workspace-local :current-move-selected]))
(let [selected (wsh/lookup-selected state {:omit-blocked? true})
move-events (->> stream
(rx/filter (ptk/type? ::move-selected))
(rx/filter #(= direction (deref %))))
stopper (->> move-events
(rx/debounce 100)
(rx/first))
scale (if shift? (gpt/point 10) (gpt/point 1))
mov-vec (gpt/multiply (get-displacement direction) scale)]
(rx/concat
(rx/merge
(->> move-events
(rx/take-until stopper)
(rx/scan #(gpt/add %1 mov-vec) (gpt/point 0 0))
(rx/map set-local-displacement))
(rx/of (move-selected direction shift?)))
(rx/of (set-modifiers selected)
(apply-modifiers selected)
(finish-transform))))
(rx/empty))))))
(s/def ::x number?)
(s/def ::y number?)
(s/def ::position
(s/keys :opt-un [::x ::y]))
(defn update-position
"Move shapes to a new position, from the sidebar options form."
[id position]
(us/verify ::us/uuid id)
(us/verify ::position position)
(ptk/reify ::update-position
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shape (get objects id)
bbox (-> shape :points gsh/points->selrect)
cpos (gpt/point (:x bbox) (:y bbox))
pos (gpt/point (or (:x position) (:x bbox))
(or (:y position) (:y bbox)))
displ (gmt/translate-matrix (gpt/subtract pos cpos))]
(rx/of (set-modifiers [id] {:displacement displ})
(apply-modifiers [id]))))))
(defn- calculate-frame-for-move
[ids]
(ptk/reify ::calculate-frame-for-move
ptk/WatchEvent
(watch [it state stream]
(watch [it state _]
(let [position @ms/mouse-position
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
@ -308,66 +660,6 @@
(dwu/commit-undo-transaction)
(dwc/expand-collapse frame-id)))))))
(defn start-move
([from-position] (start-move from-position nil))
([from-position ids]
(ptk/reify ::start-move
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:workspace-local :transform] :move)))
ptk/WatchEvent
(watch [it state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state {:omit-blocked? true})
ids (if (nil? ids) selected ids)
shapes (mapv #(get objects %) ids)
stopper (rx/filter ms/mouse-up? stream)
layout (get state :workspace-layout)
zoom (get-in state [:workspace-local :zoom] 1)
position (->> ms/mouse-position
(rx/take-until stopper)
(rx/map #(gpt/to-vec from-position %)))
snap-delta (rx/concat
;; We send the nil first so the stream is not waiting for the first value
(rx/of nil)
(->> position
(rx/throttle 20)
(rx/switch-map
(fn [pos]
(->> (snap/closest-snap-move page-id shapes objects layout zoom pos)
(rx/map #(vector pos %)))))))]
(if (empty? shapes)
(rx/empty)
(rx/concat
(->> position
(rx/with-latest vector snap-delta)
(rx/map snap/correct-snap-point)
(rx/map start-local-displacement))
(rx/of (apply-modifiers ids {:set-modifiers? true})
(calculate-frame-for-move ids)
(finish-transform)))))))))
(defn- get-displacement-with-grid
"Retrieve the correct displacement delta point for the
provided direction speed and distances thresholds."
[shape direction options]
(let [grid-x (:grid-x options 10)
grid-y (:grid-y options 10)
x-mod (mod (:x shape) grid-x)
y-mod (mod (:y shape) grid-y)]
(case direction
:up (gpt/point 0 (- (if (zero? y-mod) grid-y y-mod)))
:down (gpt/point 0 (- grid-y y-mod))
:left (gpt/point (- (if (zero? x-mod) grid-x x-mod)) 0)
:right (gpt/point (- grid-x x-mod) 0))))
(defn- get-displacement
"Retrieve the correct displacement delta point for the
provided direction speed and distances thresholds."
@ -378,216 +670,13 @@
:left (gpt/point (- 1) 0)
:right (gpt/point 1 0)))
(s/def ::direction #{:up :down :right :left})
(defn move-selected
[direction shift?]
(us/verify ::direction direction)
(us/verify boolean? shift?)
(let [same-event (js/Symbol "same-event")]
(ptk/reify ::move-selected
IDeref
(-deref [_] direction)
ptk/UpdateEvent
(update [_ state]
(if (nil? (get-in state [:workspace-local :current-move-selected]))
(-> state
(assoc-in [:workspace-local :transform] :move)
(assoc-in [:workspace-local :current-move-selected] same-event))
state))
ptk/WatchEvent
(watch [it state stream]
(if (= same-event (get-in state [:workspace-local :current-move-selected]))
(let [selected (wsh/lookup-selected state {:omit-blocked? true})
move-events (->> stream
(rx/filter (ptk/type? ::move-selected))
(rx/filter #(= direction (deref %))))
stopper (->> move-events
(rx/debounce 100)
(rx/first))
scale (if shift? (gpt/point 10) (gpt/point 1))
mov-vec (gpt/multiply (get-displacement direction) scale)]
(rx/concat
(rx/merge
(->> move-events
(rx/take-until stopper)
(rx/scan #(gpt/add %1 mov-vec) (gpt/point 0 0))
(rx/map start-local-displacement))
(rx/of (move-selected direction shift?)))
(rx/of (apply-modifiers selected {:set-modifiers? true})
(finish-transform))))
(rx/empty))))))
;; -- Apply modifiers
(defn set-modifiers
([ids] (set-modifiers ids nil true))
([ids modifiers] (set-modifiers ids modifiers true))
([ids modifiers recurse-frames?]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::set-modifiers
ptk/UpdateEvent
(update [_ state]
(let [modifiers (or modifiers (get-in state [:workspace-local :modifiers] {}))
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (->> ids (into #{} (remove #(get-in objects [% :blocked] false))))
not-frame-id?
(fn [shape-id]
(let [shape (get objects shape-id)]
(or recurse-frames? (not (= :frame (:type shape))))))
;; For each shape updates the modifiers given as arguments
update-shape
(fn [objects shape-id]
(update-in objects [shape-id :modifiers] #(merge % modifiers)))
;; ID's + Children but remove frame children if the flag is set to false
ids-with-children (concat ids (mapcat #(cp/get-children % objects)
(filter not-frame-id? ids)))]
(update state :workspace-modifiers
#(reduce update-shape % ids-with-children)))))))
;; Set-rotation is custom because applies different modifiers to each
;; shape adjusting their position.
(defn set-rotation
([angle shapes]
(set-rotation angle shapes (-> shapes gsh/selection-rect gsh/center-selrect)))
([angle shapes center]
(ptk/reify ::set-rotation
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)
id->obj #(get objects %)
get-children (fn [shape] (map id->obj (cp/get-children (:id shape) objects)))
shapes (->> shapes (into [] (remove #(get % :blocked false))))
shapes (->> shapes (mapcat get-children) (concat shapes))
update-shape
(fn [modifiers shape]
(let [rotate-modifiers (gsh/rotation-modifiers shape center angle)]
(assoc-in modifiers [(:id shape) :modifiers] rotate-modifiers)))]
(-> state
(update :workspace-modifiers
#(reduce update-shape % shapes))))))))
(defn increase-rotation [ids rotation]
(ptk/reify ::increase-rotation
ptk/WatchEvent
(watch [it state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
rotate-shape (fn [shape]
(let [delta (- rotation (:rotation shape))]
(set-rotation delta [shape])))]
(rx/concat
(rx/from (->> ids (map #(get objects %)) (map rotate-shape)))
(rx/of (apply-modifiers ids)))))))
(defn apply-modifiers
([ids]
(apply-modifiers ids nil))
([ids {:keys [set-modifiers?]
:or {set-modifiers? false}}]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::apply-modifiers
ptk/WatchEvent
(watch [it state stream]
(let [objects (wsh/lookup-page-objects state)
children-ids (->> ids (mapcat #(cp/get-children % objects)))
ids-with-children (d/concat [] children-ids ids)
state (if set-modifiers?
(ptk/update (set-modifiers ids) state)
state)
object-modifiers (get state :workspace-modifiers)]
(rx/of (dwu/start-undo-transaction)
(dch/update-shapes
ids-with-children
(fn [shape]
(-> shape
(merge (get object-modifiers (:id shape)))
(gsh/transform-shape)))
{:reg-objects? true
;; Attributes that can change in the transform. This way we don't have to check
;; all the attributes
:attrs [:selrect :points
:x :y
:width :height
:content
:transform
:transform-inverse
:rotation
:flip-x
:flip-y]
})
(clear-local-transform)
(dwu/commit-undo-transaction)))))))
;; --- Update Dimensions
;; Event mainly used for handling user modification of the size of the
;; object from workspace sidebar options inputs.
(defn update-dimensions
[ids attr value]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify #{:width :height} attr)
(us/verify ::us/number value)
(ptk/reify ::update-dimensions
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
update-children
(fn [objects ids modifiers]
(reduce #(assoc-in %1 [%2 :modifiers] modifiers) objects ids))
;; For each shape updates the modifiers given as arguments
update-shape
(fn [objects shape-id]
(let [shape (get objects shape-id)
modifier (gsh/resize-modifiers shape attr value)]
(-> objects
(assoc-in [shape-id :modifiers] modifier)
(cond-> (not (= :frame (:type shape)))
(update-children (cp/get-children shape-id objects) modifier)))))]
(d/update-in-when
state
[:workspace-data :pages-index page-id :objects]
#(reduce update-shape % ids))))
ptk/WatchEvent
(watch [it state stream]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
ids (d/concat [] ids (mapcat #(cp/get-children % objects) ids))]
(rx/of (apply-modifiers ids))))))
;; -- Flip ----------------------------------------------------------
(defn flip-horizontal-selected []
(ptk/reify ::flip-horizontal-selected
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state {:omit-blocked? true})
shapes (map #(get objects %) selected)
@ -597,14 +686,13 @@
(rx/of (set-modifiers selected
{:resize-vector (gpt/point -1.0 1.0)
:resize-origin origin
:displacement (gmt/translate-matrix (gpt/point (- (:width selrect)) 0))}
false)
:displacement (gmt/translate-matrix (gpt/point (- (:width selrect)) 0))})
(apply-modifiers selected))))))
(defn flip-vertical-selected []
(ptk/reify ::flip-vertical-selected
ptk/WatchEvent
(watch [it state stream]
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state {:omit-blocked? true})
shapes (map #(get objects %) selected)
@ -614,30 +702,9 @@
(rx/of (set-modifiers selected
{:resize-vector (gpt/point 1.0 -1.0)
:resize-origin origin
:displacement (gmt/translate-matrix (gpt/point 0 (- (:height selrect))))}
false)
:displacement (gmt/translate-matrix (gpt/point 0 (- (:height selrect))))})
(apply-modifiers selected))))))
(defn start-local-displacement [point]
(ptk/reify ::start-local-displacement
ptk/UpdateEvent
(update [_ state]
(let [mtx (gmt/translate-matrix point)]
(-> state
(assoc-in [:workspace-local :modifiers] {:displacement mtx}))))))
(defn clear-local-transform []
(ptk/reify ::clear-local-transform
ptk/UpdateEvent
(update [_ state]
(-> state
(dissoc :workspace-modifiers)
(update :workspace-local dissoc :modifiers :current-move-selected)))))
;; -- Transform to path ---------------------------------------------
(defn selected-to-path
[]
(ptk/reify ::selected-to-path
ptk/WatchEvent
(watch [_ state stream]
(let [ids (wsh/lookup-selected state {:omit-blocked? true})]
(rx/of (dch/update-shapes ids ups/convert-to-path))))))

View file

@ -6,21 +6,10 @@
(ns app.main.data.workspace.undo
(:require
[app.common.data :as d]
[app.common.geom.proportions :as gpr]
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.common.pages.spec :as spec]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.worker :as uw]
[app.main.streams :as ms]
[app.util.logging :as log]
[app.util.timers :as ts]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[cuerdas.core :as str]
[potok.core :as ptk]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -42,7 +31,7 @@
(subvec undo (- cnt MAX-UNDO-SIZE))
undo)))
(defn- materialize-undo
(defn materialize-undo
[changes index]
(ptk/reify ::materialize-undo
ptk/UpdateEvent
@ -51,15 +40,6 @@
(update :workspace-data cp/process-changes changes)
(assoc-in [:workspace-undo :index] index)))))
(defn- reset-undo
[index]
(ptk/reify ::reset-undo
ptk/UpdateEvent
(update [_ state]
(-> state
(update :workspace-undo dissoc :undo-index)
(update-in [:workspace-undo :items] (fn [queue] (into [] (take (inc index) queue))))))))
(defn- add-undo-entry
[state entry]
(if (and entry
@ -81,7 +61,7 @@
(update-in [:workspace-undo :transaction :undo-changes] #(into undo-changes %))
(update-in [:workspace-undo :transaction :redo-changes] #(into % redo-changes))))
(defn- append-undo
(defn append-undo
[entry]
(us/assert ::undo-entry entry)
(ptk/reify ::append-undo

View file

@ -15,7 +15,8 @@
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.main.ui.shapes.circle :as circle]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.embed :as embed]
[app.main.ui.shapes.export :as use]
[app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.group :as group]
[app.main.ui.shapes.image :as image]
@ -24,6 +25,8 @@
[app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.shapes.svg-raw :as svg-raw]
[app.main.ui.shapes.text :as text]
[app.main.ui.shapes.text.fontfaces :as ff]
[app.util.object :as obj]
[app.util.timers :as ts]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
@ -43,8 +46,9 @@
[{:keys [objects] :as data} vport]
(let [shapes (cp/select-toplevel-shapes objects {:include-frames? true})
to-finite (fn [val fallback] (if (not (mth/finite? val)) fallback val))
rect (->> (gsh/selection-rect shapes)
(gal/adjust-to-viewport vport))]
rect (cond->> (gsh/selection-rect shapes)
(some? vport)
(gal/adjust-to-viewport vport))]
(-> rect
(update :x to-finite 0)
(update :y to-finite 0)
@ -83,9 +87,17 @@
(mf/fnc svg-raw-wrapper
[{:keys [shape frame] :as props}]
(let [childs (mapv #(get objects %) (:shapes shape))]
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}]))))
(if (and (map? (:content shape))
(or (= :svg (get-in shape [:content :tag]))
(contains? shape :svg-attrs)))
[:> shape-container {:shape shape}
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}]]
[:& svg-raw-shape {:frame frame
:shape shape
:childs childs}])))))
(defn shape-wrapper-factory
[objects]
@ -98,9 +110,8 @@
(let [shape (-> (gsh/transform-shape shape)
(gsh/translate-to-frame frame))
opts #js {:shape shape}
svg-element? (and (= :svg-raw (:type shape))
(not= :svg (get-in shape [:content :tag])))]
(if-not svg-element?
svg-raw? (= :svg-raw (:type shape))]
(if-not svg-raw?
[:> shape-container {:shape shape}
(case (:type shape)
:text [:> text/text-shape opts]
@ -110,7 +121,6 @@
:circle [:> circle/circle-shape opts]
:frame [:> frame-wrapper {:shape shape}]
:group [:> group-wrapper {:shape shape :frame frame}]
:svg-raw [:> svg-raw-wrapper {:shape shape :frame frame}]
nil)]
;; Don't wrap svg elements inside a <g> otherwise some can break
@ -121,13 +131,20 @@
(mf/defc page-svg
{::mf/wrap [mf/memo]}
[{:keys [data width height thumbnails?] :as props}]
[{:keys [data width height thumbnails? embed?] :as props}]
(let [objects (:objects data)
root (get objects uuid/zero)
shapes (->> (:shapes root)
(map #(get objects %)))
shapes
(->> (:shapes root)
(map #(get objects %)))
vport {:width width :height height}
root-children
(->> shapes
(filter #(not= :frame (:type %)))
(mapcat #(cp/get-object-with-children (:id %) objects)))
vport (when (and (some? width) (some? height))
{:width width :height height})
dim (calculate-dimensions data vport)
vbox (get-viewbox dim)
background-color (get-in data [:options :background] default-color)
@ -140,29 +157,36 @@
(mf/use-memo
(mf/deps objects)
#(shape-wrapper-factory objects))]
[:svg {:view-box vbox
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"}
[:& background {:vbox dim :color background-color}]
(for [item shapes]
(let [frame? (= (:type item) :frame)]
(cond
(and frame? thumbnails? (some? (:thumbnail item)))
[:image {:xlinkHref (:thumbnail item)
:x (:x item)
:y (:y item)
:width (:width item)
:height (:height item)
;; DEBUG
;; :style {:filter "sepia(1)"}
}]
frame?
[:& frame-wrapper {:shape item
:key (:id item)}]
:else
[:& shape-wrapper {:shape item
:key (:id item)}])))]))
[:& (mf/provider embed/context) {:value embed?}
[:svg {:view-box vbox
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"
:xmlns:penpot "https://penpot.app/xmlns"
:style {:width "100%"
:height "100%"
:background background-color}}
[:& use/export-page {:options (:options data)}]
[:& ff/fontfaces-style {:shapes root-children}]
(for [item shapes]
(let [frame? (= (:type item) :frame)]
(cond
(and frame? thumbnails? (some? (:thumbnail item)))
[:image {:xlinkHref (:thumbnail item)
:x (:x item)
:y (:y item)
:width (:width item)
:height (:height item)
;; DEBUG
;; :style {:filter "sepia(1)"}
}]
frame?
[:& frame-wrapper {:shape item
:key (:id item)}]
:else
[:& shape-wrapper {:shape item
:key (:id item)}])))]]))
(mf/defc frame-svg
{::mf/wrap [mf/memo]}
@ -191,7 +215,8 @@
:height height
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"}
:xmlns "http://www.w3.org/2000/svg"
:xmlns:penpot "https://penpot.app/xmlns"}
[:& wrapper {:shape frame :view-box vbox}]]))
(mf/defc component-svg
@ -222,6 +247,60 @@
:height height
:version "1.1"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns "http://www.w3.org/2000/svg"}
:xmlns "http://www.w3.org/2000/svg"
:xmlns:penpot "https://penpot.app/xmlns"}
[:& wrapper {:shape group :view-box vbox}]]))
(mf/defc component-symbol
[{:keys [id data] :as props}]
(let [{:keys [name path objects]} data
root (get objects id)
{:keys [width height]} (:selrect root)
vbox (str "0 0 " width " " height)
modifier (-> (gpt/point (:x root) (:y root))
(gpt/negate)
(gmt/translate-matrix))
modifier-ids (concat [id] (cp/get-children id objects))
update-fn #(assoc-in %1 [%2 :modifiers :displacement] modifier)
objects (reduce update-fn objects modifier-ids)
root (assoc-in root [:modifiers :displacement] modifier)
group-wrapper
(mf/use-memo
(mf/deps objects)
#(group-wrapper-factory objects))]
[:> "symbol" #js {:id (str id)
:viewBox vbox
"penpot:path" path}
[:title name]
[:> shape-container {:shape root}
[:& group-wrapper {:shape root :view-box vbox}]]]))
(mf/defc components-sprite-svg
{::mf/wrap-props false}
[props]
(let [data (obj/get props "data")
children (obj/get props "children")
embed? (obj/get props "embed?")]
[:& (mf/provider embed/context) {:value embed?}
[:svg {:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot "https://penpot.app/xmlns"
:style {:width "100vw"
:height "100vh"
:display (when-not (some? children) "none")}}
[:defs
(for [[component-id component-data] (:components data)]
[:& component-symbol {:id component-id
:key (str component-id)
:data component-data}])]
children]]))

View file

@ -7,9 +7,9 @@
(ns app.main.fonts
"A fonts loading macros."
(:require
[cuerdas.core :as str]
[clojure.data.json :as json]
[clojure.java.io :as io]
[clojure.data.json :as json]))
[cuerdas.core :as str]))
(defn- parse-gfont-variant
[variant]

View file

@ -8,17 +8,18 @@
"Fonts management and loading logic."
(:require-macros [app.main.fonts :refer [preload-gfonts]])
(:require
[app.config :as cf]
[app.common.data :as d]
[app.common.text :as txt]
[app.config :as cf]
[app.util.dom :as dom]
[app.util.object :as obj]
[app.util.timers :as ts]
[app.util.http :as http]
[app.util.logging :as log]
[lambdaisland.uri :as u]
[goog.events :as gev]
[app.util.object :as obj]
[beicon.core :as rx]
[clojure.set :as set]
[cuerdas.core :as str]
[goog.events :as gev]
[lambdaisland.uri :as u]
[okulary.core :as l]
[promesa.core :as p]))
@ -102,7 +103,7 @@
[url on-loaded]
(let [node (create-link-element url)
head (.-head ^js js/document)]
(gev/listenOnce node "load" (fn [event]
(gev/listenOnce node "load" (fn [_]
(when (fn? on-loaded)
(on-loaded))))
(dom/append-child! head node)))
@ -138,7 +139,7 @@
(str base ":" variants "&display=block")))
(defmethod load-font :google
[{:keys [id family variants ::on-loaded] :as font}]
[{:keys [id ::on-loaded] :as font}]
(when (exists? js/window)
(log/debug :action "load-font" :font-id id :backend "google")
(let [url (generate-gfonts-url font)]
@ -181,11 +182,13 @@
(str/join "\n")))
(defmethod load-font :custom
[{:keys [id family variants ::on-loaded] :as font}]
[{:keys [id ::on-loaded] :as font}]
(when (exists? js/window)
(js/console.log "[debug:fonts]: loading custom font" id)
(let [css (generate-custom-font-css font)]
(add-font-css! css))))
(add-font-css! css)
(when (fn? on-loaded)
(on-loaded)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOAD API
@ -211,3 +214,62 @@
(or
(d/seek #(or (= (:id %) "regular") (= (:name %) "regular")) variants)
(first variants)))
;; Font embedding functions
;; Template for a CSS font face
(def font-face-template "
/* latin */
@font-face {
font-family: '%(family)s';
font-style: %(style)s;
font-weight: %(weight)s;
font-display: block;
src: url(/fonts/%(family)s-%(suffix)s.woff) format('woff');
}
")
(defn get-content-fonts
"Extracts the fonts used by the content of a text shape"
[{font-id :font-id children :children :as content}]
(let [current-font
(if (some? font-id)
#{(select-keys content [:font-id :font-variant-id])}
#{(select-keys txt/default-text-attrs [:font-id :font-variant-id])})
children-font (->> children (mapv get-content-fonts))]
(reduce set/union (conj children-font current-font))))
(defn fetch-font-css
"Given a font and the variant-id, retrieves the fontface CSS"
[{:keys [font-id font-variant-id]
:or {font-variant-id "regular"}}]
(let [{:keys [backend family variants]} (get @fontsdb font-id)]
(cond
(= :google backend)
(-> (generate-gfonts-url
{:family family
:variants [{:id font-variant-id}]})
(http/fetch-text))
(= :custom backend)
(let [variant (d/seek #(= (:id %) font-variant-id) variants)
result (generate-custom-font-variant-css family variant)]
(p/resolved result))
:else
(let [{:keys [weight style suffix] :as variant}
(d/seek #(= (:id %) font-variant-id) variants)
font-data {:family family
:style style
:suffix (or suffix font-variant-id)
:weight weight}]
(rx/of (str/fmt font-face-template font-data))))))
(defn extract-fontface-urls
"Parses the CSS and retrieves the font urls"
[^string css]
(->> (re-seq #"url\(([^)]+)\)" css)
(mapv second)))

View file

@ -9,12 +9,10 @@
"A collection of derived refs."
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.main.constants :as c]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.store :as st]
[beicon.core :as rx]
[okulary.core :as l]))
;; ---- Global refs
@ -80,7 +78,7 @@
(def dashboard-selected-files
(l/derived (fn [state]
(let [get-file #(get-in state [:dashboard-files %])
sim-file #(select-keys % [:id :name :project-id])
sim-file #(select-keys % [:id :name :project-id :is-shared])
selected (get-in state [:dashboard-local :selected-files])
xform (comp (map get-file)
(map sim-file))]
@ -242,7 +240,7 @@
modifiers (:workspace-modifiers state)
objects (cond-> objects
with-modifiers?
(cp/merge-modifiers modifiers))
(gsh/merge-modifiers modifiers))
xform (comp (map #(get objects %))
(remove nil?))]
(into [] xform ids)))

View file

@ -0,0 +1,86 @@
;; 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) UXBOX Labs SL
(ns app.main.render
(:require
["react-dom/server" :as rds]
[app.config :as cfg]
[app.main.exports :as exports]
[app.main.fonts :as fonts]
[app.util.http :as http]
[beicon.core :as rx]
[clojure.set :as set]
[rumext.alpha :as mf]))
(defn- text? [{type :type}]
(= type :text))
(defn- get-image-data [shape]
(cond
(= :image (:type shape))
[(:metadata shape)]
(some? (:fill-image shape))
[(:fill-image shape)]
:else
[]))
(defn populate-images-cache
[objects]
(let [images (->> objects
(vals)
(mapcat get-image-data))]
(->> (rx/from images)
(rx/map #(cfg/resolve-file-media %))
(rx/flat-map http/fetch-data-uri))))
(defn populate-fonts-cache [objects]
(let [texts (->> objects
(vals)
(filterv text?)
(mapv :content)) ]
(->> (rx/from texts)
(rx/map fonts/get-content-fonts)
(rx/reduce set/union #{})
(rx/flat-map identity)
(rx/flat-map fonts/fetch-font-css)
(rx/flat-map fonts/extract-fontface-urls)
(rx/flat-map http/fetch-data-uri))))
(defn render-page
[data]
(rx/concat
(->> (rx/merge
(populate-images-cache (:objects data))
(populate-fonts-cache (:objects data)))
(rx/ignore))
(->> (rx/of data)
(rx/map
(fn [data]
(let [elem (mf/element exports/page-svg #js {:data data :embed? true})]
(rds/renderToStaticMarkup elem)))))))
(defn render-components
[data]
(let [;; Join all components objects into a single map
objects (->> (:components data)
(vals)
(map :objects)
(reduce conj))]
(rx/concat
(->> (rx/merge
(populate-images-cache objects)
(populate-fonts-cache objects))
(rx/ignore))
(->> (rx/of data)
(rx/map
(fn [data]
(let [elem (mf/element exports/components-sprite-svg #js {:data data :embed? true})]
(rds/renderToStaticMarkup elem))))))))

View file

@ -10,10 +10,7 @@
[app.common.uri :as u]
[app.config :as cfg]
[app.util.http :as http]
[app.util.time :as dt]
[app.util.transit :as t]
[beicon.core :as rx]
[cuerdas.core :as str]))
[beicon.core :as rx]))
(defn handle-response
[{:keys [status body] :as response}]
@ -87,7 +84,7 @@
([id params] (mutation id params)))
(defmethod mutation :login-with-oauth
[id {:keys [provider] :as params}]
[_ {:keys [provider] :as params}]
(let [uri (u/join base-uri "api/auth/oauth/" (d/name provider))
params (dissoc params :provider)]
(->> (http/send! {:method :post :uri uri :query params})
@ -95,7 +92,7 @@
(rx/mapcat handle-response))))
(defmethod mutation :send-feedback
[id params]
[_ params]
(->> (http/send! {:method :post
:uri (u/join base-uri "api/feedback")
:body (http/transit-data params)})
@ -103,7 +100,7 @@
(rx/mapcat handle-response)))
(defmethod query :export
[id params]
[_ params]
(->> (http/send! {:method :post
:uri (u/join base-uri "export")
:body (http/transit-data params)

View file

@ -19,24 +19,24 @@
[beicon.core :as rx]
[clojure.set :as set]))
(defonce ^:private snap-accuracy 5)
(defonce ^:private snap-path-accuracy 10)
(defonce ^:private snap-distance-accuracy 10)
(def ^:const snap-accuracy 5)
(def ^:const snap-path-accuracy 10)
(def ^:const snap-distance-accuracy 10)
(defn- remove-from-snap-points
[remove-id?]
(fn [query-result]
(->> query-result
(map (fn [[value data]] [value (remove (comp remove-id? second) data)]))
(filter (fn [[_ data]] (not (empty? data)))))))
(filter (fn [[_ data]] (seq data))))))
(defn- flatten-to-points
[query-result]
(mapcat (fn [[v data]] (map (fn [[point _]] point) data)) query-result))
(mapcat (fn [[_ data]] (map (fn [[point _]] point) data)) query-result))
(defn- calculate-distance [query-result point coord]
(->> query-result
(map (fn [[value data]] [(mth/abs (- value (coord point))) [(coord point) value]]))))
(map (fn [[value _]] [(mth/abs (- value (coord point))) [(coord point) value]]))))
(defn- get-min-distance-snap [points coord]
(fn [query-result]
@ -45,7 +45,7 @@
(apply min-key first)
second)))
(defn- snap-frame-id [shapes]
(defn snap-frame-id [shapes]
(let [frames (into #{} (map :frame-id shapes))]
(cond
;; Only shapes from one frame. The common is the only one
@ -286,8 +286,9 @@
(fn [matches other]
(let [matches (into {} matches)
other (into {} other)
keys (set/union (keys matches) (keys other))]
other (into {} other)
keys (set/union (set (keys matches))
(set (keys other)))]
(into {}
(map (fn [key]
[key
@ -308,7 +309,7 @@
min-match-coord
(fn [matches]
(if (and (seq matches) (not (empty? matches)))
(if (seq matches)
(->> matches (reduce get-min))
default))]

View file

@ -75,12 +75,12 @@
(logjs "state" (get-in @state [:workspace-data :pages-index page-id :objects]))))
(defn ^:export dump-object [name]
(let [page-id (get @state :current-page-id)]
(let [objects (get-in @state [:workspace-data :pages-index page-id :objects])
target (or (d/seek (fn [[id shape]] (= name (:name shape))) objects)
(get objects (uuid name)))]
(->> target
(logjs "state")))))
(let [page-id (get @state :current-page-id)
objects (get-in @state [:workspace-data :pages-index page-id :objects])
target (or (d/seek (fn [[_ shape]] (= name (:name shape))) objects)
(get objects (uuid name)))]
(->> target
(logjs "state"))))
(defn ^:export dump-tree
([] (dump-tree false false))
@ -89,7 +89,7 @@
(let [page-id (get @state :current-page-id)
objects (get-in @state [:workspace-data :pages-index page-id :objects])
components (get-in @state [:workspace-data :components])
libraries (get-in @state [:workspace-libraries])
libraries (get @state :workspace-libraries)
root (d/seek #(nil? (:parent-id %)) (vals objects))]
(letfn [(show-shape [shape-id level objects]

View file

@ -7,12 +7,10 @@
(ns app.main.streams
"User interaction events and streams."
(:require
[beicon.core :as rx]
[app.main.store :as st]
[app.main.refs :as refs]
[app.common.geom.point :as gpt]
[app.util.globals :as globals]
[app.util.keyboard :as kbd]))
[app.util.keyboard :as kbd]
[beicon.core :as rx]))
;; --- User Events

View file

@ -6,15 +6,12 @@
(ns app.main.ui
(:require
[app.config :as cf]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.data.users :as du]
[app.main.data.messages :as dm]
[app.config :as cf]
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.users :as du]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.auth :refer [auth]]
@ -32,8 +29,6 @@
[app.main.ui.static :as static]
[app.main.ui.viewer :refer [viewer-page]]
[app.main.ui.workspace :as workspace]
[app.util.i18n :as i18n :refer [tr t]]
[app.util.router :as rt]
[app.util.timers :as ts]
[cljs.pprint :refer [pprint]]
[cljs.spec.alpha :as s]
@ -60,9 +55,11 @@
(def routes
[["/auth"
["/login" :auth-login]
(when cfg/registration-enabled
(when cf/registration-enabled
["/register" :auth-register])
(when cfg/registration-enabled
(when cf/registration-enabled
["/register/validate" :auth-register-validate])
(when cf/registration-enabled
["/register/success" :auth-register-success])
["/recovery/request" :auth-recovery-request]
["/recovery" :auth-recovery]
@ -85,6 +82,7 @@
;; Used for export
["/render-object/:file-id/:page-id/:object-id" :render-object]
["/render-sprite/:file-id" :render-sprite]
["/dashboard/team/:team-id"
["/members" :dashboard-team-members]
@ -100,9 +98,8 @@
(mf/defc on-main-error
[{:keys [error] :as props}]
(let [data (ex-data error)]
(mf/use-effect #(ptk/handle-error error))
[:span "Internal application errror"]))
(mf/use-effect #(ptk/handle-error error))
[:span "Internal application errror"])
(mf/defc main-page
{::mf/wrap [#(mf/catch % {:fallback on-main-error})]}
@ -112,6 +109,7 @@
(case (:name data)
(:auth-login
:auth-register
:auth-register-validate
:auth-register-success
:auth-recovery-request
:auth-recovery)
@ -145,7 +143,7 @@
:dashboard-team-settings)
[:*
#_[:div.modal-wrapper
[:& app.main.ui.onboarding/release-notes-modal {:version "1.6"}]]
[:& app.main.ui.onboarding/release-notes-modal {:version "1.7"}]]
[:& dashboard {:route route}]]
:viewer
@ -175,6 +173,14 @@
:page-id page-id
:object-id object-id}]))
:render-sprite
(do
(let [file-id (uuid (get-in route [:path-params :file-id]))
component-id (get-in route [:query-params :component-id])
component-id (when (some? component-id) (uuid component-id))]
[:& render/render-sprite {:file-id file-id
:component-id component-id}]))
:workspace
(let [project-id (some-> params :path :project-id uuid)
file-id (some-> params :path :file-id uuid)
@ -208,14 +214,14 @@
(derive :service-unavailable ::exceptional-state)
(defmethod ptk/handle-error ::exceptional-state
[{:keys [status] :as error}]
[error]
(ts/schedule
(st/emitf (dm/assign-exception error))))
;; We receive a explicit authentication error; this explicitly clears
;; all profile data and redirect the user to the login page.
(defmethod ptk/handle-error :authentication
[error]
[_]
(ts/schedule (st/emitf (du/logout))))
;; Error that happens on an active bussines model validation does not
@ -242,7 +248,7 @@
;; Error on parsing an SVG
(defmethod ptk/handle-error :svg-parser
[error]
[_]
(ts/schedule
(st/emitf
(dm/show {:content "SVG is invalid or malformed"
@ -258,7 +264,7 @@
context (str/fmt "ns: '%s'\nname: '%s'\nfile: '%s:%s'"
(:ns context)
(:name context)
(str cfg/public-uri "js/cljs-runtime/" (:file context))
(str cf/public-uri "js/cljs-runtime/" (:file context))
(:line context))]
(ts/schedule
(st/emitf

View file

@ -6,43 +6,35 @@
(ns app.main.ui.auth
(:require
[app.common.uuid :as uuid]
[app.main.data.messages :as dm]
[app.main.data.users :as du]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.auth.login :refer [login-page]]
[app.main.ui.auth.recovery :refer [recovery-page]]
[app.main.ui.auth.recovery-request :refer [recovery-request-page]]
[app.main.ui.auth.register :refer [register-page register-success-page]]
[app.main.ui.auth.register :refer [register-page register-success-page register-validate-page]]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.forms :as fm]
[app.util.i18n :as i18n :refer [t]]
[app.util.router :as rt]
[app.util.timers :as ts]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[app.util.i18n :as i18n :refer [tr]]
[rumext.alpha :as mf]))
(mf/defc auth
[{:keys [route] :as props}]
(let [section (get-in route [:data :name])
locale (mf/deref i18n/locale)
params (:query-params route)]
(mf/use-effect
#(dom/set-html-title (t locale "title.default")))
#(dom/set-html-title (tr "title.default")))
[:div.auth
[:section.auth-sidebar
[:a.logo {:href "https://penpot.app"} i/logo]
[:span.tagline (t locale "auth.sidebar-tagline")]]
[:span.tagline (tr "auth.sidebar-tagline")]]
[:section.auth-content
(case section
:auth-register
[:& register-page {:locale locale :params params}]
[:& register-page {:params params}]
:auth-register-validate
[:& register-validate-page {:params params}]
:auth-register-success
[:& register-success-page {:params params}]
@ -51,10 +43,11 @@
[:& login-page {:params params}]
:auth-recovery-request
[:& recovery-request-page {:locale locale}]
[:& recovery-request-page]
:auth-recovery
[:& recovery-page {:locale locale :params params}])
[:& recovery-page {:params params}])
[:div.terms-login
[:a {:href "https://penpot.app/terms.html" :target "_blank"} "Terms of service"]
[:span "and"]

View file

@ -16,13 +16,18 @@
[app.main.ui.icons :as i]
[app.main.ui.messages :as msgs]
[app.util.dom :as dom]
[app.util.i18n :refer [tr t]]
[app.util.object :as obj]
[app.util.i18n :refer [tr]]
[app.util.router :as rt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[rumext.alpha :as mf]))
(def show-alt-login-buttons?
(or cfg/google-client-id
cfg/gitlab-client-id
cfg/github-client-id
cfg/oidc-client-id))
(s/def ::email ::us/email)
(s/def ::password ::us/not-empty-string)
@ -68,7 +73,7 @@
on-submit
(mf/use-callback
(mf/deps form)
(fn [event]
(fn [_]
(reset! error nil)
(let [params (with-meta (:clean-data @form)
{:on-error on-error})]
@ -103,13 +108,15 @@
:tab-index "3"
:help-icon i/eye
:label (tr "auth.password")}]]
[:& fm/submit-button
{:label (tr "auth.login-submit")}]
(when cfg/login-with-ldap
[:& fm/submit-button
{:label (tr "auth.login-with-ldap-submit")
:on-click on-submit-ldap}])]]))
[:div.buttons-stack
[:& fm/submit-button
{:label (tr "auth.login-submit")}]
(when cfg/login-with-ldap
[:& fm/submit-button
{:label (tr "auth.login-with-ldap-submit")
:on-click on-submit-ldap}])]]]))
(mf/defc login-buttons
[{:keys [params] :as props}]
@ -147,6 +154,13 @@
[:& login-form {:params params}]
(when show-alt-login-buttons?
[:*
[:span.separator (tr "labels.or")]
[:div.buttons
[:& login-buttons {:params params}]]])
[:div.links
[:div.link-entry
[:a {:on-click #(st/emit! (rt/nav :auth-recovery-request))}
@ -158,7 +172,6 @@
[:a {:on-click #(st/emit! (rt/nav :auth-register {} params))}
(tr "auth.register-submit")]])]
[:& login-buttons {:params params}]
(when cfg/allow-demo-users
[:div.links.demo

View file

@ -11,12 +11,9 @@
[app.main.data.users :as du]
[app.main.store :as st]
[app.main.ui.components.forms :as fm]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t tr]]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(s/def ::password-1 ::us/not-empty-string)
@ -40,7 +37,7 @@
(assoc :password-1 {:message "errors.password-too-short"}))))
(defn- on-error
[form error]
[_form _error]
(st/emit! (dm/error (tr "auth.notifications.invalid-token-error"))))
(defn- on-success
@ -49,7 +46,7 @@
(rt/nav :auth-login)))
(defn- on-submit
[form event]
[form _event]
(let [mdata {:on-error on-error
:on-success on-success}
params {:token (get-in @form [:clean-data :token])
@ -57,7 +54,7 @@
(st/emit! (du/recover-profile (with-meta params mdata)))))
(mf/defc recovery-form
[{:keys [locale params] :as props}]
[{:keys [params] :as props}]
(let [form (fm/use-form :spec ::recovery-form
:validators [password-equality]
:initial params)]
@ -66,28 +63,28 @@
[:div.fields-row
[:& fm/input {:type "password"
:name :password-1
:label (t locale "auth.new-password")}]]
:label (tr "auth.new-password")}]]
[:div.fields-row
[:& fm/input {:type "password"
:name :password-2
:label (t locale "auth.confirm-password")}]]
:label (tr "auth.confirm-password")}]]
[:& fm/submit-button
{:label (t locale "auth.recovery-submit")}]]))
{:label (tr "auth.recovery-submit")}]]))
;; --- Recovery Request Page
(mf/defc recovery-page
[{:keys [locale params] :as props}]
[{:keys [params] :as props}]
[:section.generic-form
[:div.form-container
[:h1 "Forgot your password?"]
[:div.subtitle "Please enter your new password"]
[:& recovery-form {:locale locale :params params}]
[:& recovery-form {:params params}]
[:div.links
[:div.link-entry
[:a {:on-click #(st/emit! (rt/nav :auth-login))}
(t locale "profile.recovery.go-to-login")]]]]])
(tr "profile.recovery.go-to-login")]]]]])

View file

@ -12,12 +12,10 @@
[app.main.store :as st]
[app.main.ui.components.forms :as fm]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr t]]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(s/def ::email ::us/email)
@ -30,7 +28,7 @@
on-success
(mf/use-callback
(fn [data]
(fn [_ _]
(reset! submitted false)
(st/emit! (dm/info (tr "auth.notifications.recovery-token-sent"))
(rt/nav :auth-login))))
@ -86,4 +84,4 @@
[:div.links
[:div.link-entry
[:a {:on-click #(st/emit! (rt/nav :auth-login))}
(tr "auth.go-back-to-login")]]]]])
(tr "labels.go-back")]]]]])

View file

@ -7,21 +7,19 @@
(ns app.main.ui.auth.register
(:require
[app.common.spec :as us]
[app.config :as cfg]
[app.main.data.users :as du]
[app.config :as cf]
[app.main.data.messages :as dm]
[app.main.data.users :as du]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.auth.login :as login]
[app.main.ui.components.forms :as fm]
[app.main.ui.icons :as i]
[app.main.ui.messages :as msgs]
[app.main.ui.auth.login :as login]
[app.util.dom :as dom]
[app.util.i18n :refer [tr t]]
[app.util.i18n :refer [tr]]
[app.util.router :as rt]
[app.util.timers :as tm]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(mf/defc demo-warning
@ -30,6 +28,8 @@
{:type :warning
:content (tr "auth.demo-warning")}])
;; --- PAGE: Register
(defn- validate
[data]
(let [password (:password data)
@ -48,9 +48,29 @@
(s/def ::terms-privacy ::us/boolean)
(s/def ::register-form
(s/keys :req-un [::password ::fullname ::email ::terms-privacy]
(s/keys :req-un [::password ::email]
:opt-un [::invitation-token]))
(defn- handle-prepare-register-error
[form error]
(case (:code error)
:registration-disabled
(st/emit! (dm/error (tr "errors.registration-disabled")))
:email-has-permanent-bounces
(let [email (get @form [:data :email])]
(st/emit! (dm/error (tr "errors.email-has-permanent-bounces" email))))
:email-already-exists
(swap! form assoc-in [:errors :email]
{:message "errors.email-already-exists"})
(st/emit! (dm/error (tr "errors.generic")))))
(defn- handle-prepare-register-success
[_form {:keys [token] :as result}]
(st/emit! (rt/nav :auth-register-validate {} {:token token})))
(mf/defc register-form
[{:keys [params] :as props}]
(let [initial (mf/use-memo (mf/deps params) (constantly params))
@ -59,49 +79,20 @@
:initial initial)
submitted? (mf/use-state false)
on-error
(mf/use-callback
(fn [form error]
(reset! submitted? false)
(case (:code error)
:registration-disabled
(rx/of (dm/error (tr "errors.registration-disabled")))
:email-has-permanent-bounces
(let [email (get @form [:data :email])]
(rx/of (dm/error (tr "errors.email-has-permanent-bounces" email))))
:email-already-exists
(swap! form assoc-in [:errors :email]
{:message "errors.email-already-exists"})
(rx/throw error))))
on-success
(mf/use-callback
(fn [form data]
(reset! submitted? false)
(if-let [token (:invitation-token data)]
(st/emit! (rt/nav :auth-verify-token {} {:token token}))
(st/emit! (rt/nav :auth-register-success {} {:email (:email data)})))))
on-submit
(mf/use-callback
(fn [form event]
(fn [form _event]
(reset! submitted? true)
(let [data (with-meta (:clean-data @form)
{:on-error (partial on-error form)
:on-success (partial on-success form)})]
(st/emit! (du/register data)))))]
(let [params (:clean-data @form)]
(->> (rp/mutation :prepare-register-profile params)
(rx/finalize #(reset! submitted? false))
(rx/subs (partial handle-prepare-register-success form)
(partial handle-prepare-register-error form))))))
]
[:& fm/form {:on-submit on-submit
:form form}
[:div.fields-row
[:& fm/input {:name :fullname
:tab-index "1"
:label (tr "auth.fullname")
:type "text"}]]
[:div.fields-row
[:& fm/input {:type "email"
:name :email
@ -115,18 +106,141 @@
:label (tr "auth.password")
:type "password"}]]
[:& fm/submit-button
{:label (tr "auth.register-submit")
:disabled @submitted?}]]))
(mf/defc register-page
[{:keys [params] :as props}]
[:div.form-container
[:h1 (tr "auth.register-title")]
[:div.subtitle (tr "auth.register-subtitle")]
(when cf/demo-warning
[:& demo-warning])
[:& register-form {:params params}]
(when login/show-alt-login-buttons?
[:*
[:span.separator (tr "labels.or")]
[:div.buttons
[:& login/login-buttons {:params params}]]])
[:div.links
[:div.link-entry
[:span (tr "auth.already-have-account") " "]
[:a {:on-click #(st/emit! (rt/nav :auth-login {} params))
:tab-index "4"}
(tr "auth.login-here")]]
(when cf/allow-demo-users
[:div.link-entry
[:span (tr "auth.create-demo-profile") " "]
[:a {:on-click #(st/emit! (du/create-demo-profile))
:tab-index "5"}
(tr "auth.create-demo-account")]])]])
;; --- PAGE: register validation
(defn- handle-register-error
[form error]
(case (:code error)
:registration-disabled
(st/emit! (dm/error (tr "errors.registration-disabled")))
:email-has-permanent-bounces
(let [email (get @form [:data :email])]
(st/emit! (dm/error (tr "errors.email-has-permanent-bounces" email))))
:email-already-exists
(swap! form assoc-in [:errors :email]
{:message "errors.email-already-exists"})
(do
(println (:explain error))
(st/emit! (dm/error (tr "errors.generic"))))))
(defn- handle-register-success
[_form data]
(cond
(some? (:invitation-token data))
(let [token (:invitation-token data)]
(st/emit! (rt/nav :auth-verify-token {} {:token token})))
(not= "penpot" (:auth-backend data))
(st/emit! (du/login-from-register))
:else
(st/emit! (rt/nav :auth-register-success {} {:email (:email data)}))))
(s/def ::accept-terms-and-privacy (s/and ::us/boolean true?))
(s/def ::accept-newsletter-subscription ::us/boolean)
(s/def ::register-validate-form
(s/keys :req-un [::token ::fullname ::accept-terms-and-privacy]
:opt-un [::accept-newsletter-subscription]))
(mf/defc register-validate-form
[{:keys [params] :as props}]
(let [initial (mf/use-memo
(mf/deps params)
(fn []
(assoc params :accept-newsletter-subscription false)))
form (fm/use-form :spec ::register-validate-form
:initial initial)
submitted? (mf/use-state false)
on-submit
(mf/use-callback
(fn [form _event]
(reset! submitted? true)
(let [params (:clean-data @form)]
(->> (rp/mutation :register-profile params)
(rx/finalize #(reset! submitted? false))
(rx/subs (partial handle-register-success form)
(partial handle-register-error form))))))
]
[:& fm/form {:on-submit on-submit
:form form}
[:div.fields-row
[:& fm/input {:name :terms-privacy
[:& fm/input {:name :fullname
:tab-index "1"
:label (tr "auth.fullname")
:type "text"}]]
[:div.fields-row
[:& fm/input {:name :accept-terms-and-privacy
:class "check-primary"
:tab-index "4"
:label (tr "auth.terms-privacy-agreement")
:type "checkbox"}]]
(when (contains? @cf/flags :show-newsletter-check-on-register-validation)
[:div.fields-row
[:& fm/input {:name :accept-newsletter-subscription
:class "check-primary"
:label (tr "auth.newsletter-subscription")
:type "checkbox"}]])
[:& fm/submit-button
{:label (tr "auth.register-submit")
:disabled @submitted?}]]))
;; --- Register Page
(mf/defc register-validate-page
[{:keys [params] :as props}]
[:div.form-container
[:h1 (tr "auth.register-title")]
[:div.subtitle (tr "auth.register-subtitle")]
[:& register-validate-form {:params params}]
[:div.links
[:div.link-entry
[:a {:on-click #(st/emit! (rt/nav :auth-register {} {}))
:tab-index "4"}
(tr "labels.go-back")]]]])
(mf/defc register-success-page
[{:keys [params] :as props}]
@ -136,32 +250,3 @@
[:div.notification-text-email (:email params "")]
[:div.notification-text (tr "auth.check-your-email")]])
(mf/defc register-page
[{:keys [params] :as props}]
[:div.form-container
[:h1 (tr "auth.register-title")]
[:div.subtitle (tr "auth.register-subtitle")]
(when cfg/demo-warning
[:& demo-warning])
[:& register-form {:params params}]
[:div.links
[:div.link-entry
[:span (tr "auth.already-have-account") " "]
[:a {:on-click #(st/emit! (rt/nav :auth-login {} params))
:tab-index "4"}
(tr "auth.login-here")]]
(when cfg/allow-demo-users
[:div.link-entry
[:span (tr "auth.create-demo-profile") " "]
[:a {:on-click #(st/emit! (du/create-demo-profile))
:tab-index "5"}
(tr "auth.create-demo-account")]])
[:& login/login-buttons {:params params}]]])

View file

@ -6,23 +6,16 @@
(ns app.main.ui.auth.verify-token
(:require
[app.common.uuid :as uuid]
[app.main.data.messages :as dm]
[app.main.data.users :as du]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.auth.login :refer [login-page]]
[app.main.ui.auth.recovery :refer [recovery-page]]
[app.main.ui.auth.recovery-request :refer [recovery-request-page]]
[app.main.ui.auth.register :refer [register-page]]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.forms :as fm]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[app.util.timers :as ts]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[rumext.alpha :as mf]))
(defmulti handle-token (fn [token] (:iss token)))
@ -34,7 +27,7 @@
(st/emit! (du/login-from-token data))))
(defmethod handle-token :change-email
[data]
[_data]
(let [msg (tr "dashboard.notifications.email-changed-successfully")]
(ts/schedule 100 #(st/emit! (dm/success msg)))
(st/emit! (rt/nav :settings-profile)
@ -57,7 +50,7 @@
(st/emit! (rt/nav :auth-register {} {:invitation-token token})))))
(defmethod handle-token :default
[tdata]
[_tdata]
(st/emit!
(rt/nav :auth-login)
(dm/warn (tr "errors.unexpected-token"))))

View file

@ -11,16 +11,13 @@
[app.main.data.modal :as modal]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.context :as ctx]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t tr]]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.object :as obj]
[app.util.time :as dt]
[cuerdas.core :as str]
[okulary.core :as l]
[rumext.alpha :as mf]))
@ -105,7 +102,7 @@
:on-focus on-focus
:on-change on-change}]
(when (or @show-buttons?
(not (empty? @content)))
(seq @content))
[:div.buttons
[:input.btn-primary {:type "button" :value "Post" :on-click on-submit}]
[:input.btn-secondary {:type "button" :value "Cancel" :on-click on-cancel}]])]))
@ -323,7 +320,7 @@
(mf/defc thread-bubble
{::mf/wrap [mf/memo]}
[{:keys [thread zoom open? on-click] :as params}]
[{:keys [thread zoom on-click] :as params}]
(let [pos (:position thread)
pos-x (* (:x pos) zoom)
pos-y (* (:y pos) zoom)

View file

@ -6,9 +6,9 @@
(ns app.main.ui.components.color-bullet
(:require
[rumext.alpha :as mf]
[app.util.color :as uc]
[app.util.i18n :as i18n :refer [tr]]
[app.util.color :as uc]))
[rumext.alpha :as mf]))
(mf/defc color-bullet [{:keys [color on-click]}]
(if (uc/multiple? color)
@ -31,7 +31,7 @@
(mf/defc color-name [{:keys [color size on-click on-double-click]}]
(let [color (if (string? color) {:color color :opacity 1} color)
{:keys [name color opacity gradient]} color
{:keys [name color gradient]} color
color-str (or name color (gradient-type->string (:type gradient)))]
(when (or (not size) (= size :big))
[:span.color-text {:on-click #(when on-click (on-click %))

View file

@ -6,62 +6,57 @@
(ns app.main.ui.components.color-input
(:require
[app.common.data :as d]
[app.common.math :as math]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.util.color :as uc]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.object :as obj]
[app.util.simple-math :as sm]
[app.util.i18n :as i18n :refer [tr]]
[rumext.alpha :as mf]))
(mf/defc color-input
{::mf/wrap-props false
::mf/forward-ref true}
[props external-ref]
(let [value (obj/get props "value")
(let [value (obj/get props "value")
on-change (obj/get props "onChange")
;; We need a ref pointing to the input dom element, but the user
;; of this component may provide one (that is forwarded here).
;; So we use the external ref if provided, and the local one if not.
local-ref (mf/use-ref)
ref (or external-ref local-ref)
ref (or external-ref local-ref)
parse-value
(mf/use-callback
(mf/deps ref)
(fn []
(let [input-node (mf/ref-val ref)]
(try
(let [new-value (-> (dom/get-value input-node)
(uc/expand-hex)
(uc/parse-color)
(uc/prepend-hash))]
(dom/set-validity! input-node "")
new-value)
(catch :default _
(dom/set-validity! input-node (tr "errors.invalid-color"))
nil)))))
(mf/deps ref)
(fn []
(let [input-node (mf/ref-val ref)]
(try
(let [new-value (-> (dom/get-value input-node)
(uc/expand-hex)
(uc/parse-color)
(uc/prepend-hash))]
(dom/set-validity! input-node "")
new-value)
(catch :default _e
(dom/set-validity! input-node (tr "errors.invalid-color"))
nil)))))
update-input
(mf/use-callback
(mf/deps ref)
(fn [new-value]
(let [input-node (mf/ref-val ref)]
(dom/set-value! input-node (uc/remove-hash new-value)))))
(mf/deps ref)
(fn [new-value]
(let [input-node (mf/ref-val ref)]
(dom/set-value! input-node (uc/remove-hash new-value)))))
apply-value
(mf/use-callback
(mf/deps on-change update-input)
(fn [new-value]
(when new-value
(when on-change
(on-change new-value))
(update-input new-value))))
(mf/deps on-change update-input)
(fn [new-value]
(when new-value
(when on-change
(on-change new-value))
(update-input new-value))))
handle-key-down
(mf/use-callback
@ -79,12 +74,12 @@
handle-blur
(mf/use-callback
(mf/deps parse-value apply-value update-input)
(fn [event]
(let [new-value (parse-value)]
(if new-value
(apply-value new-value)
(update-input value)))))
(mf/deps parse-value apply-value update-input)
(fn [_]
(let [new-value (parse-value)]
(if new-value
(apply-value new-value)
(update-input value)))))
;; list-id (str "colors-" (uuid/next))
@ -97,6 +92,12 @@
(obj/set! "onKeyDown" handle-key-down)
(obj/set! "onBlur" handle-blur))]
(mf/use-effect
(mf/deps value)
(fn []
(when-let [node (mf/ref-val ref)]
(dom/set-value! node value))))
[:*
[:> :input props]
;; FIXME: this causes some weird interactions because of using apply-value

View file

@ -6,13 +6,12 @@
(ns app.main.ui.components.context-menu
(:require
[rumext.alpha :as mf]
[goog.object :as gobj]
[app.main.ui.components.dropdown :refer [dropdown']]
[app.main.ui.icons :as i]
[app.common.uuid :as uuid]
[app.util.dom :as dom]
[app.util.object :as obj]))
[app.util.object :as obj]
[goog.object :as gobj]
[rumext.alpha :as mf]))
(mf/defc context-menu
{::mf/wrap-props false}
@ -52,7 +51,7 @@
(- node-height)
0)]
(if (not= target-offset (:offset @local))
(when (not= target-offset (:offset @local))
(swap! local assoc :offset target-offset))))))
enter-submenu
@ -105,7 +104,9 @@
{:class (dom/classnames :is-selected (and selected (= option-name selected)))
:key option-name}
(if-not sub-options
[:a.context-menu-action {:on-click option-handler}
[:a.context-menu-action {:on-click #(do (dom/stop-propagation %)
(on-close)
(option-handler %))}
option-name]
[:a.context-menu-action.submenu
{:data-no-close true

View file

@ -6,11 +6,11 @@
(ns app.main.ui.components.copy-button
(:require
[beicon.core :as rx]
[rumext.alpha :as mf]
[app.util.webapi :as wapi]
[app.main.ui.icons :as i]
[app.util.timers :as timers]
[app.main.ui.icons :as i]))
[app.util.webapi :as wapi]
[beicon.core :as rx]
[rumext.alpha :as mf]))
(mf/defc copy-button [{:keys [data]}]
(let [just-copied (mf/use-state false)]
@ -24,9 +24,8 @@
[:button.copy-button
{:on-click #(when-not @just-copied
(do
(reset! just-copied true)
(wapi/write-to-clipboard data)))}
(reset! just-copied true)
(wapi/write-to-clipboard data))}
(if @just-copied
i/tick
i/copy)]))

View file

@ -1,11 +1,16 @@
;; 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) UXBOX Labs SL
(ns app.main.ui.components.dropdown
(:require
[rumext.alpha :as mf]
[app.common.uuid :as uuid]
[app.util.dom :as dom]
[app.util.keyboard :as kbd]
[goog.events :as events]
[goog.object :as gobj])
[goog.object :as gobj]
[rumext.alpha :as mf])
(:import goog.events.EventType))
(mf/defc dropdown'

View file

@ -7,7 +7,6 @@
(ns app.main.ui.components.editable-label
(:require
[app.main.ui.icons :as i]
[app.util.data :refer [classnames]]
[app.util.dom :as dom]
[app.util.keyboard :as kbd]
[app.util.timers :as timers]
@ -32,7 +31,7 @@
cancel-editing (fn []
(stop-editing)
(when on-cancel (on-cancel)))
on-dbl-click (fn [e] (when (not disable-dbl-click?) (start-editing)))
on-dbl-click (fn [_] (when (not disable-dbl-click?) (start-editing)))
on-key-up (fn [e]
(cond
(kbd/esc? e)

View file

@ -6,13 +6,13 @@
(ns app.main.ui.components.editable-select
(:require
[rumext.alpha :as mf]
[app.common.uuid :as uuid]
[app.common.data :as d]
[app.common.uuid :as uuid]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.timers :as timers]
[app.main.ui.icons :as i]
[app.main.ui.components.dropdown :refer [dropdown]]))
[rumext.alpha :as mf]))
(mf/defc editable-select [{:keys [value type options class on-change placeholder]}]
(let [state (mf/use-state {:id (uuid/next)
@ -24,7 +24,7 @@
open-dropdown #(swap! state assoc :is-open? true)
close-dropdown #(swap! state assoc :is-open? false)
select-item (fn [value]
(fn [event]
(fn [_]
(swap! state assoc :current-value value)
(when on-change (on-change value))))

View file

@ -6,23 +6,26 @@
(ns app.main.ui.components.file-uploader
(:require
[rumext.alpha :as mf]
[app.main.data.workspace :as dw]
[app.main.store :as st]
[app.util.dom :as dom]))
[app.util.dom :as dom]
[rumext.alpha :as mf]))
(mf/defc file-uploader
[{:keys [accept multi label-text label-class input-id input-ref on-selected] :as props}]
{::mf/forward-ref true}
[{:keys [accept multi label-text label-class input-id on-selected] :as props} input-ref]
(let [opt-pick-one #(if multi % (first %))
on-files-selected (fn [event]
(let [target (dom/get-target event)]
(st/emit!
(some-> target
(dom/get-files)
(opt-pick-one)
(on-selected)))
(dom/clean-value! target)))]
on-files-selected
(mf/use-callback
(mf/deps opt-pick-one)
(fn [event]
(let [target (dom/get-target event)]
(st/emit!
(some-> target
(dom/get-files)
(opt-pick-one)
(on-selected)))
(dom/clean-value! target))))]
[:*
(when label-text
[:label {:for input-id :class-name label-class} label-text])

View file

@ -8,7 +8,6 @@
(:require
[app.util.dom :as dom]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[rumext.alpha :as mf]))
(def fullscreen-context
@ -21,7 +20,7 @@
change
(mf/use-callback
(fn [event]
(fn [_]
(let [val (dom/fullscreen?)]
(reset! state val))))

View file

@ -70,11 +70,11 @@
apply-value
(mf/use-callback
(mf/deps on-change update-input)
(mf/deps on-change update-input value)
(fn [new-value]
(when new-value
(when on-change
(on-change new-value))
(when (and (some? new-value) (not= new-value value) (some? on-change))
(on-change new-value))
(when (some? new-value)
(update-input new-value))))
set-delta
@ -132,7 +132,7 @@
handle-blur
(mf/use-callback
(mf/deps parse-value apply-value update-input)
(fn [event]
(fn [_]
(let [new-value (parse-value)]
(if new-value
(apply-value new-value)

View file

@ -6,10 +6,10 @@
(ns app.main.ui.components.select
(:require
[rumext.alpha :as mf]
[app.common.uuid :as uuid]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.icons :as i]
[app.main.ui.components.dropdown :refer [dropdown]]))
[rumext.alpha :as mf]))
(mf/defc select [{:keys [default-value options class on-change]}]
(let [state (mf/use-state {:id (uuid/next)
@ -17,9 +17,10 @@
:current-value default-value})
open-dropdown #(swap! state assoc :is-open? true)
close-dropdown #(swap! state assoc :is-open? false)
select-item (fn [value] (fn [event]
(swap! state assoc :current-value value)
(when on-change (on-change value))))
select-item (fn [value]
(fn [_]
(swap! state assoc :current-value value)
(when on-change (on-change value))))
as-key-value (fn [item] (if (map? item) [(:value item) (:label item)] [item item]))
value->label (into {} (->> options
(map as-key-value))) ]

View file

@ -8,7 +8,7 @@
(:require [rumext.alpha :as mf]))
(mf/defc tab-element
[{:keys [children id title]}]
[{:keys [children]}]
[:div.tab-element
[:div.tab-element-content children]])

View file

@ -9,7 +9,6 @@
[app.main.data.modal :as modal]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.util.data :refer [classnames]]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr t]]
[app.util.keyboard :as k]
@ -57,10 +56,10 @@
(let [on-keydown
(fn [event]
(when (k/enter? event)
(do (dom/prevent-default event)
(dom/stop-propagation event)
(st/emit! (modal/hide))
(on-accept props))))
(dom/prevent-default event)
(dom/stop-propagation event)
(st/emit! (modal/hide))
(on-accept props)))
key (events/listen js/document EventType.KEYDOWN on-keydown)]
#(events/unlistenByKey key))))
@ -86,9 +85,9 @@
:on-click cancel-fn}])
[:input.accept-button
{:class (classnames :danger (= accept-style :danger)
:primary (= accept-style :primary))
{:class (dom/classnames
:danger (= accept-style :danger)
:primary (= accept-style :primary))
:type "button"
:value accept-label
:on-click accept-fn}]]]]]))

View file

@ -8,7 +8,6 @@
(:require
[rumext.alpha :as mf]))
(def embed-ctx (mf/create-context false))
(def render-ctx (mf/create-context nil))
(def def-ctx (mf/create-context false))

View file

@ -6,9 +6,9 @@
(ns app.main.ui.cursors
(:require
[app.common.uri :as u]
[clojure.java.io :as io]
[cuerdas.core :as str]
[app.common.uri :as u]))
[cuerdas.core :as str]))
(def cursor-folder "images/cursors")

View file

@ -6,9 +6,10 @@
(ns app.main.ui.cursors
(:require-macros [app.main.ui.cursors :refer [cursor-ref cursor-fn]])
(:require [rumext.alpha :as mf]
[cuerdas.core :as str]
[app.util.timers :as ts]))
(:require
[app.util.timers :as ts]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
;; Static cursors
(def comments (cursor-ref :comments 0 2 20))
@ -40,7 +41,7 @@
(mf/defc debug-preview
{::mf/wrap-props false}
[props]
[]
(let [rotation (mf/use-state 0)]
(mf/use-effect (fn [] (ts/interval 100 #(reset! rotation inc))))

View file

@ -6,29 +6,23 @@
(ns app.main.ui.dashboard
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.dashboard :as dd]
[app.main.data.modal :as modal]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.context :as ctx]
[app.main.ui.dashboard.export]
[app.main.ui.dashboard.files :refer [files-section]]
[app.main.ui.dashboard.fonts :refer [fonts-page font-providers-page]]
[app.main.ui.dashboard.import]
[app.main.ui.dashboard.libraries :refer [libraries-page]]
[app.main.ui.dashboard.projects :refer [projects-section]]
[app.main.ui.dashboard.fonts :refer [fonts-page font-providers-page]]
[app.main.ui.dashboard.search :refer [search-page]]
[app.main.ui.dashboard.sidebar :refer [sidebar]]
[app.main.ui.dashboard.team :refer [team-settings-page team-members-page]]
[app.main.ui.icons :as i]
[app.util.i18n :as i18n :refer [t]]
[app.util.router :as rt]
[app.util.timers :as tm]
[beicon.core :as rx]
[cuerdas.core :as str]
[okulary.core :as l]
[rumext.alpha :as mf]))
(defn ^boolean uuid-str?
@ -37,9 +31,8 @@
(boolean (re-seq us/uuid-rx s))))
(defn- parse-params
[route profile]
(let [route-name (get-in route [:data :name])
search-term (get-in route [:params :query :search-term])
[route]
(let [search-term (get-in route [:params :query :search-term])
team-id (get-in route [:params :path :team-id])
project-id (get-in route [:params :path :project-id])]
(cond->
@ -87,7 +80,7 @@
[{:keys [route] :as props}]
(let [profile (mf/deref refs/profile)
section (get-in route [:data :name])
params (parse-params route profile)
params (parse-params route)
project-id (:project-id params)
team-id (:team-id params)
@ -140,4 +133,3 @@
:section section
:search-term search-term
:team team}])])]]))

View file

@ -6,29 +6,15 @@
(ns app.main.ui.dashboard.comments
(:require
[okulary.core :as l]
[app.common.data :as d]
[app.common.spec :as us]
[app.config :as cfg]
[app.main.data.dashboard :as dd]
[app.main.data.workspace :as dw]
[app.main.data.workspace.comments :as dwcm]
[app.main.data.comments :as dcm]
[app.main.data.workspace.comments :as dwcm]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.comments :as cmt]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t tr]]
[app.util.object :as obj]
[app.util.router :as rt]
[app.util.time :as dt]
[app.util.timers :as tm]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[app.util.i18n :as i18n :refer [tr]]
[rumext.alpha :as mf]))
(mf/defc comments-section

View file

@ -0,0 +1,154 @@
;; 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) UXBOX Labs SL
(ns app.main.ui.dashboard.export
(:require
[app.common.data :as d]
[app.main.data.modal :as modal]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.main.worker :as uw]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[beicon.core :as rx]
[rumext.alpha :as mf]))
(def ^:const options [:all :merge :detach])
(mf/defc export-entry
[{:keys [file]}]
[:div.file-entry
{:class (dom/classnames
:loading (:loading? file)
:success (:export-success? file)
:error (:export-error? file))}
[:div.file-name
[:div.file-icon
(cond (:export-success? file) i/tick
(:export-error? file) i/close
(:loading? file) i/loader-pencil)]
[:div.file-name-label (:name file)]]])
(defn mark-file-error [files file-id]
(->> files
(mapv #(cond-> %
(= file-id (:id %))
(assoc :export-error? true
:loading? false)))))
(defn mark-file-success [files file-id]
(->> files
(mapv #(cond-> %
(= file-id (:id %))
(assoc :export-success? true
:loading? false)))))
(mf/defc export-dialog
{::mf/register modal/components
::mf/register-as :export}
[{:keys [team-id files has-libraries?]}]
(let [state (mf/use-state {:status :prepare
:files (->> files (mapv #(assoc % :loading? true)))})
selected-option (mf/use-state :all)
start-export
(fn []
(swap! state assoc :status :exporting)
(->> (uw/ask-many!
{:cmd :export-file
:team-id team-id
:export-type @selected-option
:files (->> files (mapv :id))})
(rx/delay-emit 1000)
(rx/subs
(fn [msg]
(when (= :error (:type msg))
(swap! state update :files mark-file-error (:file-id msg)))
(when (= :finish (:type msg))
(swap! state update :files mark-file-success (:file-id msg))
(dom/trigger-download-uri (:filename msg) (:mtype msg) (:uri msg)))))))
cancel-fn
(mf/use-callback
(fn [event]
(dom/prevent-default event)
(st/emit! (modal/hide))))
accept-fn
(mf/use-callback
(mf/deps @selected-option)
(fn [event]
(dom/prevent-default event)
(start-export)))
on-change-handler
(mf/use-callback
(fn [_ type]
(reset! selected-option type)))]
(mf/use-effect
(fn []
(when-not has-libraries?
;; Start download automaticaly
(start-export))))
[:div.modal-overlay
[:div.modal-container.export-dialog
[:div.modal-header
[:div.modal-header-title
[:h2 (tr "dashboard.export.title")]]
[:div.modal-close-button
{:on-click cancel-fn} i/close]]
(cond
(= (:status @state) :prepare)
[:*
[:div.modal-content
[:p.explain (tr "dashboard.export.explain")]
[:p.detail (tr "dashboard.export.detail")]
(for [type [:all :merge :detach]]
(let [selected? (= @selected-option type)]
[:div.export-option {:class (when selected? "selected")}
[:label.option-container
[:h3 (tr (str "dashboard.export.options." (d/name type) ".title"))]
[:p (tr (str "dashboard.export.options." (d/name type) ".message"))]
[:input {:type "radio"
:checked selected?
:on-change #(on-change-handler % type)
:name "export-option"}]
[:span {:class "option-radio-check"}]]]))]
[:div.modal-footer
[:div.action-buttons
[:input.cancel-button
{:type "button"
:value (tr "labels.cancel")
:on-click cancel-fn}]
[:input.accept-button
{:class "primary"
:type "button"
:value (tr "labels.continue")
:on-click accept-fn}]]]]
(= (:status @state) :exporting)
[:*
[:div.modal-content
(for [file (:files @state)]
[:& export-entry {:file file}])]
[:div.modal-footer
[:div.action-buttons
[:input.accept-button
{:class "primary"
:type "button"
:value (tr "labels.close")
:disabled (->> @state :files (some :loading?))
:on-click cancel-fn}]]]])]]))

View file

@ -6,13 +6,14 @@
(ns app.main.ui.dashboard.file-menu
(:require
[app.common.data :as d]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as dm]
[app.main.data.modal :as modal]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.context :as ctx]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.ui.context :as ctx]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
@ -70,19 +71,19 @@
(:projects current-team))
on-new-tab
(fn [event]
(fn [_]
(let [pparams {:project-id (:project-id file)
:file-id (:id file)}
qparams {:page-id (first (get-in file [:data :pages]))}]
(st/emit! (rt/nav-new-window :workspace pparams qparams))))
on-duplicate
(fn [event]
(fn [_]
(apply st/emit! (map dd/duplicate-file files))
(st/emit! (dm/success (tr "dashboard.success-duplicate-file"))))
delete-fn
(fn [event]
(fn [_]
(apply st/emit! (map dd/delete-file files))
(st/emit! (dm/success (tr "dashboard.success-delete-file"))))
@ -95,7 +96,7 @@
:title (tr "modals.delete-file-multi-confirm.title" file-count)
:message (tr "modals.delete-file-multi-confirm.message" file-count)
:accept-label (tr "modals.delete-file-multi-confirm.accept" file-count)
:on-accept delete-fn}))
:on-accept delete-fn}))
(st/emit! (modal/show
{:type :confirm
:title (tr "modals.delete-file-confirm.title")
@ -109,16 +110,18 @@
(st/emit! (dm/success (tr "dashboard.success-move-files")))
(st/emit! (dm/success (tr "dashboard.success-move-file"))))
(if (or navigate? (not= team-id current-team-id))
(st/emit! (dd/go-to-files project-id))
(st/emit! (dd/go-to-files team-id project-id))
(st/emit! (dd/fetch-recent-files)
(dd/clear-selected-files))))
on-move
(fn [team-id project-id]
(let [data {:ids (set (map :id files))
:project-id project-id}
mdata {:on-success #(on-move-success team-id project-id)}]
(st/emitf (dd/move-files (with-meta data mdata)))))
(let [params {:ids (set (map :id files))
:project-id project-id}]
(fn []
(st/emit! (dd/move-files
(with-meta params
{:on-success #(on-move-success team-id project-id)}))))))
add-shared
(st/emitf (dd/set-file-shared (assoc file :is-shared true)))
@ -150,7 +153,26 @@
:hint (tr "modals.remove-shared-confirm.hint")
:cancel-label :omit
:accept-label (tr "modals.remove-shared-confirm.accept")
:on-accept del-shared})))]
:on-accept del-shared})))
on-export-files
(mf/use-callback
(mf/deps files current-team-id)
(fn [_]
(->> (rx/from files)
(rx/flat-map
(fn [file]
(->> (rp/query :file-libraries {:file-id (:id file)})
(rx/map #(assoc file :has-libraries? (d/not-empty? %))))))
(rx/reduce conj [])
(rx/subs
(fn [files]
(st/emit!
(modal/show
{:type :export
:team-id current-team-id
:has-libraries? (->> files (some :has-libraries?))
:files files})))))))]
(mf/use-effect
(fn []
@ -176,6 +198,7 @@
[[(tr "dashboard.duplicate-multi" file-count) on-duplicate]
(when (or (seq current-projects) (seq other-teams))
[(tr "dashboard.move-to-multi" file-count) nil sub-options])
[(tr "dashboard.export-multi" file-count) on-export-files]
[:separator]
[(tr "labels.delete-multi-files" file-count) on-delete]]
@ -187,6 +210,7 @@
(if (:is-shared file)
[(tr "dashboard.remove-shared") on-del-shared]
[(tr "dashboard.add-shared") on-add-shared])
[(tr "dashboard.export-single") on-export-files]
[:separator]
[(tr "labels.delete") on-delete]])]

View file

@ -7,7 +7,6 @@
(ns app.main.ui.dashboard.files
(:require
[app.main.data.dashboard :as dd]
[app.main.data.modal :as modal]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.dashboard.grid :refer [grid]]
@ -16,20 +15,18 @@
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.router :as rt]
[okulary.core :as l]
[rumext.alpha :as mf]))
(mf/defc header
[{:keys [team project] :as props}]
[{:keys [project] :as props}]
(let [local (mf/use-state {:menu-open false
:edition false})
project-id (:id project)
team-id (:id team)
on-menu-click
(mf/use-callback #(swap! local assoc :menu-open true))
(mf/use-callback
(fn [event]
(let [position (dom/get-client-position event)]
(dom/prevent-default event)
(swap! local assoc :menu-open true :menu-pos position))))
on-menu-close
(mf/use-callback #(swap! local assoc :menu-open false))
@ -47,7 +44,14 @@
(mf/deps project)
(fn [event]
(dom/prevent-default event)
(st/emit! (dd/create-file {:project-id (:id project)}))))]
(st/emit! (dd/create-file {:project-id (:id project)}))))
on-import
(mf/use-callback
(mf/deps (:id project))
(fn []
(st/emit! (dd/fetch-files {:project-id (:id project)})
(dd/clear-selected-files))))]
[:header.dashboard-header
@ -63,20 +67,27 @@
[:div.dashboard-title
[:h1 {:on-double-click on-edit}
(:name project)]
[:div.icon {:on-click on-menu-click}
i/actions]
[:& project-menu {:project project
:show? (:menu-open @local)
:left (- (:x (:menu-pos @local)) 180)
:top (:y (:menu-pos @local))
:on-edit on-edit
:on-menu-close on-menu-close}]
[:div.icon.pin-icon
{:class (when (:is-pinned project) "active")
:on-click toggle-pin}
(if (:is-pinned project)
i/pin-fill
i/pin)]]))
[:a.btn-secondary.btn-small {:on-click on-create-clicked}
(tr "dashboard.new-file")]]))
:on-menu-close on-menu-close
:on-import on-import}]]))
[:div.dashboard-header-actions
[:a.btn-secondary.btn-small {:on-click on-create-clicked}
(tr "dashboard.new-file")]
[:div.icon.pin-icon.tooltip.tooltip-bottom
{:class (when (:is-pinned project) "active")
:on-click toggle-pin :alt (tr "dashboard.pin-unpin")}
(if (:is-pinned project)
i/pin-fill
i/pin)]
[:div.icon.tooltip.tooltip-bottom
{:on-click on-menu-click :alt (tr "dashboard.options")}
i/actions]]]))
(mf/defc files-section
[{:keys [project team] :as props}]
@ -99,6 +110,6 @@
[:*
[:& header {:team team :project project}]
[:section.dashboard-container
[:& grid {:id (:id project)
[:& grid {:project-id (:id project)
:files files}]]]))

View file

@ -6,27 +6,22 @@
(ns app.main.ui.dashboard.fonts
(:require
[app.common.data :as d]
[app.common.media :as cm]
[app.common.uuid :as uuid]
[app.main.data.dashboard :as dd]
[app.main.data.fonts :as df]
[app.main.data.modal :as modal]
[app.main.ui.components.file-uploader :refer [file-uploader]]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.store :as st]
[app.main.repo :as rp]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.ui.components.file-uploader :refer [file-uploader]]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.logging :as log]
[app.util.keyboard :as kbd]
[app.util.router :as rt]
[app.util.webapi :as wa]
[cuerdas.core :as str]
[app.util.logging :as log]
;; [app.util.router :as rt]
[beicon.core :as rx]
[okulary.core :as l]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(log/set-level! :trace)
@ -47,29 +42,29 @@
(mf/defc header
{::mf/wrap [mf/memo]}
[{:keys [section team] :as props}]
(let [go-fonts
(mf/use-callback
(mf/deps team)
(st/emitf (rt/nav :dashboard-fonts {:team-id (:id team)})))
;; (let [go-fonts
;; (mf/use-callback
;; (mf/deps team)
;; (st/emitf (rt/nav :dashboard-fonts {:team-id (:id team)})))
go-providers
(mf/use-callback
(mf/deps team)
(st/emitf (rt/nav :dashboard-font-providers {:team-id (:id team)})))]
;; go-providers
;; (mf/use-callback
;; (mf/deps team)
;; (st/emitf (rt/nav :dashboard-font-providers {:team-id (:id team)})))]
(use-set-page-title team section)
(use-set-page-title team section)
[:header.dashboard-header
[:div.dashboard-title
[:h1 (tr "labels.fonts")]]
[:nav
#_[:ul
[:li {:class (when (= section :fonts) "active")}
[:a {:on-click go-fonts} (tr "labels.custom-fonts")]]
[:li {:class (when (= section :providers) "active")}
[:a {:on-click go-providers} (tr "labels.font-providers")]]]]
[:header.dashboard-header
[:div.dashboard-title
[:h1 (tr "labels.fonts")]]
[:nav
#_[:ul
[:li {:class (when (= section :fonts) "active")}
[:a {:on-click go-fonts} (tr "labels.custom-fonts")]]
[:li {:class (when (= section :providers) "active")}
[:a {:on-click go-providers} (tr "labels.font-providers")]]]]
[:div]]))
[:div]])
(mf/defc font-variant-display-name
[{:keys [variant]}]
@ -88,9 +83,6 @@
on-click
(mf/use-callback #(dom/click (mf/ref-val input-ref)))
font-key-fn
(mf/use-callback (juxt :font-family :font-weight :font-style))
on-selected
(mf/use-callback
(mf/deps team installed-fonts)
@ -144,7 +136,7 @@
[:& file-uploader {:input-id "font-upload"
:accept cm/str-font-types
:multi true
:input-ref input-ref
:ref input-ref
:on-selected on-selected}]]]
[:*
@ -190,7 +182,7 @@
(reset! state (dom/get-target-val event)))
on-save
(fn [event]
(fn [_]
(let [font-family @state]
(when-not (str/blank? font-family)
(st/emit! (df/update-font
@ -204,7 +196,7 @@
(on-save event)))
on-cancel
(fn [event]
(fn [_]
(reset! edit? false)
(reset! state (:font-family font)))
@ -221,8 +213,7 @@
:title (tr "modals.delete-font.title")
:message (tr "modals.delete-font.message")
:accept-label (tr "labels.delete")
:on-accept (fn [props]
(delete-font-fn))})))
:on-accept (fn [_props] (delete-font-fn))})))
on-delete-variant
(fn [id]
@ -231,7 +222,7 @@
:title (tr "modals.delete-font-variant.title")
:message (tr "modals.delete-font-variant.message")
:accept-label (tr "labels.delete")
:on-accept (fn [props]
:on-accept (fn [_props]
(delete-variant-fn id))})))]
[:div.font-item.table-row
@ -276,7 +267,7 @@
(mf/defc installed-fonts
[{:keys [team fonts] :as props}]
[{:keys [fonts] :as props}]
(let [sterm (mf/use-state "")
matches?

View file

@ -7,15 +7,13 @@
(ns app.main.ui.dashboard.grid
(:require
[app.common.math :as mth]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as dm]
[app.main.data.modal :as modal]
[app.main.fonts :as fonts]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.dashboard.file-menu :refer [file-menu]]
[app.main.ui.dashboard.import :refer [use-import-file]]
[app.main.ui.dashboard.inline-edition :refer [inline-edition]]
[app.main.ui.icons :as i]
[app.main.worker :as wrk]
@ -23,12 +21,10 @@
[app.util.dom.dnd :as dnd]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.router :as rt]
[app.util.time :as dt]
[app.util.timers :as ts]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
;; --- Grid Item Thumbnail
@ -59,7 +55,7 @@
(str (tr "ds.updated-at" time))))
(defn create-counter-element
[element file-count]
[_element file-count]
(let [counter-el (dom/create-element "div")]
(dom/set-property! counter-el "class" "drag-counter")
(dom/set-text! counter-el (str file-count))
@ -215,25 +211,71 @@
[:div.text (tr "dashboard.loading-files")]])
(mf/defc grid
[{:keys [id opts files] :as props}]
[:section.dashboard-grid
(cond
(nil? files)
[:& loading-placeholder]
[{:keys [files project-id] :as props}]
(let [dragging? (mf/use-state false)
(seq files)
[:div.grid-row
(for [item files]
[:& grid-item
{:file item
:key (:id item)
:navigate? true}])]
on-finish-import
(mf/use-callback
(fn []
(st/emit! (dd/fetch-files {:project-id project-id})
(dd/clear-selected-files))))
:else
[:& empty-placeholder])])
import-files (use-import-file project-id on-finish-import)
on-drag-enter
(mf/use-callback
(fn [e]
(when (or (dnd/has-type? e "Files")
(dnd/has-type? e "application/x-moz-file"))
(dom/prevent-default e)
(reset! dragging? true))))
on-drag-over
(mf/use-callback
(fn [e]
(when (or (dnd/has-type? e "Files")
(dnd/has-type? e "application/x-moz-file"))
(dom/prevent-default e))))
on-drag-leave
(mf/use-callback
(fn [e]
(when-not (dnd/from-child? e)
(reset! dragging? false))))
on-drop
(mf/use-callback
(fn [e]
(when (or (dnd/has-type? e "Files")
(dnd/has-type? e "application/x-moz-file"))
(dom/prevent-default e)
(reset! dragging? false)
(import-files (.-files (.-dataTransfer e))))))]
[:section.dashboard-grid {:on-drag-enter on-drag-enter
:on-drag-over on-drag-over
:on-drag-leave on-drag-leave
:on-drop on-drop}
(cond
(nil? files)
[:& loading-placeholder]
(seq files)
[:div.grid-row
(when @dragging?
[:div.grid-item])
(for [item files]
[:& grid-item
{:file item
:key (:id item)
:navigate? true}])]
:else
[:& empty-placeholder])]))
(mf/defc line-grid-row
[{:keys [files team-id selected-files on-load-more dragging?] :as props}]
[{:keys [files selected-files on-load-more dragging?] :as props}]
(let [rowref (mf/use-ref)
width (mf/use-state nil)
@ -288,12 +330,19 @@
(tr "dashboard.show-all-files")]])]))
(mf/defc line-grid
[{:keys [project-id team-id opts files on-load-more] :as props}]
[{:keys [project-id team-id files on-load-more] :as props}]
(let [dragging? (mf/use-state false)
selected-files (mf/deref refs/dashboard-selected-files)
selected-project (mf/deref refs/dashboard-selected-project)
on-finish-import
(mf/use-callback
(fn []
(st/emit! (dd/fetch-recent-files)
(dd/clear-selected-files))))
import-files (use-import-file project-id on-finish-import)
on-drag-enter
(mf/use-callback
(mf/deps selected-project)
@ -303,13 +352,20 @@
(when-not (or (dnd/from-child? e)
(dnd/broken-event? e))
(when (not= selected-project project-id)
(reset! dragging? true))))))
(reset! dragging? true))))
(when (or (dnd/has-type? e "Files")
(dnd/has-type? e "application/x-moz-file"))
(dom/prevent-default e)
(reset! dragging? true))))
on-drag-over
(mf/use-callback
(fn [e]
(when (dnd/has-type? e "penpot/files")
(dom/prevent-default e))))
(fn [e]
(when (or (dnd/has-type? e "penpot/files")
(dnd/has-type? e "Files")
(dnd/has-type? e "application/x-moz-file"))
(dom/prevent-default e))))
on-drag-leave
(mf/use-callback
@ -327,12 +383,19 @@
(mf/use-callback
(mf/deps files selected-files)
(fn [e]
(reset! dragging? false)
(when (not= selected-project project-id)
(let [data {:ids (into #{} (keys selected-files))
:project-id project-id}
mdata {:on-success on-drop-success}]
(st/emit! (dd/move-files (with-meta data mdata)))))))]
(when (or (dnd/has-type? e "Files")
(dnd/has-type? e "application/x-moz-file"))
(dom/prevent-default e)
(reset! dragging? false)
(import-files (.-files (.-dataTransfer e))))
(when (dnd/has-type? e "penpot/files")
(reset! dragging? false)
(when (not= selected-project project-id)
(let [data {:ids (into #{} (keys selected-files))
:project-id project-id}
mdata {:on-success on-drop-success}]
(st/emit! (dd/move-files (with-meta data mdata))))))))]
[:section.dashboard-grid {:on-drag-enter on-drag-enter
:on-drag-over on-drag-over

View file

@ -0,0 +1,315 @@
;; 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) UXBOX Labs SL
(ns app.main.ui.dashboard.import
(:require
[app.common.data :as d]
[app.main.data.modal :as modal]
[app.main.store :as st]
[app.main.ui.components.file-uploader :refer [file-uploader]]
[app.main.ui.icons :as i]
[app.main.worker :as uw]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.logging :as log]
[beicon.core :as rx]
[rumext.alpha :as mf]))
(log/set-level! :debug)
(def ^:const emit-delay 1000)
(defn use-import-file
[project-id on-finish-import]
(mf/use-callback
(mf/deps project-id on-finish-import)
(fn [files]
(when files
(let [files (->> files
(mapv
(fn [file]
{:name (.-name file)
:uri (dom/create-uri file)})))]
(st/emit! (modal/show
{:type :import
:project-id project-id
:files files
:on-finish-import on-finish-import})))))))
(mf/defc import-form
{::mf/forward-ref true}
[{:keys [project-id on-finish-import]} external-ref]
(let [on-file-selected (use-import-file project-id on-finish-import)]
[:form.import-file
[:& file-uploader {:accept ".penpot"
:multi true
:ref external-ref
:on-selected on-file-selected}]]))
(defn update-file [files file-id new-name]
(->> files
(mapv
(fn [file]
(cond-> file
(= (:file-id file) file-id)
(assoc :name new-name))))))
(defn remove-file [files file-id]
(->> files
(mapv
(fn [file]
(cond-> file
(= (:file-id file) file-id)
(assoc :deleted? true))))))
(defn set-analyze-error
[files uri]
(->> files
(mapv (fn [file]
(cond-> file
(= uri (:uri file))
(assoc :status :analyze-error))))))
(defn set-analyze-result [files uri data]
(let [existing-files? (into #{} (->> files (map :file-id) (filter some?)))
replace-file
(fn [file]
(if (and (= uri (:uri file) )
(= (:status file) :analyzing))
(->> (:files data)
(remove (comp existing-files? first) )
(mapv (fn [[file-id file-data]]
(-> file-data
(assoc :file-id file-id
:status :ready
:uri uri)))))
[file]))]
(into [] (mapcat replace-file) files)))
(defn mark-files-importing [files]
(->> files
(filter #(= :ready (:status %)))
(mapv #(assoc % :status :importing))))
(defn update-status [files file-id status]
(->> files
(mapv (fn [file]
(cond-> file
(= file-id (:file-id file))
(assoc :status status))))))
(mf/defc import-entry
[{:keys [state file editing?]}]
(let [loading? (or (= :analyzing (:status file))
(= :importing (:status file)))
load-success? (= :import-success (:status file))
analyze-error? (= :analyze-error (:status file))
import-error? (= :import-error (:status file))
ready? (= :ready (:status file))
is-shared? (:shared file)
handle-edit-key-press
(mf/use-callback
(fn [e]
(when (or (kbd/enter? e) (kbd/esc? e))
(dom/prevent-default e)
(dom/stop-propagation e)
(dom/blur! (dom/get-target e)))))
handle-edit-blur
(mf/use-callback
(mf/deps file)
(fn [e]
(let [value (dom/get-target-val e)]
(swap! state #(-> (assoc % :editing nil)
(update :files update-file (:file-id file) value))))))
handle-edit-entry
(mf/use-callback
(mf/deps file)
(fn []
(swap! state assoc :editing (:file-id file))))
handle-remove-entry
(mf/use-callback
(mf/deps file)
(fn []
(swap! state update :files remove-file (:file-id file))))]
[:div.file-entry
{:class (dom/classnames
:loading loading?
:success load-success?
:error (or import-error? analyze-error?)
:editable (and ready? (not editing?)))}
[:div.file-name
[:div.file-icon
(cond loading? i/loader-pencil
ready? i/logo-icon
load-success? i/tick
import-error? i/close
analyze-error? i/close)]
(if editing?
[:div.file-name-edit
[:input {:type "text"
:auto-focus true
:default-value (:name file)
:on-key-press handle-edit-key-press
:on-blur handle-edit-blur}]]
[:div.file-name-label (:name file) (when is-shared? i/library)])
[:div.edit-entry-buttons
[:button {:on-click handle-edit-entry} i/pencil]
[:button {:on-click handle-remove-entry} i/trash]]]
(when analyze-error?
[:div.error-message
(tr "dashboard.import.analyze-error")])
(when import-error?
[:div.error-message
(tr "dashboard.import.import-error")])
[:div.linked-libraries
(for [library-id (:libraries file)]
(let [library-data (->> @state :files (d/seek #(= library-id (:file-id %))))
error? (or (:deleted? library-data) (:import-error library-data))]
(when (some? library-data)
[:div.linked-library-tag {:class (when error? "error")}
(if error? i/unchain i/chain) (:name library-data)])))]]))
(mf/defc import-dialog
{::mf/register modal/components
::mf/register-as :import}
[{:keys [project-id files on-finish-import]}]
(let [state (mf/use-state
{:status :analyzing
:editing nil
:files (->> files
(mapv #(assoc % :status :analyzing)))})
analyze-import
(mf/use-callback
(fn [files]
(->> (uw/ask-many!
{:cmd :analyze-import
:files (->> files (mapv :uri))})
(rx/delay-emit emit-delay)
(rx/subs
(fn [{:keys [uri data error] :as msg}]
(log/debug :msg msg)
(if (some? error)
(swap! state update :files set-analyze-error uri)
(swap! state update :files set-analyze-result uri data)))))))
import-files
(mf/use-callback
(fn [project-id files]
(->> (uw/ask-many!
{:cmd :import-files
:project-id project-id
:files files})
(rx/delay-emit emit-delay)
(rx/subs
(fn [{:keys [file-id status] :as msg}]
(log/debug :msg msg)
(swap! state update :files update-status file-id status))))))
handle-cancel
(mf/use-callback
(mf/deps (:editing @state))
(fn [event]
(when (nil? (:editing @state))
(dom/prevent-default event)
(st/emit! (modal/hide)))))
handle-continue
(mf/use-callback
(mf/deps project-id (:files @state))
(fn [event]
(dom/prevent-default event)
(let [files (->> @state :files (filterv #(= :ready (:status %))))]
(import-files project-id files))
(swap! state
(fn [state]
(-> state
(assoc :status :importing)
(update :files mark-files-importing))))))
handle-accept
(mf/use-callback
(fn [event]
(dom/prevent-default event)
(st/emit! (modal/hide))
(when on-finish-import (on-finish-import))))
success-files (->> @state :files (filter #(= (:status %) :import-success)) count)
pending-analysis? (> (->> @state :files (filter #(= (:status %) :analyzing)) count) 0)
pending-import? (> (->> @state :files (filter #(= (:status %) :importing)) count) 0)]
(mf/use-effect
(fn []
(let [sub (analyze-import files)]
#(rx/dispose! sub))))
(mf/use-effect
(fn []
;; dispose uris when the component is umount
#(doseq [file files]
(dom/revoke-uri (:uri file)))))
[:div.modal-overlay
[:div.modal-container.import-dialog
[:div.modal-header
[:div.modal-header-title
[:h2 (tr "dashboard.import")]]
[:div.modal-close-button
{:on-click handle-cancel} i/close]]
[:div.modal-content
(when (and (= :importing (:status @state))
(not pending-import?))
[:div.feedback-banner
[:div.icon i/checkbox-checked]
[:div.message (tr "dashboard.import.import-message" success-files)]])
(for [file (->> (:files @state) (filterv (comp not :deleted?)))]
(let [editing? (and (some? (:file-id file))
(= (:file-id file) (:editing @state)))]
[:& import-entry {:state state
:file file
:editing? editing?}]))]
[:div.modal-footer
[:div.action-buttons
[:input.cancel-button
{:type "button"
:value (tr "labels.cancel")
:on-click handle-cancel}]
(when (= :analyzing (:status @state))
[:input.accept-button
{:class "primary"
:type "button"
:value (tr "labels.continue")
:disabled pending-analysis?
:on-click handle-continue}])
(when (= :importing (:status @state))
[:input.accept-button
{:class "primary"
:type "button"
:value (tr "labels.accept")
:disabled pending-import?
:on-click handle-accept}])]]]]))

View file

@ -7,14 +7,11 @@
(ns app.main.ui.dashboard.libraries
(:require
[app.main.data.dashboard :as dd]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.dashboard.grid :refer [grid]]
[app.main.ui.icons :as i]
[app.main.refs :as refs]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[okulary.core :as l]
[rumext.alpha :as mf]))
(mf/defc libraries-page

View file

@ -10,17 +10,17 @@
[app.main.data.messages :as dm]
[app.main.data.modal :as modal]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.components.context-menu :refer [context-menu]]
[app.main.ui.context :as ctx]
[app.main.ui.dashboard.import :as udi]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[beicon.core :as rx]
[rumext.alpha :as mf]))
(mf/defc project-menu
[{:keys [project show? on-edit on-menu-close top left] :as props}]
[{:keys [project show? on-edit on-menu-close top left on-import] :as props}]
(assert (some? project) "missing `project` prop")
(assert (boolean? show?) "missing `show?` prop")
(assert (fn? on-edit) "missing `on-edit` prop")
@ -59,7 +59,7 @@
(dd/move-project (with-meta data mdata)))))
delete-fn
(fn [event]
(fn [_]
(st/emit! (dm/success (tr "dashboard.success-delete-project"))
(dd/delete-project project)
(dd/go-to-projects (:team-id project))))
@ -71,22 +71,42 @@
:title (tr "modals.delete-project-confirm.title")
:message (tr "modals.delete-project-confirm.message")
:accept-label (tr "modals.delete-project-confirm.accept")
:on-accept delete-fn}))]
:on-accept delete-fn}))
[:& context-menu {:on-close on-menu-close
:show show?
:fixed? (or (not= top 0) (not= left 0))
:min-width? true
:top top
:left left
:options [(when-not (:is-default project)
[(tr "labels.rename") on-edit])
[(tr "dashboard.duplicate") on-duplicate]
[(tr "dashboard.pin-unpin") toggle-pin]
(when (seq teams)
[(tr "dashboard.move-to") nil
(for [team teams]
[(:name team) (on-move (:id team))])])
[:separator]
[(tr "labels.delete") on-delete]]}]))
file-input (mf/use-ref nil)
on-import-files
(mf/use-callback
(fn []
(dom/click (mf/ref-val file-input))))
on-finish-import
(mf/use-callback
(fn []
(when (some? on-import) (on-import))))]
[:*
[:& udi/import-form {:ref file-input
:project-id (:id project)
:on-finish-import on-finish-import}]
[:& context-menu
{:on-close on-menu-close
:show show?
:fixed? (or (not= top 0) (not= left 0))
:min-width? true
:top top
:left left
:options [(when-not (:is-default project)
[(tr "labels.rename") on-edit])
[(tr "dashboard.duplicate") on-duplicate]
[(tr "dashboard.pin-unpin") toggle-pin]
(when (seq teams)
[(tr "dashboard.move-to") nil
(for [team teams]
[(:name team) (on-move (:id team))])])
(when (some? on-import)
[(tr "dashboard.import") on-import-files])
[:separator]
[(tr "labels.delete") on-delete]]}]]))

View file

@ -6,8 +6,6 @@
(ns app.main.ui.dashboard.projects
(:require
[app.common.exceptions :as ex]
[app.main.constants :as c]
[app.main.data.dashboard :as dd]
[app.main.refs :as refs]
[app.main.store :as st]
@ -16,8 +14,7 @@
[app.main.ui.dashboard.project-menu :refer [project-menu]]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t tr]]
[app.util.keyboard :as kbd]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[app.util.time :as dt]
[okulary.core :as l]
@ -30,6 +27,7 @@
[:header.dashboard-header
[:div.dashboard-title
[:h1 (tr "dashboard.projects-title")]]
[:a.btn-secondary.btn-small {:on-click create}
(tr "dashboard.new-project")]]))
@ -37,7 +35,6 @@
[{:keys [project first? files] :as props}]
(let [locale (mf/deref i18n/locale)
project-id (:id project)
team-id (:team-id project)
file-count (or (:count project) 0)
@ -96,17 +93,16 @@
(fn []
(let [mdata {:on-success on-file-created}
params {:project-id (:id project)}]
(st/emit! (dd/create-file (with-meta params mdata))))))]
(st/emit! (dd/create-file (with-meta params mdata))))))
on-import
(mf/use-callback
(fn []
(st/emit! (dd/fetch-recent-files)
(dd/clear-selected-files))))]
[:div.dashboard-project-row {:class (when first? "first")}
[:div.project
(when-not (:is-default project)
[:span.pin-icon
{:class (when (:is-pinned project) "active")
:on-click toggle-pin}
(if (:is-pinned project)
i/pin-fill
i/pin)])
(if (:edition? @local)
[:& inline-edition {:content (:name project)
:on-end on-edit}]
@ -116,13 +112,13 @@
(tr "labels.drafts")
(:name project))])
(when (:menu-open @local)
[:& project-menu {:project project
:show? (:menu-open @local)
:left (:x (:menu-pos @local))
:top (:y (:menu-pos @local))
:on-edit on-edit-open
:on-menu-close on-menu-close}])
[:& project-menu {:project project
:show? (:menu-open @local)
:left (:x (:menu-pos @local))
:top (:y (:menu-pos @local))
:on-edit on-edit-open
:on-menu-close on-menu-close
:on-import on-import}]
[:span.info (str file-count " files")]
(when (> file-count 0)
@ -130,9 +126,21 @@
(dt/timeago {:locale locale}))]
[:span.recent-files-row-title-info (str ", " time)]))
[:a.btn-secondary.btn-small
{:on-click create-file}
(tr "dashboard.new-file")]]
(when-not (:is-default project)
[:span.pin-icon.tooltip.tooltip-bottom
{:class (when (:is-pinned project) "active")
:on-click toggle-pin :alt (tr "dashboard.pin-unpin")}
(if (:is-pinned project)
i/pin-fill
i/pin)])
[:a.btn-secondary.btn-small.tooltip.tooltip-bottom
{:on-click create-file :alt (tr "dashboard.new-file")}
i/close]
[:a.btn-secondary.btn-small.tooltip.tooltip-bottom
{:on-click on-menu-click :alt (tr "dashboard.options")}
i/actions]]
[:& line-grid
{:project-id (:id project)

View file

@ -13,7 +13,6 @@
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[okulary.core :as l]
[rumext.alpha :as mf]))
(mf/defc search-page

View file

@ -9,13 +9,11 @@
[app.common.data :as d]
[app.common.spec :as us]
[app.config :as cfg]
[app.main.data.comments :as dcm]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as dm]
[app.main.data.modal :as modal]
[app.main.data.users :as du]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.components.forms :as fm]
@ -24,23 +22,17 @@
[app.main.ui.dashboard.project-menu :refer [project-menu]]
[app.main.ui.dashboard.team-form]
[app.main.ui.icons :as i]
[app.util.avatars :as avatars]
[app.util.dom :as dom]
[app.util.dom.dnd :as dnd]
[app.util.i18n :as i18n :refer [tr]]
[app.util.keyboard :as kbd]
[app.util.object :as obj]
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[goog.functions :as f]
[okulary.core :as l]
[rumext.alpha :as mf]))
(mf/defc sidebar-project
[{:keys [item team-id selected?] :as props}]
[{:keys [item selected?] :as props}]
(let [dstate (mf/deref refs/dashboard-local)
selected-files (:selected-files dstate)
selected-project (:selected-project dstate)
@ -111,7 +103,7 @@
on-drop
(mf/use-callback
(mf/deps item selected-files)
(fn [e]
(fn [_]
(swap! local assoc :dragging? false)
(when (not= selected-project (:id item))
(let [data {:ids selected-files
@ -157,7 +149,7 @@
on-search-blur
(mf/use-callback
(fn [event]
(fn [_]
(reset! focused? false)))
on-search-change
@ -170,7 +162,7 @@
on-clear-click
(mf/use-callback
(mf/deps team-id)
(fn [event]
(fn [_]
(let [search-input (dom/get-element "search-input")]
(dom/clean-value! search-input)
(dom/focus! search-input)
@ -189,7 +181,7 @@
:on-change on-search-change
:ref #(when % (set! (.-value %) search-term))}]
(if (or @focused? (not (empty? search-term)))
(if (or @focused? (seq search-term))
[:div.clear-search
{:on-click on-clear-click}
i/close]
@ -199,9 +191,8 @@
i/search])]))
(mf/defc teams-selector-dropdown
[{:keys [team profile] :as props}]
(let [show-dropdown? (mf/use-state false)
teams (mf/deref refs/teams)
[{:keys [profile] :as props}]
(let [teams (mf/deref refs/teams)
on-create-clicked
(mf/use-callback
@ -246,7 +237,7 @@
on-cancel (st/emitf (modal/hide))
on-accept
(fn [event]
(fn [_]
(let [member-id (get-in @form [:clean-data :member-id])]
(accept member-id)))]
@ -291,9 +282,6 @@
members-map (mf/deref refs/dashboard-team-members)
members (vals members-map)
on-create-clicked
(st/emitf (modal/show :team-form {}))
on-rename-clicked
(st/emitf (modal/show :team-form {:team team}))
@ -358,9 +346,7 @@
(mf/defc sidebar-team-switch
[{:keys [team profile] :as props}]
(let [show-dropdown? (mf/use-state false)
show-team-opts-ddwn? (mf/use-state false)
(let [show-team-opts-ddwn? (mf/use-state false)
show-teams-ddwn? (mf/use-state false)]
[:div.sidebar-team-switch

View file

@ -7,10 +7,8 @@
(ns app.main.ui.dashboard.team
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.config :as cfg]
[app.main.constants :as c]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as dm]
[app.main.data.modal :as modal]
@ -23,15 +21,12 @@
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[app.util.time :as dt]
[cljs.spec.alpha :as s]
[okulary.core :as l]
[rumext.alpha :as mf]))
(mf/defc header
{::mf/wrap [mf/memo]}
[{:keys [section team] :as props}]
[{:keys [section] :as props}]
(let [go-members (st/emitf (dd/go-to-team-members))
go-settings (st/emitf (dd/go-to-team-settings))
invite-member (st/emitf (modal/show {:type ::invite-member}))
@ -43,7 +38,7 @@
[:h1 (cond
members-section? (tr "labels.members")
settings-section? (tr "labels.settings")
nil)]]
:else nil)]]
[:nav
[:ul
[:li {:class (when members-section? "active")}
@ -96,7 +91,7 @@
(dm/error (tr "errors.member-is-muted"))
(and (= :validation type)
(= :email-has-permanent-bounces))
(= :email-has-permanent-bounces code))
(dm/error (tr "errors.email-has-permanent-bounces" email))
:else
@ -136,7 +131,7 @@
set-owner-fn (partial set-role :owner)
set-admin (partial set-role :admin)
set-editor (partial set-role :editor)
set-viewer (partial set-role :viewer)
;; set-viewer (partial set-role :viewer)
set-owner
(st/emitf (modal/show
@ -242,7 +237,7 @@
:members-map members-map}]]]))
(mf/defc team-settings-page
[{:keys [team profile] :as props}]
[{:keys [team] :as props}]
(let [finput (mf/use-ref)
members-map (mf/deref refs/dashboard-team-members)
@ -285,7 +280,7 @@
[:img {:src (cfg/resolve-team-photo-url team)}]
[:& file-uploader {:accept "image/jpeg,image/png"
:multi false
:input-ref finput
:ref finput
:on-selected on-file-selected}]]]
[:div.block.owner-block

View file

@ -6,7 +6,6 @@
(ns app.main.ui.dashboard.team-form
(:require
[app.common.data :as d]
[app.common.spec :as us]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as dm]
@ -14,13 +13,10 @@
[app.main.store :as st]
[app.main.ui.components.forms :as fm]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.object :as obj]
[app.util.router :as rt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[rumext.alpha :as mf]))
(s/def ::name ::us/not-empty-string)
@ -28,20 +24,20 @@
(s/keys :req-un [::name]))
(defn- on-create-success
[form response]
[_form response]
(let [msg "Team created successfuly"]
(st/emit! (dm/success msg)
(modal/hide)
(rt/nav :dashboard-projects {:team-id (:id response)}))))
(defn- on-update-success
[form response]
[_form _response]
(let [msg "Team created successfuly"]
(st/emit! (dm/success msg)
(modal/hide))))
(defn- on-error
[form response]
[form _response]
(let [id (get-in @form [:clean-data :id])]
(if id
(rx/of (dm/error "Error on updating team."))
@ -62,20 +58,19 @@
(st/emit! (dd/update-team (with-meta team mdata))
(modal/hide))))
(mf/defc team-form-modal
{::mf/register modal/components
(defn- on-submit
[form _]
(let [data (:clean-data @form)]
(if (:id data)
(on-update-submit form)
(on-create-submit form))))
(mf/defc team-form-modal {::mf/register modal/components
::mf/register-as :team-form}
[{:keys [team] :as props}]
(let [form (fm/use-form :spec ::team-form
:initial (or team {}))
on-submit
(mf/use-callback
(mf/deps team)
(if team
(partial on-update-submit form)
(partial on-create-submit form)))]
(let [initial (mf/use-memo (fn [] (or team {})))
form (fm/use-form :spec ::team-form
:initial initial)]
[:div.modal-overlay
[:div.modal-container.team-form-modal
[:& fm/form {:form form :on-submit on-submit}
@ -91,7 +86,7 @@
[:div.modal-content.generic-form
[:& fm/input {:type "text"
:auto-focus true
:auto-focus? true
:form form
:name :name
:label (tr "labels.create-team.placeholder")}]]

View file

@ -6,7 +6,6 @@
(ns app.main.ui.handoff
(:require
[app.common.exceptions :as ex]
[app.main.data.viewer :as dv]
[app.main.data.viewer.shortcuts :as sc]
[app.main.refs :as refs]
@ -15,15 +14,12 @@
[app.main.ui.handoff.render :refer [render-frame-svg]]
[app.main.ui.handoff.right-sidebar :refer [right-sidebar]]
[app.main.ui.hooks :as hooks]
[app.main.ui.icons :as i]
[app.main.ui.viewer.header :refer [header]]
[app.main.ui.viewer.thumbnails :refer [thumbnails-panel]]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [t tr]]
[app.util.keyboard :as kbd]
[beicon.core :as rx]
[goog.events :as events]
[okulary.core :as l]
[rumext.alpha :as mf])
(:import goog.events.EventType))

View file

@ -6,18 +6,18 @@
(ns app.main.ui.handoff.attributes
(:require
[rumext.alpha :as mf]
[app.util.i18n :as i18n]
[app.common.geom.shapes :as gsh]
[app.main.ui.handoff.exports :refer [exports]]
[app.main.ui.handoff.attributes.layout :refer [layout-panel]]
[app.main.ui.handoff.attributes.fill :refer [fill-panel]]
[app.main.ui.handoff.attributes.stroke :refer [stroke-panel]]
[app.main.ui.handoff.attributes.shadow :refer [shadow-panel]]
[app.main.ui.handoff.attributes.blur :refer [blur-panel]]
[app.main.ui.handoff.attributes.fill :refer [fill-panel]]
[app.main.ui.handoff.attributes.image :refer [image-panel]]
[app.main.ui.handoff.attributes.layout :refer [layout-panel]]
[app.main.ui.handoff.attributes.shadow :refer [shadow-panel]]
[app.main.ui.handoff.attributes.stroke :refer [stroke-panel]]
[app.main.ui.handoff.attributes.svg :refer [svg-panel]]
[app.main.ui.handoff.attributes.text :refer [text-panel]]
[app.main.ui.handoff.attributes.svg :refer [svg-panel]]))
[app.main.ui.handoff.exports :refer [exports]]
[app.util.i18n :as i18n]
[rumext.alpha :as mf]))
(def type->options
{:multiple [:fill :stroke :image :text :shadow :blur]

Some files were not shown because too many files have changed in this diff Show more