2026-05-05 11:19:45 +02:00

1082 lines
44 KiB
Clojure

;; 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) KALEIDOS INC
(ns app.main.data.workspace.tokens.application
(:require
[app.common.data :as d]
[app.common.files.tokens :as cfo]
[app.common.types.component :as ctk]
[app.common.types.shape.layout :as ctsl]
[app.common.types.shape.radius :as ctsr]
[app.common.types.shape.token :as ctst]
[app.common.types.stroke :as cts]
[app.common.types.text :as txt]
[app.common.types.token :as ctt]
[app.common.types.tokens-lib :as ctob]
[app.common.types.typography :as cty]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.event :as ev]
[app.main.data.helpers :as dsh]
[app.main.data.notifications :as ntf]
[app.main.data.style-dictionary :as sd]
[app.main.data.tinycolor :as tinycolor]
[app.main.data.tokenscript :as ts]
[app.main.data.workspace :as udw]
[app.main.data.workspace.colors :as wdc]
[app.main.data.workspace.shape-layout :as dwsl]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.transforms :as dwtr]
[app.main.data.workspace.undo :as dwu]
[app.main.data.workspace.wasm-text :as dwwt]
[app.main.features :as features]
[app.main.fonts :as fonts]
[app.main.store :as st]
[app.util.i18n :refer [tr]]
[beicon.v2.core :as rx]
[clojure.set :as set]
[cuerdas.core :as str]
[potok.v2.core :as ptk]))
(declare token-properties)
(declare update-layout-item-margin)
(declare all-attrs-appliable-for-token?)
;; Events to update the value of attributes with applied tokens ---------------------------------------------------------
;; (note that dwsh/update-shapes function returns an event)
(defn update-shape-radius
([value shape-ids attributes] (update-shape-radius value shape-ids attributes nil))
([value shape-ids attributes page-id]
(when (number? value)
(let [value (max 0 value)]
(dwsh/update-shapes shape-ids
(fn [shape]
(ctsr/set-radius-for-corners shape attributes value))
{:reg-objects? true
:ignore-touched true
:page-id page-id
:attrs ctt/border-radius-keys})))))
(defn update-shape-radius-for-corners
([value shape-ids attributes] (update-shape-radius-for-corners value shape-ids attributes nil))
([value shape-ids attributes page-id]
(when (number? value)
(let [value (max 0 value)]
(dwsh/update-shapes shape-ids
(fn [shape]
(ctsr/set-radius-for-corners shape attributes value))
{:reg-objects? true
:ignore-touched true
:page-id page-id
:attrs ctt/border-radius-keys})))))
(defn update-opacity
([value shape-ids attributes] (update-opacity value shape-ids attributes nil))
([value shape-ids _attributes page-id] ; The attributes param is needed to have the same arity that other update functions
(when (<= 0 value 1)
(dwsh/update-shapes shape-ids
#(assoc % :opacity value)
{:ignore-touched true
:page-id page-id}))))
;; FIXME: if attributes are not always present, maybe we have an
;; options here for pass optional value and preserve the correct and
;; uniform api across all functions (?)
(defn update-rotation
([value shape-ids attributes] (update-rotation value shape-ids attributes nil))
([value shape-ids _attributes page-id] ; The attributes param is needed to have the same arity that other update functions
(ptk/reify ::update-shape-rotation
ptk/WatchEvent
(watch [_ _ _]
(when (number? value)
(rx/of
(udw/trigger-bounding-box-cloaking shape-ids)
(udw/increase-rotation shape-ids value nil
{:page-id page-id
:ignore-touched true})))))))
(defn update-stroke-width
([value shape-ids attributes] (update-stroke-width value shape-ids attributes nil))
([value shape-ids _attributes page-id] ; The attributes param is needed to have the same arity that other update functions
(when (number? value)
(dwsh/update-shapes shape-ids
(fn [shape]
(if (seq (:strokes shape))
(assoc-in shape [:strokes 0 :stroke-width] value)
(let [stroke (assoc cts/default-stroke :stroke-width value)]
(assoc shape :strokes [stroke]))))
{:reg-objects? true
:ignore-touched true
:page-id page-id
:attrs [:strokes]}))))
(defn update-color [f value shape-ids page-id]
(when-let [tc (tinycolor/valid-color value)]
(let [hex (tinycolor/->hex-string tc)
opacity (tinycolor/alpha tc)]
(f shape-ids {:color hex :opacity opacity} 0 {:ignore-touched true
:page-id page-id}))))
(defn value->color
"Transform a token color value into penpot color data structure"
[color]
(when-let [tc (tinycolor/valid-color color)]
(let [hex (tinycolor/->hex-string tc)
opacity (tinycolor/alpha tc)]
{:color hex :opacity opacity})))
(defn update-fill
([value shape-ids attributes]
(update-fill value shape-ids attributes nil))
([value shape-ids _attributes page-id] ;; The attributes param is needed to have the same arity that other update functions
(ptk/reify ::update-fill
ptk/WatchEvent
(watch [_ state _]
(when-let [color (value->color value)]
(let [update-fn #(wdc/assoc-shape-fill %1 0 %2)]
(wdc/transform-fill state shape-ids color update-fn {:ignore-touched true
:page-id page-id})))))))
(defn update-stroke-color
([value shape-ids attributes]
(update-stroke-color value shape-ids attributes nil))
;; The attributes param is needed to have the same arity that other update functions
([value shape-ids _attributes page-id]
(when-let [color (value->color value)]
(dwsh/update-shapes shape-ids
#(wdc/update-shape-stroke-color % 0 color)
{:page-id page-id
:ignore-touched true
:changed-sub-attr [:stroke-color]}))))
(defn value->shadow
"Transform a token shadow value into penpot shadow data structure"
[value]
(mapv (fn [{:keys [offset-x offset-y blur spread color inset]}]
{:id (random-uuid)
:hidden false
:offset-x offset-x
:offset-y offset-y
:blur blur
:color (value->color color)
:spread spread
:style
(case inset
true :inner-shadow
:drop-shadow)})
value))
(defn update-shadow
([value shape-ids attributes]
(update-shadow value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when (sequential? value)
(let [shadows (value->shadow value)]
(dwsh/update-shapes shape-ids
#(assoc % :shadow shadows)
{:reg-objects? true
:ignore-touched true
:page-id page-id
:attrs [:shadow]})))))
(defn update-fill-stroke
([value shape-ids attributes]
(update-fill-stroke value shape-ids attributes nil))
([value shape-ids attributes page-id]
(ptk/reify ::update-fill-stroke
ptk/WatchEvent
(watch [_ _ _]
(rx/of
(when (:fill attributes) (update-fill value shape-ids attributes page-id))
(when (:stroke-color attributes) (update-stroke-color value shape-ids attributes page-id)))))))
(defn- attributes->layout-gap [attributes value]
(let [layout-gap (-> (set/intersection attributes #{:column-gap :row-gap})
(zipmap (repeat value)))]
{:layout-gap layout-gap}))
(defn- shape-ids-with-layout [state page-id shape-ids]
(->> (dsh/lookup-shapes state page-id shape-ids)
(eduction
(filter ctsl/any-layout?)
(map :id))))
(defn- shape-ids-with-layout-parent [state page-id shape-ids]
(let [objects (dsh/lookup-page-objects state)]
(->> (dsh/lookup-shapes state page-id shape-ids)
(eduction
(filter #(ctsl/any-layout-immediate-child? objects %))
(map :id)))))
(defn update-layout-item-margin
([value shape-ids attrs] (update-layout-item-margin value shape-ids attrs nil))
([value shape-ids attrs page-id]
(ptk/reify ::update-layout-item-margin
ptk/WatchEvent
(watch [_ state _]
(when (number? value)
(let [ids-with-layout-parent (shape-ids-with-layout-parent state (or page-id (:current-page-id state)) shape-ids)]
(rx/of
(dwsl/update-layout ids-with-layout-parent
{:layout-item-margin (zipmap attrs (repeat value))}
{:ignore-touched true
:page-id page-id}))))))))
(defn update-layout-padding
([value shape-ids attrs] (update-layout-padding value shape-ids attrs nil))
([value shape-ids attrs page-id]
(ptk/reify ::update-layout-padding
ptk/WatchEvent
(watch [_ state _]
(when (number? value)
(let [ids-with-layout (shape-ids-with-layout state (or page-id (:current-page-id state)) shape-ids)]
(rx/of
(dwsl/update-layout ids-with-layout
{:layout-padding (zipmap attrs (repeat value))}
{:ignore-touched true
:page-id page-id}))))))))
(defn update-shape-position
([value shape-ids attributes] (update-shape-position value shape-ids attributes nil))
([value shape-ids attributes page-id]
(ptk/reify ::update-shape-position
ptk/WatchEvent
(watch [_ state _]
(when (number? value)
(let [page-id (or page-id (get state :current-page-id))]
(->> (rx/from shape-ids)
(rx/map #(dwtr/update-position % (zipmap attributes (repeat value))
{:ignore-touched true
:page-id page-id})))))))))
(defn update-layout-gap
[value shape-ids attributes page-id]
(ptk/reify ::update-layout-gap
ptk/WatchEvent
(watch [_ state _]
(when (number? value)
(let [ids-with-layout (shape-ids-with-layout state (or page-id (:current-page-id state)) shape-ids)
layout-attributes (attributes->layout-gap attributes value)]
(rx/of
(dwsl/update-layout ids-with-layout
layout-attributes
{:ignore-touched true
:page-id page-id})))))))
(defn update-layout-sizing-limits
([value shape-ids attributes] (update-layout-sizing-limits value shape-ids attributes nil))
([value shape-ids attributes page-id]
(ptk/reify ::update-layout-sizing-limits
ptk/WatchEvent
(watch [_ _ _]
(when (number? value)
(let [props (-> {:layout-item-min-w value
:layout-item-min-h value
:layout-item-max-w value
:layout-item-max-h value}
(select-keys attributes))]
(rx/of
(dwsl/update-layout-child shape-ids props {:ignore-touched true
:page-id page-id}))))))))
(defn- generate-text-shape-update
[txt-attrs shape-ids page-id]
(let [update-node? (fn [node]
(or (txt/is-text-node? node)
(txt/is-paragraph-node? node)))
update-fn (fn [node _]
(-> node
(d/txt-merge txt-attrs)
(cty/remove-typography-from-node)))
;; Check if any attribute affects text layout (requires resize)
affects-layout? (some #(contains? txt-attrs %) [:font-size :font-family :font-weight :letter-spacing :line-height])]
(ptk/reify ::generate-text-shape-update
ptk/WatchEvent
(watch [_ state _]
(cond-> (rx/of (dwsh/update-shapes shape-ids
#(txt/update-text-content % update-node? update-fn nil)
{:ignore-touched true
:page-id page-id}))
(and affects-layout?
(features/active-feature? state "render-wasm/v1"))
(rx/merge
(rx/of (dwwt/resize-wasm-text-all shape-ids))))))))
(defn update-line-height
([value shape-ids attributes] (update-line-height value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when (number? value)
(generate-text-shape-update {:line-height value} shape-ids page-id))))
(defn update-letter-spacing
([value shape-ids attributes] (update-letter-spacing value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when (number? value)
(generate-text-shape-update {:letter-spacing (str value)} shape-ids page-id))))
(defn warn-font-variant-not-found! []
(st/emit!
(ntf/show {:content (tr "workspace.tokens.font-variant-not-found")
:type :toast
:level :warning
:timeout 7000})))
(defn- update-closest-font-variant-id-by-weight
[txt-attrs target-variant font-id on-mismatch]
(let [font (fonts/get-font-data font-id)
variant (when font
(fonts/find-closest-variant font (:weight target-variant) (:style target-variant)))
call-on-mismatch? (when (and (fn? on-mismatch) variant)
(or
(not= (:font-weight target-variant) (:weight variant))
(when (:font-style target-variant)
(not= (:font-style target-variant) (:style variant)))))]
(when call-on-mismatch?
(on-mismatch))
(cond-> txt-attrs
(:id variant) (assoc :font-variant-id (:id variant)))))
(defn- generate-font-family-text-shape-update
[txt-attrs shape-ids page-id on-mismatch]
(let [not-found-font (= (:font-id txt-attrs) (str uuid/zero))
update-node? (fn [node]
(or (txt/is-text-node? node)
(txt/is-paragraph-node? node)))
update-fn (fn [node find-closest-weight?]
(let [font-id (if not-found-font (:font-id node) (:font-id txt-attrs))
txt-attrs (cond-> txt-attrs
find-closest-weight? (update-closest-font-variant-id-by-weight node font-id on-mismatch))]
(-> node
(d/txt-merge txt-attrs)
(cty/remove-typography-from-node))))]
(ptk/reify ::generate-font-family-text-shape-update
ptk/WatchEvent
(watch [_ state _]
(cond-> (rx/of (dwsh/update-shapes shape-ids
(fn [shape]
(txt/update-text-content shape update-node? #(update-fn %1 (ctst/font-weight-applied? shape)) nil))
{:ignore-touched true
:page-id page-id}))
(features/active-feature? state "render-wasm/v1")
(rx/merge
(rx/of (dwwt/resize-wasm-text-all shape-ids))))))))
(defn- create-font-family-text-attrs
[value]
(let [font-family (-> (first value)
;; Strip quotes around font-family like `"Inter"`
(str/trim #"[\"']"))
font (some-> font-family
(fonts/find-font-family))]
(if font
{:font-id (:id font)
:font-family (:family font)}
{:font-id (str uuid/zero)
:font-family font-family})))
(defn update-font-family
([value shape-ids attributes] (update-font-family value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when-let [text-attrs (create-font-family-text-attrs value)]
(generate-font-family-text-shape-update text-attrs shape-ids page-id nil))))
(defn update-font-family-interactive
([value shape-ids attributes] (update-font-family-interactive value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when-let [text-attrs (create-font-family-text-attrs value)]
(generate-font-family-text-shape-update text-attrs shape-ids page-id warn-font-variant-not-found!))))
(defn update-font-size
([value shape-ids attributes] (update-font-size value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when (number? value)
(generate-text-shape-update {:font-size (str value)} shape-ids page-id))))
(defn update-text-case
([value shape-ids attributes] (update-text-case value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when (string? value)
(generate-text-shape-update {:text-transform value} shape-ids page-id))))
(defn update-text-decoration
([value shape-ids attributes] (update-text-decoration value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when (ctt/valid-text-decoration value)
(let [css-value (case value
"strike-through" "line-through"
value)]
(generate-text-shape-update {:text-decoration css-value} shape-ids page-id)))))
(defn update-text-decoration-interactive
([value shape-ids attributes] (update-text-decoration-interactive value shape-ids attributes nil))
([value shape-ids attributes page-id]
(when (ctt/valid-text-decoration value)
(st/emit! (ptk/data-event :expand-text-more-options))
(update-text-decoration value shape-ids attributes page-id))))
(defn- generate-font-weight-text-shape-update
[font-variant shape-ids page-id on-mismatch]
(let [font-variant (assoc font-variant
:font-weight (:weight font-variant)
:font-style (:style font-variant))
update-node? (fn [node]
(or (txt/is-text-node? node)
(txt/is-paragraph-node? node)))
update-fn (fn [node _]
(let [txt-attrs (update-closest-font-variant-id-by-weight font-variant font-variant (:font-id node) on-mismatch)]
(-> node
(d/txt-merge txt-attrs)
(cty/remove-typography-from-node))))]
(ptk/reify ::generate-font-weight-text-shape-update
ptk/WatchEvent
(watch [_ state _]
(cond-> (rx/of (dwsh/update-shapes shape-ids
#(txt/update-text-content % update-node? update-fn nil)
{:ignore-touched true
:page-id page-id}))
(features/active-feature? state "render-wasm/v1")
(rx/merge
(rx/of (dwwt/resize-wasm-text-all shape-ids))))))))
(defn update-font-weight
([value shape-ids attributes] (update-font-weight value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when-let [font-variant (ctt/valid-font-weight-variant value)]
(generate-font-weight-text-shape-update font-variant shape-ids page-id nil))))
(defn update-font-weight-interactive
([value shape-ids attributes] (update-font-weight-interactive value shape-ids attributes nil))
([value shape-ids _attributes page-id]
(when-let [font-variant (ctt/valid-font-weight-variant value)]
(generate-font-weight-text-shape-update font-variant shape-ids page-id warn-font-variant-not-found!))))
(defn- apply-functions-map
"Apply map of functions `fs` to a map of values `vs` using `args`.
The keys for both must match to be applied with an non-nil value in `vs`.
Returns a vector of the resulting values.
E.g.: `(apply-functions {:a + :b -} {:a 1 :b nil :c 10} [1 1]) => [3]`"
[fs vs args]
(map (fn [[k f]]
(when-let [v (get vs k)]
(apply f v args)))
fs))
(defn update-typography
([value shape-ids attributes] (update-typography value shape-ids attributes nil))
([value shape-ids attributes page-id]
(when (map? value)
(rx/merge
(apply-functions-map
{:font-size update-font-size
:font-family update-font-family
:font-weight update-font-weight
:letter-spacing update-letter-spacing
:text-case update-text-case
:text-decoration update-text-decoration
:line-height update-line-height}
value
[shape-ids attributes page-id])))))
(defn update-shape-dimensions
([value shape-ids attributes] (update-shape-dimensions value shape-ids attributes nil))
([value shape-ids attributes page-id]
(ptk/reify ::update-shape-dimensions
ptk/WatchEvent
(watch [_ _ _]
(when (number? value)
(rx/of
(when (:width attributes) (dwtr/update-dimensions shape-ids :width value {:ignore-touched true :page-id page-id}))
(when (:height attributes) (dwtr/update-dimensions shape-ids :height value {:ignore-touched true :page-id page-id}))))))))
(defn- attributes->actions
[{:keys [value shape-ids attributes page-id]}]
(cond-> []
(some attributes #{:width :height})
(conj #(update-shape-dimensions
value shape-ids
(set (filter attributes #{:width :height}))
page-id))
(some attributes #{:x :y})
(conj #(update-shape-position
value shape-ids
(set (filter attributes #{:x :y}))
page-id))
(some attributes #{:p1 :p2 :p3 :p4})
(conj #(update-layout-padding
value shape-ids
(set (filter attributes #{:p1 :p2 :p3 :p4}))
page-id))
(some attributes #{:m1 :m2 :m3 :m4})
(conj #(update-layout-item-margin
value shape-ids
(set (filter attributes #{:m1 :m2 :m3 :m4}))
page-id))
(some attributes #{:row-gap :column-gap})
(conj #(update-layout-gap
value shape-ids
(set (filter attributes #{:row-gap :column-gap}))
page-id))
(some attributes #{:r1 :r2 :r3 :r4})
(conj #(if (= attributes #{:r1 :r2 :r3 :r4})
(update-shape-radius value shape-ids attributes page-id)
(update-shape-radius-for-corners
value shape-ids
(set (filter attributes #{:r1 :r2 :r3 :r4}))
page-id)))
(some attributes #{:stroke-width})
(conj #(update-stroke-width
value shape-ids
#{:stroke-width}
page-id))
(some attributes #{:max-width :max-height :layout-item-max-h :layout-item-max-w :layout-item-min-h :layout-item-min-w})
(conj #(update-layout-sizing-limits
value shape-ids
(set (filter attributes #{:max-width :max-height :layout-item-max-h :layout-item-max-w :layout-item-min-h :layout-item-min-w}))
page-id))))
(defn apply-dimensions-token
([value shape-ids attributes] (apply-dimensions-token value shape-ids attributes nil))
([value shape-ids attributes page-id]
(ptk/reify ::apply-dimensions-token
ptk/WatchEvent
(watch [_ state _]
(when (number? value)
(let [actions (attributes->actions
{:value value
:shape-ids shape-ids
:attributes attributes
:page-id page-id
:state state})]
(apply rx/of (map #(%) actions))))))))
(defn apply-spacing-token
([value shape-ids attributes] (apply-spacing-token value shape-ids attributes nil))
([value shape-ids attributes page-id]
(ptk/reify ::apply-spacing-token
ptk/WatchEvent
(watch [_ state _]
(let [spacing-attrs
#{:row-gap :column-gap
:m1 :m2 :m3 :m4
:p1 :p2 :p3 :p4}]
(when (and (number? value)
(set? attributes)
(set/subset? attributes spacing-attrs))
(let [actions (attributes->actions
{:value value
:shape-ids shape-ids
:attributes attributes
:page-id page-id
:state state})]
(apply rx/of (map #(%) actions)))))))))
(defn apply-sizing-token
([value shape-ids attributes] (apply-sizing-token value shape-ids attributes nil))
([value shape-ids attributes page-id]
(ptk/reify ::apply-sizing-token
ptk/WatchEvent
(watch [_ state _]
(let [sizing-attrs
#{:width :height
:max-width :max-height}]
(when (and (number? value)
(set? attributes)
(set/subset? attributes sizing-attrs))
(let [actions (attributes->actions
{:value value
:shape-ids shape-ids
:attributes attributes
:page-id page-id
:state state})]
(apply rx/of (map #(%) actions)))))))))
;; Events to apply / unapply tokens to shapes ------------------------------------------------------------
(def attributes->shape-update
"Maps each attribute-set to the update function that applies it to a shape.
Used both here (to resolve the correct update fn when explicit attrs are
passed to toggle-token) and in propagation.cljs (re-exported from there)."
{ctt/border-radius-keys update-shape-radius-for-corners
ctt/color-keys update-fill-stroke
ctt/stroke-width-keys update-stroke-width
ctt/sizing-keys apply-dimensions-token
ctt/opacity-keys update-opacity
ctt/rotation-keys update-rotation
;; Typography
ctt/font-family-keys update-font-family
ctt/font-size-keys update-font-size
ctt/font-weight-keys update-font-weight
ctt/letter-spacing-keys update-letter-spacing
ctt/text-case-keys update-text-case
ctt/text-decoration-keys update-text-decoration
ctt/typography-token-keys update-typography
ctt/shadow-keys update-shadow
ctt/line-height-keys update-line-height
;; Layout
#{:x :y} update-shape-position
#{:p1 :p2 :p3 :p4} update-layout-padding
#{:m1 :m2 :m3 :m4} update-layout-item-margin
#{:column-gap :row-gap} update-layout-gap
#{:width :height} apply-dimensions-token
#{:layout-item-min-w :layout-item-min-h
:layout-item-max-w :layout-item-max-h} update-layout-sizing-limits})
;; Flattened per-individual-key version of attributes->shape-update.
;; Allows O(1) lookup of the update function for any single attribute.
(def ^:private attr->shape-update
(reduce
(fn [acc [attr-set update-fn]]
(into acc (map (fn [k] [k update-fn]) attr-set)))
{}
attributes->shape-update))
(defn apply-token
"Apply `attributes` that match `token` for `shape-ids`.
Optionally remove attributes from `attributes-to-remove`,
this is useful for applying a single attribute from an attributes set
while removing other applied tokens from this set."
[{:keys [attributes attributes-to-remove token shape-ids on-update-shape]}]
(assert (ctob/token? token) "apply-token event requires a valid token")
(ptk/reify ::apply-token
ptk/WatchEvent
(watch [_ state _]
;; We do not allow to apply tokens while text editor is open.
;; The classic text editor sets :workspace-editor-state; the WASM text editor
;; does not, so we also check :workspace-local :edition for text shapes.
(let [edition (get-in state [:workspace-local :edition])
objects (dsh/lookup-page-objects state)
text-editing? (and (some? edition)
(= :text (:type (get objects edition))))]
(if (and (empty? (get state :workspace-editor-state))
(some? token)
(not text-editing?))
(let [attributes-to-remove
;; Remove atomic typography tokens when applying composite and vice-versa
(cond
(ctt/typography-token-keys (:type token)) (set/union attributes-to-remove ctt/typography-keys)
(ctt/typography-keys (:type token)) (set/union attributes-to-remove ctt/typography-token-keys)
:else attributes-to-remove)]
(when-let [tokens (some-> (dsh/lookup-file-data state)
(get :tokens-lib)
(ctob/get-tokens-in-active-sets))]
(->> (if (contains? cf/flags :tokenscript)
(rx/of (ts/resolve-tokens tokens))
(sd/resolve-tokens tokens))
(rx/mapcat
(fn [resolved-tokens]
(let [undo-id (js/Symbol)
objects (dsh/lookup-page-objects state)
selected-shapes (select-keys objects shape-ids)
shapes (->> selected-shapes
(filter (fn [[_ shape]]
(or
(and (ctsl/any-layout-immediate-child? objects shape)
(some ctt/spacing-margin-keys attributes))
(and (ctt/any-appliable-attr-for-shape? attributes (:type shape) (:layout shape))
(all-attrs-appliable-for-token? attributes (:type token)))))))
shape-ids (d/nilv (keys shapes) [])
any-variant? (->> shapes vals (some ctk/is-variant?) boolean)
resolved-value (get-in resolved-tokens [(:name token) :resolved-value])
resolved-value (if (contains? cf/flags :tokenscript)
(ts/tokenscript-symbols->penpot-unit resolved-value)
resolved-value)
tokenized-attributes (cfo/attributes-map attributes token)
type (:type token)]
(rx/concat
(rx/of
(st/emit! (ev/event {::ev/name "apply-tokens"
:type type
:applied-to attributes
:applied-to-variant any-variant?}))
(dwu/start-undo-transaction undo-id)
(dwsh/update-shapes shape-ids (fn [shape]
(cond-> shape
attributes-to-remove
(update :applied-tokens #(apply (partial dissoc %) attributes-to-remove))
:always
(update :applied-tokens merge tokenized-attributes)))))
(when on-update-shape
(let [res (on-update-shape resolved-value shape-ids attributes)]
;; Composed updates return observables and need to be executed differently
(if (rx/observable? res)
res
(rx/of res))))
(rx/of (dwu/commit-undo-transaction undo-id)))))))))
(rx/of (ntf/show {:content (tr "workspace.tokens.error-text-edition")
:type :toast
:level :warning
:timeout 3000})))))))
(defn apply-spacing-token-separated
"Handles edge-case for spacing token when applying token via toggle button.
Splits out `shape-ids` into seperate default actions:
- Layouts take the `default` update function
- Shapes inside layout will only take margin"
[{:keys [token shapes attr]}]
(ptk/reify ::apply-spacing-token-separated
ptk/WatchEvent
(watch [_ state _]
(let [objects (dsh/lookup-page-objects state)
{:keys [attributes on-update-shape]}
(get token-properties (:type token))
{:keys [other frame-children]}
(group-by #(if (ctsl/any-layout-immediate-child? objects %) :frame-children :other) shapes)]
(rx/of
(apply-token {:attributes (or attr attributes)
:token token
:shape-ids (map :id other)
:on-update-shape on-update-shape})
(apply-token {:attributes ctt/spacing-margin-keys
:token token
:shape-ids (map :id frame-children)
:on-update-shape update-layout-item-margin}))))))
(defn unapply-token
"Removes `attributes` that match `token` for `shape-ids`.
Doesn't update shape attributes."
[{:keys [attributes token-name shape-ids] :as _props}]
(ptk/reify ::unapply-token
ptk/WatchEvent
(watch [_ _ _]
(rx/of
(let [remove-token #(when % (cfo/remove-attributes-for-token attributes token-name %))]
(dwsh/update-shapes
shape-ids
(fn [shape]
(update shape :applied-tokens remove-token))))))))
(defn unapply-multiple-tokens
"Removes `attributes` for `shape-ids` without knowing the token, used when a token is deleted."
[{:keys [attributes shape-ids] :as _props}]
(ptk/reify ::unapply-multiple-tokens
ptk/WatchEvent
(watch [_ _ _]
(rx/of
(dwsh/update-shapes
shape-ids
(fn [shape]
(update shape :applied-tokens #(when % (apply dissoc % attributes)))))))))
(defn toggle-token
[{:keys [token attrs shape-ids expand-with-children]}]
(ptk/reify ::on-toggle-token
ptk/WatchEvent
(watch [_ state _]
(let [objects (dsh/lookup-page-objects state)
shapes (into [] (keep (d/getf objects)) shape-ids)
shapes
(if expand-with-children
(into []
(mapcat (fn [shape]
(if (= (:type shape) :group)
(keep objects (:shapes shape))
[shape])))
shapes)
shapes)
{:keys [attributes all-attributes on-update-shape]}
(get token-properties (:type token))
on-update-shape
(if (seq attrs)
(or (get attr->shape-update (first attrs)) on-update-shape)
on-update-shape)
unapply-tokens?
(cfo/shapes-token-applied? token shapes (or attrs all-attributes attributes))
shape-ids
(map :id shapes)]
(if unapply-tokens?
(rx/of
(unapply-token {:attributes (or attrs all-attributes attributes)
:token-name (:name token)
:shape-ids shape-ids}))
(rx/of
(cond
(and (= (:type token) :spacing)
(nil? attrs))
(apply-spacing-token-separated {:token token
:attr attrs
:shapes shapes})
:else
(apply-token {:attributes (if (empty? attrs) attributes attrs)
:token token
:shape-ids shape-ids
:on-update-shape on-update-shape}))))))))
(defn apply-token-from-input
[{:keys [token attrs shape-ids expand-with-children]}]
(ptk/reify ::apply-token-from-input
ptk/WatchEvent
(watch [_ state _]
(let [objects (dsh/lookup-page-objects state)
shapes (into [] (keep (d/getf objects)) shape-ids)
shapes
(if expand-with-children
(into []
(mapcat (fn [shape]
(if (= (:type shape) :group)
(keep objects (:shapes shape))
[shape])))
shapes)
shapes)
{:keys [attributes _ on-update-shape]}
(get token-properties (:type token))
on-update-shape
(if (seq attrs)
(or (get attr->shape-update (first attrs)) on-update-shape)
on-update-shape)]
(rx/of
(cond
(and (= (:type token) :spacing)
(nil? attrs))
(apply-spacing-token-separated {:token token
:attr attrs
:shapes shapes})
:else
(apply-token {:attributes (if (empty? attrs) attributes attrs)
:token token
:shape-ids shape-ids
:on-update-shape on-update-shape})))))))
(defn apply-token-on-color-selected
[color-operations token]
(ptk/reify ::apply-token-on-color-selected
ptk/WatchEvent
(watch [_ _ _]
(let [undo-id (js/Symbol)]
(rx/concat
(rx/of (dwu/start-undo-transaction undo-id))
(->> (rx/from color-operations)
(rx/map
(fn [cop]
(let [shape-ids [(:shape-id cop)]]
(case (:prop cop)
:fill (apply-token {:attributes #{:fill}
:token token
:shape-ids shape-ids
:on-update-shape update-fill})
:stroke (apply-token {:attributes #{:stroke-color}
:token token
:shape-ids shape-ids
:on-update-shape update-stroke-color})
;; Text
:content (apply-token {:attributes #{:fill}
:token token
:shape-ids shape-ids
:on-update-shape update-fill})
:shadow (rx/empty))))))
(rx/of (dwu/commit-undo-transaction undo-id)))))))
;; Map token types to different properties used along the cokde ---------------------------------------------
;; FIXME: the values should be lazy evaluated, probably a function,
;; becasue on future we will need to translate that labels and that
;; can not be done statically
(def token-properties
"A map of default properties by token type"
(d/ordered-map
:border-radius
{:title "Border Radius"
:attributes ctt/border-radius-keys
:on-update-shape update-shape-radius
:modal {:key :tokens/border-radius
:fields [{:label "Border Radius"
:key :border-radius}]}}
:shadow
{:title "Shadow"
:attributes ctt/shadow-keys
:on-update-shape update-shadow
:modal {:key :tokens/shadow
:fields [{:label "Shadow"
:key :shadow}]}}
:color
{:title "Color"
:attributes #{:fill}
:all-attributes ctt/color-keys
:on-update-shape update-fill-stroke
:modal {:key :tokens/color
:fields [{:label "Color" :key :color}]}}
:font-size
{:title "Font Size"
:attributes ctt/font-size-keys
:on-update-shape update-font-size
:modal {:key :tokens/font-size
:fields [{:label "Font Size"
:key :font-size}]}}
:letter-spacing
{:title "Letter Spacing"
:attributes ctt/letter-spacing-keys
:on-update-shape update-letter-spacing
:modal {:key :tokens/letter-spacing
:fields [{:label "Letter Spacing"
:key :letter-spacing}]}}
:font-family
{:title "Font Family"
:attributes ctt/font-family-keys
:on-update-shape update-font-family-interactive
:modal {:key :tokens/font-family
:fields [{:label "Font Family"
:key :font-family}]}}
:text-case
{:title "Text Case"
:attributes ctt/text-case-keys
:on-update-shape update-text-case
:modal {:key :tokens/text-case
:fields [{:label "Text Case"
:key :text-case}]}}
:font-weight
{:title "Font Weight"
:attributes ctt/font-weight-keys
:on-update-shape update-font-weight-interactive
:modal {:key :tokens/font-weight
:fields [{:label "Font Weight"
:key :font-weight}]}}
:typography
{:title "Typography"
:attributes ctt/typography-token-keys
:on-update-shape update-typography
:modal {:key :tokens/typography
:fields [{:label "Typography"
:key :typography}]}}
:text-decoration
{:title "Text Decoration"
:attributes ctt/text-decoration-keys
:on-update-shape update-text-decoration-interactive
:modal {:key :tokens/text-decoration
:fields [{:label "Text Decoration"
:key :text-decoration}]}}
:stroke-width
{:title "Stroke Width"
:attributes ctt/stroke-width-keys
:on-update-shape update-stroke-width
:modal {:key :tokens/stroke-width
:fields [{:label "Stroke Width"
:key :stroke-width}]}}
:sizing
{:title "Sizing"
:attributes #{:width :height}
:all-attributes ctt/sizing-keys
:on-update-shape apply-sizing-token
:modal {:key :tokens/sizing
:fields [{:label "Sizing"
:key :sizing}]}}
:dimensions
{:title "Dimensions"
:attributes #{:width :height}
:all-attributes (set/union
ctt/spacing-keys
ctt/sizing-keys
ctt/border-radius-keys
ctt/axis-keys
ctt/stroke-width-keys)
:on-update-shape apply-dimensions-token
:modal {:key :tokens/dimensions
:fields [{:label "Dimensions"
:key :dimensions}]}}
:opacity
{:title "Opacity"
:attributes ctt/opacity-keys
:on-update-shape update-opacity
:modal {:key :tokens/opacity
:fields [{:label "Opacity"
:key :opacity}]}}
:number
{:title "Number"
:attributes ctt/rotation-keys
:all-attributes ctt/number-keys
:on-update-shape update-rotation
:modal {:key :tokens/number
:fields [{:label "Number"
:key :number}]}}
:rotation
{:title "Rotation"
:attributes ctt/rotation-keys
:on-update-shape update-rotation
:modal {:key :tokens/rotation
:fields [{:label "Rotation"
:key :rotation}]}}
:spacing
{:title "Spacing"
:attributes #{:column-gap :row-gap}
:all-attributes ctt/spacing-keys
:on-update-shape apply-spacing-token
:modal {:key :tokens/spacing
:fields [{:label "Spacing"
:key :spacing}]}}))
(defn get-token-properties [token]
(get token-properties (:type token)))
(defn get-update-shape-fn
"Get the function that updates the attributes of a shape if this token is applied."
[token]
(when token
(-> (get-token-properties token)
:on-update-shape)))
(defn appliable-attributes-for-token
"Get the attributes to which this token type can be applied."
[token-type]
(let [props (get token-properties token-type)]
(or (:all-attributes props)
(:attributes props))))
(defn all-attrs-appliable-for-token?
"Check if any of the given attributes can be applied for the given token type."
[attributes token-type]
(set/subset? attributes (appliable-attributes-for-token token-type)))