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

Merge remote-tracking branch 'origin/staging'

Browse source
This commit is contained in:
Alejandro Alonso 2022-08-24 08:11:22 +02:00
commit 8d8e4c5e22
478 changed files with 18827 additions and 441795 deletions
Download patch file Download diff file Expand all files Collapse all files

16
frontend/src/app/config.cljs
View file

@ -80,10 +80,6 @@
(def default-theme "default")
(def default-language "en")
(def google-client-id (obj/get global "penpotGoogleClientID" nil))
(def gitlab-client-id (obj/get global "penpotGitlabClientID" nil))
(def github-client-id (obj/get global "penpotGithubClientID" nil))
(def oidc-client-id (obj/get global "penpotOIDCClientID" nil))
(def worker-uri (obj/get global "penpotWorkerURI" "/js/worker.js"))
(def translations (obj/get global "penpotTranslations"))
(def themes (obj/get global "penpotThemes"))
@ -100,14 +96,6 @@
(def terms-of-service-uri (obj/get global "penpotTermsOfServiceURI" nil))
(def privacy-policy-uri (obj/get global "penpotPrivacyPolicyURI" nil))
;; maintain for backward compatibility
(let [login-with-ldap (obj/get global "penpotLoginWithLDAP" false)
registration (obj/get global "penpotRegistrationEnabled" true)]
(when login-with-ldap
(swap! flags conj :login-with-ldap))
(when (false? registration)
(swap! flags disj :registration)))
(defn get-public-uri
[]
(let [uri (u/uri (or (obj/get global "penpotPublicURI")
@ -123,11 +111,11 @@
;; --- Helper Functions
(defn ^boolean check-browser? [candidate]
(us/verify ::browser candidate)
(us/verify! ::browser candidate)
(= candidate @browser))
(defn ^boolean check-platform? [candidate]
(us/verify ::platform candidate)
(us/verify! ::platform candidate)
(= candidate @platform))
(defn resolve-profile-photo-url

1
frontend/src/app/main.cljs
View file

@ -25,6 +25,7 @@
[app.util.theme :as theme]
[beicon.core :as rx]
[debug]
[features]
[potok.core :as ptk]
[rumext.alpha :as mf]))

52
frontend/src/app/main/broadcast.cljs Normal file
View file

@ -0,0 +1,52 @@
;; 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.broadcast
"BroadcastChannel API."
(:require
[app.common.transit :as t]
[beicon.core :as rx]
[potok.core :as ptk]))
(defrecord BroadcastMessage [id type data]
cljs.core/IDeref
(-deref [_] data))
(def ^:const default-topic "penpot")
;; The main broadcast channel instance, used for emit data
(defonce default-channel
(js/BroadcastChannel. default-topic))
(defonce stream
(->> (rx/create (fn [subs]
(let [chan (js/BroadcastChannel. default-topic)]
(unchecked-set chan "onmessage" #(rx/push! subs (unchecked-get % "data")))
(fn [] (.close ^js chan)))))
(rx/map t/decode-str)
(rx/map map->BroadcastMessage)
(rx/share)))
(defn emit!
([type data]
(.postMessage ^js default-channel (t/encode-str {:id nil :type type :data data}))
nil)
([id type data]
(.postMessage ^js default-channel (t/encode-str {:id id :type type :data data}))
nil))
(defn type?
([type]
(fn [obj] (= (:type obj) type)))
([obj type]
(= (:type obj) type)))
(defn event
[type data]
(ptk/reify ::event
ptk/EffectEvent
(effect [_ _ _]
(emit! type data))))

169
frontend/src/app/main/constants.cljs
View file

@ -23,3 +23,172 @@
:grid-alignment true
:background "var(--color-white)"})
(def has-layout-item false)
(def size-presets
[{:name "APPLE"}
{:name "iPhone 12/12 Pro"
:width 390
:height 844}
{:name "iPhone 12 Mini"
:width 360
:height 780}
{:name "iPhone 12 Pro Max"
:width 428
:height 926}
{:name "iPhone X/XS/11 Pro"
:width 375
:height 812}
{:name "iPhone XS Max/XR/11"
:width 414
:height 896}
{:name "iPhone 6/7/8 Plus"
:width 414
:height 736}
{:name "iPhone 6/7/8/SE2"
:width 375
:height 667}
{:name "iPhone 5/SE"
:width 320
:height 568}
{:name "iPad"
:width 768
:height 1024}
{:name "iPad Pro 10.5in"
:width 834
:height 1112}
{:name "iPad Pro 12.9in"
:width 1024
:height 1366}
{:name "Watch 44mm"
:width 368
:height 448}
{:name "Watch 42mm"
:width 312
:height 390}
{:name "Watch 40mm"
:width 324
:height 394}
{:name "Watch 38mm"
:width 272
:height 340}
{:name "ANDROID"}
{:name "Mobile"
:width 360
:height 640}
{:name "Tablet"
:width 768
:height 1024}
{:name "Google Pixel 4a/5"
:width 393
:height 851}
{:name "Samsung Galaxy S20+"
:width 384
:height 854}
{:name "Samsung Galaxy A71/A51"
:width 412
:height 914}
{:name "MICROSOFT"}
{:name "Surface Pro 3"
:width 1440
:height 960}
{:name "Surface Pro 4/5/6/7"
:width 1368
:height 912}
{:name "ReMarkable"}
{:name "Remarkable 2"
:width 840
:height 1120}
{:name "WEB"}
{:name "Web 1280"
:width 1280
:height 800}
{:name "Web 1366"
:width 1366
:height 768}
{:name "Web 1024"
:width 1024
:height 768}
{:name "Web 1920"
:width 1920
:height 1080}
{:name "PRINT (96dpi)"}
{:name "A0"
:width 3179
:height 4494}
{:name "A1"
:width 2245
:height 3179}
{:name "A2"
:width 1587
:height 2245}
{:name "A3"
:width 1123
:height 1587}
{:name "A4"
:width 794
:height 1123}
{:name "A5"
:width 559
:height 794}
{:name "A6"
:width 397
:height 559}
{:name "Letter"
:width 816
:height 1054}
{:name "DIN Lang"
:width 835
:height 413}
{:name "SOCIAL MEDIA"}
{:name "Instagram profile"
:width 320
:height 320}
{:name "Instagram post"
:width 1080
:height 1080}
{:name "Instagram story"
:width 1080
:height 1920}
{:name "Facebook profile"
:width 720
:height 720}
{:name "Facebook cover"
:width 820
:height 312}
{:name "Facebook post"
:width 1200
:height 630}
{:name "LinkedIn profile"
:width 400
:height 400}
{:name "LinkedIn cover"
:width 1584
:height 396}
{:name "LinkedIn post"
:width 1200
:height 627}
{:name "Twitter profile"
:width 400
:height 400}
{:name "Twitter header"
:width 1500
:height 500}
{:name "Twitter post"
:width 1024
:height 512}
{:name "YouTube profile"
:width 800
:height 800}
{:name "YouTube banner"
:width 2560
:height 1440}
{:name "YouTube thumb"
:width 1280
:height 720}])

257
frontend/src/app/main/data/comments.cljs
View file

@ -8,7 +8,10 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.repo :as rp]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
@ -59,26 +62,69 @@
(declare retrieve-comment-threads)
(declare refresh-comment-thread)
(s/def ::create-thread-params
(s/def ::create-thread-on-workspace-params
(s/keys :req-un [::page-id ::file-id ::position ::content]))
(defn create-thread
[params]
(us/assert ::create-thread-params params)
(letfn [(created [{:keys [id comment] :as thread} state]
(-> state
(update :comment-threads assoc id (dissoc thread :comment))
(update :comments-local assoc :open id)
(update :comments-local dissoc :draft)
(update :workspace-drawing dissoc :comment)
(update-in [:comments id] assoc (:id comment) comment)))]
(s/def ::create-thread-on-viewer-params
(s/keys :req-un [::page-id ::file-id ::position ::content ::frame-id]))
(ptk/reify ::create-comment-thread
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :create-comment-thread params)
(rx/mapcat #(rp/query :comment-thread {:file-id (:file-id %) :id (:id %)}))
(rx/map #(partial created %))
(defn created-thread-on-workspace
[{:keys [id comment page-id] :as thread}]
(ptk/reify ::created-thread-on-workspace
ptk/UpdateEvent
(update [_ state]
(-> state
(update :comment-threads assoc id (dissoc thread :comment))
(update-in [:workspace-data :pages-index page-id :options :comment-threads-position] assoc id (select-keys thread [:position :frame-id]))
(update :comments-local assoc :open id)
(update :comments-local dissoc :draft)
(update :workspace-drawing dissoc :comment)
(update-in [:comments id] assoc (:id comment) comment)))))
(defn create-thread-on-workspace
[params]
(us/assert ::create-thread-on-workspace-params params)
(ptk/reify ::create-thread-on-workspace
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
frame-id (cph/frame-id-by-position objects (:position params))
params (assoc params :frame-id frame-id)]
(->> (rp/cmd! :create-comment-thread params)
(rx/mapcat #(rp/cmd! :get-comment-thread {:file-id (:file-id %) :id (:id %)}))
(rx/map created-thread-on-workspace)
(rx/catch #(rx/throw {:type :comment-error})))))))
(defn created-thread-on-viewer
[{:keys [id comment page-id] :as thread}]
(ptk/reify ::created-thread-on-workspace
ptk/UpdateEvent
(update [_ state]
(-> state
(update :comment-threads assoc id (dissoc thread :comment))
(update-in [:viewer :pages page-id :options :comment-threads-position] assoc id (select-keys thread [:position :frame-id]))
(update :comments-local assoc :open id)
(update :comments-local dissoc :draft)
(update :workspace-drawing dissoc :comment)
(update-in [:comments id] assoc (:id comment) comment)))))
(defn create-thread-on-viewer
[params]
(us/assert ::create-thread-on-viewer-params params)
(ptk/reify ::create-thread-on-viewer
ptk/WatchEvent
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)
frame-id (:frame-id params)
params (assoc params :share-id share-id :frame-id frame-id)]
(->> (rp/cmd! :create-comment-thread params)
(rx/mapcat #(rp/cmd! :get-comment-thread {:file-id (:file-id %) :id (:id %) :share-id share-id}))
(rx/map created-thread-on-viewer)
(rx/catch #(rx/throw {:type :comment-error})))))))
(defn update-comment-thread-status
@ -86,13 +132,13 @@
(us/assert ::comment-thread thread)
(ptk/reify ::update-comment-thread-status
ptk/WatchEvent
(watch [_ _ _]
(let [done #(d/update-in-when % [:comment-threads id] assoc :count-unread-comments 0)]
(->> (rp/mutation :update-comment-thread-status {:id id})
(watch [_ state _]
(let [done #(d/update-in-when % [:comment-threads id] assoc :count-unread-comments 0)
share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :update-comment-thread-status {:id id :share-id share-id})
(rx/map (constantly done))
(rx/catch #(rx/throw {:type :comment-error})))))))
(defn update-comment-thread
[{:keys [id is-resolved] :as thread}]
(us/assert ::comment-thread thread)
@ -105,11 +151,11 @@
(d/update-in-when state [:comment-threads id] assoc :is-resolved is-resolved))
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :update-comment-thread {:id id :is-resolved is-resolved})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore)))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :update-comment-thread {:id id :is-resolved is-resolved :share-id share-id})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore))))))
(defn add-comment
[thread content]
@ -119,12 +165,13 @@
(update-in state [:comments (:id thread)] assoc (:id comment) comment))]
(ptk/reify ::create-comment
ptk/WatchEvent
(watch [_ _ _]
(rx/concat
(->> (rp/mutation :add-comment {:thread-id (:id thread) :content content})
(rx/map #(partial created %))
(rx/catch #(rx/throw {:type :comment-error})))
(rx/of (refresh-comment-thread thread)))))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(rx/concat
(->> (rp/cmd! :create-comment {:thread-id (:id thread) :content content :share-id share-id})
(rx/map #(partial created %))
(rx/catch #(rx/throw {:type :comment-error})))
(rx/of (refresh-comment-thread thread))))))))
(defn update-comment
[{:keys [id content thread-id] :as comment}]
@ -135,27 +182,49 @@
(d/update-in-when state [:comments thread-id id] assoc :content content))
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :update-comment {:id id :content content})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore)))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :update-comment {:id id :content content :share-id share-id})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore))))))
(defn delete-comment-thread
(defn delete-comment-thread-on-workspace
[{:keys [id] :as thread}]
(us/assert ::comment-thread thread)
(ptk/reify ::delete-comment-thread
(ptk/reify ::delete-comment-thread-on-workspace
ptk/UpdateEvent
(update [_ state]
(-> state
(update :comments dissoc id)
(update :comment-threads dissoc id)))
(let [page-id (:current-page-id state)]
(-> state
(update-in [:workspace-data :pages-index page-id :options :comment-threads-position] dissoc id)
(update :comments dissoc id)
(update :comment-threads dissoc id))))
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :delete-comment-thread {:id id})
(->> (rp/cmd! :delete-comment-thread {:id id})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore)))))
(defn delete-comment-thread-on-viewer
[{:keys [id] :as thread}]
(us/assert ::comment-thread thread)
(ptk/reify ::delete-comment-thread-on-viewer
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)]
(-> state
(update-in [:viewer :pages page-id :options :comment-threads-position] dissoc id)
(update :comments dissoc id)
(update :comment-threads dissoc id))))
ptk/WatchEvent
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :delete-comment-thread {:id id :share-id share-id})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore))))))
(defn delete-comment
[{:keys [id thread-id] :as comment}]
(us/assert ::comment comment)
@ -165,10 +234,11 @@
(d/update-in-when state [:comments thread-id] dissoc id))
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :delete-comment {:id id})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore)))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :delete-comment {:id id :share-id share-id})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore))))))
(defn refresh-comment-thread
[{:keys [id file-id] :as thread}]
@ -177,22 +247,34 @@
(assoc-in state [:comment-threads id] thread))]
(ptk/reify ::refresh-comment-thread
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :comment-thread {:file-id file-id :id id})
(rx/map #(partial fetched %))
(rx/catch #(rx/throw {:type :comment-error})))))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :get-comment-thread {:file-id file-id :id id :share-id share-id})
(rx/map #(partial fetched %))
(rx/catch #(rx/throw {:type :comment-error}))))))))
(defn retrieve-comment-threads
[file-id]
(us/assert ::us/uuid file-id)
(letfn [(fetched [data state]
(assoc state :comment-threads (d/index-by :id data)))]
(letfn [(set-comment-threds [state comment-thread]
(let [path [:workspace-data :pages-index (:page-id comment-thread) :options :comment-threads-position (:id comment-thread)]
thread-position (get-in state path)]
(cond-> state
(nil? thread-position)
(->
(assoc-in (conj path :position) (:position comment-thread))
(assoc-in (conj path :frame-id) (:frame-id comment-thread))))))
(fetched [data state]
(let [state (assoc state :comment-threads (d/index-by :id data))]
(reduce set-comment-threds state data)))]
(ptk/reify ::retrieve-comment-threads
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :comment-threads {:file-id file-id})
(rx/map #(partial fetched %))
(rx/catch #(rx/throw {:type :comment-error})))))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :get-comment-threads {:file-id file-id :share-id share-id})
(rx/map #(partial fetched %))
(rx/catch #(rx/throw {:type :comment-error}))))))))
(defn retrieve-comments
[thread-id]
@ -201,10 +283,11 @@
(update state :comments assoc thread-id (d/index-by :id comments)))]
(ptk/reify ::retrieve-comments
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :comments {:thread-id thread-id})
(rx/map #(partial fetched %))
(rx/catch #(rx/throw {:type :comment-error})))))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :get-comments {:thread-id thread-id :share-id share-id})
(rx/map #(partial fetched %))
(rx/catch #(rx/throw {:type :comment-error}))))))))
(defn retrieve-unread-comment-threads
"A event used mainly in dashboard for retrieve all unread threads of a team."
@ -214,7 +297,7 @@
ptk/WatchEvent
(watch [_ _ _]
(let [fetched #(assoc %2 :comment-threads (d/index-by :id %1))]
(->> (rp/query :unread-comment-threads {:team-id team-id})
(->> (rp/cmd! :get-unread-comment-threads {:team-id team-id})
(rx/map #(partial fetched %))
(rx/catch #(rx/throw {:type :comment-error})))))))
@ -243,7 +326,7 @@
(update :workspace-drawing dissoc :comment)))))
(defn update-filters
[{:keys [mode show] :as params}]
[{:keys [mode show list] :as params}]
(ptk/reify ::update-filters
ptk/UpdateEvent
(update [_ state]
@ -254,7 +337,17 @@
(assoc :mode mode)
(some? show)
(assoc :show show)))))))
(assoc :show show)
(some? list)
(assoc :list list)))))))
(defn update-options
[params]
(ptk/reify ::update-options
ptk/UpdateEvent
(update [_ state]
(update state :comments-local merge params))))
(s/def ::create-draft-params
(s/keys :req-un [::page-id ::file-id ::position]))
@ -324,3 +417,41 @@
(= :yours mode)
(filter #(contains? (:participants %) (:id profile))))))
(defn update-comment-thread-frame
([thread ]
(update-comment-thread-frame thread uuid/zero))
([thread frame-id]
(us/assert ::comment-thread thread)
(ptk/reify ::update-comment-thread-frame
ptk/UpdateEvent
(update [_ state]
(let [thread-id (:id thread)]
(assoc-in state [:comment-threads thread-id :frame-id] frame-id)))
ptk/WatchEvent
(watch [_ _ _]
(let [thread-id (:id thread)]
(->> (rp/cmd! :update-comment-thread-frame {:id thread-id :frame-id frame-id})
(rx/catch #(rx/throw {:type :comment-error :code :update-comment-thread-frame}))
(rx/ignore)))))))
(defn detach-comment-thread
"Detach comment threads that are inside a frame when that frame is deleted"
[ids]
(us/assert! ::us/coll-of-uuid ids)
(ptk/reify ::detach-comment-thread
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
is-frame? (fn [id] (= :frame (get-in objects [id :type])))
frame-ids? (into #{} (filter is-frame?) ids)]
(->> state
:comment-threads
(vals)
(filter (fn [comment] (some #(= % (:frame-id comment)) frame-ids?)))
(map update-comment-thread-frame)
(rx/from))))))

6
frontend/src/app/main/data/dashboard.cljs
View file

@ -427,9 +427,9 @@
(defn invite-team-members
[{:keys [emails role team-id resend?] :as params}]
(us/assert ::us/set-of-emails emails)
(us/assert ::us/keyword role)
(us/assert ::us/uuid team-id)
(us/assert! ::us/set-of-valid-emails emails)
(us/assert! ::us/keyword role)
(us/assert! ::us/uuid team-id)
(ptk/reify ::invite-team-members
IDeref
(-deref [_] {:role role :team-id team-id :resend? resend?})

8
frontend/src/app/main/data/exports.cljs
View file

@ -145,7 +145,7 @@
ptk/WatchEvent
(watch [_ _ _]
(when (= status "ended")
(->> (rp/query! :exporter {:cmd :get-resource :blob? true :id resource-id})
(->> (rp/command! :export {:cmd :get-resource :blob? true :id resource-id})
(rx/delay 500)
(rx/map #(dom/trigger-download filename %)))))))
@ -165,9 +165,9 @@
:wait true}]
(rx/concat
(rx/of ::dwp/force-persist)
(->> (rp/query! :exporter params)
(->> (rp/command! :export params)
(rx/mapcat (fn [{:keys [id filename]}]
(->> (rp/query! :exporter {:cmd :get-resource :blob? true :id id})
(->> (rp/command! :export {:cmd :get-resource :blob? true :id id})
(rx/map (fn [data]
(dom/trigger-download filename data)
(clear-export-state uuid/zero))))))
@ -213,7 +213,7 @@
;; Launch the exportation process and stores the resource id
;; locally.
(->> (rp/query! :exporter params)
(->> (rp/command! :export params)
(rx/map (fn [{:keys [id] :as resource}]
(vreset! resource-id id)
(initialize-export-status exports cmd resource))))

7
frontend/src/app/main/data/media.cljs
View file

@ -35,12 +35,9 @@
;; --- Utility functions
(defn validate-file ;; Check that a file obtained with the file javascript API is valid.
(defn validate-file
"Check that a file obtained with the file javascript API is valid."
[file]
(when (> (.-size file) cm/max-file-size)
(ex/raise :type :validation
:code :media-too-large
:hint (str/fmt "media size is large than 5mb (size: %s)" (.-size file))))
(when-not (contains? cm/valid-image-types (.-type file))
(ex/raise :type :validation
:code :media-type-not-allowed

30
frontend/src/app/main/data/users.cljs
View file

@ -173,8 +173,7 @@
(when (is-authenticated? profile)
(->> (rx/of (profile-fetched profile)
(fetch-teams)
(get-redirect-event)
(ws/initialize))
(get-redirect-event))
(rx/observe-on :async)))))))
(s/def ::invitation-token ::us/not-empty-string)
@ -207,7 +206,7 @@
;; the returned profile is an NOT authenticated profile, we
;; proceed to logout and show an error message.
(->> (rp/mutation :login (d/without-nils params))
(->> (rp/command! :login-with-password (d/without-nils params))
(rx/merge-map (fn [data]
(rx/merge
(rx/of (fetch-profile))
@ -293,7 +292,7 @@
(ptk/reify ::logout
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :logout)
(->> (rp/command! :logout)
(rx/delay-at-least 300)
(rx/catch (constantly (rx/of 1)))
(rx/map #(logged-out params)))))))
@ -436,7 +435,6 @@
(rx/map (constantly (fetch-profile)))
(rx/catch on-error))))))
(defn fetch-users
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
@ -447,9 +445,23 @@
(ptk/reify ::fetch-team-users
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :team-users {:team-id team-id})
(->> (rp/query! :team-users {:team-id team-id})
(rx/map #(partial fetched %)))))))
(defn fetch-file-comments-users
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
(letfn [(fetched [users state]
(->> users
(d/index-by :id)
(assoc state :file-comments-users)))]
(ptk/reify ::fetch-file-comments-users
ptk/WatchEvent
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/command! :get-profiles-for-file-comments {:team-id team-id :share-id share-id})
(rx/map #(partial fetched %))))))))
;; --- EVENT: request-account-deletion
(defn request-account-deletion
@ -482,7 +494,7 @@
:or {on-error rx/throw
on-success identity}} (meta data)]
(->> (rp/mutation :request-profile-recovery data)
(->> (rp/command! :request-profile-recovery data)
(rx/tap on-success)
(rx/catch on-error))))))
@ -501,7 +513,7 @@
(let [{:keys [on-error on-success]
:or {on-error rx/throw
on-success identity}} (meta data)]
(->> (rp/mutation :recover-profile data)
(->> (rp/command! :recover-profile data)
(rx/tap on-success)
(rx/catch on-error))))))
@ -512,7 +524,7 @@
(ptk/reify ::create-demo-profile
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/mutation :create-demo-profile {})
(->> (rp/command! :create-demo-profile {})
(rx/map login)))))

193
frontend/src/app/main/data/viewer.cljs
View file

@ -7,11 +7,11 @@
(ns app.main.data.viewer
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.interactions :as cti]
[app.common.uuid :as uuid]
[app.common.types.shape.interactions :as ctsi]
[app.main.data.comments :as dcm]
[app.main.data.fonts :as df]
[app.main.repo :as rp]
@ -21,6 +21,9 @@
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(s/def ::nilable-boolean (s/nilable ::us/boolean))
(s/def ::nilable-animation (s/nilable ::ctsi/animation))
;; --- Local State Initialization
(def ^:private
@ -33,8 +36,9 @@
:comments-show :unresolved
:selected #{}
:collapsed #{}
:overlays []
:hover nil})
:hover nil
:share-id ""
:file-comments-users []})
(declare fetch-comment-threads)
(declare fetch-bundle)
@ -51,7 +55,7 @@
:opt-un [::share-id ::page-id]))
(defn initialize
[{:keys [file-id] :as params}]
[{:keys [file-id share-id] :as params}]
(us/assert ::initialize-params params)
(ptk/reify ::initialize
ptk/UpdateEvent
@ -62,7 +66,8 @@
(fn [lstate]
(if (nil? lstate)
default-local-state
lstate)))))
lstate)))
(assoc-in [:viewer-local :share-id] share-id)))
ptk/WatchEvent
(watch [_ _ _]
@ -86,13 +91,6 @@
(update [_ state]
(dissoc state :viewer))))
(defn select-frames
[{:keys [objects] :as page}]
(let [root (get objects uuid/zero)]
(into [] (comp (map #(get objects %))
(filter #(= :frame (:type %))))
(reverse (:shapes root)))))
;; --- Data Fetching
(s/def ::fetch-bundle-params
@ -107,7 +105,7 @@
(watch [_ _ _]
(let [params' (cond-> {:file-id file-id}
(uuid? share-id) (assoc :share-id share-id))]
(->> (rp/query :view-only-bundle params')
(->> (rp/query! :view-only-bundle params')
(rx/mapcat
(fn [{:keys [fonts] :as bundle}]
(rx/of (df/fonts-fetched fonts)
@ -120,7 +118,9 @@
(let [pages (->> (get-in file [:data :pages])
(map (fn [page-id]
(let [data (get-in file [:data :pages-index page-id])]
[page-id (assoc data :frames (select-frames data))])))
[page-id (assoc data
:frames (cph/get-viewer-frames (:objects data))
:all-frames (cph/get-viewer-frames (:objects data) {:all-frames? true}))])))
(into {}))]
(ptk/reify ::bundle-fetched
@ -144,7 +144,7 @@
(rx/of (go-to-frame-auto))))))))
(defn fetch-comment-threads
[{:keys [file-id page-id] :as params}]
[{:keys [file-id page-id share-id] :as params}]
(letfn [(fetched [data state]
(->> data
(filter #(= page-id (:page-id %)))
@ -159,7 +159,7 @@
(ptk/reify ::fetch-comment-threads
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :comment-threads {:file-id file-id})
(->> (rp/cmd! :get-comment-threads {:file-id file-id :share-id share-id})
(rx/map #(partial fetched %))
(rx/catch on-error))))))
@ -170,7 +170,7 @@
(ptk/reify ::refresh-comment-thread
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :comment-thread {:file-id file-id :id id})
(->> (rp/cmd! :get-comment-thread {:file-id file-id :id id})
(rx/map #(partial fetched %)))))))
(defn fetch-comments
@ -181,7 +181,7 @@
(ptk/reify ::retrieve-comments
ptk/WatchEvent
(watch [_ _ _]
(->> (rp/query :comments {:thread-id thread-id})
(->> (rp/cmd! :get-comments {:thread-id thread-id})
(rx/map #(partial fetched %)))))))
;; --- Zoom Management
@ -303,6 +303,18 @@
(dcm/close-thread)
(rt/nav :viewer pparams (assoc qparams :index (inc index)))))))))
(def select-first-frame
(ptk/reify ::select-first-frame
ptk/WatchEvent
(watch [_ state _]
(let [route (:route state)
qparams (:query-params route)
pparams (:path-params route)]
(rx/of
(dcm/close-thread)
(rt/nav :viewer pparams (assoc qparams :index 0)))))))
(s/def ::interactions-mode #{:hide :show :show-on-click})
(defn set-interactions-mode
@ -320,7 +332,8 @@
(declare flash-done)
(def flash-interactions
(defn flash-interactions
[]
(ptk/reify ::flash-interactions
ptk/UpdateEvent
(update [_ state]
@ -358,7 +371,7 @@
(ptk/reify ::complete-animation
ptk/UpdateEvent
(update [_ state]
(d/dissoc-in state [:viewer-local :current-animation]))))
(dissoc state :viewer-animation))))
;; --- Navigation inside page
@ -367,7 +380,7 @@
(ptk/reify ::go-to-frame-by-index
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :overlays] []))
(assoc state :viewer-overlays []))
ptk/WatchEvent
(watch [_ state _]
@ -378,10 +391,13 @@
(rx/of (rt/nav screen pparams (assoc qparams :index index)))))))
(defn go-to-frame
([frame-id] (go-to-frame frame-id nil))
([frame-id]
(go-to-frame frame-id nil))
([frame-id animation]
(us/verify ::us/uuid frame-id)
(us/verify (s/nilable ::cti/animation) animation)
(us/assert! ::us/uuid frame-id)
(us/assert! ::nilable-animation animation)
(ptk/reify ::go-to-frame
ptk/UpdateEvent
(update [_ state]
@ -393,13 +409,13 @@
frame (get frames index)]
(cond-> state
:always
(assoc-in [:viewer-local :overlays] [])
(assoc :viewer-overlays [])
(some? animation)
(assoc-in [:viewer-local :current-animation]
{:kind :go-to-frame
:orig-frame-id (:id frame)
:animation animation}))))
(assoc :viewer-animation
{:kind :go-to-frame
:orig-frame-id (:id frame)
:animation animation}))))
ptk/WatchEvent
(watch [_ state _]
@ -408,8 +424,7 @@
page-id (:page-id qparams)
frames (get-in state [:viewer :pages page-id :frames])
index (d/index-of-pred frames #(= (:id %) frame-id))]
(when index
(rx/of (go-to-frame-by-index index))))))))
(rx/of (go-to-frame-by-index (or index 0))))))))
(defn go-to-frame-auto
[]
@ -430,7 +445,7 @@
(ptk/reify ::go-to-section
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:viewer-local :overlays] []))
(assoc state :viewer-overlays []))
ptk/WatchEvent
(watch [_ state _]
@ -441,95 +456,101 @@
;; --- Overlays
(defn- do-open-overlay
(defn- open-overlay*
[state frame position close-click-outside background-overlay animation]
(cond-> state
:always
(update-in [:viewer-local :overlays] conj
{:frame frame
:position position
:close-click-outside close-click-outside
:background-overlay background-overlay})
(some? animation)
(assoc-in [:viewer-local :current-animation]
{:kind :open-overlay
:overlay-id (:id frame)
:animation animation})))
(update :viewer-overlays conj
{:frame frame
:id (:id frame)
:position position
:close-click-outside close-click-outside
:background-overlay background-overlay})
(defn- do-close-overlay
(some? animation)
(assoc :viewer-animation
{:kind :open-overlay
:overlay-id (:id frame)
:animation animation})))
(defn- close-overlay*
[state frame-id animation]
(if (nil? animation)
(update-in state [:viewer-local :overlays]
(fn [overlays]
(d/removev #(= (:id (:frame %)) frame-id) overlays)))
(assoc-in state [:viewer-local :current-animation]
{:kind :close-overlay
:overlay-id frame-id
:animation animation})))
(update state :viewer-overlays
(fn [overlays]
(d/removev #(= (:id (:frame %)) frame-id) overlays)))
(assoc state :viewer-animation
{:kind :close-overlay
:overlay-id frame-id
:animation animation})))
(defn open-overlay
[frame-id position close-click-outside background-overlay animation]
(us/verify ::us/uuid frame-id)
(us/verify ::gpt/point position)
(us/verify (s/nilable ::us/boolean) close-click-outside)
(us/verify (s/nilable ::us/boolean) background-overlay)
(us/verify (s/nilable ::cti/animation) animation)
(us/assert! ::us/uuid frame-id)
(us/assert! ::gpt/point position)
(us/assert! ::nilable-boolean close-click-outside)
(us/assert! ::nilable-boolean background-overlay)
(us/assert! ::nilable-animation animation)
(ptk/reify ::open-overlay
ptk/UpdateEvent
(update [_ state]
(let [route (:route state)
qparams (:query-params route)
page-id (:page-id qparams)
frames (get-in state [:viewer :pages page-id :frames])
frames (dm/get-in state [:viewer :pages page-id :all-frames])
frame (d/seek #(= (:id %) frame-id) frames)
overlays (get-in state [:viewer-local :overlays])]
overlays (:viewer-overlays state)]
(if-not (some #(= (:frame %) frame) overlays)
(do-open-overlay state
frame
position
close-click-outside
background-overlay
animation)
(open-overlay* state
frame
position
close-click-outside
background-overlay
animation)
state)))))
(defn toggle-overlay
[frame-id position close-click-outside background-overlay animation]
(us/verify ::us/uuid frame-id)
(us/verify ::gpt/point position)
(us/verify (s/nilable ::us/boolean) close-click-outside)
(us/verify (s/nilable ::us/boolean) background-overlay)
(us/verify (s/nilable ::cti/animation) animation)
(us/assert! ::us/uuid frame-id)
(us/assert! ::gpt/point position)
(us/assert! ::nilable-boolean close-click-outside)
(us/assert! ::nilable-boolean background-overlay)
(us/assert! ::nilable-animation animation)
(ptk/reify ::toggle-overlay
ptk/UpdateEvent
(update [_ state]
(let [route (:route state)
qparams (:query-params route)
page-id (:page-id qparams)
frames (get-in state [:viewer :pages page-id :frames])
frames (get-in state [:viewer :pages page-id :all-frames])
frame (d/seek #(= (:id %) frame-id) frames)
overlays (get-in state [:viewer-local :overlays])]
overlays (:viewer-overlays state)]
(if-not (some #(= (:frame %) frame) overlays)
(do-open-overlay state
frame
position
close-click-outside
background-overlay
animation)
(do-close-overlay state
(:id frame)
(cti/invert-direction animation)))))))
(open-overlay* state
frame
position
close-click-outside
background-overlay
animation)
(close-overlay* state
(:id frame)
(ctsi/invert-direction animation)))))))
(defn close-overlay
([frame-id] (close-overlay frame-id nil))
([frame-id animation]
(us/verify ::us/uuid frame-id)
(us/verify (s/nilable ::cti/animation) animation)
(us/assert! ::us/uuid frame-id)
(us/assert! ::nilable-animation animation)
(ptk/reify ::close-overlay
ptk/UpdateEvent
(update [_ state]
(do-close-overlay state
frame-id
animation)))))
(close-overlay* state
frame-id
animation)))))
;; --- Objects selection

4
frontend/src/app/main/data/viewer/shortcuts.cljs
View file

@ -42,12 +42,12 @@
:fn #(st/emit! dv/toggle-fullscreen)}
:next-frame {:tooltip ds/left-arrow
:command "left"
:command ["left" "up"]
:subsections [:general-viewer]
:fn #(st/emit! dv/select-prev-frame)}
:prev-frame {:tooltip ds/right-arrow
:command "right"
:command ["right" "down"]
:subsections [:general-viewer]
:fn #(st/emit! dv/select-next-frame)}

58
frontend/src/app/main/data/websocket.cljs
View file

@ -7,14 +7,19 @@
(ns app.main.data.websocket
(:require
[app.common.data.macros :as dm]
[app.common.logging :as l]
[app.common.uri :as u]
[app.config :as cf]
[app.util.websocket :as ws]
[beicon.core :as rx]
[potok.core :as ptk]))
(l/set-level! :error)
(dm/export ws/send!)
(defonce ws-conn (volatile! nil))
(defn- prepare-uri
[params]
(let [base (-> (u/join cf/public-uri "ws/notifications")
@ -30,41 +35,46 @@
[message]
(ptk/reify ::send-message
ptk/EffectEvent
(effect [_ state _]
(let [ws-conn (:ws-conn state)]
(ws/send! ws-conn message)))))
(effect [_ _ _]
(some-> @ws-conn (ws/send! message)))))
(defn initialize
[]
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
(let [sid (:session-id state)
uri (prepare-uri {:session-id sid})]
(assoc state :ws-conn (ws/create uri))))
ptk/WatchEvent
(watch [_ state stream]
(let [ws-conn (:ws-conn state)
stoper (rx/merge
(rx/filter (ptk/type? ::finalize) stream)
(rx/filter (ptk/type? ::initialize) stream))]
(l/trace :hint "event:initialize" :fn "watch")
(let [sid (:session-id state)
uri (prepare-uri {:session-id sid})
ws (ws/create uri)]
(->> (rx/merge
(->> (ws/get-rcv-stream ws-conn)
(rx/filter ws/message-event?)
(rx/map :payload)
(rx/map #(ptk/data-event ::message %)))
(->> (ws/get-rcv-stream ws-conn)
(rx/filter ws/opened-event?)
(rx/map (fn [_] (ptk/data-event ::opened {})))))
(rx/take-until stoper))))))
(vreset! ws-conn ws)
(let [stoper (rx/merge
(rx/filter (ptk/type? ::finalize) stream)
(rx/filter (ptk/type? ::initialize) stream))]
(->> (rx/merge
(rx/of #(assoc % :ws-conn ws))
(->> (ws/get-rcv-stream ws)
(rx/filter ws/message-event?)
(rx/map :payload)
(rx/map #(ptk/data-event ::message %)))
(->> (ws/get-rcv-stream ws)
(rx/filter ws/opened-event?)
(rx/map (fn [_] (ptk/data-event ::opened {})))))
(rx/take-until stoper)))))))
;; --- Finalize Websocket
(defn finalize
[]
(ptk/reify ::finalize
ptk/UpdateEvent
(update [_ state]
(dissoc state :ws-conn))
ptk/EffectEvent
(effect [_ state _]
(some-> (:ws-conn state) ws/close!))))
(effect [_ _ _]
(l/trace :hint "event:finalize" :fn "effect")
(some-> @ws-conn ws/close!))))

231
frontend/src/app/main/data/workspace.cljs
View file

@ -13,14 +13,13 @@
[app.common.geom.point :as gpt]
[app.common.geom.proportions :as gpr]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.shape :as spec.shape]
[app.common.text :as txt]
[app.common.transit :as t]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.data.events :as ev]
@ -28,8 +27,10 @@
[app.main.data.users :as du]
[app.main.data.workspace.bool :as dwb]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.collapse :as dwco]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing :as dwd]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.fix-bool-contents :as fbc]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.guides :as dwgu]
@ -43,10 +44,12 @@
[app.main.data.workspace.path.shapes-to-path :as dwps]
[app.main.data.workspace.persistence :as dwp]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.thumbnails :as dwth]
[app.main.data.workspace.transforms :as dwt]
[app.main.data.workspace.undo :as dwu]
[app.main.data.workspace.viewport :as dwv]
[app.main.data.workspace.zoom :as dwz]
[app.main.repo :as rp]
[app.main.streams :as ms]
@ -54,6 +57,7 @@
[app.util.globals :as ug]
[app.util.http :as http]
[app.util.i18n :as i18n]
[app.util.names :as un]
[app.util.router :as rt]
[app.util.timers :as tm]
[app.util.webapi :as wapi]
@ -62,7 +66,7 @@
[cuerdas.core :as str]
[potok.core :as ptk]))
(s/def ::shape-attrs ::spec.shape/shape-attrs)
(s/def ::shape-attrs ::cts/shape-attrs)
(s/def ::set-of-string
(s/every string? :kind set?))
@ -129,7 +133,6 @@
(rx/merge
(rx/of (dwn/initialize team-id file-id)
(dwp/initialize-file-persistence file-id))
(->> stream
(rx/filter #(= ::dwc/index-initialized %))
(rx/take 1)
@ -141,7 +144,7 @@
(unchecked-set ug/global "name" name)))))
(defn- file-initialized
[{:keys [file users project libraries] :as bundle}]
[{:keys [file users project libraries file-comments-users] :as bundle}]
(ptk/reify ::file-initialized
ptk/UpdateEvent
(update [_ state]
@ -152,11 +155,13 @@
:workspace-project project
:workspace-file (assoc file :initialized true)
:workspace-data (-> (:data file)
(cph/start-object-indices)
;; DEBUG: Uncomment this to try out migrations in local without changing
;; the version number
#_(assoc :version 17)
#_(app.common.pages.migrations/migrate-data 19))
:workspace-libraries (d/index-by :id libraries)))
:workspace-libraries (d/index-by :id libraries)
:current-file-comments-users (d/index-by :id file-comments-users)))
ptk/WatchEvent
(watch [_ _ _]
@ -263,8 +268,8 @@
ptk/WatchEvent
(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-1")
unames (un/retrieve-used-names pages)
name (un/generate-unique-name unames "Page-1")
changes (-> (pcb/empty-changes it)
(pcb/add-empty-page id name))]
@ -278,9 +283,9 @@
(watch [it state _]
(let [id (uuid/next)
pages (get-in state [:workspace-data :pages-index])
unames (dwc/retrieve-used-names pages)
unames (un/retrieve-used-names pages)
page (get-in state [:workspace-data :pages-index page-id])
name (dwc/generate-unique-name unames (:name page))
name (un/generate-unique-name unames (:name page))
no_thumbnails_objects (->> (:objects page)
(d/mapm (fn [_ val] (dissoc val :use-for-thumbnail?))))
@ -392,140 +397,6 @@
(assoc-in state [:workspace-global :tooltip] content)
(assoc-in state [:workspace-global :tooltip] nil)))))
;; --- Viewport Sizing
(defn initialize-viewport
[{:keys [width height] :as size}]
(letfn [(update* [{:keys [vport] :as local}]
(let [wprop (/ (:width vport) width)
hprop (/ (:height vport) height)]
(-> local
(assoc :vport size)
(update :vbox (fn [vbox]
(-> vbox
(update :width #(/ % wprop))
(update :height #(/ % hprop))))))))
(initialize [state local]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
local (assoc local :vport size :zoom 1)]
(cond
(or (not (d/num? (:width srect)))
(not (d/num? (:height srect))))
(assoc local :vbox (assoc size :x 0 :y 0))
(or (> (:width srect) width)
(> (:height srect) height))
(let [srect (gal/adjust-to-viewport size srect {:padding 40})
zoom (/ (:width size) (:width srect))]
(-> local
(assoc :zoom zoom)
(update :vbox merge srect)))
:else
(assoc local :vbox (assoc size
:x (+ (:x srect) (/ (- (:width srect) width) 2))
:y (+ (:y srect) (/ (- (:height srect) height) 2)))))))
(setup [state local]
(if (and (:vbox local) (:vport local))
(update* local)
(initialize state local)))]
(ptk/reify ::initialize-viewport
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local
(fn [local]
(setup state local)))))))
(defn update-viewport-position
[{:keys [x y] :or {x identity y identity}}]
(us/assert fn? x)
(us/assert fn? y)
(ptk/reify ::update-viewport-position
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :vbox]
(fn [vbox]
(-> vbox
(update :x x)
(update :y y)))))))
(defn update-viewport-size
[resize-type {:keys [width height] :as size}]
(ptk/reify ::update-viewport-size
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local
(fn [{:keys [vport] :as local}]
(if (or (nil? vport)
(mth/almost-zero? width)
(mth/almost-zero? height))
;; If we have a resize to zero just keep the old value
local
(let [wprop (/ (:width vport) width)
hprop (/ (:height vport) height)
vbox (:vbox local)
vbox-x (:x vbox)
vbox-y (:y vbox)
vbox-width (:width vbox)
vbox-height (:height vbox)
vbox-width' (/ vbox-width wprop)
vbox-height' (/ vbox-height hprop)
vbox-x'
(case resize-type
:left (+ vbox-x (- vbox-width vbox-width'))
:right vbox-x
(+ vbox-x (/ (- vbox-width vbox-width') 2)))
vbox-y'
(case resize-type
:top (+ vbox-y (- vbox-height vbox-height'))
:bottom vbox-y
(+ vbox-y (/ (- vbox-height vbox-height') 2)))]
(-> local
(assoc :vport size)
(assoc-in [:vbox :x] vbox-x')
(assoc-in [:vbox :y] vbox-y')
(assoc-in [:vbox :width] vbox-width')
(assoc-in [:vbox :height] vbox-height')))))))))
(defn start-panning []
(ptk/reify ::start-panning
ptk/WatchEvent
(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])
(rx/concat
(rx/of #(-> % (assoc-in [:workspace-local :panning] true)))
(->> stream
(rx/filter ms/pointer-event?)
(rx/filter #(= :delta (:source %)))
(rx/map :pt)
(rx/take-until stopper)
(rx/map (fn [delta]
(let [delta (gpt/divide delta zoom)]
(update-viewport-position {:x #(- % (:x delta))
:y #(- % (:y delta))})))))))))))
(defn finish-panning []
(ptk/reify ::finish-panning
ptk/UpdateEvent
(update [_ state]
(-> state
(update :workspace-local dissoc :panning)))))
;; --- Update Shape Attrs
(defn update-shape
@ -576,7 +447,7 @@
hover-guides (get-in state [:workspace-guides :hover])]
(cond
(d/not-empty? selected)
(rx/of (dwc/delete-shapes selected)
(rx/of (dwsh/delete-shapes selected)
(dws/deselect-all))
(d/not-empty? hover-guides)
@ -794,7 +665,7 @@
ids)]
(rx/of (dch/commit-changes changes)
(dwc/expand-collapse parent-id))))))
(dwco/expand-collapse parent-id))))))
(defn relocate-selected-shapes
[parent-id to-index]
@ -819,15 +690,15 @@
(case type
:text
(rx/of (dwc/start-edition-mode id))
(rx/of (dwe/start-edition-mode id))
(:group :bool)
(rx/of (dwc/select-shapes (into (d/ordered-set) [(last shapes)])))
(rx/of (dws/select-shapes (into (d/ordered-set) [(last shapes)])))
:svg-raw
nil
(rx/of (dwc/start-edition-mode id)
(rx/of (dwe/start-edition-mode id)
(dwdp/start-path-edit id)))))))))
@ -1215,16 +1086,9 @@
;; selected and its parents
objects (cph/selected-subtree objects selected)
z-index (cp/calculate-z-index objects)
z-values (->> selected
(map #(vector %
(+ (get z-index %)
(get z-index (get-in objects [% :frame-id]))))))
selected
(->> z-values
(sort-by second)
(map first)
(into (d/ordered-set)))]
selected (->> (cph/sort-z-index objects selected)
(reverse)
(into (d/ordered-set)))]
(assoc data :selected selected)))
@ -1241,8 +1105,8 @@
;; Prepare the shape object. Mainly needed for image shapes
;; for retrieve the image data and convert it to the
;; data-url.
(prepare-object [objects selected {:keys [type] :as obj}]
(let [obj (maybe-translate obj objects selected)]
(prepare-object [objects selected+children {:keys [type] :as obj}]
(let [obj (maybe-translate obj objects selected+children)]
(if (= type :image)
(let [url (cfg/resolve-file-media (:metadata obj))]
(->> (http/send! {:method :get
@ -1265,9 +1129,9 @@
(update res :images conj img-part))
res)))
(maybe-translate [shape objects selected]
(maybe-translate [shape objects selected+children]
(if (and (not= (:type shape) :frame)
(not (contains? selected (:frame-id shape))))
(not (contains? selected+children (:frame-id shape))))
;; When the parent frame is not selected we change to relative
;; coordinates
(let [frame (get objects (:frame-id shape))]
@ -1284,6 +1148,8 @@
(let [objects (wsh/lookup-page-objects state)
selected (->> (wsh/lookup-selected state)
(cph/clean-loops objects))
selected+children (cph/selected-with-children objects selected)
pdata (reduce (partial collect-object-ids objects) {} selected)
initial {:type :copied-shapes
:file-id (:current-file-id state)
@ -1293,7 +1159,7 @@
(->> (rx/from (seq (vals pdata)))
(rx/merge-map (partial prepare-object objects selected))
(rx/merge-map (partial prepare-object objects selected+children))
(rx/reduce collect-data initial)
(rx/map (partial sort-selected state))
(rx/map t/encode-str)
@ -1553,7 +1419,7 @@
(into (d/ordered-set)))]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes selected))))]
(dws/select-shapes selected))))]
(ptk/reify ::paste-shape
ptk/WatchEvent
@ -1602,7 +1468,7 @@
:content (as-content text)})]
(rx/of (dwu/start-undo-transaction)
(dws/deselect-all)
(dwc/add-shape shape)
(dwsh/add-shape shape)
(dwu/commit-undo-transaction))))))
;; TODO: why not implement it in terms of upload-media-workspace?
@ -1673,21 +1539,23 @@
(watch [_ state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shapes (cph/get-immediate-children objects)
selected (wsh/lookup-selected state)
selected-objs (map #(get objects %) selected)
has-frame? (some #(= (:type %) :frame) selected-objs)]
(when (not (or (empty? selected) has-frame?))
selected-objs (map #(get objects %) selected)]
(when (d/not-empty? selected)
(let [srect (gsh/selection-rect selected-objs)
frame-id (:frame-id (first shapes))
frame-id (get-in objects [(first selected) :frame-id])
parent-id (get-in objects [(first selected) :parent-id])
shape (-> (cp/make-minimal-shape :frame)
(merge {:x (:x srect) :y (:y srect) :width (:width srect) :height (:height srect)})
(assoc :frame-id frame-id)
(assoc :frame-id frame-id :parent-id parent-id)
(cond-> (not= frame-id uuid/zero)
(assoc :fills [] :hide-in-viewer true))
(cp/setup-rect-selrect))]
(rx/of
(dwu/start-undo-transaction)
(dwc/add-shape shape)
(dwc/move-shapes-into-frame (:id shape) selected)
(dwsh/add-shape shape)
(dwsh/move-shapes-into-frame (:id shape) selected)
(dwu/commit-undo-transaction))))))))
@ -1710,10 +1578,10 @@
(dm/export dwly/set-opacity)
;; Common
(dm/export dwc/add-shape)
(dm/export dwc/clear-edition-mode)
(dm/export dwc/select-shapes)
(dm/export dwc/start-edition-mode)
(dm/export dwsh/add-shape)
(dm/export dwe/clear-edition-mode)
(dm/export dws/select-shapes)
(dm/export dwe/start-edition-mode)
;; Drawing
(dm/export dwd/select-for-drawing)
@ -1761,3 +1629,10 @@
;; Thumbnails
(dm/export dwth/update-thumbnail)
;; Viewport
(dm/export dwv/initialize-viewport)
(dm/export dwv/update-viewport-position)
(dm/export dwv/update-viewport-size)
(dm/export dwv/start-panning)
(dm/export dwv/finish-panning)

9
frontend/src/app/main/data/workspace/bool.cljs
View file

@ -13,8 +13,9 @@
[app.common.path.shapes-to-path :as stp]
[app.common.uuid :as uuid]
[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]
[app.util.names :as un]
[beicon.core :as rx]
[cuerdas.core :as str]
[potok.core :as ptk]))
@ -89,8 +90,8 @@
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state)
base-name (-> bool-type d/name str/capital (str "-1"))
name (-> (dwc/retrieve-used-names objects)
(dwc/generate-unique-name base-name))
name (-> (un/retrieve-used-names objects)
(un/generate-unique-name base-name))
shapes (selected-shapes state)]
(when-not (empty? shapes)
@ -101,7 +102,7 @@
(pcb/add-object boolean-data {:index index})
(pcb/change-parent shape-id shapes))]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set shape-id)))))))))
(dws/select-shapes (d/ordered-set shape-id)))))))))
(defn group-to-bool
[shape-id bool-type]

16
frontend/src/app/main/data/workspace/changes.cljs
View file

@ -10,8 +10,9 @@
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.changes-spec :as pcs]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[app.common.uuid :as uuid]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
@ -126,9 +127,7 @@
[]))]
(into #{}
(comp (mapcat change->ids)
(keep #(if (= :frame (get-in objects [% :type]))
%
(get-in objects [% :frame-id])))
(keep #(cph/get-shape-id-root-frame objects %))
(remove #(= uuid/zero %)))
changes)))
@ -160,10 +159,13 @@
[:workspace-data]
[:workspace-libraries file-id :data])]
(try
(us/assert ::spec.change/changes redo-changes)
(us/assert ::spec.change/changes undo-changes)
(us/assert ::pcs/changes redo-changes)
(us/assert ::pcs/changes undo-changes)
(update-in state path cp/process-changes redo-changes false)
(update-in state path (fn [file]
(-> file
(cp/process-changes redo-changes false)
(cph/update-object-indices page-id))))
(catch :default err
(log/error :js/error err)

51
frontend/src/app/main/data/workspace/collapse.cljs Normal file
View file

@ -0,0 +1,51 @@
;; 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.collapse
(:require
[app.common.pages.helpers :as cph]
[app.common.uuid :as uuid]
[potok.core :as ptk]))
;; --- Shape attrs (Layers Sidebar)
(defn expand-all-parents
[ids objects]
(ptk/reify ::expand-all-parents
ptk/UpdateEvent
(update [_ state]
(let [expand-fn (fn [expanded]
(merge expanded
(->> ids
(map #(cph/get-parent-ids objects %))
flatten
(remove #(= % uuid/zero))
(map (fn [id] {id true}))
(into {}))))]
(update-in state [:workspace-local :expanded] expand-fn)))))
(defn toggle-collapse
[id]
(ptk/reify ::toggle-collapse
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :expanded id] not))))
(defn expand-collapse
[id]
(ptk/reify ::expand-collapse
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :expanded id] true))))
(defn collapse-all
[]
(ptk/reify ::collapse-all
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :expanded))))

285
frontend/src/app/main/data/workspace/colors.cljs
View file

@ -6,79 +6,32 @@
(ns app.main.data.workspace.colors
(:require
[app.common.colors :as clr]
[app.common.colors :as colors]
[app.common.data :as d]
[app.common.pages.helpers :as cph]
[app.main.broadcast :as mbc]
[app.main.data.modal :as md]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.layout :as layout]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.texts :as dwt]
[app.main.repo :as rp]
[app.util.color :as uc]
[beicon.core :as rx]
[potok.core :as ptk]))
(def clear-color-for-rename
(ptk/reify ::clear-color-for-rename
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-global :color-for-rename] nil))))
(declare rename-color-result)
(defn rename-color
[file-id color-id name]
(ptk/reify ::rename-color
ptk/WatchEvent
(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]
(ptk/reify ::rename-color-result
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-file :colors] #(d/replace-by-id % color)))))
(defn change-palette-selected
"Change the library used by the general palette tool"
[selected]
(ptk/reify ::change-palette-selected
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-global :selected-palette] selected))
ptk/EffectEvent
(effect [_ state _]
(let [wglobal (:workspace-global state)]
(layout/persist-layout-state! wglobal)))))
(defn change-palette-selected-colorpicker
"Change the library used by the color picker"
[selected]
(ptk/reify ::change-palette-selected-colorpicker
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-global :selected-palette-colorpicker] selected))
ptk/EffectEvent
(effect [_ state _]
(let [wglobal (:workspace-global state)]
(layout/persist-layout-state! wglobal)))))
;; A set of keys that are used for shared state identifiers
(def ^:const colorpicker-selected-broadcast-key ::colorpicker-selected)
(def ^:const colorpalette-selected-broadcast-key ::colorpalette-selected)
(defn show-palette
"Show the palette tool and change the library it uses"
[selected]
(ptk/reify ::show-palette
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-global :selected-palette] selected))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (layout/toggle-layout-flag :colorpalette :force? true)))
(rx/of (layout/toggle-layout-flag :colorpalette :force? true)
(mbc/event colorpalette-selected-broadcast-key selected)))
ptk/EffectEvent
(effect [_ state _]
@ -182,10 +135,10 @@
ptk/WatchEvent
(watch [_ state _]
(let [change-fn (fn [shape attrs]
(-> shape
(cond-> (not (contains? shape :fills))
(assoc :fills []))
(assoc-in [:fills position] (into {} attrs))))]
(-> shape
(cond-> (not (contains? shape :fills))
(assoc :fills []))
(assoc-in [:fills position] (into {} attrs))))]
(transform-fill state ids color change-fn)))))
(defn change-fill-and-clear
@ -366,45 +319,11 @@
(-> state
(assoc-in [:workspace-global :picking-color?] true)
(assoc ::md/modal {:id (random-uuid)
:data {:color clr/black :opacity 1}
:data {:color colors/black :opacity 1}
:type :colorpicker
:props {:on-change handle-change-color}
:allow-click-outside true})))))))
(defn start-gradient
[gradient]
(ptk/reify ::start-gradient
ptk/UpdateEvent
(update [_ state]
(let [id (-> state wsh/lookup-selected first)]
(-> state
(assoc-in [:workspace-global :current-gradient] gradient)
(assoc-in [:workspace-global :current-gradient :shape-id] id))))))
(defn stop-gradient
[]
(ptk/reify ::stop-gradient
ptk/UpdateEvent
(update [_ state]
(-> state
(update :workspace-global dissoc :current-gradient)))))
(defn update-gradient
[changes]
(ptk/reify ::update-gradient
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:workspace-global :current-gradient] merge changes)))))
(defn select-gradient-stop
[spot]
(ptk/reify ::select-gradient-stop
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc-in [:workspace-global :editing-stop] spot)))))
(defn color-att->text
[color]
{:fill-color (:color color)
@ -433,7 +352,9 @@
:fill (change-fill [(:shape-id shape)] new-color (:index shape))
:stroke (change-stroke [(:shape-id shape)] new-color (:index shape))
:shadow (change-shadow [(:shape-id shape)] new-color (:index shape))
:content (dwt/update-text-with-function (:shape-id shape) (partial change-text-color old-color new-color (:index shape))))))))))
:content (dwt/update-text-with-function
(:shape-id shape)
(partial change-text-color old-color new-color (:index shape))))))))))
(defn apply-color-from-palette
[color is-alt?]
@ -455,3 +376,177 @@
(if is-alt?
(rx/of (change-stroke ids (merge uc/empty-color color) 0))
(rx/of (change-fill ids (merge uc/empty-color color) 0)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COLORPICKER STATE MANAGEMENT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn split-color-components
[{:keys [color opacity] :as data}]
(let [value (if (uc/hex? color) color colors/black)
[r g b] (uc/hex->rgb value)
[h s v] (uc/hex->hsv value)]
(merge data
{:hex (or value "000000")
:alpha (or opacity 1)
:r r :g g :b b
:h h :s s :v v})))
(defn materialize-color-components
[{:keys [hex alpha] :as data}]
(-> data
(assoc :color hex)
(assoc :opacity alpha)))
(defn clear-color-components
[data]
(dissoc data :hex :alpha :r :g :b :h :s :v))
(defn- create-gradient
[type]
{:start-x 0.5
:start-y (if (= type :linear-gradient) 0.0 0.5)
:end-x 0.5
:end-y 1
:width 1.0})
(defn get-color-from-colorpicker-state
[{:keys [type current-color stops gradient] :as state}]
(if (= type :color)
(clear-color-components current-color)
{:gradient (-> gradient
(assoc :type (case type
:linear-gradient :linear
:radial-gradient :radial))
(assoc :stops (mapv clear-color-components stops))
(dissoc :shape-id))}))
(defn- colorpicker-onchange-runner
"Effect event that runs the on-change callback with the latest
colorpicker state converted to color object."
[on-change]
(ptk/reify ::colorpicker-onchange-runner
ptk/WatchEvent
(watch [_ state _]
(when-let [color (some-> state :colorpicker get-color-from-colorpicker-state)]
(on-change color)
(rx/of (dwl/add-recent-color color))))))
(defn initialize-colorpicker
[on-change]
(ptk/reify ::initialize-colorpicker
ptk/WatchEvent
(watch [_ _ stream]
(let [stoper (rx/merge
(rx/filter (ptk/type? ::finalize-colorpicker) stream)
(rx/filter (ptk/type? ::initialize-colorpicker) stream))]
(->> (rx/merge
(->> stream
(rx/filter (ptk/type? ::update-colorpicker-gradient))
(rx/debounce 200))
(rx/filter (ptk/type? ::update-colorpicker-color) stream)
(rx/filter (ptk/type? ::activate-colorpicker-gradient) stream))
(rx/map (constantly (colorpicker-onchange-runner on-change)))
(rx/take-until stoper))))))
(defn finalize-colorpicker
[]
(ptk/reify ::finalize-colorpicker
ptk/UpdateEvent
(update [_ state]
(dissoc state :colorpicker))))
(defn update-colorpicker
[{:keys [gradient] :as data}]
(ptk/reify ::update-colorpicker
ptk/UpdateEvent
(update [_ state]
(let [shape-id (-> state wsh/lookup-selected first)]
(update state :colorpicker
(fn [state]
(if (some? gradient)
(let [stop (or (:editing-stop state) 0)
stops (mapv split-color-components (:stops gradient))
type (case (:type gradient)
:linear :linear-gradient
:radial :radial-gradient)]
(-> state
(assoc :type type)
(assoc :current-color (nth stops stop))
(assoc :stops stops)
(assoc :gradient (-> gradient
(dissoc :stops)
(assoc :shape-id shape-id)))
(assoc :editing-stop stop)))
(-> state
(assoc :type :color)
(assoc :current-color (split-color-components (dissoc data :gradient)))
(dissoc :editing-stop)
(dissoc :gradient)
(dissoc :stops)))))))))
(defn update-colorpicker-color
[changes]
(ptk/reify ::update-colorpicker-color
ptk/UpdateEvent
(update [_ state]
(update state :colorpicker
(fn [state]
(let [state (-> state
(update :current-color merge changes)
(update :current-color materialize-color-components))]
(if-let [stop (:editing-stop state)]
(update-in state [:stops stop] (fn [data] (->> changes
(merge data)
(materialize-color-components))))
(-> state
(assoc :type :color)
(dissoc :gradient :stops :editing-stop)))))))))
(defn update-colorpicker-gradient
[changes]
(ptk/reify ::update-colorpicker-gradient
ptk/UpdateEvent
(update [_ state]
(update-in state [:colorpicker :gradient] merge changes))))
(defn select-colorpicker-gradient-stop
[stop]
(ptk/reify ::select-colorpicket-gradient-stop
ptk/UpdateEvent
(update [_ state]
(update state :colorpicker
(fn [state]
(if-let [color (get-in state [:stops stop])]
(assoc state
:current-color color
:editing-stop stop)
state))))))
(defn activate-colorpicker-gradient
[type]
(ptk/reify ::activate-colorpicker-gradient
ptk/UpdateEvent
(update [_ state]
(update state :colorpicker
(fn [state]
(if (= type (:type state))
(do
(-> state
(assoc :type :color)
(dissoc :editing-stop :stops :gradient)))
(let [gradient (create-gradient type)
color (:current-color state)]
(-> state
(assoc :type type)
(assoc :gradient gradient)
(cond-> (not (:stops state))
(assoc :editing-stop 0
:stops [(assoc color :offset 0)
(-> color
(assoc :alpha 0)
(assoc :offset 1)
(materialize-color-components))]))))))))))

85
frontend/src/app/main/data/workspace/comments.cljs
View file

@ -6,10 +6,18 @@
(ns app.main.data.workspace.comments
(:require
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.main.data.comments :as dcm]
[app.main.data.workspace :as dw]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.changes :as dwc]
[app.main.data.workspace.common :as dwco]
[app.main.data.workspace.drawing :as dwd]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.viewport :as dwv]
[app.main.repo :as rp]
[app.main.streams :as ms]
[app.util.router :as rt]
[beicon.core :as rx]
@ -33,7 +41,7 @@
(rx/map handle-comment-layer-click)
(rx/take-until stoper))
(->> stream
(rx/filter dwc/interrupt?)
(rx/filter dwco/interrupt?)
(rx/map handle-interrupt)
(rx/take-until stoper)))))))
@ -95,8 +103,75 @@
(rx/merge
(rx/of (rt/nav :workspace pparams qparams))
(->> stream
(rx/filter (ptk/type? ::dw/initialize-viewport))
(rx/filter (ptk/type? ::dwv/initialize-viewport))
(rx/take 1)
(rx/mapcat #(rx/of (center-to-comment-thread thread)
(dw/select-for-drawing :comments)
(dwd/select-for-drawing :comments)
(dcm/open-thread thread)))))))))
(defn update-comment-thread-position
([thread [new-x new-y]]
(update-comment-thread-position thread [new-x new-y] nil))
([thread [new-x new-y] frame-id]
(us/assert ::dcm/comment-thread thread)
(ptk/reify ::update-comment-thread-position
ptk/WatchEvent
(watch [it state _]
(let [thread-id (:id thread)
page (wsh/lookup-page state)
page-id (:id page)
objects (wsh/lookup-page-objects state page-id)
new-frame-id (if (nil? frame-id)
(cph/frame-id-by-position objects {:x new-x :y new-y})
(:frame-id thread))
thread (assoc thread
:position {:x new-x :y new-y}
:frame-id new-frame-id)
changes
(-> (pcb/empty-changes it)
(pcb/with-page page)
(pcb/update-page-option :comment-threads-position assoc thread-id (select-keys thread [:position :frame-id])))]
(rx/merge
(rx/of (dwc/commit-changes changes))
(->> (rp/cmd! :update-comment-thread-position thread)
(rx/catch #(rx/throw {:type :update-comment-thread-position}))
(rx/ignore))))))))
(defn move-frame-comment-threads
"Move comment threads that are inside a frame when that frame is moved"
[ids]
(us/assert! ::us/coll-of-uuid ids)
(ptk/reify ::move-frame-comment-threads
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
is-frame? (fn [id] (= :frame (get-in objects [id :type])))
frame-ids? (into #{} (filter is-frame?) ids)
object-modifiers (:workspace-modifiers state)
threads-position-map (:comment-threads-position (wsh/lookup-page-options state))
build-move-event
(fn [comment-thread]
(let [frame (get objects (:frame-id comment-thread))
frame' (-> (merge frame (get object-modifiers (:frame-id comment-thread)))
(gsh/transform-shape))
moved (gpt/to-vec (gpt/point (:x frame) (:y frame))
(gpt/point (:x frame') (:y frame')))
position (get-in threads-position-map [(:id comment-thread) :position])
new-x (+ (:x position) (:x moved))
new-y (+ (:y position) (:y moved))]
(update-comment-thread-position comment-thread [new-x new-y] (:id frame))))]
(->> (:comment-threads state)
(vals)
(map #(assoc % :position (get-in threads-position-map [(:id %) :position])))
(map #(assoc % :frame-id (get-in threads-position-map [(:id %) :frame-id])))
(filter (comp frame-ids? :frame-id))
(map build-move-event)
(rx/from))))))

386
frontend/src/app/main/data/workspace/common.cljs
View file

@ -6,34 +6,16 @@
(ns app.main.data.workspace.common
(:require
[app.common.data :as d]
[app.common.geom.proportions :as gpr]
[app.common.geom.shapes :as gsh]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.interactions :as csi]
[app.common.spec.page :as csp]
[app.common.spec.shape :as spec.shape]
[app.common.uuid :as uuid]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.main.streams :as ms]
[app.main.worker :as uw]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module
(log/set-level! :warn)
(s/def ::shape-attrs ::spec.shape/shape-attrs)
(s/def ::set-of-string (s/every string? :kind set?))
(s/def ::ordered-set-of-uuid (s/every uuid? :kind d/ordered-set?))
(defn initialized?
"Check if the state is properly intialized in a workspace. This means
it has the `:current-page-id` and `:current-file-id` properly set."
@ -57,64 +39,6 @@
(->> (uw/ask! msg)
(rx/map (constantly ::index-initialized)))))))
;; --- Common Helpers & Events
;; TODO: looks duplicate
(defn get-frame-at-point
[objects point]
(let [frames (cph/get-frames objects)]
(d/seek #(gsh/has-point? % point) frames)))
(defn- extract-numeric-suffix
[basename]
(if-let [[_ p1 p2] (re-find #"(.*)-([0-9]+)$" basename)]
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
(defn retrieve-used-names
[objects]
(into #{} (comp (map :name) (remove nil?)) (vals objects)))
(defn generate-unique-name
"A unique name generator"
[used basename]
(s/assert ::set-of-string used)
(s/assert ::us/string basename)
(if-not (contains? used basename)
basename
(let [[prefix initial] (extract-numeric-suffix basename)]
(loop [counter initial]
(let [candidate (str prefix "-" counter)]
(if (contains? used candidate)
(recur (inc counter))
candidate))))))
;; --- Shape attrs (Layers Sidebar)
(defn toggle-collapse
[id]
(ptk/reify ::toggle-collapse
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :expanded id] not))))
(defn expand-collapse
[id]
(ptk/reify ::expand-collapse
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :expanded id] true))))
(defn collapse-all
[]
(ptk/reify ::collapse-all
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local dissoc :expanded))))
;; These functions should've been in `src/app/main/data/workspace/undo.cljs` but doing that causes
;; a circular dependency with `src/app/main/data/workspace/changes.cljs`
(def undo
@ -185,313 +109,3 @@
:origin it
:save-undo? false})))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shapes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn expand-all-parents
[ids objects]
(ptk/reify ::expand-all-parents
ptk/UpdateEvent
(update [_ state]
(let [expand-fn (fn [expanded]
(merge expanded
(->> ids
(map #(cph/get-parent-ids objects %))
flatten
(remove #(= % uuid/zero))
(map (fn [id] {id true}))
(into {}))))]
(update-in state [:workspace-local :expanded] expand-fn)))))
;; --- Update Shape Attrs
;; NOTE: This is a generic implementation for update multiple shapes
;; in one single commit/undo entry.
(defn select-shapes
[ids]
(us/verify ::ordered-set-of-uuid ids)
(ptk/reify ::select-shapes
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] ids))
ptk/WatchEvent
(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)
(defn start-edition-mode
[id]
(us/assert ::us/uuid id)
(ptk/reify ::start-edition-mode
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)]
;; Can only edit objects that exist
(if (contains? objects id)
(-> state
(assoc-in [:workspace-local :selected] #{id})
(assoc-in [:workspace-local :edition] id))
state)))
ptk/WatchEvent
(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
(ptk/reify ::clear-edition-mode
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(-> state
(update :workspace-local dissoc :edition)
(cond-> (some? id) (update-in [:workspace-local :edit-path] dissoc id)))))))
(defn get-shape-layer-position
[objects selected attrs]
(if (= :frame (:type attrs))
;; Frames are always positioned on the root frame
[uuid/zero uuid/zero nil]
;; Calculate the frame over which we're drawing
(let [position @ms/mouse-position
frame-id (:frame-id attrs (cph/frame-id-by-position objects position))
shape (when-not (empty? selected)
(cph/get-base-shape objects selected))]
;; When no shapes has been selected or we're over a different frame
;; we add it as the latest shape of that frame
(if (or (not shape) (not= (:frame-id shape) frame-id))
[frame-id frame-id nil]
;; Otherwise, we add it to next to the selected shape
(let [index (cph/get-position-on-parent objects (:id shape))
{:keys [frame-id parent-id]} shape]
[frame-id parent-id (inc index)])))))
(defn make-new-shape
[attrs objects selected]
(let [default-attrs (if (= :frame (:type attrs))
cp/default-frame-attrs
cp/default-shape-attrs)
selected-non-frames
(into #{} (comp (map (d/getf objects))
(remove cph/frame-shape?))
selected)
[frame-id parent-id index]
(get-shape-layer-position objects selected-non-frames attrs)]
(-> (merge default-attrs attrs)
(gpr/setup-proportions)
(assoc :frame-id frame-id
:parent-id parent-id
:index index))))
(defn add-shape
([attrs]
(add-shape attrs {}))
([attrs {:keys [no-select?]}]
(us/verify ::shape-attrs attrs)
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
id (or (:id attrs) (uuid/next))
name (-> objects
(retrieve-used-names)
(generate-unique-name (:name attrs)))
shape (make-new-shape
(assoc attrs :id id :name name)
objects
selected)
changes (-> (pcb/empty-changes it page-id)
(pcb/add-object shape {:index (when (= :frame (:type shape)) 0)}))]
(rx/concat
(rx/of (dch/commit-changes changes)
(when-not no-select?
(select-shapes (d/ordered-set id))))
(when (= :text (:type attrs))
(->> (rx/of (start-edition-mode id))
(rx/observe-on :async)))))))))
(defn move-shapes-into-frame [frame-id shapes]
(ptk/reify ::move-shapes-into-frame
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
to-move-shapes (->> (cph/get-immediate-children objects)
(remove cph/frame-shape?)
(d/enumerate)
(filterv (comp shapes :id second))
(mapv second))
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/change-parent frame-id to-move-shapes 0))]
(rx/of (dch/commit-changes changes))))))
(s/def ::set-of-uuid
(s/every ::us/uuid :kind set?))
(defn delete-shapes
[ids]
(us/assert ::set-of-uuid ids)
(ptk/reify ::delete-shapes
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
page (wsh/lookup-page state page-id)
ids (cph/clean-loops objects ids)
groups-to-unmask
(reduce (fn [group-ids id]
;; When the shape to delete is the mask of a masked group,
;; the mask condition must be removed, and it must be
;; converted to a normal group.
(let [obj (get objects id)
parent (get objects (:parent-id obj))]
(if (and (:masked-group? parent)
(= id (first (:shapes parent))))
(conj group-ids (:id parent))
group-ids)))
#{}
ids)
interacting-shapes
(filter (fn [shape]
;; If any of the deleted shapes is the destination of
;; some interaction, this must be deleted, too.
(let [interactions (:interactions shape)]
(some #(and (csi/has-destination %)
(contains? ids (:destination %)))
interactions)))
(vals objects))
;; If any of the deleted shapes is a frame with guides
guides (into {} (map (juxt :id identity) (->> (get-in page [:options :guides])
(vals)
(filter #(not (contains? ids (:frame-id %)))))))
starting-flows
(filter (fn [flow]
;; If any of the deleted is a frame that starts a flow,
;; this must be deleted, too.
(contains? ids (:starting-frame flow)))
(-> page :options :flows))
all-parents
(reduce (fn [res id]
;; All parents of any deleted shape must be resized.
(into res (cph/get-parent-ids objects id)))
(d/ordered-set)
ids)
all-children
(->> ids ;; Children of deleted shapes must be also deleted.
(reduce (fn [res id]
(into res (cph/get-children-ids objects id)))
[])
(reverse)
(into (d/ordered-set)))
find-all-empty-parents (fn recursive-find-empty-parents [empty-parents]
(let [all-ids (into empty-parents ids)
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? all-ids %) shapes))))
obj)))
(take-while some?)
(map :id))
calculated-empty-parents (into #{} empty-parents-xform all-parents)]
(if (= empty-parents calculated-empty-parents)
empty-parents
(recursive-find-empty-parents calculated-empty-parents))))
empty-parents
;; Any parent whose children are all deleted, must be deleted too.
(into (d/ordered-set) (find-all-empty-parents #{}))
changes (-> (pcb/empty-changes it page-id)
(pcb/with-page page)
(pcb/with-objects objects)
(pcb/set-page-option :guides guides)
(pcb/remove-objects all-children)
(pcb/remove-objects ids)
(pcb/remove-objects empty-parents)
(pcb/resize-parents all-parents)
(pcb/update-shapes groups-to-unmask
(fn [shape]
(assoc shape :masked-group? false)))
(pcb/update-shapes (map :id interacting-shapes)
(fn [shape]
(update shape :interactions
(fn [interactions]
(when interactions
(d/removev #(and (csi/has-destination %)
(contains? ids (:destination %)))
interactions))))))
(cond->
(seq starting-flows)
(pcb/update-page-option :flows (fn [flows]
(reduce #(csp/remove-flow %1 (:id %2))
flows
starting-flows)))))]
(rx/of (dch/commit-changes changes))))))
;; --- Add shape to Workspace
(defn- viewport-center
[state]
(let [{:keys [x y width height]} (get-in state [:workspace-local :vbox])]
[(+ x (/ width 2)) (+ y (/ height 2))]))
(defn create-and-add-shape
[type frame-x frame-y data]
(ptk/reify ::create-and-add-shape
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [width height]} data
[vbc-x vbc-y] (viewport-center state)
x (:x data (- vbc-x (/ width 2)))
y (:y data (- vbc-y (/ height 2)))
page-id (:current-page-id state)
frame-id (-> (wsh/lookup-page-objects state page-id)
(cph/frame-id-by-position {:x frame-x :y frame-y}))
shape (-> (cp/make-minimal-shape type)
(merge data)
(merge {:x x :y y})
(assoc :frame-id frame-id)
(cp/setup-rect-selrect))]
(rx/of (add-shape shape))))))

29
frontend/src/app/main/data/workspace/drawing/box.cljs
View file

@ -65,22 +65,21 @@
focus (:workspace-focus-selected state)
zoom (get-in state [:workspace-local :zoom] 1)
frames (cph/get-frames objects)
fid (or (->> frames
(filter #(gsh/has-point? % initial))
first
:id)
uuid/zero)
fid (cph/frame-id-by-position objects initial)
shape (-> state
(get-in [:workspace-drawing :object])
(cp/setup-shape {:x (:x initial)
:y (:y initial)
:width 0.01
:height 0.01})
(assoc :frame-id fid)
(assoc :initialized? true)
(assoc :click-draw? true))]
shape (get-in state [:workspace-drawing :object])
shape (-> shape
(cp/setup-shape {:x (:x initial)
:y (:y initial)
:width 0.01
:height 0.01})
(cond-> (and (cph/frame-shape? shape)
(not= fid uuid/zero))
(assoc :fills [] :hide-in-viewer true))
(assoc :frame-id fid)
(assoc :initialized? true)
(assoc :click-draw? true))]
(rx/concat
;; Add shape to drawing state
(rx/of #(assoc-in state [:workspace-drawing :object] shape))

16
frontend/src/app/main/data/workspace/drawing/common.cljs
View file

@ -10,7 +10,9 @@
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.main.data.workspace.common :as dwc]
[app.common.pages.helpers :as cph]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.main.worker :as uw]
[beicon.core :as rx]
@ -29,7 +31,8 @@
ptk/WatchEvent
(watch [_ state _]
(let [tool (get-in state [:workspace-drawing :tool])
shape (get-in state [:workspace-drawing :object])]
shape (get-in state [:workspace-drawing :object])
objects (wsh/lookup-page-objects state)]
(rx/concat
(when (:initialized? shape)
(let [page-id (:current-page-id state)
@ -63,13 +66,16 @@
(rx/of (dwu/start-undo-transaction))
(rx/empty))
(rx/of (dwc/add-shape shape {:no-select? (= tool :curve)}))
(rx/of (dwsh/add-shape shape {:no-select? (= tool :curve)}))
(if (= :frame (:type shape))
(->> (uw/ask! {:cmd :selection/query
:page-id page-id
:rect (:selrect shape)})
(rx/map #(dwc/move-shapes-into-frame (:id shape) %)))
:rect (:selrect shape)
:include-frames? true
:full-frame? true})
(rx/map #(cph/clean-loops objects %))
(rx/map #(dwsh/move-shapes-into-frame (:id shape) %)))
(rx/empty)))))
;; Delay so the mouse event can read the drawing state

47
frontend/src/app/main/data/workspace/edition.cljs Normal file
View file

@ -0,0 +1,47 @@
;; 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.edition
(:require
[app.common.spec :as us]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn interrupt? [e] (= e :interrupt))
(declare clear-edition-mode)
(defn start-edition-mode
[id]
(us/assert ::us/uuid id)
(ptk/reify ::start-edition-mode
ptk/UpdateEvent
(update [_ state]
(let [objects (wsh/lookup-page-objects state)]
;; Can only edit objects that exist
(if (contains? objects id)
(-> state
(assoc-in [:workspace-local :selected] #{id})
(assoc-in [:workspace-local :edition] id))
state)))
ptk/WatchEvent
(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
(ptk/reify ::clear-edition-mode
ptk/UpdateEvent
(update [_ state]
(let [id (get-in state [:workspace-local :edition])]
(-> state
(update :workspace-local dissoc :edition)
(cond-> (some? id) (update-in [:workspace-local :edit-path] dissoc id)))))))

12
frontend/src/app/main/data/workspace/groups.cljs
View file

@ -12,8 +12,9 @@
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[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]
[app.util.names :as un]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -21,7 +22,6 @@
[objects selected]
(->> selected
(map #(get objects %))
(filter #(not= :frame (:type %)))
(map #(assoc % ::index (cph/get-position-on-parent objects (:id %))))
(sort-by ::index)))
@ -71,8 +71,8 @@
(= (count shapes) 1)
(= (:type (first shapes)) :group))
(:name (first shapes))
(-> (dwc/retrieve-used-names objects)
(dwc/generate-unique-name base-name)))
(-> (un/retrieve-used-names objects)
(un/generate-unique-name base-name)))
selrect (gsh/selection-rect shapes)
group (-> (cp/make-minimal-group frame-id selrect gname)
@ -143,7 +143,7 @@
(let [[group changes]
(prepare-create-group it objects page-id shapes "Group-1" false)]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set (:id group))))))))))
(dws/select-shapes (d/ordered-set (:id group))))))))))
(def ungroup-selected
(ptk/reify ::ungroup-selected
@ -204,7 +204,7 @@
(pcb/resize-parents [(:id group)]))]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set (:id group))))))))))
(dws/select-shapes (d/ordered-set (:id group))))))))))
(def unmask-group
(ptk/reify ::unmask-group

6
frontend/src/app/main/data/workspace/guides.cljs
View file

@ -10,7 +10,7 @@
[app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb]
[app.common.spec :as us]
[app.common.spec.page :as csp]
[app.common.types.page :as ctp]
[app.main.data.workspace.changes :as dwc]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
@ -24,7 +24,7 @@
(merge guide))))
(defn update-guides [guide]
(us/verify ::csp/guide guide)
(us/verify ::ctp/guide guide)
(ptk/reify ::update-guides
ptk/WatchEvent
(watch [it state _]
@ -36,7 +36,7 @@
(rx/of (dwc/commit-changes changes))))))
(defn remove-guide [guide]
(us/verify ::csp/guide guide)
(us/verify ::ctp/guide guide)
(ptk/reify ::remove-guide
ptk/UpdateEvent
(update [_ state]

122
frontend/src/app/main/data/workspace/interactions.cljs
View file

@ -11,13 +11,13 @@
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.interactions :as csi]
[app.common.spec.page :as csp]
[app.common.types.page :as ctp]
[app.common.types.shape.interactions :as ctsi]
[app.common.uuid :as uuid]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.streams :as ms]
[app.util.names :as un]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -32,7 +32,7 @@
flows (get-in page [:options :flows] [])
unames (into #{} (map :name flows))
name (dwc/generate-unique-name unames "Flow-1")
name (un/generate-unique-name unames "Flow-1")
new-flow {:id (uuid/next)
:name name
@ -41,7 +41,7 @@
(rx/of (dch/commit-changes
(-> (pcb/empty-changes it)
(pcb/with-page page)
(pcb/update-page-option :flows csp/add-flow new-flow))))))))
(pcb/update-page-option :flows ctp/add-flow new-flow))))))))
(defn add-flow-selected-frame
[]
@ -61,7 +61,7 @@
(rx/of (dch/commit-changes
(-> (pcb/empty-changes it)
(pcb/with-page page)
(pcb/update-page-option :flows csp/remove-flow flow-id))))))))
(pcb/update-page-option :flows ctp/remove-flow flow-id))))))))
(defn rename-flow
[flow-id name]
@ -74,8 +74,8 @@
(rx/of (dch/commit-changes
(-> (pcb/empty-changes it)
(pcb/with-page page)
(pcb/update-page-option :flows csp/update-flow flow-id
#(csp/rename-flow % name)))))))))
(pcb/update-page-option :flows ctp/update-flow flow-id
#(ctp/rename-flow % name)))))))))
(defn start-rename-flow
[id]
@ -99,8 +99,8 @@
in the page"
[objects frame-id]
(let [children (cph/get-children-with-self objects frame-id)]
(or (some csi/flow-origin? (map :interactions children))
(some #(csi/flow-to? % frame-id) (map :interactions (vals objects))))))
(or (some ctsi/flow-origin? (map :interactions children))
(some #(ctsi/flow-to? % frame-id) (map :interactions (vals objects))))))
(defn add-new-interaction
([shape] (add-new-interaction shape nil))
@ -116,15 +116,15 @@
page-id
:options
:flows] [])
flow (csp/get-frame-flow flows (:id frame))]
flow (ctp/get-frame-flow flows (:id frame))]
(rx/concat
(rx/of (dch/update-shapes [(:id shape)]
(fn [shape]
(let [new-interaction (csi/set-destination
csi/default-interaction
(let [new-interaction (ctsi/set-destination
ctsi/default-interaction
destination)]
(update shape :interactions
csi/add-interaction new-interaction)))))
ctsi/add-interaction new-interaction)))))
(when (and (not (connected-frame? objects (:id frame)))
(nil? flow))
(rx/of (add-flow (:id frame))))))))))
@ -137,7 +137,7 @@
(rx/of (dch/update-shapes [(:id shape)]
(fn [shape]
(update shape :interactions
csi/remove-interaction index)))))))
ctsi/remove-interaction index)))))))
(defn update-interaction
[shape index update-fn]
@ -147,7 +147,7 @@
(rx/of (dch/update-shapes [(:id shape)]
(fn [shape]
(update shape :interactions
csi/update-interaction index update-fn)))))))
ctsi/update-interaction index update-fn)))))))
(declare move-edit-interaction)
(declare finish-edit-interaction)
@ -171,21 +171,33 @@
(rx/map #(move-edit-interaction initial-pos %)))
(rx/of (finish-edit-interaction index initial-pos))))))))
(defn get-target-frame
[state position]
(let [objects (wsh/lookup-page-objects state)
from-id (-> state wsh/lookup-selected first)
from-shape (wsh/lookup-shape state from-id)
from-frame-id (if (cph/frame-shape? from-shape)
from-id (:frame-id from-shape))
target-frame (cph/frame-by-position objects position)]
(when (and (not= (:id target-frame) uuid/zero)
(not= (:id target-frame) from-frame-id)
(not (:hide-in-viewer target-frame)))
target-frame)))
(defn move-edit-interaction
[initial-pos position]
[_initial-pos position]
(ptk/reify ::move-edit-interaction
ptk/UpdateEvent
(update [_ state]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected-shape-id (-> state wsh/lookup-selected first)
selected-shape (get objects selected-shape-id)
selected-shape-frame-id (:frame-id selected-shape)
start-frame (get objects selected-shape-frame-id)
end-frame (dwc/get-frame-at-point objects position)]
(cond-> state
(not= position initial-pos) (assoc-in [:workspace-local :draw-interaction-to] position)
(not= start-frame end-frame) (assoc-in [:workspace-local :draw-interaction-to-frame] end-frame))))))
(let [end-frame (get-target-frame state position)]
(-> state
(assoc-in [:workspace-local :draw-interaction-to] position)
(assoc-in [:workspace-local :draw-interaction-to-frame] end-frame))))))
(defn finish-edit-interaction
[index initial-pos]
@ -199,32 +211,40 @@
ptk/WatchEvent
(watch [_ state _]
(let [position @ms/mouse-position
page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
frame (dwc/get-frame-at-point objects position)
(let [position @ms/mouse-position
target-frame (get-target-frame state position)
shape-id (-> state wsh/lookup-selected first)
shape (wsh/lookup-shape state shape-id)
shape-id (-> state wsh/lookup-selected first)
shape (get objects shape-id)]
change-interaction
(fn [interaction]
(cond-> interaction
(not (ctsi/has-destination interaction))
(ctsi/set-action-type :navigate)
(when (and shape (not (= position initial-pos)))
(if (nil? frame)
(when index
(rx/of (remove-interaction shape index)))
(let [frame (if (or (= (:id frame) (:id shape))
(= (:id frame) (:frame-id shape)))
nil ;; Drop onto self frame -> set destination to none
frame)]
(if (nil? index)
(rx/of (add-new-interaction shape (:id frame)))
(rx/of (update-interaction shape index
(fn [interaction]
(cond-> interaction
(not (csi/has-destination interaction))
(csi/set-action-type :navigate)
:always
(ctsi/set-destination (:id target-frame))))]
(cond
(or (nil? shape)
;; Didn't changed the position for the interaction
(= position initial-pos)
;; New interaction but invalid target
(and (nil? index) (nil? target-frame)))
nil
;; Dropped interaction in an invalid target. We remove it
(and (some? index) (nil? target-frame))
(rx/of (remove-interaction shape index))
(nil? index)
(rx/of (add-new-interaction shape (:id target-frame)))
:else
(rx/of (update-interaction shape index change-interaction)))))))
:always
(csi/set-destination (:id frame))))))))))))))
;; --- Overlays
(declare move-overlay-pos)
@ -302,7 +322,7 @@
new-interactions
(update interactions index
#(csi/set-overlay-position % overlay-pos))]
#(ctsi/set-overlay-position % overlay-pos))]
(rx/of (dch/update-shapes [(:id shape)] #(merge % {:interactions new-interactions})))))))

31
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -11,25 +11,26 @@
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.changes-spec :as pcs]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[app.common.spec.color :as spec.color]
[app.common.spec.file :as spec.file]
[app.common.spec.typography :as spec.typography]
[app.common.types.color :as ctc]
[app.common.types.file :as ctf]
[app.common.types.typography :as ctt]
[app.common.uuid :as uuid]
[app.main.data.dashboard :as dd]
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.i18n :refer [tr]]
[app.util.names :as un]
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
@ -98,7 +99,7 @@
color (-> color
(assoc :id id)
(assoc :name (default-color-name color)))]
(us/assert ::spec.color/color color)
(us/assert ::ctc/color color)
(ptk/reify ::add-color
IDeref
(-deref [_] color)
@ -112,7 +113,7 @@
(defn add-recent-color
[color]
(us/assert ::spec.color/recent-color color)
(us/assert! ::ctc/recent-color color)
(ptk/reify ::add-recent-color
ptk/WatchEvent
(watch [it _ _]
@ -141,7 +142,7 @@
(defn update-color
[color file-id]
(us/assert ::spec.color/color color)
(us/assert ::ctc/color color)
(us/assert ::us/uuid file-id)
(ptk/reify ::update-color
ptk/WatchEvent
@ -175,7 +176,7 @@
(defn add-media
[media]
(us/assert ::spec.file/media-object media)
(us/assert ::ctf/media-object media)
(ptk/reify ::add-media
ptk/WatchEvent
(watch [it _ _]
@ -217,7 +218,7 @@
([typography] (add-typography typography true))
([typography edit?]
(let [typography (update typography :id #(or % (uuid/next)))]
(us/assert ::spec.typography/typography typography)
(us/assert ::ctt/typography typography)
(ptk/reify ::add-typography
IDeref
(-deref [_] typography)
@ -246,7 +247,7 @@
(defn update-typography
[typography file-id]
(us/assert ::spec.typography/typography typography)
(us/assert ::ctt/typography typography)
(us/assert ::us/uuid file-id)
(ptk/reify ::update-typography
ptk/WatchEvent
@ -297,7 +298,7 @@
(dwlh/generate-add-component it shapes objects page-id file-id)]
(when-not (empty? (:redo-changes changes))
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set (:id group)))))))))))
(dws/select-shapes (d/ordered-set (:id group)))))))))))
(defn add-component
"Add a new component to current file library, from the currently selected shapes.
@ -353,7 +354,7 @@
component (cph/get-component libraries id)
all-components (-> state :workspace-data :components vals)
unames (into #{} (map :name) all-components)
new-name (dwc/generate-unique-name unames (:name component))
new-name (un/generate-unique-name unames (:name component))
[new-shape new-shapes _updated-shapes]
(dwlh/duplicate-component component)
@ -403,7 +404,7 @@
page
libraries)]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set (:id new-shape))))))))
(dws/select-shapes (d/ordered-set (:id new-shape))))))))
(defn detach-component
"Remove all references to components in the shape with the given id,
@ -464,7 +465,7 @@
(defn ext-library-changed
[file-id modified-at revn changes]
(us/assert ::us/uuid file-id)
(us/assert ::spec.change/changes changes)
(us/assert ::pcs/changes changes)
(ptk/reify ::ext-library-changed
ptk/UpdateEvent
(update [_ state]

18
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

@ -8,17 +8,17 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.geom.shapes :as gsh]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.color :as color]
[app.common.text :as txt]
[app.main.data.workspace.common :as dwc]
[app.common.types.color :as ctc]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.state-helpers :as wsh]
[app.util.names :as un]
[cljs.spec.alpha :as s]
[clojure.set :as set]))
@ -144,13 +144,13 @@
delta (gpt/subtract position orig-pos)
objects (:objects page)
unames (volatile! (dwc/retrieve-used-names objects))
unames (volatile! (un/retrieve-used-names objects))
frame-id (cph/frame-id-by-position objects (gpt/add orig-pos delta))
update-new-shape
(fn [new-shape original-shape]
(let [new-name (dwc/generate-unique-name @unames (:name new-shape))]
(let [new-name (un/generate-unique-name @unames (:name new-shape))]
(when (nil? (:parent-id original-shape))
(vswap! unames conj new-name))
@ -158,7 +158,7 @@
(cond-> new-shape
true
(as-> $
(geom/move $ delta)
(gsh/move $ delta)
(assoc $ :frame-id frame-id)
(assoc $ :parent-id
(or (:parent-id $) (:frame-id $)))
@ -299,7 +299,7 @@
(defmethod uses-assets? :colors
[_ shape library-id _]
(color/uses-library-colors? shape library-id))
(ctc/uses-library-colors? shape library-id))
(defmethod uses-assets? :typographies
[_ shape library-id _]
@ -331,7 +331,7 @@
(let [library-colors (get-assets library-id :colors state)]
(pcb/update-shapes changes
[(:id shape)]
#(color/sync-shape-colors % library-id library-colors))))
#(ctc/sync-shape-colors % library-id library-colors))))
(defmethod generate-sync-shape :typographies
[_ changes library-id state container shape]
@ -1150,7 +1150,7 @@
origin-root-pos (shape-pos origin-root)
dest-root-pos (shape-pos dest-root)
delta (gpt/subtract dest-root-pos origin-root-pos)]
(geom/move shape delta)))
(gsh/move shape delta)))
(defn- make-change
[container change]

6
frontend/src/app/main/data/workspace/media.cljs
View file

@ -10,8 +10,8 @@
[app.common.spec :as us]
[app.main.data.media :as dmm]
[app.main.data.messages :as dm]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.svg-upload :as svg]
[app.main.repo :as rp]
[app.main.store :as st]
@ -72,7 +72,7 @@
:height height
:mtype mtype
:id id}}]
(rx/of (dwc/create-and-add-shape :image x y shape))))))
(rx/of (dwsh/create-and-add-shape :image x y shape))))))
(defn svg-uploaded
[svg-data file-id position]
@ -200,7 +200,7 @@
(= (:code error) :invalid-image)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-too-large)
(= (:code error) :media-max-file-size-reached)
(rx/of (dm/error (tr "errors.media-too-large")))
(= (:code error) :media-type-mismatch)

84
frontend/src/app/main/data/workspace/notifications.cljs
View file

@ -7,9 +7,8 @@
(ns app.main.data.workspace.notifications
(:require
[app.common.data :as d]
[app.common.pages.changes-spec :as pcs]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[app.common.uuid :as uuid]
[app.main.data.websocket :as dws]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.libraries :as dwl]
@ -34,51 +33,53 @@
(ptk/reify ::initialize
ptk/WatchEvent
(watch [_ state stream]
(let [subs-id (uuid/next)
stoper (rx/filter (ptk/type? ::finalize) stream)
(let [stoper (rx/filter (ptk/type? ::finalize) stream)
profile-id (:profile-id state)
initmsg [{:type :subscribe-file
:subs-id subs-id
:file-id file-id}
{:type :subscribe-team
:team-id team-id}]
initmsg [{:type :subscribe-file
:file-id file-id}
{:type :subscribe-team
:team-id team-id}]
endmsg {:type :unsubscribe-file
:subs-id subs-id}
endmsg {:type :unsubscribe-file
:file-id file-id}
stream (->> (rx/merge
;; Send the subscription message
(->> (rx/from initmsg)
(rx/map dws/send))
stream (->> (rx/merge
;; Send the subscription message
(->> (rx/from initmsg)
(rx/map dws/send))
;; Subscribe to notifications of the subscription
(->> stream
(rx/filter (ptk/type? ::dws/message))
(rx/map deref) ;; :library-change events occur in a different file, but need to be processed anyway
(rx/filter #(or (= subs-id (:subs-id %)) (= (:type %) :library-change)))
(rx/map process-message))
;; Subscribe to notifications of the subscription
(->> stream
(rx/filter (ptk/type? ::dws/message))
(rx/map deref)
(rx/filter (fn [{:keys [subs-id] :as msg}]
(or (= subs-id team-id)
(= subs-id profile-id)
(= subs-id file-id))))
(rx/map process-message))
;; On reconnect, send again the subscription messages
(->> stream
(rx/filter (ptk/type? ::dws/opened))
(rx/mapcat #(->> (rx/from initmsg)
(rx/map dws/send))))
;; On reconnect, send again the subscription messages
(->> stream
(rx/filter (ptk/type? ::dws/opened))
(rx/mapcat #(->> (rx/from initmsg)
(rx/map dws/send))))
;; Emit presence event for current user;
;; this is because websocket server don't
;; emits this for the same user.
(rx/of (handle-presence {:type :connect
:session-id (:session-id state)
:profile-id (:profile-id state)}))
;; Emit presence event for current user;
;; this is because websocket server don't
;; emits this for the same user.
(rx/of (handle-presence {:type :connect
:session-id (:session-id state)
:profile-id (:profile-id state)}))
;; Emit to all other connected users the current pointer
;; position changes.
(->> stream
(rx/filter ms/pointer-event?)
(rx/sample 50)
(rx/map #(handle-pointer-send subs-id file-id (:pt %)))))
;; Emit to all other connected users the current pointer
;; position changes.
(->> stream
(rx/filter ms/pointer-event?)
(rx/sample 50)
(rx/map #(handle-pointer-send file-id (:pt %)))))
(rx/take-until stoper))]
(rx/take-until stoper))]
(rx/concat stream (rx/of (dws/send endmsg)))))))
@ -95,13 +96,12 @@
nil))
(defn- handle-pointer-send
[subs-id file-id point]
[file-id point]
(ptk/reify ::handle-pointer-send
ptk/WatchEvent
(watch [_ state _]
(let [page-id (:current-page-id state)
message {:type :pointer-update
:subs-id subs-id
:file-id file-id
:page-id page-id
:position point}]
@ -184,7 +184,7 @@
(s/def ::file-id uuid?)
(s/def ::session-id uuid?)
(s/def ::revn integer?)
(s/def ::changes ::spec.change/changes)
(s/def ::changes ::pcs/changes)
(s/def ::file-change-event
(s/keys :req-un [::type ::profile-id ::file-id ::session-id ::revn ::changes]))

4
frontend/src/app/main/data/workspace/path/drawing.cljs
View file

@ -13,8 +13,8 @@
[app.common.path.shapes-to-path :as upsp]
[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.edition :as dwe]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.common :as common]
[app.main.data.workspace.path.helpers :as helpers]
@ -276,7 +276,7 @@
(watch [_ _ _]
(rx/of (setup-frame-path)
(dwdc/handle-finish-drawing)
(dwc/start-edition-mode shape-id)
(dwe/start-edition-mode shape-id)
(change-edit-mode :draw)))))
(defn handle-new-shape

4
frontend/src/app/main/data/workspace/path/edition.cljs
View file

@ -13,7 +13,7 @@
[app.common.path.shapes-to-path :as upsp]
[app.common.path.subpaths :as ups]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.drawing :as drawing]
[app.main.data.workspace.path.helpers :as helpers]
@ -64,7 +64,7 @@
(let [changes (changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
(if (empty? new-content)
(rx/of (dch/commit-changes changes)
dwc/clear-edition-mode)
dwe/clear-edition-mode)
(rx/of (dch/commit-changes changes)
(selection/update-selection point-change)
(fn [state] (update-in state [:workspace-local :edit-path id] dissoc :content-modifiers :moving-nodes :moving-handler))))))))))

4
frontend/src/app/main/data/workspace/path/tools.cljs
View file

@ -9,7 +9,7 @@
[app.common.path.shapes-to-path :as upsp]
[app.common.path.subpaths :as ups]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.state-helpers :as wsh]
@ -40,7 +40,7 @@
(rx/of (dch/update-shapes [id] upsp/convert-to-path))
(rx/of (dch/commit-changes changes)
(when (empty? new-content)
dwc/clear-edition-mode))))))))))
dwe/clear-edition-mode))))))))))
(defn make-corner
([]

45
frontend/src/app/main/data/workspace/persistence.cljs
View file

@ -9,9 +9,9 @@
[app.common.data :as d]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-spec :as pcs]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[app.common.spec.file :as spec.file]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.dashboard :as dd]
@ -157,13 +157,15 @@
(->> (rx/from frame-updates)
(rx/flat-map (fn [[page-id frames]]
(->> frames (map #(vector page-id %)))))
(rx/map (fn [[page-id frame-id]] (dwt/update-thumbnail page-id frame-id))))
(rx/map (fn [[page-id frame-id]] (dwt/update-thumbnail (:id file) page-id frame-id))))
(->> (rx/of lagged)
(rx/mapcat seq)
(rx/map #(shapes-changes-persisted file-id %)))))))
(rx/catch (fn [cause]
(rx/concat
(rx/of (rt/assign-exception cause))
(if (= :authentication (:type cause))
(rx/empty)
(rx/of (rt/assign-exception cause)))
(rx/throw cause))))))))))
@ -199,7 +201,7 @@
:updated-at (dt/now)))))))
(s/def ::shapes-changes-persisted
(s/keys :req-un [::revn ::spec.change/changes]))
(s/keys :req-un [::revn ::pcs/changes]))
(defn shapes-persisted-event? [event]
(= (ptk/type event) ::changes-persisted))
@ -237,7 +239,7 @@
(s/def ::version ::us/integer)
(s/def ::revn ::us/integer)
(s/def ::ordering ::us/integer)
(s/def ::data ::spec.file/data)
(s/def ::data ::ctf/data)
(s/def ::file ::dd/file)
(s/def ::project ::dd/project)
@ -258,20 +260,23 @@
[project-id file-id]
(ptk/reify ::fetch-bundle
ptk/WatchEvent
(watch [_ _ _]
(->> (rx/zip (rp/query :file-raw {:id file-id})
(rp/query :team-users {:file-id file-id})
(rp/query :project {:id project-id})
(rp/query :file-libraries {:file-id file-id}))
(rx/take 1)
(rx/map (fn [[file-raw users project libraries]]
{:file-raw file-raw
:users users
:project project
:libraries libraries}))
(rx/mapcat (fn [{:keys [project] :as bundle}]
(rx/of (ptk/data-event ::bundle-fetched bundle)
(df/load-team-fonts (:team-id project)))))))))
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rx/zip (rp/query! :file-raw {:id file-id})
(rp/query! :team-users {:file-id file-id})
(rp/query! :project {:id project-id})
(rp/query! :file-libraries {:file-id file-id})
(rp/cmd! :get-profiles-for-file-comments {:file-id file-id :share-id share-id}))
(rx/take 1)
(rx/map (fn [[file-raw users project libraries file-comments-users]]
{:file-raw file-raw
:users users
:project project
:libraries libraries
:file-comments-users file-comments-users}))
(rx/mapcat (fn [{:keys [project] :as bundle}]
(rx/of (ptk/data-event ::bundle-fetched bundle)
(df/load-team-fonts (:team-id project))))))))))
;; --- Helpers

71
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -8,24 +8,25 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as geom]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.spec.interactions :as cti]
[app.common.spec.page :as ctp]
[app.common.types.page :as ctp]
[app.common.types.shape.interactions :as ctsi]
[app.common.uuid :as uuid]
[app.main.data.modal :as md]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.collapse :as dwc]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.thumbnails :as dwt]
[app.main.data.workspace.zoom :as dwz]
[app.main.refs :as refs]
[app.main.streams :as ms]
[app.main.worker :as uw]
[app.util.names :as un]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
@ -41,6 +42,8 @@
(s/def ::set-of-string
(s/every string? :kind set?))
(defn interrupt? [e] (= e :interrupt))
;; --- Selection Rect
(declare select-shapes-by-current-selrect)
@ -59,7 +62,7 @@
ptk/WatchEvent
(watch [_ state stream]
(let [zoom (get-in state [:workspace-local :zoom] 1)
stop? (fn [event] (or (dwc/interrupt? event) (ms/mouse-up? event)))
stop? (fn [event] (or (interrupt? event) (ms/mouse-up? event)))
stoper (->> stream (rx/filter stop?))
init-selrect
@ -180,24 +183,28 @@
(ptk/reify ::select-all
ptk/WatchEvent
(watch [_ state _]
(let [focus (:workspace-focus-selected state)
(let [;; Make the select-all aware of the focus mode; in this
;; case delimit the objects to the focused shapes if focus
;; mode is active
focus (:workspace-focus-selected state)
objects (-> (wsh/lookup-page-objects state)
(cp/focus-objects focus))
selected (let [frame-ids (into #{} (comp
(map (d/getf objects))
(map :frame-id))
(wsh/lookup-selected state))
frame-id (if (= 1 (count frame-ids))
(first frame-ids)
uuid/zero)]
(cph/get-immediate-children objects frame-id))
lookup (d/getf objects)
parents (->> (wsh/lookup-selected state)
(into #{} (comp (keep lookup) (map :parent-id))))
selected (into (d/ordered-set)
(comp (remove :blocked) (map :id))
selected)]
;; If we have a only unique parent, then use it as main
;; anchor for the selection; if not, use the root frame as
;; parent
parent (if (= 1 (count parents))
(-> parents first lookup)
(lookup uuid/zero))
(rx/of (select-shapes selected))))))
toselect (->> (cph/get-immediate-children objects (:id parent))
(into (d/ordered-set) (comp (remove :blocked) (map :id))))]
(rx/of (select-shapes toselect))))))
(defn deselect-all
"Clear all possible state of drawing, edition
@ -264,7 +271,7 @@
;; in the later vector position
selected (->> children
reverse
(d/seek #(geom/has-point? % position)))]
(d/seek #(gsh/has-point? % position)))]
(when selected
(rx/of (select-shape (:id selected))))))))
@ -281,7 +288,7 @@
move to the desired position, and recalculate parents and frames as needed."
[all-objects page ids delta it]
(let [shapes (map (d/getf all-objects) ids)
unames (volatile! (dwc/retrieve-used-names (:objects page)))
unames (volatile! (un/retrieve-used-names (:objects page)))
update-unames! (fn [new-name] (vswap! unames conj new-name))
all-ids (reduce #(into %1 (cons %2 (cph/get-children-ids all-objects %2))) (d/ordered-set) ids)
ids-map (into {} (map #(vector % (uuid/next))) all-ids)
@ -316,7 +323,7 @@
(defn- prepare-duplicate-frame-change
[changes objects page unames update-unames! ids-map obj delta]
(let [new-id (ids-map (:id obj))
frame-name (dwc/generate-unique-name @unames (:name obj))
frame-name (un/generate-unique-name @unames (:name obj))
_ (update-unames! frame-name)
new-frame (-> obj
@ -325,8 +332,8 @@
:frame-id uuid/zero
:shapes [])
(dissoc :use-for-thumbnail?)
(geom/move delta)
(d/update-when :interactions #(cti/remap-interactions % ids-map objects)))
(gsh/move delta)
(d/update-when :interactions #(ctsi/remap-interactions % ids-map objects)))
changes (-> (pcb/add-object changes new-frame)
(pcb/amend-last-change #(assoc % :old-id (:id obj))))
@ -351,7 +358,7 @@
(if (some? obj)
(let [new-id (ids-map (:id obj))
parent-id (or parent-id frame-id)
name (dwc/generate-unique-name @unames (:name obj))
name (un/generate-unique-name @unames (:name obj))
_ (update-unames! name)
new-obj (-> obj
@ -360,8 +367,8 @@
:parent-id parent-id
:frame-id frame-id)
(dissoc :shapes)
(geom/move delta)
(d/update-when :interactions #(cti/remap-interactions % ids-map objects)))
(gsh/move delta)
(d/update-when :interactions #(ctsi/remap-interactions % ids-map objects)))
changes (-> (pcb/add-object changes new-obj {:ignore-touched true})
(pcb/amend-last-change #(assoc % :old-id (:id obj))))]
@ -392,7 +399,7 @@
(let [update-flows (fn [flows]
(reduce
(fn [flows frame]
(let [name (dwc/generate-unique-name @unames "Flow-1")
(let [name (un/generate-unique-name @unames "Flow-1")
_ (vswap! unames conj name)
new-flow {:id (uuid/next)
:name name
@ -412,7 +419,7 @@
(fn [g frame]
(let [new-id (ids-map (:id frame))
new-frame (-> frame
(geom/move delta))
(gsh/move delta))
new-guides (->> guides
(vals)
(filter #(= (:frame-id %) (:id frame)))
@ -422,11 +429,9 @@
(assoc :position (if (= (:axis %) :x)
(+ (:position %) (- (:x new-frame) (:x frame)))
(+ (:position %) (- (:y new-frame) (:y frame))))))))]
(if-not (empty? new-guides)
(conj g
(into {} (map (juxt :id identity) new-guides)))
{})))
(cond-> g
(not-empty new-guides)
(conj (into {} (map (juxt :id identity) new-guides))))))
guides
frames)]
(-> (pcb/with-page changes page)

269
frontend/src/app/main/data/workspace/shapes.cljs Normal file
View file

@ -0,0 +1,269 @@
;; 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.shapes
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.proportions :as gpr]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.types.page :as csp]
[app.common.types.shape :as spec.shape]
[app.common.types.shape.interactions :as csi]
[app.common.uuid :as uuid]
[app.main.data.comments :as dc]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.streams :as ms]
[app.util.names :as un]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(s/def ::shape-attrs ::spec.shape/shape-attrs)
(defn get-shape-layer-position
[objects selected attrs]
;; Calculate the frame over which we're drawing
(let [position @ms/mouse-position
frame-id (:frame-id attrs (cph/frame-id-by-position objects position))
shape (when-not (empty? selected)
(cph/get-base-shape objects selected))]
;; When no shapes has been selected or we're over a different frame
;; we add it as the latest shape of that frame
(if (or (not shape) (not= (:frame-id shape) frame-id))
[frame-id frame-id nil]
;; Otherwise, we add it to next to the selected shape
(let [index (cph/get-position-on-parent objects (:id shape))
{:keys [frame-id parent-id]} shape]
[frame-id parent-id (inc index)]))))
(defn make-new-shape
[attrs objects selected]
(let [default-attrs (if (= :frame (:type attrs))
cp/default-frame-attrs
cp/default-shape-attrs)
selected-non-frames
(into #{} (comp (map (d/getf objects))
(remove cph/frame-shape?))
selected)
[frame-id parent-id index]
(get-shape-layer-position objects selected-non-frames attrs)]
(-> (merge default-attrs attrs)
(gpr/setup-proportions)
(assoc :frame-id frame-id
:parent-id parent-id
:index index))))
(defn add-shape
([attrs]
(add-shape attrs {}))
([attrs {:keys [no-select?]}]
(us/verify ::shape-attrs attrs)
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
selected (wsh/lookup-selected state)
id (or (:id attrs) (uuid/next))
name (-> objects
(un/retrieve-used-names)
(un/generate-unique-name (:name attrs)))
shape (make-new-shape
(assoc attrs :id id :name name)
objects
selected)
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/add-object shape)
(cond-> (some? (:parent-id attrs))
(pcb/change-parent (:parent-id attrs) [shape])))]
(rx/concat
(rx/of (dch/commit-changes changes)
(when-not no-select?
(dws/select-shapes (d/ordered-set id))))
(when (= :text (:type attrs))
(->> (rx/of (dwe/start-edition-mode id))
(rx/observe-on :async)))))))))
(defn move-shapes-into-frame [frame-id shapes]
(ptk/reify ::move-shapes-into-frame
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
to-move-shapes
(into []
(map (d/getf objects))
(reverse (cph/sort-z-index objects shapes)))
changes
(when (d/not-empty? to-move-shapes)
(-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/change-parent frame-id to-move-shapes 0)))]
(if (some? changes)
(rx/of (dch/commit-changes changes))
(rx/empty))))))
(s/def ::set-of-uuid
(s/every ::us/uuid :kind set?))
(defn delete-shapes
[ids]
(us/assert ::set-of-uuid ids)
(ptk/reify ::delete-shapes
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
page (wsh/lookup-page state page-id)
ids (cph/clean-loops objects ids)
lookup (d/getf objects)
groups-to-unmask
(reduce (fn [group-ids id]
;; When the shape to delete is the mask of a masked group,
;; the mask condition must be removed, and it must be
;; converted to a normal group.
(let [obj (lookup id)
parent (lookup (:parent-id obj))]
(if (and (:masked-group? parent)
(= id (first (:shapes parent))))
(conj group-ids (:id parent))
group-ids)))
#{}
ids)
interacting-shapes
(filter (fn [shape]
;; If any of the deleted shapes is the destination of
;; some interaction, this must be deleted, too.
(let [interactions (:interactions shape)]
(some #(and (csi/has-destination %)
(contains? ids (:destination %)))
interactions)))
(vals objects))
;; If any of the deleted shapes is a frame with guides
guides (into {}
(comp (map second)
(remove #(contains? ids (:frame-id %)))
(map (juxt :id identity)))
(dm/get-in page [:options :guides]))
starting-flows
(filter (fn [flow]
;; If any of the deleted is a frame that starts a flow,
;; this must be deleted, too.
(contains? ids (:starting-frame flow)))
(-> page :options :flows))
all-parents
(reduce (fn [res id]
;; All parents of any deleted shape must be resized.
(into res (cph/get-parent-ids objects id)))
(d/ordered-set)
ids)
all-children
(->> ids ;; Children of deleted shapes must be also deleted.
(reduce (fn [res id]
(into res (cph/get-children-ids objects id)))
[])
(reverse)
(into (d/ordered-set)))
find-all-empty-parents
(fn recursive-find-empty-parents [empty-parents]
(let [all-ids (into empty-parents ids)
contains? (partial contains? all-ids)
xform (comp (map lookup)
(filter cph/group-shape?)
(remove #(->> (:shapes %) (remove contains?) seq))
(map :id))
parents (into #{} xform all-parents)]
(if (= empty-parents parents)
empty-parents
(recursive-find-empty-parents parents))))
empty-parents
;; Any parent whose children are all deleted, must be deleted too.
(into (d/ordered-set) (find-all-empty-parents #{}))
changes (-> (pcb/empty-changes it page-id)
(pcb/with-page page)
(pcb/with-objects objects)
(pcb/set-page-option :guides guides)
(pcb/remove-objects all-children)
(pcb/remove-objects ids)
(pcb/remove-objects empty-parents)
(pcb/resize-parents all-parents)
(pcb/update-shapes groups-to-unmask
(fn [shape]
(assoc shape :masked-group? false)))
(pcb/update-shapes (map :id interacting-shapes)
(fn [shape]
(d/update-when shape :interactions
(fn [interactions]
(into []
(remove #(and (csi/has-destination %)
(contains? ids (:destination %))))
interactions)))))
(cond-> (seq starting-flows)
(pcb/update-page-option :flows (fn [flows]
(->> (map :id starting-flows)
(reduce csp/remove-flow flows))))))]
(rx/of
(dc/detach-comment-thread ids)
(dch/commit-changes changes))))))
(defn- viewport-center
[state]
(let [{:keys [x y width height]} (get-in state [:workspace-local :vbox])]
[(+ x (/ width 2)) (+ y (/ height 2))]))
(defn create-and-add-shape
[type frame-x frame-y data]
(ptk/reify ::create-and-add-shape
ptk/WatchEvent
(watch [_ state _]
(prn ">>>create-")
(let [{:keys [width height]} data
[vbc-x vbc-y] (viewport-center state)
x (:x data (- vbc-x (/ width 2)))
y (:y data (- vbc-y (/ height 2)))
page-id (:current-page-id state)
frame-id (-> (wsh/lookup-page-objects state page-id)
(cph/frame-id-by-position {:x frame-x :y frame-y}))
shape (-> (cp/make-minimal-shape type)
(merge data)
(merge {:x x :y y})
(assoc :frame-id frame-id)
(cp/setup-rect-selrect))]
(rx/of (add-shape shape))))))

4
frontend/src/app/main/data/workspace/shortcuts.cljs
View file

@ -208,8 +208,8 @@
;; TOOLS
:draw-frame {:tooltip "A"
:command "a"
:draw-frame {:tooltip "B"
:command ["b" "a"]
:subsections [:tools :basics]
:fn #(st/emit! (dwd/select-for-drawing :frame))}

8
frontend/src/app/main/data/workspace/state_helpers.cljs
View file

@ -70,6 +70,14 @@
selected (dm/get-in state [:workspace-local :selected])]
(process-selected-shapes objects selected options))))
(defn lookup-shape
([state id]
(lookup-shape state (:current-page-id state) id))
([state page-id id]
(let [objects (lookup-page-objects state page-id)]
(get objects id))))
(defn lookup-shapes
([state ids]
(lookup-shapes state (:current-page-id state) ids))

16
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -17,9 +17,11 @@
[app.common.spec :refer [max-safe-int min-safe-int]]
[app.common.uuid :as uuid]
[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.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
[app.util.color :as uc]
[app.util.names :as un]
[app.util.path.parser :as upp]
[app.util.svg :as usvg]
[beicon.core :as rx]
@ -358,7 +360,7 @@
(let [{:keys [tag attrs hidden]} element-data
attrs (usvg/format-styles attrs)
element-data (cond-> element-data (map? element-data) (assoc :attrs attrs))
name (dwc/generate-unique-name unames (or (:id attrs) (tag->name tag)))
name (un/generate-unique-name unames (or (:id attrs) (tag->name tag)))
att-refs (usvg/find-attr-references attrs)
references (usvg/find-def-references (:defs svg-data) att-refs)
@ -415,7 +417,7 @@
(if (some? shape)
(let [shape-id (:id shape)
new-shape (dwc/make-new-shape shape objects selected)
new-shape (dwsh/make-new-shape shape objects selected)
changes (-> changes
(pcb/add-object new-shape)
(pcb/change-parent parent-id [new-shape] index))
@ -442,10 +444,10 @@
x (- x vb-x (/ vb-width 2))
y (- y vb-y (/ vb-height 2))
unames (dwc/retrieve-used-names objects)
unames (un/retrieve-used-names objects)
svg-name (->> (str/replace (:name svg-data) ".svg" "")
(dwc/generate-unique-name unames))
(un/generate-unique-name unames))
svg-data (-> svg-data
(assoc :x x
@ -482,7 +484,7 @@
(assoc :content (into [base-background-shape] (:content svg-data))))
;; Creates the root shape
new-shape (dwc/make-new-shape root-shape objects selected)
new-shape (dwsh/make-new-shape root-shape objects selected)
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
@ -506,7 +508,7 @@
vec))]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set root-id))))
(dws/select-shapes (d/ordered-set root-id))))
(catch :default e
(.error js/console "Error SVG" e)

3
frontend/src/app/main/data/workspace/texts.cljs
View file

@ -17,6 +17,7 @@
[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.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[app.util.router :as rt]
@ -78,7 +79,7 @@
(when (some? id)
(rx/of (dws/deselect-shape id)
(dwc/delete-shapes #{id})))))))))
(dwsh/delete-shapes #{id})))))))))
(defn initialize-editor-state
[{:keys [id content] :as shape} decorator]

50
frontend/src/app/main/data/workspace/thumbnails.cljs
View file

@ -34,7 +34,7 @@
(fn [subs]
;; We look in the DOM a canvas that 1) matches the id and 2) that it's not empty
;; will be empty on first rendering before drawing the thumbnail and we don't want to store that
(let [node (dom/query (dm/fmt "canvas.thumbnail-canvas[data-object-id='%']:not([data-empty])" object-id))]
(let [node (dom/query (dm/fmt "canvas.thumbnail-canvas[data-object-id='%'][data-empty='false']" object-id))]
(if (some? node)
(-> node
(.toBlob (fn [blob]
@ -56,29 +56,35 @@
(defn update-thumbnail
"Updates the thumbnail information for the given frame `id`"
[page-id frame-id]
(ptk/reify ::update-thumbnail
ptk/WatchEvent
(watch [_ state _]
(let [object-id (dm/str page-id frame-id)
file-id (:current-file-id state)
blob-result (thumbnail-stream object-id)]
([page-id frame-id]
(update-thumbnail nil page-id frame-id))
(->> blob-result
(rx/merge-map
(fn [blob]
(if (some? blob)
(wapi/read-file-as-data-url blob)
(rx/of nil))))
([file-id page-id frame-id]
(ptk/reify ::update-thumbnail
ptk/WatchEvent
(watch [_ state _]
(let [object-id (dm/str page-id frame-id)
file-id (or file-id (:current-file-id state))
blob-result (thumbnail-stream object-id)]
(rx/merge-map
(fn [data]
(let [params {:file-id file-id :object-id object-id :data data}]
(rx/merge
;; Update the local copy of the thumbnails so we don't need to request it again
(rx/of #(assoc-in % [:workspace-file :thumbnails object-id] data))
(->> (rp/mutation! :upsert-file-object-thumbnail params)
(rx/ignore)))))))))))
(->> blob-result
(rx/merge-map
(fn [blob]
(if (some? blob)
(wapi/read-file-as-data-url blob)
(rx/of nil))))
(rx/merge-map
(fn [data]
(if (some? file-id)
(let [params {:file-id file-id :object-id object-id :data data}]
(rx/merge
;; Update the local copy of the thumbnails so we don't need to request it again
(rx/of #(assoc-in % [:workspace-file :thumbnails object-id] data))
(->> (rp/mutation! :upsert-file-object-thumbnail params)
(rx/ignore))))
(rx/empty))))))))))
(defn- extract-frame-changes
"Process a changes set in a commit to extract the frames that are changing"

127
frontend/src/app/main/data/workspace/transforms.cljs
View file

@ -17,7 +17,8 @@
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.collapse :as dwc]
[app.main.data.workspace.comments :as dwcm]
[app.main.data.workspace.guides :as dwg]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
@ -181,50 +182,59 @@
(assoc :grow-type :fixed))))
(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)
ids-with-children (into (vec ids) (mapcat #(cph/get-children-ids objects %)) ids)
object-modifiers (get state :workspace-modifiers)
shapes (map (d/getf objects) ids)
ignore-tree (->> (map #(get-ignore-tree object-modifiers objects %) shapes)
(reduce merge {}))]
([ids]
(apply-modifiers ids nil))
(rx/of (dwu/start-undo-transaction)
(dwg/move-frame-guides ids-with-children)
(dch/update-shapes
ids-with-children
(fn [shape]
(let [modif (get object-modifiers (:id shape))
text-shape? (cph/text-shape? shape)]
(-> shape
(merge modif)
(gsh/transform-shape)
(cond-> text-shape?
(update-grow-type 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
:position-data
:flip-x
:flip-y
:grow-type]})
(clear-local-transform)
(dwu/commit-undo-transaction))))))
([ids {:keys [undo-transation?] :or {undo-transation? true}}]
(us/verify (s/coll-of uuid?) ids)
(ptk/reify ::apply-modifiers
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
ids-with-children (into (vec ids) (mapcat #(cph/get-children-ids objects %)) ids)
object-modifiers (get state :workspace-modifiers)
shapes (map (d/getf objects) ids)
ignore-tree (->> (map #(get-ignore-tree object-modifiers objects %) shapes)
(reduce merge {}))]
(rx/concat
(if undo-transation?
(rx/of (dwu/start-undo-transaction))
(rx/empty))
(rx/of (dwg/move-frame-guides ids-with-children)
(dwcm/move-frame-comment-threads ids-with-children)
(dch/update-shapes
ids-with-children
(fn [shape]
(let [modif (get object-modifiers (:id shape))
text-shape? (cph/text-shape? shape)]
(-> shape
(merge modif)
(gsh/transform-shape)
(cond-> text-shape?
(update-grow-type 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
:position-data
:flip-x
:flip-y
:grow-type]})
(clear-local-transform))
(if undo-transation?
(rx/of (dwu/commit-undo-transaction))
(rx/empty))))))))
(defn- check-delta
"If the shape is a component instance, check its relative position respect the
@ -274,9 +284,9 @@
(defn set-pixel-precision
"Adjust modifiers so they adjust to the pixel grid"
[modifiers shape]
[{:keys [resize-transform] :as modifiers} shape]
(if (some? (:resize-transform modifiers))
(if (and (some? resize-transform) (not (gmt/unit? resize-transform)))
;; If we're working with a rotation we don't handle pixel precision because
;; the transformation won't have the precision anyway
modifiers
@ -762,9 +772,11 @@
(rx/map (partial set-modifiers ids))
(rx/take-until stopper))
(rx/of (apply-modifiers ids)
(rx/of (dwu/start-undo-transaction)
(calculate-frame-for-move ids)
(finish-transform)))))))))
(apply-modifiers ids {:undo-transation? false})
(finish-transform)
(dwu/commit-undo-transaction)))))))))
(s/def ::direction #{:up :down :right :left})
@ -852,20 +864,23 @@
objects (wsh/lookup-page-objects state page-id)
frame-id (cph/frame-id-by-position objects position)
moving-shapes (->> ids
(cph/clean-loops objects)
(map #(get objects %))
(remove #(or (nil? %)
(= (:frame-id %) frame-id))))
moving-shapes
(->> ids
(cph/clean-loops objects)
(keep #(get objects %))
(remove #(= (:frame-id %) frame-id)))
moving-frames
(->> ids
(filter #(cph/frame-shape? objects %)))
changes (-> (pcb/empty-changes it page-id)
(pcb/with-objects objects)
(pcb/update-shapes moving-frames (fn [shape] (assoc shape :hide-in-viewer true)))
(pcb/change-parent frame-id moving-shapes))]
(when-not (empty? changes)
(rx/of dwu/pop-undo-into-transaction
(dch/commit-changes changes)
(dwu/commit-undo-transaction)
(rx/of (dch/commit-changes changes)
(dwc/expand-collapse frame-id)))))))
(defn- get-displacement

6
frontend/src/app/main/data/workspace/undo.cljs
View file

@ -6,8 +6,8 @@
(ns app.main.data.workspace.undo
(:require
[app.common.pages.changes-spec :as pcs]
[app.common.spec :as us]
[app.common.spec.change :as spec.change]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
@ -15,8 +15,8 @@
;; Undo / Redo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::undo-changes ::spec.change/changes)
(s/def ::redo-changes ::spec.change/changes)
(s/def ::undo-changes ::pcs/changes)
(s/def ::redo-changes ::pcs/changes)
(s/def ::undo-entry
(s/keys :req-un [::undo-changes ::redo-changes]))

148
frontend/src/app/main/data/workspace/viewport.cljs Normal file
View file

@ -0,0 +1,148 @@
;; 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.viewport
(:require
[app.common.data :as d]
[app.common.geom.align :as gal]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.streams :as ms]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn initialize-viewport
[{:keys [width height] :as size}]
(letfn [(update* [{:keys [vport] :as local}]
(let [wprop (/ (:width vport) width)
hprop (/ (:height vport) height)]
(-> local
(assoc :vport size)
(update :vbox (fn [vbox]
(-> vbox
(update :width #(/ % wprop))
(update :height #(/ % hprop))))))))
(initialize [state local]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state page-id)
shapes (cph/get-immediate-children objects)
srect (gsh/selection-rect shapes)
local (assoc local :vport size :zoom 1)]
(cond
(or (not (d/num? (:width srect)))
(not (d/num? (:height srect))))
(assoc local :vbox (assoc size :x 0 :y 0))
(or (> (:width srect) width)
(> (:height srect) height))
(let [srect (gal/adjust-to-viewport size srect {:padding 40})
zoom (/ (:width size) (:width srect))]
(-> local
(assoc :zoom zoom)
(update :vbox merge srect)))
:else
(assoc local :vbox (assoc size
:x (+ (:x srect) (/ (- (:width srect) width) 2))
:y (+ (:y srect) (/ (- (:height srect) height) 2)))))))
(setup [state local]
(if (and (:vbox local) (:vport local))
(update* local)
(initialize state local)))]
(ptk/reify ::initialize-viewport
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local
(fn [local]
(setup state local)))))))
(defn update-viewport-position
[{:keys [x y] :or {x identity y identity}}]
(us/assert fn? x)
(us/assert fn? y)
(ptk/reify ::update-viewport-position
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :vbox]
(fn [vbox]
(-> vbox
(update :x x)
(update :y y)))))))
(defn update-viewport-size
[resize-type {:keys [width height] :as size}]
(ptk/reify ::update-viewport-size
ptk/UpdateEvent
(update [_ state]
(update state :workspace-local
(fn [{:keys [vport] :as local}]
(if (or (nil? vport)
(mth/almost-zero? width)
(mth/almost-zero? height))
;; If we have a resize to zero just keep the old value
local
(let [wprop (/ (:width vport) width)
hprop (/ (:height vport) height)
vbox (:vbox local)
vbox-x (:x vbox)
vbox-y (:y vbox)
vbox-width (:width vbox)
vbox-height (:height vbox)
vbox-width' (/ vbox-width wprop)
vbox-height' (/ vbox-height hprop)
vbox-x'
(case resize-type
:left (+ vbox-x (- vbox-width vbox-width'))
:right vbox-x
(+ vbox-x (/ (- vbox-width vbox-width') 2)))
vbox-y'
(case resize-type
:top (+ vbox-y (- vbox-height vbox-height'))
:bottom vbox-y
(+ vbox-y (/ (- vbox-height vbox-height') 2)))]
(-> local
(assoc :vport size)
(assoc-in [:vbox :x] vbox-x')
(assoc-in [:vbox :y] vbox-y')
(assoc-in [:vbox :width] vbox-width')
(assoc-in [:vbox :height] vbox-height')))))))))
(defn start-panning []
(ptk/reify ::start-panning
ptk/WatchEvent
(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])
(rx/concat
(rx/of #(-> % (assoc-in [:workspace-local :panning] true)))
(->> stream
(rx/filter ms/pointer-event?)
(rx/filter #(= :delta (:source %)))
(rx/map :pt)
(rx/take-until stopper)
(rx/map (fn [delta]
(let [delta (gpt/divide delta zoom)]
(update-viewport-position {:x #(- % (:x delta))
:y #(- % (:y delta))})))))))))))
(defn finish-panning []
(ptk/reify ::finish-panning
ptk/UpdateEvent
(update [_ state]
(-> state
(update :workspace-local dissoc :panning)))))

32
frontend/src/app/main/errors.cljs
View file

@ -21,6 +21,7 @@
[app.util.router :as rt]
[app.util.storage :refer [storage]]
[app.util.timers :as ts]
[cuerdas.core :as str]
[potok.core :as ptk]))
(defn on-error
@ -45,6 +46,14 @@
;; Set the main potok error handler
(reset! st/on-error on-error)
(defmethod ptk/handle-error :default
[error]
(let [hint (str/concat "Unexpected error: " (:hint error))]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group hint)
(ex/ignoring (js/console.error (pr-str error)))
(js/console.groupEnd hint)))
;; We receive a explicit authentication error; this explicitly clears
;; all profile data and redirect the user to the login page. This is
;; here and not in app.main.errors because of circular dependency.
@ -105,7 +114,6 @@
(js/console.groupEnd msg)))
;; Error on parsing an SVG
;; TODO: looks unused and deprecated
(defmethod ptk/handle-error :svg-parser
@ -187,14 +195,20 @@
(defn on-unhandled-error
[error]
(if (instance? ExceptionInfo error)
(-> error ex-data ptk/handle-error)
(let [hint (ex-message error)
msg (dm/str "Unhandled Internal Error: " hint)]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group msg)
(ex/ignoring (js/console.error error))
(js/console.groupEnd msg))))
(letfn [(is-ignorable-exception? [cause]
(let [message (ex-message cause)]
(or (= message "Possible side-effect in debug-evaluate")
(= message "Unexpected end of input") true
(str/starts-with? message "Unexpected token "))))]
(if (instance? ExceptionInfo error)
(-> error ex-data ptk/handle-error)
(when-not (is-ignorable-exception? error)
(let [hint (ex-message error)
msg (dm/str "Unhandled Internal Error: " hint)]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group msg)
(ex/ignoring (js/console.error error))
(js/console.groupEnd msg))))))
(defonce uncaught-error-handler
(letfn [(on-error [event]

24
frontend/src/app/main/refs.cljs
View file

@ -209,7 +209,7 @@
(def workspace-recent-fonts
(l/derived (fn [data]
(get data :workspace-data []))
(get data :recent-fonts []))
workspace-data))
(def workspace-file-typography
@ -270,6 +270,14 @@
(into [] (keep (d/getf objects)) children-ids)))
workspace-page-objects =))
(defn all-children-objects
[id]
(l/derived
(fn [objects]
(let [children-ids (cph/get-children-ids objects id)]
(into [] (keep (d/getf objects)) children-ids)))
workspace-page-objects =))
(def workspace-page-options
(l/derived :options workspace-page))
@ -306,8 +314,11 @@
(fn [{:keys [modifiers objects]}]
(let [keys (->> modifiers
(keys)
(filter #(or (= frame-id %)
(= frame-id (get-in objects [% :frame-id])))))]
(filter (fn [id]
(let [shape (get objects id)]
(or (= frame-id id)
(and (= frame-id (:frame-id shape))
(not (= :frame (:type shape)))))))))]
(select-keys modifiers keys)))
workspace-modifiers-with-objects
=))
@ -376,6 +387,9 @@
(def users
(l/derived :users st/state))
(def current-file-comments-users
(l/derived :current-file-comments-users st/state))
(def viewer-fullscreen?
(l/derived (fn [state]
(dm/get-in state [:viewer-local :fullscreen?]))
@ -396,3 +410,7 @@
(defn workspace-text-modifier-by-id [id]
(l/derived #(get % id) workspace-text-modifier =))
(def colorpicker
(l/derived :colorpicker st/state))

239
frontend/src/app/main/render.cljs
View file

@ -14,11 +14,11 @@
(:require
["react-dom/server" :as rds]
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bounds :as gsb]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.config :as cfg]
@ -28,7 +28,6 @@
[app.main.ui.shapes.circle :as circle]
[app.main.ui.shapes.embed :as embed]
[app.main.ui.shapes.export :as export]
[app.main.ui.shapes.filters :as filters]
[app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.group :as group]
[app.main.ui.shapes.image :as image]
@ -61,9 +60,11 @@
(defn- calculate-dimensions
[objects]
(let [shapes (cph/get-immediate-children objects)
rect (gsh/selection-rect shapes)]
(-> rect
(let [bounds
(->> (cph/get-root-objects objects)
(map (partial gsb/get-object-bounds objects))
(gsh/join-rects))]
(-> bounds
(update :x mth/finite 0)
(update :y mth/finite 0)
(update :width mth/finite 100000)
@ -77,10 +78,13 @@
frame-shape (frame/frame-shape shape-wrapper)]
(mf/fnc frame-wrapper
[{:keys [shape] :as props}]
(let [childs (mapv #(get objects %) (:shapes shape))
(let [render-thumbnails? (mf/use-ctx muc/render-thumbnails)
childs (mapv #(get objects %) (:shapes shape))
shape (gsh/transform-shape shape)]
[:> shape-container {:shape shape}
[:& frame-shape {:shape shape :childs childs}]]))))
(if (and render-thumbnails? (some? (:thumbnail shape)))
[:& frame/frame-thumbnail {:shape shape :bounds (:children-bounds shape)}]
[:& frame-shape {:shape shape :childs childs}])))))
(defn group-wrapper-factory
[objects]
@ -169,7 +173,7 @@
[objects object-id]
(let [object (get objects object-id)
object (cond->> object
(cph/root-frame? object)
(cph/root? object)
(adapt-root-frame objects))
;; Replace the previous object with the new one
@ -186,136 +190,114 @@
(reduce updt-fn objects mod-ids)))
(defn get-object-bounds
[objects object-id]
(let [object (get objects object-id)
padding (filters/calculate-padding object true)
bounds (-> (filters/get-filters-bounds object)
(update :x - (:horizontal padding))
(update :y - (:vertical padding))
(update :width + (* 2 (:horizontal padding)))
(update :height + (* 2 (:vertical padding))))]
(if (cph/group-shape? object)
(if (:masked-group? object)
(get-object-bounds objects (-> object :shapes first))
(->> (:shapes object)
(into [bounds] (map (partial get-object-bounds objects)))
(gsh/join-rects)))
bounds)))
(mf/defc page-svg
{::mf/wrap [mf/memo]}
[{:keys [data thumbnails? render-embed? include-metadata?] :as props
:or {render-embed? false include-metadata? false}}]
(let [objects (:objects data)
shapes (cph/get-immediate-children objects)
dim (calculate-dimensions objects)
vbox (format-viewbox dim)
bgcolor (dm/get-in data [:options :background] default-color)
frame-wrapper
(mf/use-memo
(mf/deps objects)
#(frame-wrapper-factory objects))
shape-wrapper
(mf/use-memo
(mf/deps objects)
#(shape-wrapper-factory objects))]
[:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[:svg {:view-box vbox
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:style {:width "100%"
:height "100%"
:background bgcolor}
:fill "none"}
[:& (mf/provider muc/render-thumbnails) {:value thumbnails?}
[:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[:svg {:view-box vbox
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:style {:width "100%"
:height "100%"
:background bgcolor}
:fill "none"}
(when include-metadata?
[:& export/export-page {:options (:options data)}])
(when include-metadata?
[:& export/export-page {:options (:options data)}])
(let [shapes (->> shapes
(remove cph/frame-shape?)
(mapcat #(cph/get-children-with-self objects (:id %))))
fonts (ff/shapes->fonts shapes)]
[:& ff/fontfaces-style {:fonts fonts}])
(let [shapes (->> shapes
(remove cph/frame-shape?)
(mapcat #(cph/get-children-with-self objects (:id %))))
fonts (ff/shapes->fonts shapes)]
[:& ff/fontfaces-style {:fonts fonts}])
(for [item shapes]
(let [frame? (= (:type item) :frame)]
(cond
(and frame? thumbnails? (some? (:thumbnail item)))
[:> shape-container {:shape item}
[:& frame/frame-thumbnail {:shape item}]]
frame?
[:& frame-wrapper {:shape item
:key (:id item)}]
:else
[:& shape-wrapper {:shape item
:key (:id item)}])))]]]))
(for [item shapes]
[:& shape-wrapper {:shape item
:key (:id item)}])]]]]))
;; Component that serves for render frame thumbnails, mainly used in
;; the viewer and handoff
(mf/defc frame-svg
{::mf/wrap [mf/memo]}
[{:keys [objects frame zoom show-thumbnails?] :or {zoom 1} :as props}]
(let [frame-id (:id frame)
include-metadata? (mf/use-ctx export/include-metadata-ctx)
modifier
(mf/with-memo [(:x frame) (:y frame)]
(-> (gpt/point (:x frame) (:y frame))
(gpt/negate)
(gmt/translate-matrix)))
bounds (gsb/get-object-bounds objects frame)
;; Bounds without shadows/blur will be the bounds of the thumbnail
bounds2 (gsb/get-object-bounds objects (dissoc frame :shadow :blur))
delta-bounds (gpt/point (:x bounds) (:y bounds))
modifier (gmt/translate-matrix (gpt/negate delta-bounds))
children-ids
(cph/get-children-ids objects frame-id)
objects
(mf/with-memo [frame-id objects modifier]
(let [update-fn #(assoc-in %1 [%2 :modifiers :displacement] modifier)]
(->> (cph/get-children-ids objects frame-id)
(->> children-ids
(into [frame-id])
(reduce update-fn objects))))
frame
(mf/with-memo [modifier]
(assoc-in frame [:modifiers :displacement] modifier))
(-> frame
(assoc-in [:modifiers :displacement] modifier)
(gsh/transform-shape)))
wrapper
(mf/with-memo [objects]
(frame-wrapper-factory objects))
frame
(cond-> frame
(and (some? bounds) (nil? (:children-bounds bounds)))
(assoc :children-bounds bounds2))
width (* (:width frame) zoom)
height (* (:height frame) zoom)
vbox (format-viewbox {:width (:width frame 0) :height (:height frame 0)})]
frame (-> frame
(update-in [:children-bounds :x] - (:x delta-bounds))
(update-in [:children-bounds :y] - (:y delta-bounds)))
[:svg {:view-box vbox
:width (ust/format-precision width viewbox-decimal-precision)
:height (ust/format-precision height viewbox-decimal-precision)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:fill "none"}
(if (or (not show-thumbnails?) (nil? (:thumbnail frame)))
[:& wrapper {:shape frame :view-box vbox}]
shape-wrapper
(mf/use-memo
(mf/deps objects)
#(shape-wrapper-factory objects))
;; Render the frame thumbnail
(let [frame (gsh/transform-shape frame)]
[:> shape-container {:shape frame}
[:& frame/frame-thumbnail {:shape frame}]]))]))
width (* (:width bounds) zoom)
height (* (:height bounds) zoom)
vbox (format-viewbox {:width (:width bounds 0) :height (:height bounds 0)})]
[:& (mf/provider muc/render-thumbnails) {:value show-thumbnails?}
[:svg {:view-box vbox
:width (ust/format-precision width viewbox-decimal-precision)
:height (ust/format-precision height viewbox-decimal-precision)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:fill "none"}
[:& shape-wrapper {:shape frame}]]]))
;; Component for rendering a thumbnail of a single componenent. Mainly
;; used to render thumbnails on assets panel.
(mf/defc component-svg
{::mf/wrap [mf/memo #(mf/deferred % ts/idle-then-raf)]}
[{:keys [objects group zoom] :or {zoom 1} :as props}]
@ -363,7 +345,7 @@
(mf/defc object-svg
{::mf/wrap [mf/memo]}
[{:keys [objects object-id render-texts? render-embed?]
[{:keys [objects object-id render-embed?]
:or {render-embed? false}
:as props}]
(let [object (get objects object-id)
@ -371,60 +353,31 @@
(:hide-fill-on-export object)
(assoc :fills []))
{:keys [x y width height]} (get-object-bounds objects object-id)
vbox (dm/str x " " y " " width " " height)
frame-wrapper
(mf/with-memo [objects]
(frame-wrapper-factory objects))
group-wrapper
(mf/with-memo [objects]
(group-wrapper-factory objects))
{:keys [width height] :as bounds} (gsb/get-object-bounds objects object)
vbox (format-viewbox bounds)
fonts (ff/shape->fonts object objects)
shape-wrapper
(mf/with-memo [objects]
(shape-wrapper-factory objects))
(shape-wrapper-factory objects))]
text-shapes (sequence (filter cph/text-shape?) (vals objects))
render-texts? (and render-texts? (d/seek (comp nil? :position-data) text-shapes))]
[:& (mf/provider export/include-metadata-ctx) {:value false}
[:& (mf/provider embed/context) {:value render-embed?}
[:svg {:id (dm/str "screenshot-" object-id)
:view-box vbox
:width (ust/format-precision width viewbox-decimal-precision)
:height (ust/format-precision height viewbox-decimal-precision)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
;; Fix Chromium bug about color of html texts
;; https://bugs.chromium.org/p/chromium/issues/detail?id=1244560#c5
:style {:-webkit-print-color-adjust :exact}
:fill "none"}
[:& (mf/provider embed/context) {:value render-embed?}
[:svg {:id (dm/str "screenshot-" object-id)
:view-box vbox
:width width
:height height
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
;; Fix Chromium bug about color of html texts
;; https://bugs.chromium.org/p/chromium/issues/detail?id=1244560#c5
:style {:-webkit-print-color-adjust :exact}
:fill "none"}
(let [fonts (ff/shape->fonts object objects)]
[:& ff/fontfaces-style {:fonts fonts}])
(case (:type object)
:frame [:& frame-wrapper {:shape object :view-box vbox}]
:group [:> shape-container {:shape object}
[:& group-wrapper {:shape object}]]
[:& shape-wrapper {:shape object}])]
;; Auxiliary SVG for rendering text-shapes
(when render-texts?
(for [object text-shapes]
[:& (mf/provider muc/text-plain-colors-ctx) {:value true}
[:svg
{:id (dm/str "screenshot-text-" (:id object))
:view-box (dm/str "0 0 " (:width object) " " (:height object))
:width (:width object)
:height (:height object)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:fill "none"}
[:& shape-wrapper {:shape (assoc object :x 0 :y 0)}]]]))]))
[:& ff/fontfaces-style {:fonts fonts}]
[:& shape-wrapper {:shape object}]]]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SPRITES (DEBUG)

39
frontend/src/app/main/repo.cljs
View file

@ -73,10 +73,23 @@
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))
(defn- send-command!
"A simple helper for a common case of sending and receiving transit
data to the penpot mutation api."
[id params {:keys [response-type form-data?]}]
(->> (http/send! {:method :post
:uri (u/join base-uri "api/rpc/command/" (name id))
:credentials "include"
:body (if form-data? (http/form-data params) (http/transit-data params))
:response-type (or response-type :text)})
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))
(defn- dispatch [& args] (first args))
(defmulti query dispatch)
(defmulti mutation dispatch)
(defmulti command dispatch)
(defmethod query :default
[id params]
@ -90,6 +103,18 @@
[id params]
(send-mutation! id params))
(defmethod command :default
[id params]
(send-command! id params nil))
(defmethod command :export-binfile
[id params]
(send-command! id params {:response-type :blob}))
(defmethod command :import-binfile
[id params]
(send-command! id params {:form-data? true}))
(defn query!
([id] (query id {}))
([id params] (query id params)))
@ -98,7 +123,15 @@
([id] (mutation id {}))
([id params] (mutation id params)))
(defmethod mutation :login-with-oauth
(defn command!
([id] (command id {}))
([id params] (command id params)))
(defn cmd!
([id] (command id {}))
([id params] (command id params)))
(defmethod command :login-with-oidc
[_ {:keys [provider] :as params}]
(let [uri (u/join base-uri "api/auth/oauth/" (d/name provider))
params (dissoc params :provider)]
@ -109,7 +142,7 @@
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response))))
(defmethod mutation :send-feedback
(defmethod command :send-feedback
[_ params]
(->> (http/send! {:method :post
:uri (u/join base-uri "api/feedback")
@ -128,7 +161,7 @@
(rx/map http/conditional-decode-transit)
(rx/mapcat handle-response)))
(defmethod query :exporter
(defmethod command :export
[_ params]
(let [default {:wait false :blob? false}]
(send-export (merge default params))))

1
frontend/src/app/main/ui.cljs
View file

@ -29,6 +29,7 @@
(mf/defc on-main-error
[{:keys [error] :as props}]
(mf/with-effect
(js/console.log error)
(st/emit! (rt/assign-exception error)))
[:span "Internal application error"])

113
frontend/src/app/main/ui/auth/login.cljs
View file

@ -23,10 +23,11 @@
[rumext.alpha :as mf]))
(def show-alt-login-buttons?
(or cf/google-client-id
cf/gitlab-client-id
cf/github-client-id
cf/oidc-client-id))
(some (partial contains? @cf/flags)
[:login-with-google
:login-with-github
:login-with-gitlab
:login-with-oidc]))
(s/def ::email ::us/email)
(s/def ::password ::us/not-empty-string)
@ -36,19 +37,27 @@
(s/keys :req-un [::email ::password]
:opt-un [::invitation-token]))
(defn- login-with-oauth
(defn- login-with-oidc
[event provider params]
(dom/prevent-default event)
(->> (rp/mutation! :login-with-oauth (assoc params :provider provider))
(->> (rp/command! :login-with-oidc (assoc params :provider provider))
(rx/subs (fn [{:keys [redirect-uri] :as rsp}]
(.replace js/location redirect-uri)))))
(.replace js/location redirect-uri))
(fn [{:keys [type code] :as error}]
(cond
(and (= type :restriction)
(= code :provider-not-configured))
(st/emit! (dm/error (tr "errors.auth-provider-not-configured")))
:else
(st/emit! (dm/error (tr "errors.generic"))))))))
(defn- login-with-ldap
[event params]
(dom/prevent-default event)
(dom/stop-propagation event)
(let [{:keys [on-error]} (meta params)]
(->> (rp/mutation! :login-with-ldap params)
(->> (rp/command! :login-with-ldap params)
(rx/subs (fn [profile]
(if-let [token (:invitation-token profile)]
(st/emit! (rt/nav :auth-verify-token {} {:token token}))
@ -56,14 +65,18 @@
(fn [{:keys [type code] :as error}]
(cond
(and (= type :restriction)
(= code :ldap-disabled))
(= code :ldap-not-initialized))
(st/emit! (dm/error (tr "errors.ldap-disabled")))
(fn? on-error)
(on-error error)))))))
(on-error error)
:else
(st/emit! (dm/error (tr "errors.generic")))))))))
(mf/defc login-form
[{:keys [params] :as props}]
[{:keys [params on-success-callback] :as props}]
(let [initial (mf/use-memo (mf/deps params) (constantly params))
error (mf/use-state false)
@ -73,10 +86,17 @@
(fn [_]
(reset! error (tr "errors.wrong-credentials")))
on-succes
on-success-default
(fn [data]
(when-let [token (:invitation-token data)]
(st/emit! (rt/nav :auth-verify-token {} {:token token}))))
on-success
(fn [data]
(if (nil? on-success-callback)
(on-success-default data)
(on-success-callback)
))
on-submit
(mf/use-callback
@ -84,7 +104,7 @@
(reset! error nil)
(let [params (with-meta (:clean-data @form)
{:on-error on-error
:on-success on-succes})]
:on-success on-success})]
(st/emit! (du/login params)))))
on-submit-ldap
@ -95,7 +115,7 @@
(let [params (:clean-data @form)]
(login-with-ldap event (with-meta params
{:on-error on-error
:on-success on-succes})))))]
:on-success on-success})))))]
[:*
(when-let [message @error]
[:& msgs/inline-banner
@ -134,63 +154,68 @@
(mf/defc login-buttons
[{:keys [params] :as props}]
[:div.auth-buttons
(when cf/google-client-id
(when (contains? @cf/flags :login-with-google)
[:a.btn-primary.btn-large.btn-google-auth
{:on-click #(login-with-oauth % :google params)}
{:on-click #(login-with-oidc % :google params)}
[:span.logo i/brand-google]
(tr "auth.login-with-google-submit")])
(when cf/github-client-id
(when (contains? @cf/flags :login-with-github)
[:a.btn-primary.btn-large.btn-github-auth
{:on-click #(login-with-oauth % :github params)}
{:on-click #(login-with-oidc % :github params)}
[:span.logo i/brand-github]
(tr "auth.login-with-github-submit")])
(when cf/gitlab-client-id
(when (contains? @cf/flags :login-with-gitlab)
[:a.btn-primary.btn-large.btn-gitlab-auth
{:on-click #(login-with-oauth % :gitlab params)}
{:on-click #(login-with-oidc % :gitlab params)}
[:span.logo i/brand-gitlab]
(tr "auth.login-with-gitlab-submit")])
(when cf/oidc-client-id
(when (contains? @cf/flags :login-with-oidc)
[:a.btn-primary.btn-large.btn-github-auth
{:on-click #(login-with-oauth % :oidc params)}
{:on-click #(login-with-oidc % :oidc params)}
[:span.logo i/brand-openid]
(tr "auth.login-with-oidc-submit")])])
(mf/defc login-button-oidc
[{:keys [params] :as props}]
(when cf/oidc-client-id
(when (contains? @cf/flags :login-with-oidc)
[:div.link-entry.link-oidc
[:a {:on-click #(login-with-oauth % :oidc params)}
[:a {:on-click #(login-with-oidc % :oidc params)}
(tr "auth.login-with-oidc-submit")]]))
(mf/defc login-methods
[{:keys [params on-success-callback] :as props}]
[:*
(when show-alt-login-buttons?
[:*
[:span.separator
[:span.line]
[:span.text (tr "labels.continue-with")]
[:span.line]]
[:div.buttons
[:& login-buttons {:params params}]]
(when (or (contains? @cf/flags :login)
(contains? @cf/flags :login-with-ldap))
[:span.separator
[:span.line]
[:span.text (tr "labels.or")]
[:span.line]])])
(when (or (contains? @cf/flags :login)
(contains? @cf/flags :login-with-ldap))
[:& login-form {:params params :on-success-callback on-success-callback}])])
(mf/defc login-page
[{:keys [params] :as props}]
[:div.generic-form.login-form
[:div.form-container
[:h1 {:data-test "login-title"} (tr "auth.login-title")]
(when show-alt-login-buttons?
[:*
[:span.separator
[:span.line]
[:span.text (tr "labels.continue-with")]
[:span.line]]
[:div.buttons
[:& login-buttons {:params params}]]
(when (or (contains? @cf/flags :login)
(contains? @cf/flags :login-with-ldap))
[:span.separator
[:span.line]
[:span.text (tr "labels.or")]
[:span.line]])])
(when (or (contains? @cf/flags :login)
(contains? @cf/flags :login-with-ldap))
[:& login-form {:params params}])
[:& login-methods {:params params}]
[:div.links
(when (contains? @cf/flags :login)

34
frontend/src/app/main/ui/auth/recovery_request.cljs
View file

@ -22,15 +22,19 @@
(s/def ::recovery-request-form (s/keys :req-un [::email]))
(mf/defc recovery-form
[]
[{:keys [on-success-callback] :as props}]
(let [form (fm/use-form :spec ::recovery-request-form :initial {})
submitted (mf/use-state false)
default-success-finish #(st/emit! (dm/info (tr "auth.notifications.recovery-token-sent")))
on-success
(mf/use-callback
(fn [_ _]
(fn [cdata _]
(reset! submitted false)
(st/emit! (dm/info (tr "auth.notifications.recovery-token-sent")))))
(if (nil? on-success-callback)
(default-success-finish)
(on-success-callback (:email cdata)))))
on-error
(mf/use-callback
@ -74,15 +78,17 @@
;; --- Recovery Request Page
(mf/defc recovery-request-page
[]
[:section.generic-form
[:div.form-container
[:h1 (tr "auth.recovery-request-title")]
[:div.subtitle (tr "auth.recovery-request-subtitle")]
[:& recovery-form]
[{:keys [params on-success-callback go-back-callback] :as props}]
(let [default-go-back #(st/emit! (rt/nav :auth-login))
go-back (or go-back-callback default-go-back)]
[:section.generic-form
[:div.form-container
[:h1 (tr "auth.recovery-request-title")]
[:div.subtitle (tr "auth.recovery-request-subtitle")]
[:& recovery-form {:params params :on-success-callback on-success-callback}]
[:div.links
[:div.link-entry
[:a {:on-click #(st/emit! (rt/nav :auth-login))
:data-test "go-back-link"}
(tr "labels.go-back")]]]]])
[:div.links
[:div.link-entry
[:a {:on-click go-back
:data-test "go-back-link"}
(tr "labels.go-back")]]]]]))

59
frontend/src/app/main/ui/auth/register.cljs
View file

@ -68,28 +68,34 @@
(st/emit! (dm/error (tr "errors.generic")))))
(defn- handle-prepare-register-success
[_ params]
[params]
(st/emit! (rt/nav :auth-register-validate {} params)))
(mf/defc register-form
[{:keys [params] :as props}]
[{:keys [params on-success-callback] :as props}]
(let [initial (mf/use-memo (mf/deps params) (constantly params))
form (fm/use-form :spec ::register-form
:validators [validate]
:initial initial)
submitted? (mf/use-state false)
on-success (fn [p]
(if (nil? on-success-callback)
(handle-prepare-register-success p)
(on-success-callback p)))
on-submit
(mf/use-callback
(fn [form _event]
(reset! submitted? true)
(let [cdata (:clean-data @form)]
(->> (rp/mutation :prepare-register-profile cdata)
(->> (rp/command! :prepare-register-profile cdata)
(rx/map #(merge % params))
(rx/finalize #(reset! submitted? false))
(rx/subs (partial handle-prepare-register-success form)
(partial handle-prepare-register-error form))))))
]
(rx/subs
on-success
(partial handle-prepare-register-error form))))))]
[:& fm/form {:on-submit on-submit
@ -113,15 +119,10 @@
:disabled @submitted?
:data-test "register-form-submit"}]]))
(mf/defc register-page
[{:keys [params] :as props}]
[:div.form-container
[:h1 {:data-test "registration-title"} (tr "auth.register-title")]
[:div.subtitle (tr "auth.register-subtitle")]
(when (contains? @cf/flags :demo-warning)
[:& demo-warning])
(mf/defc register-methods
[{:keys [params on-success-callback] :as props}]
[:*
(when login/show-alt-login-buttons?
[:*
[:span.separator
@ -139,7 +140,19 @@
[:span.text (tr "labels.or")]
[:span.line]])])
[:& register-form {:params params}]
[:& register-form {:params params :on-success-callback on-success-callback}]])
(mf/defc register-page
[{:keys [params] :as props}]
[:div.form-container
[:h1 {:data-test "registration-title"} (tr "auth.register-title")]
[:div.subtitle (tr "auth.register-subtitle")]
(when (contains? @cf/flags :demo-warning)
[:& demo-warning])
[:& register-methods {:params params}]
[:div.links
[:div.link-entry
@ -170,7 +183,7 @@
(st/emit! (dm/error (tr "errors.generic"))))))
(defn- handle-register-success
[_form data]
[data]
(cond
(some? (:invitation-token data))
(let [token (:invitation-token data)]
@ -197,21 +210,25 @@
::accept-newsletter-subscription])))
(mf/defc register-validate-form
[{:keys [params] :as props}]
[{:keys [params on-success-callback] :as props}]
(let [form (fm/use-form :spec ::register-validate-form
:initial params)
submitted? (mf/use-state false)
on-success (fn [p]
(if (nil? on-success-callback)
(handle-register-success p)
(on-success-callback (:email p))))
on-submit
(mf/use-callback
(fn [form _event]
(reset! submitted? true)
(let [params (:clean-data @form)]
(->> (rp/mutation :register-profile params)
(->> (rp/command! :register-profile params)
(rx/finalize #(reset! submitted? false))
(rx/subs (partial handle-register-success form)
(partial handle-register-error form))))))
]
(rx/subs on-success
(partial handle-register-error form))))))]
[:& fm/form {:on-submit on-submit
:form form}

159
frontend/src/app/main/ui/comments.cljs
View file

@ -6,9 +6,11 @@
(ns app.main.ui.comments
(:require
[app.common.geom.point :as gpt]
[app.config :as cfg]
[app.main.data.comments :as dcm]
[app.main.data.modal :as modal]
[app.main.data.workspace.comments :as dwcm]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.components.dropdown :refer [dropdown]]
@ -109,8 +111,10 @@
[:input.btn-secondary {:type "button" :value "Cancel" :on-click on-cancel}]])]))
(mf/defc draft-thread
[{:keys [draft zoom on-cancel on-submit] :as props}]
(let [position (:position draft)
[{:keys [draft zoom on-cancel on-submit position-modifier]}]
(let [position (cond-> (:position draft)
(some? position-modifier)
(gpt/transform position-modifier))
content (:content draft)
pos-x (* (:x position) zoom)
pos-y (* (:y position) zoom)
@ -183,7 +187,7 @@
[:input.btn-secondary {:type "button" :value "Cancel" :on-click on-cancel}]]]))
(mf/defc comment-item
[{:keys [comment thread users] :as props}]
[{:keys [comment thread users origin] :as props}]
(let [owner (get users (:owner-id comment))
profile (mf/deref refs/profile)
options (mf/use-state false)
@ -210,7 +214,9 @@
(mf/use-callback
(mf/deps thread)
#(st/emit! (dcm/close-thread)
(dcm/delete-comment-thread thread)))
(if (= origin :viewer)
(dcm/delete-comment-thread-on-viewer thread)
(dcm/delete-comment-thread-on-workspace thread))))
on-delete-thread
@ -278,9 +284,13 @@
(l/derived (l/in [:comments id]) st/state))
(mf/defc thread-comments
[{:keys [thread zoom users]}]
{::mf/wrap [mf/memo]}
[{:keys [thread zoom users origin position-modifier]}]
(let [ref (mf/use-ref)
pos (:position thread)
pos (cond-> (:position thread)
(some? position-modifier)
(gpt/transform position-modifier))
pos-x (+ (* (:x pos) zoom) 14)
pos-y (- (* (:y pos) zoom) 14)
@ -313,39 +323,146 @@
[:div.comments
[:& comment-item {:comment comment
:users users
:thread thread}]
:thread thread
:origin origin}]
(for [item (rest comments)]
[:*
[:hr]
[:& comment-item {:comment item :users users}]])
[:& comment-item {:comment item
:users users
:origin origin}]])
[:div {:ref ref}]]
[:& reply-form {:thread thread}]])))
(defn use-buble
[zoom {:keys [position frame-id]}]
(let [dragging-ref (mf/use-ref false)
start-ref (mf/use-ref nil)
state (mf/use-state {:hover false
:new-position-x nil
:new-position-y nil
:new-frame-id frame-id})
on-pointer-down
(mf/use-callback
(fn [event]
(dom/capture-pointer event)
(mf/set-ref-val! dragging-ref true)
(mf/set-ref-val! start-ref (dom/get-client-position event))))
on-pointer-up
(mf/use-callback
(mf/deps (select-keys @state [:new-position-x :new-position-y :new-frame-id]))
(fn [_ thread]
(when (and
(some? (:new-position-x @state))
(some? (:new-position-y @state)))
(st/emit! (dwcm/update-comment-thread-position thread [(:new-position-x @state) (:new-position-y @state)])))))
on-lost-pointer-capture
(mf/use-callback
(fn [event]
(dom/release-pointer event)
(mf/set-ref-val! dragging-ref false)
(mf/set-ref-val! start-ref nil)
(swap! state assoc :new-position-x nil)
(swap! state assoc :new-position-y nil)))
on-mouse-move
(mf/use-callback
(mf/deps position zoom)
(fn [event]
(when-let [_ (mf/ref-val dragging-ref)]
(let [start-pt (mf/ref-val start-ref)
current-pt (dom/get-client-position event)
delta-x (/ (- (:x current-pt) (:x start-pt)) zoom)
delta-y (/ (- (:y current-pt) (:y start-pt)) zoom)]
(swap! state assoc
:new-position-x (+ (:x position) delta-x)
:new-position-y (+ (:y position) delta-y))))))]
{:on-pointer-down on-pointer-down
:on-pointer-up on-pointer-up
:on-mouse-move on-mouse-move
:on-lost-pointer-capture on-lost-pointer-capture
:state state}))
(mf/defc thread-bubble
{::mf/wrap [mf/memo]}
[{:keys [thread zoom on-click] :as params}]
(let [pos (:position thread)
pos-x (* (:x pos) zoom)
pos-y (* (:y pos) zoom)
on-click* (fn [event]
(dom/stop-propagation event)
(on-click thread))]
[{:keys [thread zoom open? on-click origin position-modifier]}]
(let [pos (cond-> (:position thread)
(some? position-modifier)
(gpt/transform position-modifier))
drag? (mf/use-ref nil)
was-open? (mf/use-ref nil)
{:keys [on-pointer-down
on-pointer-up
on-mouse-move
state
on-lost-pointer-capture]} (use-buble zoom thread)
pos-x (* (or (:new-position-x @state) (:x pos)) zoom)
pos-y (* (or (:new-position-y @state) (:y pos)) zoom)
on-pointer-down*
(mf/use-callback
(mf/deps origin was-open? open? drag? on-pointer-down)
(fn [event]
(when (not= origin :viewer)
(mf/set-ref-val! was-open? open?)
(when open? (st/emit! (dcm/close-thread)))
(mf/set-ref-val! drag? false)
(dom/stop-propagation event)
(on-pointer-down event))))
on-pointer-up*
(mf/use-callback
(mf/deps origin thread was-open? drag? on-pointer-up)
(fn [event]
(when (not= origin :viewer)
(dom/stop-propagation event)
(on-pointer-up event thread)
(when (or (and (mf/ref-val was-open?) (mf/ref-val drag?))
(and (not (mf/ref-val was-open?)) (not (mf/ref-val drag?))))
(st/emit! (dcm/open-thread thread))))))
on-mouse-move*
(mf/use-callback
(mf/deps origin drag? on-mouse-move)
(fn [event]
(when (not= origin :viewer)
(mf/set-ref-val! drag? true)
(dom/stop-propagation event)
(on-mouse-move event))))
on-click*
(mf/use-callback
(mf/deps origin thread on-click)
(fn [event]
(dom/stop-propagation event)
(when (= origin :viewer)
(on-click thread))))]
[:div.thread-bubble
{:style {:top (str pos-y "px")
:left (str pos-x "px")}
:on-mouse-down (fn [event]
(dom/prevent-default event))
:on-pointer-down on-pointer-down*
:on-pointer-up on-pointer-up*
:on-mouse-move on-mouse-move*
:on-click on-click*
:on-lost-pointer-capture on-lost-pointer-capture
:class (dom/classnames
:resolved (:is-resolved thread)
:unread (pos? (:count-unread-comments thread)))
:on-click on-click*}
:unread (pos? (:count-unread-comments thread)))}
[:span (:seqn thread)]]))
(mf/defc comment-thread
[{:keys [item users on-click] :as props}]
[{:keys [item users on-click]}]
(let [owner (get users (:owner-id item))
on-click*
(mf/use-callback
(mf/deps item)

40
frontend/src/app/main/ui/components/color_bullet.cljs
View file

@ -17,23 +17,31 @@
:radial (tr "workspace.gradients.radial")
nil))
(mf/defc color-bullet [{:keys [color on-click]}]
(if (uc/multiple? color)
[:div.color-bullet.multiple {:on-click #(when on-click (on-click %))}]
(mf/defc color-bullet
{::mf/wrap [mf/memo]}
[{:keys [color on-click]}]
(let [on-click (mf/use-fn
(mf/deps color on-click)
(fn [event]
(when (fn? on-click)
(^function on-click color event))))]
;; No multiple selection
(let [color (if (string? color) {:color color :opacity 1} color)]
[:div.color-bullet.tooltip.tooltip-right
{:class (dom/classnames :is-library-color (some? (:id color))
:is-not-library-color (nil? (:id color))
:is-gradient (some? (:gradient color)))
:on-click #(when on-click (on-click %))
:alt (or (:name color) (:color color) (gradient-type->string (:type (:gradient color))))}
(if (:gradient color)
[:div.color-bullet-wrapper {:style {:background (uc/color->background color)}}]
[:div.color-bullet-wrapper
[:div.color-bullet-left {:style {:background (uc/color->background (assoc color :opacity 1))}}]
[:div.color-bullet-right {:style {:background (uc/color->background color)}}]])])))
(if (uc/multiple? color)
[:div.color-bullet.multiple {:on-click on-click}]
;; No multiple selection
(let [color (if (string? color) {:color color :opacity 1} color)]
[:div.color-bullet.tooltip.tooltip-right
{:class (dom/classnames :is-library-color (some? (:id color))
:is-not-library-color (nil? (:id color))
:is-gradient (some? (:gradient color)))
:on-click on-click
:alt (or (:name color) (:color color) (gradient-type->string (:type (:gradient color))))}
(if (:gradient color)
[:div.color-bullet-wrapper {:style {:background (uc/color->background color)}}]
[:div.color-bullet-wrapper
[:div.color-bullet-left {:style {:background (uc/color->background (assoc color :opacity 1))}}]
[:div.color-bullet-right {:style {:background (uc/color->background color)}}]])]))))
(mf/defc color-name [{:keys [color size on-click on-double-click]}]
(let [color (if (string? color) {:color color :opacity 1} color)

5
frontend/src/app/main/ui/components/context_menu.cljs
View file

@ -7,6 +7,7 @@
(ns app.main.ui.components.context-menu
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.main.refs :as refs]
[app.main.ui.components.dropdown :refer [dropdown']]
[app.main.ui.icons :as i]
@ -110,10 +111,10 @@
(for [[index [option-name option-handler sub-options data-test]] (d/enumerate (:options level))]
(when option-name
(if (= option-name :separator)
[:li.separator]
[:li.separator {:key (dm/str "context-item-" index)}]
[:li.context-menu-item
{:class (dom/classnames :is-selected (and selected (= option-name selected)))
:key index}
:key (dm/str "context-item-" index)}
(if-not sub-options
[:a.context-menu-action {:on-click #(do (dom/stop-propagation %)
(on-close)

9
frontend/src/app/main/ui/components/forms.cljs
View file

@ -243,7 +243,7 @@
(into [] (distinct) (conj coll item)))
(mf/defc multi-input
[{:keys [form label class name trim valid-item-fn] :as props}]
[{:keys [form label class name trim valid-item-fn on-submit] :as props}]
(let [form (or form (mf/use-ctx form-ctx))
input-name (get props :name)
touched? (get-in @form [:touched input-name])
@ -297,8 +297,11 @@
(dom/prevent-default event)
(dom/stop-propagation event)
(let [val (cond-> @value trim str/trim)]
(reset! value "")
(swap! items conj-dedup {:text val :valid (valid-item-fn val)})))
(when (and (kbd/enter? event) (str/empty? @value) (not-empty @items))
(on-submit form))
(when (not (str/empty? @value))
(reset! value "")
(swap! items conj-dedup {:text val :valid (valid-item-fn val)}))))
(and (kbd/backspace? event)
(str/empty? @value))

13
frontend/src/app/main/ui/context.cljs
View file

@ -8,12 +8,7 @@
(:require
[rumext.alpha :as mf]))
(def render-ctx (mf/create-context nil))
(def def-ctx (mf/create-context false))
;; This content is used to replace complex colors to simple ones
;; for text shapes in the export process
(def text-plain-colors-ctx (mf/create-context false))
(def render-id (mf/create-context nil))
(def current-route (mf/create-context nil))
(def current-profile (mf/create-context nil))
@ -21,4 +16,8 @@
(def current-project-id (mf/create-context nil))
(def current-page-id (mf/create-context nil))
(def current-file-id (mf/create-context nil))
(def scroll-ctx (mf/create-context nil))
(def current-scroll (mf/create-context nil))
(def current-zoom (mf/create-context nil))
(def active-frames (mf/create-context nil))
(def render-thumbnails (mf/create-context nil))

2
frontend/src/app/main/ui/dashboard/comments.cljs
View file

@ -31,7 +31,7 @@
show-dropdown (mf/use-fn #(reset! show-dropdown? true))
hide-dropdown (mf/use-fn #(reset! show-dropdown? false))
threads-map (mf/deref refs/comment-threads)
users (mf/deref refs/users)
users (mf/deref refs/current-file-comments-users)
tgroups (->> (vals threads-map)
(sort-by :modified-at)

8
frontend/src/app/main/ui/dashboard/export.cljs
View file

@ -51,7 +51,7 @@
(mf/defc export-dialog
{::mf/register modal/components
::mf/register-as :export}
[{:keys [team-id files has-libraries?]}]
[{:keys [team-id files has-libraries? binary?]}]
(let [state (mf/use-state {:status :prepare
:files (->> files (mapv #(assoc % :loading? true)))})
selected-option (mf/use-state :all)
@ -60,10 +60,11 @@
(fn []
(swap! state assoc :status :exporting)
(->> (uw/ask-many!
{:cmd :export-file
{:cmd (if binary? :export-binary-file :export-standard-file)
:team-id team-id
:export-type @selected-option
:files (->> files (mapv :id))})
:files files
})
(rx/delay-emit 1000)
(rx/subs
(fn [msg]
@ -73,6 +74,7 @@
(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]

53
frontend/src/app/main/ui/dashboard/file_menu.cljs
View file

@ -158,26 +158,38 @@
:on-accept del-shared})))
on-export-files
(fn [event-name binary?]
(st/emit! (ptk/event ::ev/event {::ev/name event-name
::ev/origin "dashboard"
:num-files (count files)}))
(->> (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
:binary? binary?}))))))
on-export-binary-files
(mf/use-callback
(mf/deps files current-team-id)
(fn [_]
(st/emit! (ptk/event ::ev/event {::ev/name "export-files"
::ev/origin "dashboard"
:num-files (count files)}))
(->> (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})))))))
(on-export-files "export-binary-files" true)))
on-export-standard-files
(mf/use-callback
(mf/deps files current-team-id)
(fn [_]
(on-export-files "export-standard-files" false)))
;; NOTE: this is used for detect if component is still mounted
mounted-ref (mf/use-ref true)]
@ -210,7 +222,8 @@
[[(tr "dashboard.duplicate-multi" file-count) on-duplicate nil "duplicate-multi"]
(when (or (seq current-projects) (seq other-teams))
[(tr "dashboard.move-to-multi" file-count) nil sub-options "move-to-multi"])
[(tr "dashboard.export-multi" file-count) on-export-files]
[(tr "dashboard.export-binary-multi" file-count) on-export-binary-files]
[(tr "dashboard.export-standard-multi" file-count) on-export-standard-files]
[:separator]
[(tr "labels.delete-multi-files" file-count) on-delete nil "delete-multi-files"]]
@ -222,7 +235,9 @@
(if (:is-shared file)
[(tr "dashboard.remove-shared") on-del-shared nil "file-del-shared"]
[(tr "dashboard.add-shared") on-add-shared nil "file-add-shared"])
[(tr "dashboard.export-single") on-export-files nil "file-export"]
[:separator]
[(tr "dashboard.download-binary-file") on-export-binary-files nil "download-binary-file"]
[(tr "dashboard.download-standard-file") on-export-standard-files nil "download-standard-file"]
[:separator]
[(tr "labels.delete") on-delete nil "file-delete"]])]

44
frontend/src/app/main/ui/dashboard/import.cljs
View file

@ -7,6 +7,7 @@
(ns app.main.ui.dashboard.import
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.logging :as log]
[app.main.data.events :as ev]
[app.main.data.modal :as modal]
@ -49,7 +50,7 @@
(let [on-file-selected (use-import-file project-id on-finish-import)]
[:form.import-file
[:& file-uploader {:accept ".penpot"
[:& file-uploader {:accept ".penpot,.zip"
:multi true
:ref external-ref
:on-selected on-file-selected}]]))
@ -78,19 +79,20 @@
(= uri (:uri file))
(assoc :status :analyze-error))))))
(defn set-analyze-result [files uri data]
(defn set-analyze-result [files uri type data]
(let [existing-files? (into #{} (->> files (map :file-id) (filter some?)))
replace-file
(fn [file]
(if (and (= uri (:uri file) )
(if (and (= uri (:uri file))
(= (:status file) :analyzing))
(->> (:files data)
(remove (comp existing-files? first) )
(remove (comp existing-files? first))
(mapv (fn [[file-id file-data]]
(-> file-data
(assoc :file-id file-id
:status :ready
:uri uri)))))
:uri uri
:type type)))))
[file]))]
(into [] (mapcat replace-file) files)))
@ -139,7 +141,7 @@
(str message)))
(mf/defc import-entry
[{:keys [state file editing?]}]
[{:keys [state file editing? can-be-deleted?]}]
(let [loading? (or (= :analyzing (:status file))
(= :importing (:status file)))
@ -206,9 +208,11 @@
[: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]]]
[:div.edit-entry-buttons
(when (= "application/zip" (:type file))
[:button {:on-click handle-edit-entry} i/pencil])
(when can-be-deleted?
[:button {:on-click handle-remove-entry} i/trash])]]
(cond
analyze-error?
@ -245,21 +249,20 @@
(fn [files]
(->> (uw/ask-many!
{:cmd :analyze-import
:files (->> files (mapv :uri))})
:files files})
(rx/delay-emit emit-delay)
(rx/subs
(fn [{:keys [uri data error] :as msg}]
(fn [{:keys [uri data error type] :as msg}]
(log/debug :uri uri :data data :error error)
(if (some? error)
(swap! state update :files set-analyze-error uri)
(swap! state update :files set-analyze-result uri data)))))))
(swap! state update :files set-analyze-result uri type data)))))))
import-files
(mf/use-callback
(fn [project-id files]
(st/emit! (ptk/event ::ev/event {::ev/name "import-files"
:num-files (count files)}))
(->> (uw/ask-many!
{:cmd :import-files
:project-id project-id
@ -281,7 +284,7 @@
(mf/deps project-id (:files @state))
(fn [event]
(dom/prevent-default event)
(let [files (->> @state :files (filterv #(= :ready (:status %))))]
(let [files (->> @state :files (filterv #(and (= :ready (:status %)) (not (:deleted? %)))))]
(import-files project-id files))
(swap! state
@ -300,7 +303,8 @@
warning-files (->> @state :files (filter #(and (= (:status %) :import-finish) (d/not-empty? (:errors %)))) count)
success-files (->> @state :files (filter #(and (= (:status %) :import-finish) (empty? (:errors %)))) count)
pending-analysis? (> (->> @state :files (filter #(= (:status %) :analyzing)) count) 0)
pending-import? (> (->> @state :files (filter #(= (:status %) :importing)) count) 0)]
pending-import? (> (->> @state :files (filter #(= (:status %) :importing)) count) 0)
files (->> (:files @state) (filterv (comp not :deleted?)))]
(mf/use-effect
(fn []
@ -333,12 +337,14 @@
[: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)))]
(for [file files]
(let [editing? (and (some? (:file-id file))
(= (:file-id file) (:editing @state)))]
[:& import-entry {:state state
:key (dm/str (:id file))
:file file
:editing? editing?}]))]
:editing? editing?
:can-be-deleted? (> (count files) 1)}]))]
[:div.modal-footer
[:div.action-buttons

7
frontend/src/app/main/ui/dashboard/team.cljs
View file

@ -77,7 +77,7 @@
]
(filterv identity)))
(s/def ::emails (s/and ::us/set-of-emails d/not-empty?))
(s/def ::emails (s/and ::us/set-of-valid-emails d/not-empty?))
(s/def ::role ::us/keyword)
(s/def ::team-id ::us/uuid)
@ -142,7 +142,8 @@
:auto-focus? true
:trim true
:valid-item-fn us/parse-email
:label (tr "modals.invite-member.emails")}]
:label (tr "modals.invite-member.emails")
:on-submit on-submit}]
[:& fm/select {:name :role :options roles}]]
[:div.action-buttons
@ -605,7 +606,7 @@
[:div.label (tr "dashboard.team-info")]
[:div.name (:name team)]
[:div.icon
[:span.update-overlay {:on-click on-image-click} i/exit]
[:span.update-overlay {:on-click on-image-click} i/image]
[:img {:src (cfg/resolve-team-photo-url team)}]
[:& file-uploader {:accept "image/jpeg,image/png"
:multi false

62
frontend/src/app/main/ui/features.cljs Normal file
View file

@ -0,0 +1,62 @@
;; 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.features
(:require
[app.common.data :as d]
[app.common.logging :as log]
[app.main.store :as st]
[okulary.core :as l]
[potok.core :as ptk]
[rumext.alpha :as mf]))
(log/set-level! :debug)
(def features-list #{:auto-layout})
(defn toggle-feature
[feature]
(ptk/reify ::toggle-feature
ptk/UpdateEvent
(update [_ state]
(log/debug :msg "toggle-feature"
:feature (d/name feature)
:result (if (not (contains? (:features state) feature))
"enabled"
"disabled"))
(-> state
(update :features
(fn [features]
(let [features (or features #{})]
(if (contains? features feature)
(disj features feature)
(conj features feature)))))))))
(defn toggle-feature!
[feature]
(assert (contains? features-list feature) "Not supported feature")
(st/emit! (toggle-feature feature)))
(def features
(l/derived :features st/state))
(defn active-feature
[feature]
(l/derived #(contains? % feature) features))
(defn use-feature
[feature]
(assert (contains? features-list feature) "Not supported feature")
(let [active-feature-ref (mf/use-memo (mf/deps feature) #(active-feature feature))
active-feature? (mf/deref active-feature-ref)]
active-feature?))
;; By default the features are active in local environments
(when *assert*
;; Activate all features in local environment
(doseq [f features-list]
(toggle-feature! f)))

68
frontend/src/app/main/ui/hooks.cljs
View file

@ -7,16 +7,26 @@
(ns app.main.ui.hooks
"A collection of general purpose react hooks."
(:require
[app.common.data.macros :as dm]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.main.broadcast :as mbc]
[app.main.data.shortcuts :as dsc]
[app.main.refs :as refs]
[app.main.store :as st]
[app.util.dom :as dom]
[app.util.dom.dnd :as dnd]
[app.util.storage :refer [storage]]
[app.util.timers :as ts]
[beicon.core :as rx]
[goog.functions :as f]
[rumext.alpha :as mf]))
(defn use-id
"Get a stable id value across rerenders."
[]
(mf/use-memo #(dm/str (uuid/next))))
(defn use-rxsub
[ob]
(let [[state reset-state!] (mf/useState @ob)]
@ -191,7 +201,6 @@
[(deref state) ref]))
(defn use-stream
"Wraps the subscription to a stream into a `use-effect` call"
([stream on-subscribe]
@ -205,6 +214,7 @@
;; https://reactjs.org/docs/hooks-faq.html#how-to-get-the-previous-props-or-state
(defn use-previous
"Returns the value from previuous render cycle."
[value]
(let [ref (mf/use-ref value)]
(mf/use-effect
@ -214,13 +224,27 @@
(mf/ref-val ref)))
(defn use-update-var
"Returns a var pointer what automatically updates with latest values."
[value]
(let [ref (mf/use-var value)]
(mf/use-effect
(mf/deps value)
(fn []
(reset! ref value)))
ref))
(let [ptr (mf/use-var value)]
(mf/with-effect [value]
(reset! ptr value))
ptr))
(defn use-ref-callback
"Returns a stable callback pointer what calls the interned
callback. The interned callback will be automatically updated on
each reander if the reference changes and works as noop if the
pointer references to nil value."
[f]
(let [ptr (mf/use-ref nil)]
(mf/with-effect [f]
(mf/set-ref-val! ptr #js {:f f}))
(mf/use-fn
(fn [& args]
(let [obj (mf/ref-val ptr)]
(when ^boolean obj
(apply (.-f obj) args)))))))
(defn use-equal-memo
[val]
@ -258,4 +282,34 @@
#(cp/focus-objects objects focus))]
objects)))
(defn use-debounce
[ms value]
(let [[state update-state-fn] (mf/useState value)
update-fn (mf/use-memo (mf/deps ms) #(f/debounce update-state-fn ms))]
(mf/with-effect [value]
(update-fn value))
state))
(defn use-shared-state
"A specialized hook that adds persistence and inter-context reactivity
to the default mf/use-state hook.
The state is automatically persisted under the provided key on
localStorage. And it will keep watching events with type equals to
`key` for new values."
[key default]
(let [id (use-id)
state (mf/use-state (get @storage key default))
stream (mf/with-memo []
(->> mbc/stream
(rx/filter #(= (:type %) key))
(rx/filter #(not= (:id %) id))
(rx/map deref)))]
(mf/with-effect [@state key]
(mbc/emit! id key @state)
(swap! storage assoc key @state))
(use-stream stream (partial reset! state))
state))

56
frontend/src/app/main/ui/hooks/resize.cljs
View file

@ -8,7 +8,9 @@
(:require
[app.common.geom.point :as gpt]
[app.common.logging :as log]
[app.common.spec :as us]
[app.main.ui.context :as ctx]
[app.main.ui.hooks :as hooks]
[app.util.dom :as dom]
[app.util.storage :refer [storage]]
[rumext.alpha :as mf]))
@ -72,38 +74,38 @@
(defn use-resize-observer
[callback]
(assert (some? callback))
(us/assert! (some? callback) "the `callback` is mandatory")
(let [prev-val-ref (mf/use-ref nil)
current-observer-ref (mf/use-ref nil)
observer-ref (mf/use-ref nil)
callback (hooks/use-ref-callback callback)
;; We use the ref as a callback when the dom node is ready (or change)
node-ref
(mf/use-callback
(mf/deps callback)
(fn [^js node]
(let [^js current-observer (mf/ref-val current-observer-ref)
^js prev-val (mf/ref-val prev-val-ref)]
node-ref (mf/use-fn
(fn [^js node]
(when (some? node)
(let [^js observer (mf/ref-val observer-ref)
^js prev-val (mf/ref-val prev-val-ref)]
(when (and (not= prev-val node) (some? current-observer))
(log/debug :action "disconnect" :js/prev-val prev-val :js/node node)
(.disconnect current-observer)
(mf/set-ref-val! current-observer-ref nil))
(when (and (not= prev-val node) (some? observer))
(log/debug :action "disconnect" :js/prev-val prev-val :js/node node)
(.disconnect observer)
(mf/set-ref-val! observer-ref nil))
(when (and (not= prev-val node) (some? node))
(let [^js observer
(js/ResizeObserver. #(callback last-resize-type (dom/get-client-size node)))]
(mf/set-ref-val! current-observer-ref observer)
(log/debug :action "observe" :js/node node :js/observer observer)
(.observe observer node))))
(mf/set-ref-val! prev-val-ref node)))]
(when (and (not= prev-val node) (some? node))
(let [^js observer (js/ResizeObserver.
#(callback last-resize-type (dom/get-client-size node)))]
(mf/set-ref-val! observer-ref observer)
(log/debug :action "observe" :js/node node :js/observer observer)
(.observe observer node))))
(mf/set-ref-val! prev-val-ref node))))]
(mf/with-effect []
;; On dismount we need to disconnect the current observer
(fn []
(when-let [observer (mf/ref-val observer-ref)]
(log/debug :action "disconnect")
(.disconnect ^js observer))))
(mf/use-effect
(fn []
;; On dismount we need to disconnect the current observer
(fn []
(let [current-observer (mf/ref-val current-observer-ref)]
(when (some? current-observer)
(log/debug :action "disconnect")
(.disconnect current-observer))))))
node-ref))

14
frontend/src/app/main/ui/icons.cljs
View file

@ -26,8 +26,17 @@
(def arrow-slide (icon-xref :arrow-slide))
(def artboard (icon-xref :artboard))
(def at (icon-xref :at))
(def auto-direction (icon-xref :auto-direction))
(def auto-fill (icon-xref :auto-fill))
(def auto-fix (icon-xref :auto-fix))
(def auto-fix-layout (icon-xref :auto-fix-layout))
(def auto-gap (icon-xref :auto-gap))
(def auto-height (icon-xref :auto-height))
(def auto-hug (icon-xref :auto-hug))
(def auto-margin-side (icon-xref :auto-margin-side))
(def auto-margin (icon-xref :auto-margin))
(def auto-padding (icon-xref :auto-padding))
(def auto-padding-side (icon-xref :auto-padding-side))
(def auto-width (icon-xref :auto-width))
(def bool-difference (icon-xref :boolean-difference))
(def bool-exclude (icon-xref :boolean-exclude))
@ -67,6 +76,8 @@
(def full-screen-off (icon-xref :full-screen-off))
(def grid (icon-xref :grid))
(def grid-snap (icon-xref :grid-snap))
(def go-next (icon-xref :go-next))
(def go-prev (icon-xref :go-prev))
(def help (icon-xref :help))
(def icon-empty (icon-xref :icon-empty))
(def icon-filter (icon-xref :filter))
@ -134,6 +145,7 @@
(def radius-4 (icon-xref :radius-4))
(def recent (icon-xref :recent))
(def redo (icon-xref :redo))
(def reset (icon-xref :reset))
(def rotate (icon-xref :rotate))
(def ruler (icon-xref :ruler))
(def ruler-tool (icon-xref :ruler-tool))
@ -152,6 +164,8 @@
(def size-vert (icon-xref :size-vert))
(def sort-ascending (icon-xref :sort-ascending))
(def sort-descending (icon-xref :sort-descending))
(def space-around (icon-xref :space-around))
(def space-between (icon-xref :space-between))
(def strikethrough (icon-xref :strikethrough))
(def stroke (icon-xref :stroke))
(def switch (icon-xref :switch))

16
frontend/src/app/main/ui/measurements.cljs
View file

@ -240,16 +240,20 @@
(when (seq selected-shapes)
[:g.measurement-feedback {:pointer-events "none"}
[:& selection-guides {:selrect selected-selrect :bounds bounds :zoom zoom}]
[:& selection-guides {:selrect selected-selrect
:bounds bounds
:zoom zoom}]
[:& size-display {:selrect selected-selrect :zoom zoom}]
(if (or (not hover-shape) (not hover-selected-shape?))
(when (and frame (not= uuid/zero (:id frame)))
[:g.hover-shapes
[:& distance-display {:from (:selrect frame)
:to selected-selrect
:zoom zoom
:bounds bounds-selrect}]])
(let [frame-bb (-> (:points frame) (gsh/points->selrect))]
[:g.hover-shapes
[:& selection-rect {:type :hover :selrect frame-bb :zoom zoom}]
[:& distance-display {:from frame-bb
:to selected-selrect
:zoom zoom
:bounds bounds-selrect}]]))
[:g.hover-shapes
[:& selection-rect {:type :hover :selrect hover-selrect :zoom zoom}]

5
frontend/src/app/main/ui/onboarding/team_choice.cljs
View file

@ -102,7 +102,7 @@
[{:value "editor" :label (tr "labels.editor")}
{:value "admin" :label (tr "labels.admin")}])
(s/def ::emails (s/and ::us/set-of-emails d/not-empty?))
(s/def ::emails (s/and ::us/set-of-valid-emails d/not-empty?))
(s/def ::role ::us/keyword)
(s/def ::invite-form
(s/keys :req-un [::role ::emails]))
@ -171,7 +171,8 @@
:auto-focus? true
:trim true
:valid-item-fn us/parse-email
:label (tr "modals.invite-member.emails")}]
:label (tr "modals.invite-member.emails")
:on-submit on-submit}]
[:& fm/select {:name :role :options roles}]]
[:div.buttons

3
frontend/src/app/main/ui/releases.cljs
View file

@ -15,6 +15,7 @@
[app.main.ui.releases.v1-12]
[app.main.ui.releases.v1-13]
[app.main.ui.releases.v1-14]
[app.main.ui.releases.v1-15]
[app.main.ui.releases.v1-4]
[app.main.ui.releases.v1-5]
[app.main.ui.releases.v1-6]
@ -84,4 +85,4 @@
(defmethod rc/render-release-notes "0.0"
[params]
(rc/render-release-notes (assoc params :version "1.14")))
(rc/render-release-notes (assoc params :version "1.15")))

2
frontend/src/app/main/ui/releases/v1_11.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Beta version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Beta 1.11 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Beta 1.11 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_12.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Beta version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Beta 1.12 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Beta 1.12 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_13.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Beta version " version]
[:div.modal-content
[:p "Penpot continues to grow with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Beta 1.13 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Beta 1.13 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_14.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Beta version " version]
[:div.modal-content
[:p "Penpot continues to grow with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Beta 1.14 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Beta 1.14 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

108
frontend/src/app/main/ui/releases/v1_15.cljs Normal file
View file

@ -0,0 +1,108 @@
;; 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.releases.v1-15
(:require
[app.main.ui.releases.common :as c]
[rumext.alpha :as mf]))
(defmethod c/render-release-notes "1.15"
[{:keys [slide klass next finish navigate version]}]
(mf/html
(case @slide
:start
[:div.modal-overlay
[:div.animated {:class @klass}
[:div.modal-container.onboarding.feature
[:div.modal-left
[:img {:src "images/login-on.jpg" :border "0" :alt "What's new Beta release 1.15"}]]
[:div.modal-right
[:div.modal-title
[:h2 "What's new?"]]
[:span.release "Beta version " version]
[:div.modal-content
[:p "Penpot continues to grow with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peek of the most important stuff that the Beta 1.15 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]
[:img.deco.right {:src "images/deco-right.png" :border "0"}]]]]
0
[:div.modal-overlay
[:div.animated {:class @klass}
[:div.modal-container.onboarding.feature
[:div.modal-left
[:img {:src "images/features/1.15-nested-boards.gif" :border "0" :alt "Nested boards"}]]
[:div.modal-right
[:div.modal-title
[:h2 "Nested boards"]]
[:div.modal-content
[:p "Unlike its predecessors (the artboards) boards can contain other boards and offer the options to clip content and show them or not at the View Mode, opening up a ton of possibilities when creating and organizing your designs."]
[:p "Say goodbye to Artboards and hello to Boards!"]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]
[:& c/navigation-bullets
{:slide @slide
:navigate navigate
:total 4}]]]]]]
1
[:div.modal-overlay
[:div.animated {:class @klass}
[:div.modal-container.onboarding.feature
[:div.modal-left
[:img {:src "images/features/1.15-share.gif" :border "0" :alt "Share prototype options"}]]
[:div.modal-right
[:div.modal-title
[:h2 "Share prototype options"]]
[:div.modal-content
[:p "Have you ever wanted to share a Penpot file and get feedback from people that are not in your Penpot team?"]
[:p "Now you can thanks to new permissions that allow you to decide who can comment and/or inspect the code at a shared prototype link."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]
[:& c/navigation-bullets
{:slide @slide
:navigate navigate
:total 4}]]]]]]
2
[:div.modal-overlay
[:div.animated {:class @klass}
[:div.modal-container.onboarding.feature
[:div.modal-left
[:img {:src "images/features/1.15-comments.gif" :border "0" :alt "Comments positioning"}]]
[:div.modal-right
[:div.modal-title
[:h2 "Comments poitioning"]]
[:div.modal-content
[:p "They live! Now you can move existing comments wherever you want by dragging them."]
[:p "Also, comments inside boards will be associated with it, so that if you move a board its comments will maintain its place inside it."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]
[:& c/navigation-bullets
{:slide @slide
:navigate navigate
:total 4}]]]]]]
3
[:div.modal-overlay
[:div.animated {:class @klass}
[:div.modal-container.onboarding.feature
[:div.modal-left
[:img {:src "images/features/1.15-view-mode.gif" :border "0" :alt "View Mode improvements"}]]
[:div.modal-right
[:div.modal-title
[:h2 "View Mode improvements"]]
[:div.modal-content
[:p "The View Mode, used for presenting designs, is now easier to use thanks to new navigation buttons and microinteractions."]
[:p "We’ve also made some adjustments to ensure the access to the options from small screens."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click finish} "Start!"]
[:& c/navigation-bullets
{:slide @slide
:navigate navigate
:total 4}]]]]]])))

2
frontend/src/app/main/ui/releases/v1_4.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Alpha version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Alpha 1.4.0 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Alpha 1.4.0 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_5.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Alpha version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Alpha 1.5.0 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Alpha 1.5.0 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_6.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Alpha version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Alpha 1.6.0 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Alpha 1.6.0 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_7.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Alpha version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Alpha 1.7 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Alpha 1.7 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_8.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Alpha version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Alpha 1.8 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Alpha 1.8 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/releases/v1_9.cljs
View file

@ -25,7 +25,7 @@
[:span.release "Alpha version " version]
[:div.modal-content
[:p "Penpot continues growing with new features that improve performance, user experience and visual design."]
[:p "We are happy to show you a sneak peak of the most important stuff that the Alpha 1.9 version brings."]]
[:p "We are happy to show you a sneak peek of the most important stuff that the Alpha 1.9 version brings."]]
[:div.modal-navigation
[:button.btn-secondary {:on-click next} "Continue"]]]
[:img.deco {:src "images/deco-left.png" :border "0"}]

2
frontend/src/app/main/ui/settings/feedback.cljs
View file

@ -55,7 +55,7 @@
(fn [form _]
(reset! loading true)
(let [data (:clean-data @form)]
(->> (rp/mutation! :send-feedback data)
(->> (rp/command! :send-feedback data)
(rx/subs on-succes on-error)))))]
[:& fm/form {:class "feedback-form"

22
frontend/src/app/main/ui/shapes/attrs.cljs
View file

@ -10,8 +10,8 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh]
[app.common.spec.radius :as ctr]
[app.common.spec.shape :refer [stroke-caps-line stroke-caps-marker]]
[app.common.types.shape :refer [stroke-caps-line stroke-caps-marker]]
[app.common.types.shape.radius :as ctsr]
[app.main.ui.context :as muc]
[app.util.object :as obj]
[app.util.svg :as usvg]
@ -31,7 +31,7 @@
(defn add-border-radius [attrs {:keys [x y width height] :as shape}]
(case (ctr/radius-mode shape)
(case (ctsr/radius-mode shape)
:radius-1
(let [radius (gsh/shape-corners-1 shape)]
(obj/merge! attrs #js {:rx radius :ry radius}))
@ -159,7 +159,7 @@
(defn add-style-attrs
([props shape]
(let [render-id (mf/use-ctx muc/render-ctx)]
(let [render-id (mf/use-ctx muc/render-id)]
(add-style-attrs props shape render-id)))
([props shape render-id]
@ -169,7 +169,7 @@
[svg-attrs svg-styles]
(extract-svg-attrs render-id svg-defs svg-attrs)
styles (-> (obj/get props "style" (obj/new))
styles (-> (obj/get props "style" (obj/create))
(obj/merge! svg-styles)
(add-layer-props shape))
@ -211,24 +211,24 @@
(defn extract-style-attrs
[shape]
(-> (obj/new)
(-> (obj/create)
(add-style-attrs shape)))
(defn extract-fill-attrs
[fill-data render-id index type]
(let [fill-styles (-> (obj/get fill-data "style" (obj/new))
(let [fill-styles (-> (obj/get fill-data "style" (obj/create))
(add-fill fill-data render-id index type))]
(-> (obj/new)
(-> (obj/create)
(obj/set! "style" fill-styles))))
(defn extract-stroke-attrs
[stroke-data index render-id]
(let [stroke-styles (-> (obj/get stroke-data "style" (obj/new))
(let [stroke-styles (-> (obj/get stroke-data "style" (obj/create))
(add-stroke stroke-data render-id index))]
(-> (obj/new)
(-> (obj/create)
(obj/set! "style" stroke-styles))))
(defn extract-border-radius-attrs
[shape]
(-> (obj/new)
(-> (obj/create)
(add-border-radius shape)))

4
frontend/src/app/main/ui/shapes/circle.cljs
View file

@ -6,7 +6,7 @@
(ns app.main.ui.shapes.circle
(:require
[app.common.geom.shapes :as geom]
[app.common.geom.shapes :as gsh]
[app.main.ui.shapes.attrs :as attrs]
[app.main.ui.shapes.custom-stroke :refer [shape-custom-strokes]]
[app.util.object :as obj]
@ -17,7 +17,7 @@
[props]
(let [shape (unchecked-get props "shape")
{:keys [x y width height]} shape
transform (geom/transform-matrix shape)
transform (gsh/transform-str shape)
cx (+ x (/ width 2))
cy (+ y (/ height 2))

15
frontend/src/app/main/ui/shapes/custom_stroke.cljs
View file

@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bounds :as gsb]
[app.common.pages.helpers :as cph]
[app.main.ui.context :as muc]
[app.main.ui.shapes.attrs :as attrs]
@ -45,7 +46,7 @@
:center (/ (:stroke-width shape 0) 2)
:outer (:stroke-width shape 0)
0)
margin (gsh/shape-stroke-margin shape stroke-width)
margin (gsb/shape-stroke-margin shape stroke-width)
bounding-box (-> (gsh/points->selrect (:points shape))
(update :x - (+ stroke-width margin))
(update :y - (+ stroke-width margin))
@ -210,7 +211,7 @@
{::mf/wrap-props false}
[props]
(let [render-id (mf/use-ctx muc/render-ctx)
(let [render-id (mf/use-ctx muc/render-id)
child (obj/get props "children")
base-props (obj/get child "props")
elem-name (obj/get child "type")
@ -252,7 +253,7 @@
(mf/defc inner-stroke
{::mf/wrap-props false}
[props]
(let [render-id (mf/use-ctx muc/render-ctx)
(let [render-id (mf/use-ctx muc/render-id)
child (obj/get props "children")
base-props (obj/get child "props")
elem-name (obj/get child "type")
@ -291,7 +292,7 @@
(let [child (obj/get props "children")
shape (obj/get props "shape")
render-id (mf/use-ctx muc/render-ctx)
render-id (mf/use-ctx muc/render-id)
index (obj/get props "index")
stroke-width (:stroke-width shape 0)
stroke-style (:stroke-style shape :none)
@ -416,7 +417,7 @@
shape (obj/get props "shape")
elem-name (obj/get child "type")
position (or (obj/get props "position") 0)
render-id (or (obj/get props "render-id") (mf/use-ctx muc/render-ctx))]
render-id (or (obj/get props "render-id") (mf/use-ctx muc/render-id))]
[:g {:id (dm/fmt "fills-%" (:id shape))}
[:> elem-name (build-fill-props shape child position render-id)]]))
@ -426,9 +427,9 @@
(let [child (obj/get props "children")
shape (obj/get props "shape")
elem-name (obj/get child "type")
render-id (or (obj/get props "render-id") (mf/use-ctx muc/render-ctx))
render-id (or (obj/get props "render-id") (mf/use-ctx muc/render-id))
stroke-id (dm/fmt "strokes-%" (:id shape))
stroke-props (-> (obj/new)
stroke-props (-> (obj/create)
(obj/set! "id" stroke-id)
(cond->
;; There is a blur

12
frontend/src/app/main/ui/shapes/export.cljs
View file

@ -95,6 +95,10 @@
(add! :constraints-v)
(add! :fixed-scroll)
(cond-> frame?
(-> (add! :show-content)
(add! :hide-in-viewer)))
(cond-> (and (or rect? image? frame?) (some? (:r1 shape)))
(-> (add! :r1)
(add! :r2)
@ -262,7 +266,7 @@
(when (= (:type shape) :svg-raw)
(let [shape (-> shape (d/update-in-when [:content :attrs :style] str->style))
props
(-> (obj/new)
(-> (obj/create)
(obj/set! "penpot:x" (:x shape))
(obj/set! "penpot:y" (:y shape))
(obj/set! "penpot:width" (:width shape))
@ -282,7 +286,7 @@
(for [[index fill] (d/enumerate fills)]
[:> "penpot:fill"
#js {:penpot:fill-color (if (some? (:fill-color-gradient fill))
(str/format "url(#%s)" (str "fill-color-gradient_" (mf/use-ctx muc/render-ctx) "_" index))
(str/format "url(#%s)" (str "fill-color-gradient_" (mf/use-ctx muc/render-id) "_" index))
(d/name (:fill-color fill)))
:penpot:fill-color-ref-file (d/name (:fill-color-ref-file fill))
:penpot:fill-color-ref-id (d/name (:fill-color-ref-id fill))
@ -295,7 +299,7 @@
(for [[index stroke] (d/enumerate strokes)]
[:> "penpot:stroke"
#js {:penpot:stroke-color (if (some? (:stroke-color-gradient stroke))
(str/format "url(#%s)" (str "stroke-color-gradient_" (mf/use-ctx muc/render-ctx) "_" index))
(str/format "url(#%s)" (str "stroke-color-gradient_" (mf/use-ctx muc/render-id) "_" index))
(d/name (:stroke-color stroke)))
:penpot:stroke-color-ref-file (d/name (:stroke-color-ref-file stroke))
:penpot:stroke-color-ref-id (d/name (:stroke-color-ref-id stroke))
@ -328,7 +332,7 @@
(mf/defc export-data
[{:keys [shape]}]
(let [props (-> (obj/new) (add-data shape) (add-library-refs shape))]
(let [props (-> (obj/create) (add-data shape) (add-library-refs shape))]
[:> "penpot:shape" props
(export-shadow-data shape)
(export-blur-data shape)

2
frontend/src/app/main/ui/shapes/fills.cljs
View file

@ -41,7 +41,7 @@
(cfg/resolve-file-media (:fill-image shape)))
embed (embed/use-data-uris [uri])
transform (gsh/transform-matrix shape)
transform (gsh/transform-str shape)
;; When true the image has not loaded yet
loading? (and (some? uri) (not (contains? embed uri)))

115
frontend/src/app/main/ui/shapes/filters.cljs
View file

@ -8,8 +8,7 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.geom.shapes.bounds :as gsb]
[app.common.uuid :as uuid]
[app.util.color :as color]
[cuerdas.core :as str]
@ -108,34 +107,6 @@
:in2 filter-in
:result filter-id}])
(defn filter-bounds [shape filter-entry]
(let [{:keys [x y width height]} (:selrect shape)
{:keys [offset-x offset-y blur spread] :or {offset-x 0 offset-y 0 blur 0 spread 0}} (:params filter-entry)
filter-x (min x (+ x offset-x (- spread) (- blur) -5))
filter-y (min y (+ y offset-y (- spread) (- blur) -5))
filter-width (+ width (mth/abs offset-x) (* spread 2) (* blur 2) 10)
filter-height (+ height (mth/abs offset-y) (* spread 2) (* blur 2) 10)]
{:x1 filter-x
:y1 filter-y
:x2 (+ filter-x filter-width)
:y2 (+ filter-y filter-height)}))
(defn blur-filters [type value]
(->> [value]
(remove :hidden)
(filter #(= (:type %) type))
(map #(hash-map :id (str "filter_" (:id %))
:type (:type %)
:params %))))
(defn shadow-filters [type filters]
(->> filters
(remove :hidden)
(filter #(= (:style %) type))
(map #(hash-map :id (str "filter_" (:id %))
:type (:style %)
:params %))))
(mf/defc filter-entry [{:keys [entry]}]
(let [props #js {:filter-id (:id entry)
:filter-in (:filter-in entry)
@ -148,84 +119,6 @@
:image-fix [:> image-fix-filter props]
:blend-filters [:> blend-filters props])))
(defn shape->filters
[shape]
(d/concat-vec
[{:id "BackgroundImageFix" :type :image-fix}]
;; Background blur won't work in current SVG specification
;; We can revisit this in the future
#_(->> shape :blur (blur-filters :background-blur))
(->> shape :shadow (shadow-filters :drop-shadow))
[{:id "shape" :type :blend-filters}]
(->> shape :shadow (shadow-filters :inner-shadow))
(->> shape :blur (blur-filters :layer-blur))))
(defn get-filters-bounds
([shape]
(let [filters (shape->filters shape)
blur-value (or (-> shape :blur :value) 0)]
(get-filters-bounds shape filters blur-value)))
([shape filters blur-value]
(let [svg-root? (and (= :svg-raw (:type shape)) (not= :svg (get-in shape [:content :tag])))
{:keys [x y width height]} (:selrect shape)]
(if svg-root?
;; When is a raw-svg but not the root we use the whole svg as bound for the filter. Is the maximum
;; we're allowed to display
{:x x :y y :width width :height height}
;; Otherwise we calculate the bound
(let [filter-bounds (->> filters
(filter #(= :drop-shadow (:type %)))
(map (partial filter-bounds shape)))
;; We add the selrect so the minimum size will be the selrect
filter-bounds (conj filter-bounds (-> shape :points gsh/points->selrect))
x1 (apply min (map :x1 filter-bounds))
y1 (apply min (map :y1 filter-bounds))
x2 (apply max (map :x2 filter-bounds))
y2 (apply max (map :y2 filter-bounds))
x1 (- x1 (* blur-value 2))
x2 (+ x2 (* blur-value 2))
y1 (- y1 (* blur-value 2))
y2 (+ y2 (* blur-value 2))]
;; We should move the frame filter coordinates because they should be
;; relative with the frame. By default they come as absolute
{:x x1
:y y1
:width (- x2 x1)
:height (- y2 y1)})))))
(defn calculate-padding
([shape]
(calculate-padding shape false))
([shape ignore-margin?]
(let [stroke-width (apply max 0 (map #(case (:stroke-alignment % :center)
:center (/ (:stroke-width % 0) 2)
:outer (:stroke-width % 0)
0) (:strokes shape)))
margin (if ignore-margin?
0
(apply max 0 (map #(gsh/shape-stroke-margin % stroke-width) (:strokes shape))))
shadow-width (apply max 0 (map #(case (:style % :drop-shadow)
:drop-shadow (+ (mth/abs (:offset-x %)) (* (:spread %) 2) (* (:blur %) 2) 10)
0) (:shadow shape)))
shadow-height (apply max 0 (map #(case (:style % :drop-shadow)
:drop-shadow (+ (mth/abs (:offset-y %)) (* (:spread %) 2) (* (:blur %) 2) 10)
0) (:shadow shape)))]
{:horizontal (+ stroke-width margin shadow-width)
:vertical (+ stroke-width margin shadow-height)})))
(defn change-filter-in
"Adds the previous filter as `filter-in` parameter"
[filters]
@ -234,9 +127,9 @@
(mf/defc filters
[{:keys [filter-id shape]}]
(let [filters (-> shape shape->filters change-filter-in)
bounds (get-filters-bounds shape filters (or (-> shape :blur :value) 0))
padding (calculate-padding shape)
(let [filters (-> shape gsb/shape->filters change-filter-in)
bounds (gsb/get-rect-filter-bounds (:selrect shape) filters (or (-> shape :blur :value) 0))
padding (gsb/calculate-padding shape)
selrect (:selrect shape)
filter-x (/ (- (:x bounds) (:x selrect) (:horizontal padding)) (:width selrect))
filter-y (/ (- (:y bounds) (:y selrect) (:vertical padding)) (:height selrect))

136
frontend/src/app/main/ui/shapes/frame.cljs
View file

@ -28,95 +28,95 @@
[{:keys [shape render-id]}]
(when (= :frame (:type shape))
(let [{:keys [x y width height]} shape
transform (gsh/transform-str shape)
props (-> (attrs/extract-style-attrs shape)
(obj/merge!
#js {:x x
:y y
:width width
:height height}))
:height height
:transform transform}))
path? (some? (.-d props))]
[:clipPath {:id (frame-clip-id shape render-id) :class "frame-clip"}
(if path?
[:> :path props]
[:> :rect props])])))
;; Wrapper around the frame that will handle things such as strokes and other properties
;; we wrap the proper frames and also the thumbnails
(mf/defc frame-container
{::mf/wrap-props false}
[props]
(let [shape (obj/get props "shape")
children (obj/get props "children")
{:keys [x y width height show-content]} shape
transform (gsh/transform-str shape)
props (-> (attrs/extract-style-attrs shape)
(obj/merge!
#js {:x x
:y y
:transform transform
:width width
:height height
:className "frame-background"}))
path? (some? (.-d props))
render-id (mf/use-ctx muc/render-id)]
[:*
[:g {:clip-path (when (not show-content) (frame-clip-url shape render-id))}
(when (not show-content)
[:& frame-clip-def {:shape shape :render-id render-id}])
[:& shape-fills {:shape shape}
(if path?
[:> :path props]
[:> :rect props])]
children]
[:& shape-strokes {:shape shape}
(if path?
[:> :path props]
[:> :rect props])]]))
(mf/defc frame-thumbnail-image
{::mf/wrap-props false}
[props]
(let [shape (obj/get props "shape")
bounds (or (obj/get props "bounds") (gsh/points->selrect (:points shape)))]
(when (:thumbnail shape)
[:image.frame-thumbnail
{:id (dm/str "thumbnail-" (:id shape))
:href (:thumbnail shape)
:x (:x bounds)
:y (:y bounds)
:width (:width bounds)
:height (:height bounds)
;; DEBUG
:style {:filter (when (debug? :thumbnails) "sepia(1)")}}])))
(mf/defc frame-thumbnail
{::mf/wrap-props false}
[props]
(let [shape (obj/get props "shape")]
(when (:thumbnail shape)
(let [{:keys [x y width height]} shape
transform (gsh/transform-matrix shape)
props (-> (attrs/extract-style-attrs shape)
(obj/merge!
#js {:x x
:y y
:transform (str transform)
:width width
:height height
:className "frame-background"}))
path? (some? (.-d props))
render-id (mf/use-ctx muc/render-ctx)]
[:*
[:g {:clip-path (frame-clip-url shape render-id)}
[:& frame-clip-def {:shape shape :render-id render-id}]
[:& shape-fills {:shape shape}
(if path?
[:> :path props]
[:> :rect props])]
[:image.frame-thumbnail
{:id (dm/str "thumbnail-" (:id shape))
:href (:thumbnail shape)
:x (:x shape)
:y (:y shape)
:width (:width shape)
:height (:height shape)
;; DEBUG
:style {:filter (when (debug? :thumbnails) "sepia(1)")}}]]
[:& shape-strokes {:shape shape}
(if path?
[:> :path props]
[:> :rect props])]]))))
[:> frame-container props
[:> frame-thumbnail-image props]])))
(defn frame-shape
[shape-wrapper]
(mf/fnc frame-shape
{::mf/wrap-props false}
[props]
(let [childs (unchecked-get props "childs")
shape (unchecked-get props "shape")
{:keys [x y width height]} shape
transform (gsh/transform-matrix shape)
props (-> (attrs/extract-style-attrs shape)
(obj/merge!
#js {:x x
:y y
:transform (str transform)
:width width
:height height
:className "frame-background"}))
path? (some? (.-d props))
render-id (mf/use-ctx muc/render-ctx)]
[:*
[:g {:clip-path (frame-clip-url shape render-id)}
[:& shape-fills {:shape shape}
(if path?
[:> :path props]
[:> :rect props])]
[:g.frame-children
(for [item childs]
[:& shape-wrapper {:shape item
:key (dm/str (:id item))}])]]
[:& shape-strokes {:shape shape}
(if path?
[:> :path props]
[:> :rect props])]])))
(let [childs (unchecked-get props "childs")]
[:> frame-container props
[:g.frame-children
(for [item childs]
[:& shape-wrapper {:key (dm/str (:id item)) :shape item}])]])))

8
frontend/src/app/main/ui/shapes/gradients.cljs
View file

@ -27,13 +27,15 @@
(obj/set! "penpot:width" (:width gradient))))
(mf/defc linear-gradient [{:keys [id gradient shape]}]
(let [transform (when (= :path (:type shape)) (gsh/transform-matrix shape nil (gpt/point 0.5 0.5)))
(let [transform (when (= :path (:type shape))
(gsh/transform-matrix shape nil (gpt/point 0.5 0.5)))
base-props #js {:id id
:x1 (:start-x gradient)
:y1 (:start-y gradient)
:x2 (:end-x gradient)
:y2 (:end-y gradient)
:gradientTransform transform}
:gradientTransform (dm/str transform)}
include-metadata? (mf/use-ctx ed/include-metadata-ctx)
@ -102,7 +104,7 @@
(let [attr (obj/get props "attr")
shape (obj/get props "shape")
id (obj/get props "id")
id' (mf/use-ctx muc/render-ctx)
id' (mf/use-ctx muc/render-id)
id (or id (dm/str (name attr) "_" id'))
gradient (get shape attr)
gradient-props #js {:id id

10
frontend/src/app/main/ui/shapes/group.cljs
View file

@ -21,7 +21,7 @@
(let [shape (unchecked-get props "shape")
childs (unchecked-get props "childs")
objects (unchecked-get props "objects")
render-id (mf/use-ctx muc/render-ctx)
render-id (mf/use-ctx muc/render-id)
masked-group? (:masked-group? shape)
[mask childs] (if masked-group?
@ -34,18 +34,18 @@
; Firefox bug: https://bugzilla.mozilla.org/show_bug.cgi?id=1734805
[clip-wrapper clip-props]
(if masked-group?
["g" (-> (obj/new)
["g" (-> (obj/create)
(obj/set! "clipPath" (clip-url render-id mask)))]
[mf/Fragment nil])
[mask-wrapper mask-props]
(if masked-group?
["g" (-> (obj/new)
(obj/set! "mask" (mask-url render-id mask)))]
["g" (-> (obj/create)
(obj/set! "mask" (mask-url render-id mask)))]
[mf/Fragment nil])
;; This factory is generic, it's used for viewer, workspace and handoff.
;; These props are generated in viewer wrappers only, in the rest of the
;; These props are generated in viewer wrappers only, in the rest of the
;; cases these props will be nil, not affecting the code.
delta (unchecked-get props "delta")
fixed? (unchecked-get props "fixed?")]

2
frontend/src/app/main/ui/shapes/image.cljs
View file

@ -18,7 +18,7 @@
(let [shape (unchecked-get props "shape")
{:keys [x y width height]} shape
transform (gsh/transform-matrix shape)
transform (gsh/transform-str shape)
props (-> (attrs/extract-style-attrs shape)
(obj/merge! (attrs/extract-border-radius-attrs shape))
(obj/merge!

8
frontend/src/app/main/ui/shapes/mask.cljs
View file

@ -47,18 +47,18 @@
{::mf/wrap-props false}
[props]
(let [mask (unchecked-get props "mask")
render-id (mf/use-ctx muc/render-ctx)
render-id (mf/use-ctx muc/render-id)
svg-text? (and (= :text (:type mask)) (some? (:position-data mask)))
;; This factory is generic, it's used for viewer, workspace and handoff.
;; These props are generated in viewer wrappers only, in the rest of the
;; cases these props will be nil, not affecting the code.
;; These props are generated in viewer wrappers only, in the rest of the
;; cases these props will be nil, not affecting the code.
fixed? (unchecked-get props "fixed?")
delta (unchecked-get props "delta")
mask-bb (-> (gsh/transform-shape mask)
(cond-> fixed? (gsh/move delta))
(:points))
mask-bb-rect (gsh/points->rect mask-bb)]
[:defs
[:filter {:id (filter-id render-id mask)}

2
frontend/src/app/main/ui/shapes/rect.cljs
View file

@ -17,7 +17,7 @@
[props]
(let [shape (unchecked-get props "shape")
{:keys [x y width height]} shape
transform (gsh/transform-matrix shape)
transform (gsh/transform-str shape)
props (-> (attrs/extract-style-attrs shape)
(obj/merge!

41
frontend/src/app/main/ui/shapes/shape.cljs
View file

@ -8,8 +8,9 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.uuid :as uuid]
[app.common.pages.helpers :as cph]
[app.main.ui.context :as muc]
[app.main.ui.hooks :as h]
[app.main.ui.shapes.attrs :as attrs]
[app.main.ui.shapes.export :as ed]
[app.main.ui.shapes.fills :as fills]
@ -48,18 +49,19 @@
{::mf/forward-ref true
::mf/wrap-props false}
[props ref]
(let [shape (obj/get props "shape")
children (obj/get props "children")
pointer-events (obj/get props "pointer-events")
type (:type shape)
render-id (mf/use-memo #(str (uuid/next)))
filter-id (str "filter_" render-id)
styles (-> (obj/new)
(obj/set! "pointerEvents" pointer-events)
(let [shape (unchecked-get props "shape")
children (unchecked-get props "children")
pointer-events (unchecked-get props "pointer-events")
disable-shadows? (unchecked-get props "disable-shadows?")
(cond-> (and (:blend-mode shape) (not= (:blend-mode shape) :normal))
(obj/set! "mixBlendMode" (d/name (:blend-mode shape)))))
type (:type shape)
render-id (h/use-id)
filter-id (dm/str "filter_" render-id)
styles (-> (obj/create)
(obj/set! "pointerEvents" pointer-events)
(cond-> (and (:blend-mode shape) (not= (:blend-mode shape) :normal))
(obj/set! "mixBlendMode" (d/name (:blend-mode shape)))))
include-metadata? (mf/use-ctx ed/include-metadata-ctx)
@ -68,20 +70,21 @@
wrapper-props
(-> (obj/clone props)
(obj/without ["shape" "children"])
(obj/without ["shape" "children" "disable-shadows?"])
(obj/set! "ref" ref)
(obj/set! "id" (dm/fmt "shape-%" (:id shape)))
(obj/set! "style" styles))
wrapper-props
(cond-> wrapper-props
(some #(= (:type shape) %) [:group :svg-raw :frame])
(obj/set! "filter" (filters/filter-str filter-id shape)))
wrapper-props
(cond-> wrapper-props
(= :group type)
(attrs/add-style-attrs shape render-id))
(attrs/add-style-attrs shape render-id)
(and (or (cph/group-shape? shape)
(cph/frame-shape? shape)
(cph/svg-raw-shape? shape))
(not disable-shadows?))
(obj/set! "filter" (filters/filter-str filter-id shape)))
svg-group? (and (contains? shape :svg-attrs) (= :group type))
@ -89,7 +92,7 @@
svg-group?
(propagate-wrapper-styles wrapper-props))]
[:& (mf/provider muc/render-ctx) {:value render-id}
[:& (mf/provider muc/render-id) {:value render-id}
[:> :g wrapper-props
(when include-metadata?
[:& ed/export-data {:shape shape}])

7
frontend/src/app/main/ui/shapes/svg_defs.cljs
View file

@ -10,8 +10,7 @@
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.shapes :as gsh]
[app.main.ui.shapes.filters :as f]
[app.util.object :as obj]
[app.common.geom.shapes.bounds :as gsb]
[app.util.svg :as usvg]
[rumext.alpha :as mf]))
@ -68,7 +67,7 @@
[wrapper wrapper-props] (if (= tag :mask)
["g" #js {:className "svg-mask-wrapper"
:transform (str transform)}]
[mf/Fragment (obj/new)])]
[mf/Fragment #js {}])]
[:> (name tag) (clj->js attrs)
[:> wrapper wrapper-props
@ -88,7 +87,7 @@
(d/parse-double (get-in svg-def [:attrs :width]))
(d/parse-double (get-in svg-def [:attrs :height])))
(gsh/transform-rect transform))
(f/get-filters-bounds shape))))
(gsb/get-shape-filter-bounds shape))))
(mf/defc svg-defs [{:keys [shape render-id]}]
(let [svg-defs (:svg-defs shape)

2
frontend/src/app/main/ui/shapes/svg_raw.cljs
View file

@ -60,7 +60,7 @@
(obj/set! "preserveAspectRatio" "none"))]
[:& (mf/provider svg-ids-ctx) {:value ids-mapping}
[:g.svg-raw {:transform (dm/str (gsh/transform-matrix shape))}
[:g.svg-raw {:transform (gsh/transform-str shape)}
[:> "svg" attrs children]]]))
(mf/defc svg-element

34
frontend/src/app/main/ui/shapes/text/fo_text.cljs
View file

@ -8,8 +8,7 @@
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.geom.shapes :as geom]
[app.main.ui.context :as muc]
[app.common.geom.shapes :as gsh]
[app.main.ui.shapes.attrs :as attrs]
[app.main.ui.shapes.text.styles :as sts]
[app.util.color :as uc]
@ -91,23 +90,6 @@
(recur (uc/next-rgb current-rgb))
current-hex))))
(defn- remap-colors
"Returns a new content replacing the original colors by their mapped 'simple color'"
[content color-mapping]
(cond-> content
(and (:fill-opacity content) (< (:fill-opacity content) 1.0))
(-> (assoc :fill-color (get color-mapping [(:fill-color content) (:fill-opacity content)]))
(assoc :fill-opacity 1.0))
(some? (:fill-color-gradient content))
(-> (assoc :fill-color (get color-mapping (:fill-color-gradient content)))
(assoc :fill-opacity 1.0)
(dissoc :fill-color-gradient))
(contains? content :children)
(update :children #(mapv (fn [node] (remap-colors node color-mapping)) %))))
(defn- fill->color
"Given a content node returns the information about that node fill color"
[{:keys [fill-color fill-opacity fill-color-gradient]}]
@ -192,31 +174,25 @@
::mf/forward-ref true}
[props ref]
(let [shape (obj/get props "shape")
transform (str (geom/transform-matrix shape))
transform (gsh/transform-str shape)
{:keys [id x y width height content]} shape
grow-type (obj/get props "grow-type") ;; This is only needed in workspace
;; We add 8px to add a padding for the exporter
;; width (+ width 8)
[colors color-mapping color-mapping-inverse] (retrieve-colors shape)
plain-colors? (mf/use-ctx muc/text-plain-colors-ctx)
content (cond-> content
plain-colors?
(remap-colors color-mapping))]
[colors _color-mapping color-mapping-inverse] (retrieve-colors shape)]
[:foreignObject
{:x x
:y y
:id id
:data-colors (->> colors (str/join ","))
:data-mapping (-> color-mapping-inverse (clj->js) (js/JSON.stringify))
:data-mapping (-> color-mapping-inverse clj->js js/JSON.stringify)
:transform transform
:width (if (#{:auto-width} grow-type) 100000 width)
:height (if (#{:auto-height :auto-width} grow-type) 100000 height)
:style (-> (obj/new) (attrs/add-layer-props shape))
:style (-> (obj/create) (attrs/add-layer-props shape))
:ref ref}
;; We use a class here because react has a bug that won't use the appropriate selector for
;; `background-clip`

105
frontend/src/app/main/ui/shapes/text/html_text.cljs Normal file
View file

@ -0,0 +1,105 @@
;; 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.shapes.text.html-text
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.main.ui.shapes.text.styles :as sts]
[app.util.object :as obj]
[rumext.alpha :as mf]))
(mf/defc render-text
{::mf/wrap-props false}
[props]
(let [node (obj/get props "node")
parent (obj/get props "parent")
shape (obj/get props "shape")
text (:text node)
style (if (= text "")
(sts/generate-text-styles shape parent)
(sts/generate-text-styles shape node))]
[:span.text-node {:style style}
(if (= text "") "\u00A0" text)]))
(mf/defc render-root
{::mf/wrap-props false}
[props]
(let [node (obj/get props "node")
children (obj/get props "children")
shape (obj/get props "shape")
style (sts/generate-root-styles shape node)]
[:div.root.rich-text
{:style style
:xmlns "http://www.w3.org/1999/xhtml"}
children]))
(mf/defc render-paragraph-set
{::mf/wrap-props false}
[props]
(let [children (obj/get props "children")
shape (obj/get props "shape")
style (sts/generate-paragraph-set-styles shape)]
[:div.paragraph-set {:style style} children]))
(mf/defc render-paragraph
{::mf/wrap-props false}
[props]
(let [node (obj/get props "node")
shape (obj/get props "shape")
children (obj/get props "children")
style (sts/generate-paragraph-styles shape node)
dir (:text-direction node "auto")]
[:p.paragraph {:style style :dir dir} children]))
;; -- Text nodes
(mf/defc render-node
{::mf/wrap-props false}
[props]
(let [{:keys [type text children] :as parent} (obj/get props "node")]
(if (string? text)
[:> render-text props]
(let [component (case type
"root" render-root
"paragraph-set" render-paragraph-set
"paragraph" render-paragraph
nil)]
(when component
[:> component props
(for [[index node] (d/enumerate children)]
(let [props (-> (obj/clone props)
(obj/set! "node" node)
(obj/set! "parent" parent)
(obj/set! "index" index)
(obj/set! "key" index))]
[:> render-node props]))])))))
(mf/defc text-shape
{::mf/wrap-props false
::mf/forward-ref true}
[props ref]
(let [shape (obj/get props "shape")
grow-type (obj/get props "grow-type")
{:keys [id x y width height content]} shape]
[:div.text-node-html
{:id (dm/str "html-text-node-" id)
:ref ref
:data-x x
:data-y y
:style {:position "fixed"
:left 0
:top 0
:background "white"
:width (if (#{:auto-width} grow-type) 100000 width)
:height (if (#{:auto-height :auto-width} grow-type) 100000 height)}}
;; We use a class here because react has a bug that won't use the appropriate selector for
;; `background-clip`
[:style ".text-node { background-clip: text;
-webkit-background-clip: text;" ]
[:& render-node {:index 0
:shape shape
:node content}]]))

6
frontend/src/app/main/ui/shapes/text/styles.cljs
View file

@ -63,7 +63,6 @@
(let [letter-spacing (:letter-spacing data 0)
text-decoration (:text-decoration data)
text-transform (:text-transform data)
line-height (:line-height data 1.2)
font-id (:font-id data (:font-id txt/default-text-attrs))
font-variant-id (:font-variant-id data)
@ -80,13 +79,12 @@
base #js {:textDecoration text-decoration
:textTransform text-transform
:lineHeight (or line-height "1.2")
:color (if show-text? text-color "transparent")
:caretColor (or text-color "black")
:overflowWrap "initial"
:lineBreak "auto"
:whiteSpace "break-spaces"}
:whiteSpace "break-spaces"
:textRendering "geometricPrecision"}
fills
(cond
(some? (:fills data))

7
frontend/src/app/main/ui/shapes/text/svg_text.cljs
View file

@ -53,13 +53,13 @@
::mf/wrap [mf/memo]}
[props]
(let [render-id (mf/use-ctx muc/render-ctx)
(let [render-id (mf/use-ctx muc/render-id)
shape (obj/get props "shape")
shape (cond-> shape (:is-mask? shape) set-white-fill)
{:keys [x y width height position-data]} shape
transform (str (gsh/transform-matrix shape {:no-flip true}))
transform (gsh/transform-str shape {:no-flip true})
;; These position attributes are not really necesary but they are convenient for for the export
group-props (-> #js {:transform transform
@ -106,7 +106,6 @@
(obj/set! "fill" (str "url(#fill-" index "-" render-id ")")))})
shape (assoc shape :fills (:fills data))]
[:& (mf/provider muc/render-ctx) {:key index :value (str render-id "_" (:id shape) "_" index)}
[:& (mf/provider muc/render-id) {:key index :value (str render-id "_" (:id shape) "_" index)}
[:& shape-custom-strokes {:shape shape :position index :render-id render-id}
[:> :text props (:text data)]]]))]]))

309
frontend/src/app/main/ui/share_link.cljs
View file

@ -10,6 +10,7 @@
[app.common.logging :as log]
[app.config :as cf]
[app.main.data.common :as dc]
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.modal :as modal]
[app.main.refs :as refs]
@ -19,71 +20,89 @@
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[app.util.webapi :as wapi]
[potok.core :as ptk]
[rumext.alpha :as mf]))
(log/set-level! :warn)
(defn prepare-params
[{:keys [sections pages pages-mode]}]
{:pages pages
:flags (-> #{}
(into (map #(str "section-" %)) sections)
(into (map #(str "pages-" %)) [pages-mode]))})
[{:keys [pages who-comment who-inspect]}]
{:pages pages
:who-comment who-comment
:who-inspect who-inspect})
(mf/defc share-link-dialog
{::mf/register modal/components
::mf/register-as :share-link}
[{:keys [file page]}]
(let [slinks (mf/deref refs/share-links)
router (mf/deref refs/router)
route (mf/deref refs/route)
(let [current-page page
slinks (mf/deref refs/share-links)
router (mf/deref refs/router)
route (mf/deref refs/route)
link (mf/use-state nil)
confirm (mf/use-state false)
link (mf/use-state nil)
confirm (mf/use-state false)
open-ops (mf/use-state false)
opts (mf/use-state
{:pages-mode "current"
:all-pages false
:pages #{(:id page)}
:who-comment "team"
:who-inspect "team"})
opts (mf/use-state
{:sections #{"viewer"}
:pages-mode "current"
:pages #{(:id page)}})
close
(fn [event]
(dom/prevent-default event)
(st/emit! (modal/hide)))
(st/emit! (modal/hide))
(modal/disallow-click-outside!))
select-pages-mode
(fn [mode]
toggle-all
(fn []
(reset! confirm false)
(swap! opts
(fn [state]
(-> state
(assoc :pages-mode mode)
(cond-> (= mode "current") (assoc :pages #{(:id page)}))
(cond-> (= mode "all") (assoc :pages (into #{} (get-in file [:data :pages]))))))))
(if (= true (:all-pages state))
(-> state
(assoc :all-pages false)
(assoc :pages #{(:id page)}))
(-> state
(assoc :all-pages true)
(assoc :pages (into #{} (get-in file [:data :pages]))))))))
mark-checked-page
(fn [event id]
(let [target (dom/get-target event)
checked? (.-checked ^js target)]
(reset! confirm false)
(swap! opts update :pages
(fn [pages]
(if checked?
(conj pages id)
(disj pages id))))))
checked? (.-checked ^js target)
dif-pages? (not= id (first (:pages @opts)))
no-one-page (< 1 (count (:pages @opts)))
should-change (or no-one-page dif-pages?)]
(when should-change
(reset! confirm false)
(swap! opts update :pages
(fn [pages]
(if checked?
(conj pages id)
(disj pages id)))))))
create-link
(fn [_]
(let [params (prepare-params @opts)
params (assoc params :file-id (:id file))]
(st/emit! (dc/create-share-link params))))
(st/emit! (dc/create-share-link params)
(ptk/event ::ev/event {::ev/name "create-shared-link"
::ev/origin "viewer"
:can-comment (:who-comment params)
:can-inspect-code (:who-inspect params)}))))
copy-link
(fn [_]
(wapi/write-to-clipboard @link)
(st/emit! (dm/show {:type :info
:content (tr "common.share-link.link-copied-success")
:timeout 3000})))
:timeout 1000})))
try-delete-link
(fn [_]
@ -94,17 +113,27 @@
(let [params (prepare-params @opts)
slink (d/seek #(= (:flags %) (:flags params)) slinks)]
(reset! confirm false)
(st/emit! (dc/delete-share-link slink)
(dm/show {:type :info
:content (tr "common.share-link.link-deleted-success")
:timeout 3000}))))
]
(st/emit! (dc/delete-share-link slink))))
manage-open-ops
(fn [_]
(swap! open-ops not))
on-who-change
(fn [type event]
(let [target (dom/get-target event)
value (dom/get-value target)
value (keyword value)]
(reset! confirm false)
(if (= type :comment)
(swap! opts assoc :who-comment (d/name value))
(swap! opts assoc :who-inspect (d/name value)))))]
(mf/use-effect
(mf/deps file slinks @opts)
(fn []
(let [{:keys [flags pages] :as params} (prepare-params @opts)
slink (d/seek #(and (= (:flags %) flags) (= (:pages %) pages)) slinks)
(let [{:keys [pages who-comment who-inspect] :as params} (prepare-params @opts)
slink (d/seek #(and (= (:who-inspect %) who-inspect) (= (:who-comment %) who-comment) (= (:pages %) pages)) slinks)
href (when slink
(let [pparams (:path-params route)
qparams (-> (:query-params route)
@ -114,123 +143,123 @@
(assoc cf/public-uri :fragment href)))]
(reset! link (some-> href str)))))
[:div.modal-overlay
[:div.modal-overlay.share-modal
[:div.modal-container.share-link-dialog
[:div.modal-content
[:div.modal-content.initial
[:div.title
[:h2 (tr "common.share-link.title")]
[:div.modal-close-button
{:on-click close
:title (tr "labels.close")}
i/close]]
[:div.share-link-section
[:label (tr "labels.link")]
[:div.custom-input.with-icon
[:input {:type "text"
:value (or @link "")
:placeholder (tr "common.share-link.placeholder")
:read-only true}]
(when (some? @link)
[:div.help-icon {:title (tr "labels.copy")
:on-click copy-link}
i/copy])]
[:div.hint (tr "common.share-link.permissions-hint")]]]
i/close]]]
[:div.modal-content
(let [sections (:sections @opts)]
[:div.access-mode
[:div.title (tr "common.share-link.permissions-can-access")]
[:div.items
[:div.input-checkbox.check-primary.disabled
[:input.check-primary.input-checkbox {:type "checkbox" :disabled true}]
[:label (tr "labels.workspace")]]
[:div.share-link-section
(when (and (not @confirm) (some? @link))
[:div.custom-input.with-icon
[:input {:type "text"
:value (or @link "")
:placeholder (tr "common.share-link.placeholder")
:read-only true}]
[:div.help-icon {:title (tr "viewer.header.share.copy-link")
:on-click copy-link}
i/copy]])
[:div.hint-wrapper
(when (not @confirm) [:div.hint (tr "common.share-link.permissions-hint")])
(cond
(true? @confirm)
[:div.confirm-dialog
[:div.description (tr "common.share-link.confirm-deletion-link-description")]
[:div.actions
[:input.btn-secondary
{:type "button"
:on-click #(reset! confirm false)
:value (tr "labels.cancel")}]
[:input.btn-warning
{:type "button"
:on-click delete-link
:value (tr "common.share-link.destroy-link")}]]]
[:div.input-checkbox.check-primary
[:input {:type "checkbox"
:default-checked (contains? sections "viewer")}]
[:label (tr "labels.viewer")
[:span.hint "(" (tr "labels.default") ")"]]]
;; [:div.input-checkbox.check-primary
;; [:input.check-primary.input-checkbox {:type "checkbox"}]
;; [:label "Handoff" ]]
]])
(let [mode (:pages-mode @opts)]
[:*
[:div.view-mode
[:div.title (tr "common.share-link.permissions-can-view")]
[:div.items
[:div.input-radio.radio-primary
[:input {:type "radio"
:id "view-all"
:checked (= "all" mode)
:name "pages-mode"
:on-change #(select-pages-mode "all")}]
[:label {:for "view-all"} (tr "common.share-link.view-all-pages")]]
[:div.input-radio.radio-primary
[:input {:type "radio"
:id "view-current"
:name "pages-mode"
:checked (= "current" mode)
:on-change #(select-pages-mode "current")}]
[:label {:for "view-current"} (tr "common.share-link.view-current-page")]]
[:div.input-radio.radio-primary
[:input {:type "radio"
:id "view-selected"
:name "pages-mode"
:checked (= "selected" mode)
:on-change #(select-pages-mode "selected")}]
[:label {:for "view-selected"} (tr "common.share-link.view-selected-pages")]]]]
(when (= "selected" mode)
(let [pages (->> (get-in file [:data :pages])
(map #(get-in file [:data :pages-index %])))
selected (:pages @opts)]
[:ul.pages-selection
(for [page pages]
[:li.input-checkbox.check-primary {:key (str (:id page))}
[:input {:type "checkbox"
:id (str "page-" (:id page))
:on-change #(mark-checked-page % (:id page))
:checked (contains? selected (:id page))}]
[:label {:for (str "page-" (:id page))} (:name page)]])]))])]
[:div.modal-footer
(cond
(true? @confirm)
[:div.confirm-dialog
[:div.description (tr "common.share-link.confirm-deletion-link-description")]
[:div.actions
(some? @link)
[:input.btn-secondary
{:type "button"
:on-click #(reset! confirm false)
:value (tr "labels.cancel")}]
[:input.btn-warning
:class "primary"
:on-click try-delete-link
:value (tr "common.share-link.destroy-link")}]
:else
[:input.btn-primary
{:type "button"
:on-click delete-link
:value (tr "common.share-link.remove-link")
}]]]
:class "primary"
:on-click create-link
:value (tr "common.share-link.get-link")}])]]]
[:div.modal-content.ops-section
[:div.manage-permissions
{:on-click manage-open-ops}
[:span.icon i/picker-hsv]
[:div.title (tr "common.share-link.manage-ops")]]
(when @open-ops
[:*
(let [all-selected? (:all-pages @opts)
pages (->> (get-in file [:data :pages])
(map #(get-in file [:data :pages-index %])))
selected (:pages @opts)]
(some? @link)
[:input.btn-secondary
{:type "button"
:class "primary"
:on-click try-delete-link
:value (tr "common.share-link.remove-link")}]
[:*
[:div.view-mode
[:div.subtitle
[:span.icon i/play]
(tr "common.share-link.permissions-pages")]
[:div.items
(if (= 1 (count pages))
[:div.input-checkbox.check-primary
[:input {:type "checkbox"
:id (str "page-" (:id current-page))
:on-change #(mark-checked-page % (:id current-page))
:checked true}]
[:label {:for (str "page-" (:id current-page))} (:name current-page)]
[:span (str " " (tr "common.share-link.current-tag"))]]
:else
[:input.btn-primary
{:type "button"
:class "primary"
:on-click create-link
:value (tr "common.share-link.get-link")}])]
[:*
[:div.row
[:div.input-checkbox.check-primary
[:input {:type "checkbox"
:id "view-all"
:checked all-selected?
:name "pages-mode"
:on-change toggle-all}]
[:label {:for "view-all"} (tr "common.share-link.view-all")]]
[:span.count-pages (tr "common.share-link.page-shared" (i18n/c (count selected)))]]
]]))
[:ul.pages-selection
(for [page pages]
[:li.input-checkbox.check-primary {:key (str (:id page))}
[:input {:type "checkbox"
:id (str "page-" (:id page))
:on-change #(mark-checked-page % (:id page))
:checked (contains? selected (:id page))}]
(if (= (:id current-page) (:id page))
[:*
[:label {:for (str "page-" (:id page))} (:name page)]
[:span.current-tag (str " " (tr "common.share-link.current-tag"))]]
[:label {:for (str "page-" (:id page))} (:name page)])])]])]]])
[:div.access-mode
[:div.subtitle
[:span.icon i/chat]
(tr "common.share-link.permissions-can-comment")]
[:div.items
[:select.input-select {:on-change (partial on-who-change :comment)
:value (:who-comment @opts)}
[:option {:value "team"} (tr "common.share-link.team-members")]
[:option {:value "all"} (tr "common.share-link.all-users")]]]]
[:div.inspect-mode
[:div.subtitle
[:span.icon i/code]
(tr "common.share-link.permissions-can-inspect")]
[:div.items
[:select.input-select {:on-change (partial on-who-change :inspect)
:value (:who-inspect @opts)}
[:option {:value "team"} (tr "common.share-link.team-members")]
[:option {:value "all"} (tr "common.share-link.all-users")]]]]])]]]))

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