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

♻️ Add substantial refactor on how types are organized

Browse source 
This mainly affects types related to colors, fills and texts, moving library
based operations from color namespace.
This commit is contained in:
Andrey Antukh 2025-07-09 13:44:22 +02:00
parent 96d9b102b6
commit 9ee488009f
92 changed files with 1582 additions and 931 deletions
Download patch file Download diff file Expand all files Collapse all files

2
common/src/app/common/attrs.cljc
View file

@ -8,7 +8,7 @@
(:require
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.text :as txt]))
[app.common.types.text :as txt]))
(defn- get-attr
[obj attr]

7
common/src/app/common/files/changes.cljc
View file

@ -21,6 +21,7 @@
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.grid :as ctg]
[app.common.types.library :as ctl]
[app.common.types.page :as ctp]
[app.common.types.pages-list :as ctpl]
[app.common.types.path :as path]
@ -927,15 +928,15 @@
(defmethod process-change :add-color
[data {:keys [color]}]
(ctc/add-color data color))
(ctl/add-color data color))
(defmethod process-change :mod-color
[data {:keys [color]}]
(ctc/set-color data color))
(ctl/set-color data color))
(defmethod process-change :del-color
[data {:keys [id]}]
(ctc/delete-color data id))
(ctl/delete-color data id))
;; DEPRECATED: remove before 2.3
(defmethod process-change :add-recent-color

21
common/src/app/common/files/migrations.cljc
View file

@ -21,7 +21,6 @@
[app.common.math :as mth]
[app.common.schema :as sm]
[app.common.svg :as csvg]
[app.common.text :as txt]
[app.common.types.color :as types.color]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn]
@ -32,7 +31,7 @@
[app.common.types.shape :as cts]
[app.common.types.shape.interactions :as ctsi]
[app.common.types.shape.shadow :as ctss]
[app.common.types.text :as cttx]
[app.common.types.text :as types.text]
[app.common.uuid :as uuid]
[clojure.set :as set]
[cuerdas.core :as str]))
@ -623,7 +622,7 @@
(let [invalid-node? (complement valid-node?)]
(cond-> object
(cfh/text-shape? object)
(update :content #(txt/transform-nodes invalid-node? fix-node %)))))
(update :content #(types.text/transform-nodes invalid-node? fix-node %)))))
(update-container [container]
(d/update-when container :objects d/update-vals update-object))]
@ -730,7 +729,7 @@
(let [shape (update-object shape)]
(if (cfh/text-shape? shape)
(-> shape
(update :content (partial txt/transform-nodes identity update-fill))
(update :content (partial types.text/transform-nodes identity update-fill))
(d/update-when :position-data #(mapv update-object %)))
shape)))
@ -856,7 +855,7 @@
(update-object [object]
(if (cfh/text-shape? object)
(update object :content #(txt/transform-nodes txt/is-content-node? update-text-node %))
(update object :content #(types.text/transform-nodes types.text/is-content-node? update-text-node %))
object))
(update-container [container]
@ -1105,7 +1104,7 @@
;; The text shape also can has fills on the text
;; fragments so we need to fix fills there
(cond-> (cfh/text-shape? object)
(update :content (partial txt/transform-nodes txt/is-content-node? fix-fills)))))
(update :content (partial types.text/transform-nodes types.text/is-content-node? fix-fills)))))
(update-container [container]
(d/update-when container :objects d/update-vals update-object))]
@ -1423,7 +1422,7 @@
(update-object [object]
(if (cfh/text-shape? object)
(update object :content (partial txt/transform-nodes txt/is-content-node? fix-fills))
(update object :content (partial types.text/transform-nodes types.text/is-content-node? fix-fills))
object))
(update-container [container]
@ -1457,7 +1456,7 @@
;; Fixes shapes with nested :fills in the :fills attribute
;; introduced in a migration `0006-fix-old-texts-fills` when
;; txt/transform-nodes with identity pred was broken
;; types.text/transform-nodes with identity pred was broken
(remove-nested-fills [[fill :as fills]]
(if (and (= 1 (count fills))
(contains? fill :fills))
@ -1483,8 +1482,8 @@
(fix-text-content [content]
(->> content
(txt/transform-nodes txt/is-content-node? fix-object)
(txt/transform-nodes txt/is-paragraph-set-node? #(dissoc % :fills))))
(types.text/transform-nodes types.text/is-content-node? fix-object)
(types.text/transform-nodes types.text/is-paragraph-set-node? #(dissoc % :fills))))
(update-shape [object]
(-> object
@ -1539,7 +1538,7 @@
ref-shape (ctf/find-ref-shape file page libs object
{:include-deleted? true :with-context? true})
partial-touched (when ref-shape
(cttx/get-diff-type (:content object) (:content ref-shape)))]
(types.text/get-diff-type (:content object) (:content ref-shape)))]
(if (seq partial-touched)
(update object :touched (fn [touched]
(reduce #(ctk/set-touched-group %1 %2)

2
common/src/app/common/files/shapes_builder.cljc
View file

@ -7,7 +7,6 @@
(ns app.common.files.shapes-builder
"A SVG to Shapes builder."
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
@ -21,6 +20,7 @@
[app.common.math :as mth]
[app.common.schema :as sm :refer [max-safe-int min-safe-int]]
[app.common.svg :as csvg]
[app.common.types.color :as clr]
[app.common.types.path :as path]
[app.common.types.path.segment :as path.segm]
[app.common.types.shape :as cts]

98
common/src/app/common/logic/libraries.cljc
View file

@ -17,19 +17,18 @@
[app.common.logic.shapes :as cls]
[app.common.logic.variant-properties :as clvp]
[app.common.spec :as us]
[app.common.text :as txt]
[app.common.types.color :as ctc]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.library :as ctl]
[app.common.types.page :as ctp]
[app.common.types.pages-list :as ctpl]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.interactions :as ctsi]
[app.common.types.shape.layout :as ctl]
[app.common.types.text :as cttx]
[app.common.types.shape.layout :as ctsl]
[app.common.types.text :as txt]
[app.common.types.token :as cto]
[app.common.types.typography :as cty]
[app.common.types.variant :as ctv]
@ -215,8 +214,8 @@
[(:frame-id new-main-instance-shape)]
(fn [shape objects]
(cond-> shape
(ctl/grid-layout? shape)
(ctl/assign-cells objects)))
(ctsl/grid-layout? shape)
(ctsl/assign-cells objects)))
{:with-objects? true}))]))
@ -277,7 +276,7 @@
(->> ids-map vals (some #(= % (:parent-id first-shape))))
changes
(if (and (ctl/grid-layout? objects (:parent-id first-shape)) (not duplicated-parent?))
(if (and (ctsl/grid-layout? objects (:parent-id first-shape)) (not duplicated-parent?))
(let [target-cell (-> position meta :cell)
[row column]
@ -288,10 +287,10 @@
[(:parent-id first-shape)]
(fn [shape objects]
(-> shape
(ctl/assign-cells objects)
(ctsl/assign-cells objects)
(cond-> (and (some? row) (some? column))
(-> (ctl/push-into-cell [(:id first-shape)] row column)
(ctl/assign-cells objects)))))
(-> (ctsl/push-into-cell [(:id first-shape)] row column)
(ctsl/assign-cells objects)))))
{:with-objects? true})
(pcb/reorder-grid-children [(:parent-id first-shape)])))
changes)
@ -576,8 +575,8 @@
(defmethod uses-assets? :colors
[_ color-id shape library-id]
(if (nil? color-id)
(ctc/uses-library-colors? shape library-id)
(ctc/uses-library-color? shape library-id color-id)))
(cts/uses-library-colors? shape library-id)
(cts/uses-library-color? shape library-id color-id)))
(defmethod uses-assets? :typographies
[_ typography-id shape library-id]
@ -605,7 +604,7 @@
(let [library-colors (get-in libraries [library-id :data :colors])]
(pcb/update-shapes changes
[(:id shape)]
#(ctc/sync-shape-colors % library-id library-colors))))
#(ctl/sync-colors % library-id library-colors))))
(defmethod generate-sync-shape :typographies
[_ changes library-id container shape libraries _]
@ -854,7 +853,7 @@
container
omit-touched?)
(ctl/flex-layout? shape-main)
(ctsl/flex-layout? shape-main)
(update-flex-child-copy-attrs shape-main
shape-inst
library
@ -973,7 +972,7 @@
changes
(cond-> changes
(ctl/grid-layout? shape-inst)
(ctsl/grid-layout? shape-inst)
(update-grid-copy-attrs
(:id shape-inst)
shape-main
@ -1063,14 +1062,14 @@
component-container
{:copy-touched? true}))
(ctl/flex-layout? shape-main)
(ctsl/flex-layout? shape-main)
(update-flex-child-main-attrs shape-main
shape-inst
component-container
container
omit-touched?)
(ctl/grid-layout? shape-main)
(ctsl/grid-layout? shape-main)
(update-grid-main-attrs shape-main
shape-inst
component-container
@ -1670,16 +1669,16 @@
untouched-content ;; The :content of the main component
touched]
(let [main-comps-diff (cttx/get-diff-type touched-content untouched-content)
(let [main-comps-diff (txt/get-diff-type touched-content untouched-content)
diff-structure? (contains? main-comps-diff :text-content-structure)
touched-attrs (cttx/get-first-paragraph-text-attrs touched-content)
touched-attrs (txt/get-first-paragraph-text-attrs touched-content)
;; Have touched content an uniform style?
thed-unif-style? (cttx/equal-attrs? touched-content touched-attrs)
thed-unif-style? (txt/equal-attrs? touched-content touched-attrs)
untouched-attrs (cttx/get-first-paragraph-text-attrs untouched-content)
untouched-attrs (txt/get-first-paragraph-text-attrs untouched-content)
;; Have untouched content an uniform style?
untched-unif-style? (cttx/equal-attrs? untouched-content untouched-attrs)]
untched-unif-style? (txt/equal-attrs? untouched-content untouched-attrs)]
(cond
;; Both text and attrs has been touched, keep the
;; touched-content
@ -1692,14 +1691,14 @@
;; and both have uniform attributes, we keep the touched-content structure and
;; texts, updating its attrs to make them like the untouched-content
(if (and (not (touched :text-content-attribute)) thed-unif-style? untched-unif-style?)
(cttx/copy-attrs-keys touched-content untouched-attrs)
(txt/copy-attrs-keys touched-content untouched-attrs)
;; In other case, we keep the touched content
touched-content)
(touched :text-content-text)
;; Keep the texts touched in touched-content, so copy the
;; texts from touched-content into untouched-content
(cttx/copy-text-keys touched-content untouched-content)
(txt/copy-text-keys touched-content untouched-content)
(touched :text-content-attribute)
;; The untouched content has a different structure, but the touched content had't
@ -1708,20 +1707,19 @@
;; If both have uniform attributes, we keep the untouched-content structure and
;; texts, updating its attrs to make them like the touched-content
(if (and thed-unif-style? untched-unif-style?)
(cttx/copy-attrs-keys untouched-content touched-attrs)
(txt/copy-attrs-keys untouched-content touched-attrs)
;; In other case, we keep the touched content
touched-content)
;; Keep the attrs touched in touched-content, so copy the
;; texts from untouched-content into touched-content
(cttx/copy-text-keys untouched-content touched-content))
(txt/copy-text-keys untouched-content touched-content))
;; Nothing is touched
:else
untouched-content)))
(defn- add-update-attr-operations
[attr dest-shape roperations uoperations attr-val]
(let [roperation {:type :set
@ -1852,20 +1850,20 @@
(let [;; We need the differences between the contents on the main
;; components. current-content is the content of a clean copy,
;; so for all effects its the same as the content on its main
main-comps-diff (cttx/get-diff-type ref-content current-content)
main-comps-diff (txt/get-diff-type ref-content current-content)
can-keep-text? (not (contains? main-comps-diff :text-content-text))
can-keep-attr? (not (contains? main-comps-diff :text-content-attribute))
main-diff-structure? (contains? main-comps-diff :text-content-structure)
current-attrs (cttx/get-first-paragraph-text-attrs current-content)
current-attrs (txt/get-first-paragraph-text-attrs current-content)
;; Have current content an uniform style?
curr-unif-style? (cttx/equal-attrs? current-content current-attrs)
prev-attrs (cttx/get-first-paragraph-text-attrs prev-content)
curr-unif-style? (txt/equal-attrs? current-content current-attrs)
prev-attrs (txt/get-first-paragraph-text-attrs prev-content)
;; Have prev content an uniform style?
prev-unif-style? (cttx/equal-attrs? prev-content prev-attrs)
ref-attrs (cttx/get-first-paragraph-text-attrs ref-content)
prev-unif-style? (txt/equal-attrs? prev-content prev-attrs)
ref-attrs (txt/get-first-paragraph-text-attrs ref-content)
;; Have ref content an uniform style?
ref-unif-style? (cttx/equal-attrs? ref-content ref-attrs)]
ref-unif-style? (txt/equal-attrs? ref-content ref-attrs)]
(cond
;; When the main components have a difference in structure
;; (different number of paragraph or text entries)
@ -1879,7 +1877,7 @@
ref-unif-style?
prev-unif-style?
(= ref-attrs current-attrs))
(cttx/copy-attrs-keys current-content prev-attrs)
(txt/copy-attrs-keys current-content prev-attrs)
;; In any other case of structure change, we discard all
;; the overrides and keep the content of the current-shape
current-content)
@ -1903,8 +1901,8 @@
curr-unif-style?
prev-unif-style?)
(if can-keep-text?
(cttx/copy-attrs-keys prev-content current-attrs)
(cttx/copy-attrs-keys current-content prev-attrs))
(txt/copy-attrs-keys prev-content current-attrs)
(txt/copy-attrs-keys current-content prev-attrs))
;; In any other case of structure change, we discard all
;; the overrides and keep the content of the current-shape
@ -1916,14 +1914,14 @@
;; previous-shape over the attrs of current-shape
(and
(touched :text-content-text) can-keep-text?)
(cttx/copy-text-keys prev-content current-content)
(txt/copy-text-keys prev-content current-content)
;; When there is a change on :text-content-attribute,
;; and we can keep it, we copy the texts from current-shape
;; over the attrs of previous-shape
(and
(touched :text-content-attribute) can-keep-attr?)
(cttx/copy-text-keys current-content prev-content)
(txt/copy-text-keys current-content prev-content)
;; In any other case, we discard all the overrides
;; and keep the content of the current-shape
@ -2159,11 +2157,11 @@
(update cell :shapes #(filterv child? %)))))))
;; Take cells from main and remap the shapes to assign it to the copy
copy-cells (-> shape-copy :layout-grid-cells (remove-orphan-cells shape-copy))
main-cells (-> shape-main (ctl/remap-grid-cells ids-map) :layout-grid-cells)]
main-cells (-> shape-main (ctsl/remap-grid-cells ids-map) :layout-grid-cells)]
(-> shape-copy
(assoc :layout-grid-cells
(ctl/merge-cells main-cells copy-cells omit-touched?))
(ctl/assign-cells objects))))
(ctsl/merge-cells main-cells copy-cells omit-touched?))
(ctsl/assign-cells objects))))
{:ignore-touched true :with-objects? true})))
(defn- update-grid-main-attrs
@ -2187,7 +2185,7 @@
[(:id shape-main)]
(fn [shape-main]
;; Take cells from copy and remap the shapes to assign it to the copy
(let [new-cells (-> (ctl/remap-grid-cells shape-copy ids-map) :layout-grid-cells)]
(let [new-cells (-> (ctsl/remap-grid-cells shape-copy ids-map) :layout-grid-cells)]
(assoc shape-main :layout-grid-cells new-cells)))
{:ignore-touched true}))]
(pcb/concat-changes changes new-changes)))
@ -2300,8 +2298,8 @@
parent-id (:parent-id shape)
insert-before?
(and (ctl/flex-layout? objects parent-id)
(not (ctl/reverse? objects parent-id)))
(and (ctsl/flex-layout? objects parent-id)
(not (ctsl/reverse? objects parent-id)))
objects
(-> objects
@ -2317,7 +2315,7 @@
(pcb/with-objects objects)
(pcb/resize-parents new-objects-ids)
;; Fix the order of the children inside the parent
(cond-> (ctl/any-layout? objects parent-id)
(cond-> (ctsl/any-layout? objects parent-id)
(pcb/reorder-children parent-id (get-in objects [parent-id :shapes]))))]
(assoc changes :file-id library-id)))
@ -2654,8 +2652,8 @@
(gsh/move delta)
(d/update-when :interactions #(ctsi/remap-interactions % ids-map objects))
(cond-> (ctl/grid-layout? obj)
(ctl/remap-grid-cells ids-map))
(cond-> (ctsl/grid-layout? obj)
(ctsl/remap-grid-cells ids-map))
(cond-> (ctk/is-variant-container? parent)
(assoc :variant-id parent-id))
@ -2671,8 +2669,8 @@
;; We want the first added object to touch it's parent, but not subsequent children
changes (-> (pcb/add-object changes new-obj {:ignore-touched (and duplicating-component? child?)})
(pcb/amend-last-change #(assoc % :old-id (:id obj)))
(cond-> (ctl/grid-layout? objects (:parent-id obj))
(-> (pcb/update-shapes [(:parent-id obj)] ctl/assign-cells {:with-objects? true})
(cond-> (ctsl/grid-layout? objects (:parent-id obj))
(-> (pcb/update-shapes [(:parent-id obj)] ctsl/assign-cells {:with-objects? true})
(pcb/reorder-grid-children [(:parent-id obj)]))))
changes (cond-> changes

8
common/src/app/common/test_helpers/compositions.cljc
View file

@ -17,9 +17,9 @@
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.text :as txt]
[app.common.types.container :as ctn]
[app.common.types.shape :as cts]))
[app.common.types.shape :as cts]
[app.common.types.text :as txt]))
;; ----- File building
@ -35,7 +35,7 @@
(defn add-text
[file text-label content & {:keys [text-params] :as text}]
(let [shape (-> (cts/setup-shape {:type :text :x 0 :y 0})
(txt/change-text content))]
(update :content txt/change-text content))]
(ths/add-sample-shape file text-label
(merge shape
text-params))))
@ -74,7 +74,7 @@
(defn add-frame-with-text
[file frame-label child-label text & {:keys [frame-params child-params]}]
(let [shape (-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
(txt/change-text text)
(update :content txt/change-text text)
(assoc :position-data nil
:parent-label frame-label))]
(-> file

10
common/src/app/common/test_helpers/shapes.cljc
View file

@ -6,18 +6,18 @@
(ns app.common.test-helpers.shapes
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.files.helpers :as cfh]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.text :as txt]
[app.common.types.color :as ctc]
[app.common.types.color :as clr]
[app.common.types.container :as ctn]
[app.common.types.library :as ctl]
[app.common.types.pages-list :as ctpl]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.interactions :as ctsi]
[app.common.types.text :as txt]
[app.common.types.typographies-list :as cttl]
[app.common.types.typography :as ctt]))
@ -125,7 +125,7 @@
(defn add-sample-library-color
[file label & {:keys [] :as params}]
(let [color (sample-library-color label params)]
(update file :data ctc/add-color color)))
(update file :data ctl/add-color color)))
(defn sample-typography
[label & {:keys [] :as params}]
@ -149,4 +149,4 @@
(fn [file-data]
(ctpl/update-page file-data
(:id page)
#(ctst/set-shape % (assoc origin :interactions interactions)))))))
#(ctst/set-shape % (assoc origin :interactions interactions)))))))

8
common/src/app/common/test_helpers/variants.cljc
View file

@ -9,8 +9,8 @@
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.text :as txt]
[app.common.types.shape :as cts]))
[app.common.types.shape :as cts]
[app.common.types.text :as txt]))
(defn add-variant
[file variant-label component1-label root1-label component2-label root2-label
@ -60,11 +60,11 @@
[file variant-label component1-label root1-label component2-label root2-label child1-label child2-label text1 text2
& {:keys [text1-params text2-params]}]
(let [text1 (-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
(txt/change-text text1)
(update :content txt/change-text text1)
(assoc :position-data nil
:parent-label root1-label))
text2 (-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
(txt/change-text text2)
(update :content txt/change-text text2)
(assoc :position-data nil
:parent-label root2-label))

260
common/src/app/common/text.cljc
View file

@ -5,186 +5,16 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.text
"Legacy editor helpers (draftjs).
NOTE: this namespace should be not used for new code related to texts"
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.transit :as t]
[clojure.walk :as walk]
[app.common.types.text :as types.text]
[cuerdas.core :as str]))
;; -- Attrs
(def text-typography-attrs
[:typography-ref-id
:typography-ref-file])
(def text-fill-attrs
[:fill-color
:fill-opacity
:fill-color-ref-id
:fill-color-ref-file
:fill-color-gradient])
(def text-font-attrs
[:font-id
:font-family
:font-variant-id
:font-size
:font-weight
:font-style])
(def text-align-attrs
[:text-align])
(def text-direction-attrs
[:text-direction])
(def text-spacing-attrs
[:line-height
:letter-spacing])
(def text-valign-attrs
[:vertical-align])
(def text-decoration-attrs
[:text-decoration])
(def text-transform-attrs
[:text-transform])
(def text-fills
[:fills])
(def shape-attrs
[:grow-type])
(def root-attrs
text-valign-attrs)
(def paragraph-attrs
(d/concat-vec
text-align-attrs
text-direction-attrs))
(def text-node-attrs
(d/concat-vec
text-typography-attrs
text-font-attrs
text-spacing-attrs
text-decoration-attrs
text-transform-attrs
text-fills))
(def text-all-attrs (d/concat-set shape-attrs root-attrs paragraph-attrs text-node-attrs))
(def text-style-attrs
(d/concat-vec root-attrs paragraph-attrs text-node-attrs))
(def default-root-attrs
{:vertical-align "top"})
(def default-text-attrs
{:typography-ref-file nil
:typography-ref-id nil
:font-id "sourcesanspro"
:font-family "sourcesanspro"
:font-variant-id "regular"
:font-size "14"
:font-weight "400"
:font-style "normal"
:line-height "1.2"
:letter-spacing "0"
:text-transform "none"
:text-align "left"
:text-decoration "none"
:text-direction "ltr"
:fills [{:fill-color clr/black
:fill-opacity 1}]})
(def default-attrs
(merge default-root-attrs default-text-attrs))
(def typography-fields
[:font-id
:font-family
:font-variant-id
:font-size
:font-weight
:font-style
:line-height
:letter-spacing
:text-transform])
(def default-typography
(merge
{:name "Source Sans Pro Regular"}
(select-keys default-text-attrs typography-fields)))
(defn node-seq
([root] (node-seq identity root))
([match? root]
(->> (tree-seq map? :children root)
(filter match?)
(seq))))
(defn is-text-node?
[node]
(and (nil? (:type node))
(string? (:text node))))
(defn is-paragraph-set-node?
[node]
(= "paragraph-set" (:type node)))
(defn is-paragraph-node?
[node]
(= "paragraph" (:type node)))
(defn is-root-node?
[node]
(= "root" (:type node)))
(defn is-node?
[node]
(or ^boolean (is-text-node? node)
^boolean (is-paragraph-node? node)
^boolean (is-paragraph-set-node? node)
^boolean (is-root-node? node)))
(defn is-content-node?
"Only matches content nodes, ignoring the paragraph-set nodes."
[node]
(or ^boolean (is-text-node? node)
^boolean (is-paragraph-node? node)
^boolean (is-root-node? node)))
(defn transform-nodes
([transform root]
(transform-nodes identity transform root))
([pred transform root]
(walk/postwalk
(fn [item]
(if (and (is-node? item) (pred item))
(transform item)
item))
root)))
(defn update-text-content
[shape pred-fn update-fn attrs]
(let [update-attrs-fn #(update-fn % attrs)
transform #(transform-nodes pred-fn update-attrs-fn %)]
(-> shape
(update :content transform))))
(defn generate-shape-name
[text]
(subs text 0 (min 280 (count text))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DraftJS <-> Penpot Conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn encode-style-value
[v]
(t/encode-str v))
@ -369,7 +199,7 @@
:entityRanges []
:inlineStyleRanges (calc-ranges paragraph)})]
{:blocks (reduce #(conj %1 (build-block %2)) [] (node-seq #(= (:type %) "paragraph") root))
{:blocks (reduce #(conj %1 (build-block %2)) [] (types.text/node-seq #(= (:type %) "paragraph") root))
:entityMap {}}))
(defn content->text+styles
@ -377,13 +207,13 @@
[node]
(letfn
[(rec-style-text-map [acc node style]
(let [node-style (merge style (select-keys node text-all-attrs))
(let [node-style (merge style (select-keys node types.text/text-all-attrs))
head (or (-> acc first) [{} ""])
[head-style head-text] head
new-acc
(cond
(not (is-text-node? node))
(not (types.text/is-text-node? node))
(reduce #(rec-style-text-map %1 %2 node-style) acc (:children node))
(not= head-style node-style)
@ -403,82 +233,6 @@
(-> (rec-style-text-map [] node {})
reverse)))
(defn content-range->text+styles
"Given a root node of a text content extracts the texts with its associated styles"
[node start end]
(let [sss (content->text+styles node)]
(loop [styles (seq sss)
taking? false
acc 0
result []]
(if styles
(let [[node-style text] (first styles)
from acc
to (+ acc (count text))
taking? (or taking? (and (<= from start) (< start to)))
text (subs text (max 0 (- start acc)) (- end acc))
result (cond-> result
(and taking? (d/not-empty? text))
(conj (assoc node-style :text text)))
continue? (or (> from end) (>= end to))]
(recur (when continue? (rest styles)) taking? to result))
result))))
(defn content->text
"Given a root node of a text content extracts the texts with its associated styles"
[content]
(letfn [(add-node [acc node]
(cond
(is-paragraph-node? node)
(conj acc [])
(is-text-node? node)
(let [i (dec (count acc))]
(update acc i conj (:text node)))
:else
acc))]
(->> (node-seq content)
(reduce add-node [])
(map #(str/join "" %))
(str/join "\n"))))
(defn change-text
"Changes the content of the text shape to use the text as argument. Will use the styles of the
first paragraph and text that is present in the shape (and override the rest)"
[shape text]
(let [content (:content shape)
root-styles (select-keys content root-attrs)
paragraph-style (merge
default-text-attrs
(select-keys (->> content (node-seq is-paragraph-node?) first) text-all-attrs))
text-style (merge
default-text-attrs
(select-keys (->> content (node-seq is-text-node?) first) text-all-attrs))
paragraph-texts (str/split text "\n")
paragraphs
(->> paragraph-texts
(mapv
(fn [pt]
(merge
paragraph-style
{:type "paragraph"
:children [(merge {:text pt} text-style)]}))))
new-content
(d/patch-object
{:type "root"
:children
[{:type "paragraph-set"
:children paragraphs}]}
root-styles)]
(assoc shape :content new-content)))
(defn index-content
"Adds a property `$id` that identifies the current node inside"
([content]

899
common/src/app/common/types/color.cljc
View file

@ -5,15 +5,15 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.types.color
(:refer-clojure :exclude [test])
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.math :as mth]
[app.common.media :as cm]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi]
[app.common.text :as txt]
[app.common.time :as dt]
[app.common.types.plugins :as ctpg]
[clojure.set :as set]
[cuerdas.core :as str]))
@ -163,11 +163,183 @@
(def check-color
(sm/check-fn schema:color :hint "expected valid color"))
;: FIXME: maybe declare it under types.library ?
(def check-library-color
(sm/check-fn schema:library-color :hint "expected valid color"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;; CONSTANTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:const black "#000000")
(def ^:const default-layout "#DE4762")
(def ^:const gray-20 "#B1B2B5")
(def ^:const info "#59B9E2")
(def ^:const test "#fabada")
(def ^:const white "#FFFFFF")
(def ^:const warning "#FC8802")
;; new-css-system colors
(def ^:const new-primary "#7efff5")
(def ^:const new-danger "#ff3277")
(def ^:const new-warning "#fe4811")
(def ^:const new-primary-light "#6911d4")
(def ^:const background-quaternary "#2e3434")
(def ^:const background-quaternary-light "#eef0f2")
(def ^:const canvas "#E8E9EA")
(def names
{"aliceblue" "#f0f8ff"
"antiquewhite" "#faebd7"
"aqua" "#00ffff"
"aquamarine" "#7fffd4"
"azure" "#f0ffff"
"beige" "#f5f5dc"
"bisque" "#ffe4c4"
"black" "#000000"
"blanchedalmond" "#ffebcd"
"blue" "#0000ff"
"blueviolet" "#8a2be2"
"brown" "#a52a2a"
"burlywood" "#deb887"
"cadetblue" "#5f9ea0"
"chartreuse" "#7fff00"
"chocolate" "#d2691e"
"coral" "#ff7f50"
"cornflowerblue" "#6495ed"
"cornsilk" "#fff8dc"
"crimson" "#dc143c"
"cyan" "#00ffff"
"darkblue" "#00008b"
"darkcyan" "#008b8b"
"darkgoldenrod" "#b8860b"
"darkgray" "#a9a9a9"
"darkgreen" "#006400"
"darkgrey" "#a9a9a9"
"darkkhaki" "#bdb76b"
"darkmagenta" "#8b008b"
"darkolivegreen" "#556b2f"
"darkorange" "#ff8c00"
"darkorchid" "#9932cc"
"darkred" "#8b0000"
"darksalmon" "#e9967a"
"darkseagreen" "#8fbc8f"
"darkslateblue" "#483d8b"
"darkslategray" "#2f4f4f"
"darkslategrey" "#2f4f4f"
"darkturquoise" "#00ced1"
"darkviolet" "#9400d3"
"deeppink" "#ff1493"
"deepskyblue" "#00bfff"
"dimgray" "#696969"
"dimgrey" "#696969"
"dodgerblue" "#1e90ff"
"firebrick" "#b22222"
"floralwhite" "#fffaf0"
"forestgreen" "#228b22"
"fuchsia" "#ff00ff"
"gainsboro" "#dcdcdc"
"ghostwhite" "#f8f8ff"
"gold" "#ffd700"
"goldenrod" "#daa520"
"gray" "#808080"
"green" "#008000"
"greenyellow" "#adff2f"
"grey" "#808080"
"honeydew" "#f0fff0"
"hotpink" "#ff69b4"
"indianred" "#cd5c5c"
"indigo" "#4b0082"
"ivory" "#fffff0"
"khaki" "#f0e68c"
"lavender" "#e6e6fa"
"lavenderblush" "#fff0f5"
"lawngreen" "#7cfc00"
"lemonchiffon" "#fffacd"
"lightblue" "#add8e6"
"lightcoral" "#f08080"
"lightcyan" "#e0ffff"
"lightgoldenrodyellow" "#fafad2"
"lightgray" "#d3d3d3"
"lightgreen" "#90ee90"
"lightgrey" "#d3d3d3"
"lightpink" "#ffb6c1"
"lightsalmon" "#ffa07a"
"lightseagreen" "#20b2aa"
"lightskyblue" "#87cefa"
"lightslategray" "#778899"
"lightslategrey" "#778899"
"lightsteelblue" "#b0c4de"
"lightyellow" "#ffffe0"
"lime" "#00ff00"
"limegreen" "#32cd32"
"linen" "#faf0e6"
"magenta" "#ff00ff"
"maroon" "#800000"
"mediumaquamarine" "#66cdaa"
"mediumblue" "#0000cd"
"mediumorchid" "#ba55d3"
"mediumpurple" "#9370db"
"mediumseagreen" "#3cb371"
"mediumslateblue" "#7b68ee"
"mediumspringgreen" "#00fa9a"
"mediumturquoise" "#48d1cc"
"mediumvioletred" "#c71585"
"midnightblue" "#191970"
"mintcream" "#f5fffa"
"mistyrose" "#ffe4e1"
"moccasin" "#ffe4b5"
"navajowhite" "#ffdead"
"navy" "#000080"
"oldlace" "#fdf5e6"
"olive" "#808000"
"olivedrab" "#6b8e23"
"orange" "#ffa500"
"orangered" "#ff4500"
"orchid" "#da70d6"
"palegoldenrod" "#eee8aa"
"palegreen" "#98fb98"
"paleturquoise" "#afeeee"
"palevioletred" "#db7093"
"papayawhip" "#ffefd5"
"peachpuff" "#ffdab9"
"peru" "#cd853f"
"pink" "#ffc0cb"
"plum" "#dda0dd"
"powderblue" "#b0e0e6"
"purple" "#800080"
"red" "#ff0000"
"rosybrown" "#bc8f8f"
"royalblue" "#4169e1"
"saddlebrown" "#8b4513"
"salmon" "#fa8072"
"sandybrown" "#f4a460"
"seagreen" "#2e8b57"
"seashell" "#fff5ee"
"sienna" "#a0522d"
"silver" "#c0c0c0"
"skyblue" "#87ceeb"
"slateblue" "#6a5acd"
"slategray" "#708090"
"slategrey" "#708090"
"snow" "#fffafa"
"springgreen" "#00ff7f"
"steelblue" "#4682b4"
"tan" "#d2b48c"
"teal" "#008080"
"thistle" "#d8bfd8"
"tomato" "#ff6347"
"turquoise" "#40e0d0"
"violet" "#ee82ee"
"wheat" "#f5deb3"
"white" "#ffffff"
"whitesmoke" "#f5f5f5"
"yellow" "#ffff00"
"yellowgreen" "#9acd32"})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS (FIXME: this helpers are not in the correct place)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn library-color->color
@ -181,42 +353,6 @@
:path (get lcolor :path)
:name (get lcolor :name))))
;; --- fill
(defn fill->color
[fill]
(d/without-nils
{:color (:fill-color fill)
:opacity (:fill-opacity fill)
:gradient (:fill-color-gradient fill)
:image (:fill-image fill)
:ref-id (:fill-color-ref-id fill)
:ref-file (:fill-color-ref-file fill)}))
(defn set-fill-color
[shape position color opacity gradient image]
(update-in shape [:fills position]
(fn [fill]
(d/without-nils (assoc fill
:fill-color color
:fill-opacity opacity
:fill-color-gradient gradient
:fill-image image)))))
(defn attach-fill-color
[shape position ref-id ref-file]
(d/update-in-when shape [:fills position]
(fn [fill]
(-> fill
(assoc :fill-color-ref-file ref-file)
(assoc :fill-color-ref-id ref-id)))))
(defn detach-fill-color
[shape position]
(d/update-in-when shape [:fills position] dissoc :fill-color-ref-id :fill-color-ref-file))
;; stroke
(defn stroke->color
[stroke]
(d/without-nils
@ -227,59 +363,10 @@
:ref-id (:stroke-color-ref-id stroke)
:ref-file (:stroke-color-ref-file stroke)}))
(defn set-stroke-color
[shape position color opacity gradient image]
(d/update-in-when shape [:strokes position]
(fn [stroke]
(-> stroke
(assoc :stroke-color color)
(assoc :stroke-opacity opacity)
(assoc :stroke-color-gradient gradient)
(assoc :stroke-image image)
(d/without-nils)))))
(defn attach-stroke-color
[shape position ref-id ref-file]
(d/update-in-when shape [:strokes position]
(fn [stroke]
(-> stroke
(assoc :stroke-color-ref-id ref-id)
(assoc :stroke-color-ref-file ref-file)))))
(defn detach-stroke-color
[shape position]
(d/update-in-when shape [:strokes position] dissoc :stroke-color-ref-id :stroke-color-ref-file))
;; shadow
(defn shadow->color
[shadow]
(:color shadow))
(defn set-shadow-color
[shape position color opacity gradient]
(d/update-in-when shape [:shadow position :color]
(fn [shadow-color]
(-> shadow-color
(assoc :color color)
(assoc :opacity opacity)
(assoc :gradient gradient)
(d/without-nils)))))
(defn attach-shadow-color
[shape position ref-id ref-file]
(d/update-in-when shape [:shadow position :color]
(fn [color]
(-> color
(assoc :ref-id ref-id)
(assoc :ref-file ref-file)))))
(defn detach-shadow-color
[shape position]
(d/update-in-when shape [:shadow position :color] dissoc :ref-id :ref-file))
;; grid
;: FIXME: revisit colors...... WTF
(defn grid->color
[grid]
@ -291,291 +378,375 @@
:ref-id (-> color :id)
:ref-file (-> color :file-id)})))
(defn set-grid-color
[shape position color opacity gradient]
(d/update-in-when shape [:grids position :params :color]
(fn [grid-color]
(-> grid-color
(assoc :color color)
(assoc :opacity opacity)
(assoc :gradient gradient)
(d/without-nils)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn attach-grid-color
[shape position ref-id ref-file]
(d/update-in-when shape [:grids position :params :color]
(fn [color]
(-> color
(assoc :ref-id ref-id)
(assoc :ref-file ref-file)))))
(def ^:private hex-color-re
#"\#([0-9a-fA-F]{6}|[0-9a-fA-F]{3})")
(defn detach-grid-color
[shape position]
(d/update-in-when shape [:grids position :params :color] dissoc :ref-id :ref-file))
(def ^:private rgb-color-re
#"(?:|rgb)\((\d{1,3})\s*,\s*(\d{1,3})\s*,\s*(\d{1,3})\)")
;; --- Helpers for all colors in a shape
(defn get-text-node-colors
"Get all colors used by a node of a text shape"
[node]
(concat (map fill->color (:fills node))
(map stroke->color (:strokes node))))
(defn get-all-colors
"Get all colors used by a shape, in any section."
[shape]
(concat (map fill->color (:fills shape))
(map stroke->color (:strokes shape))
(map shadow->color (:shadow shape))
(when (= (:type shape) :frame)
(map grid->color (:grids shape)))
(when (= (:type shape) :text)
(reduce (fn [colors node]
(concat colors (get-text-node-colors node)))
()
(txt/node-seq (:content shape))))))
(defn uses-library-colors?
"Check if the shape uses any color in the given library."
[shape library-id]
(let [all-colors (get-all-colors shape)]
(some #(and (some? (:ref-id %))
(= (:ref-file %) library-id))
all-colors)))
(defn uses-library-color?
"Check if the shape uses the given library color."
[shape library-id color-id]
(let [all-colors (get-all-colors shape)]
(some #(and (= (:ref-id %) color-id)
(= (:ref-file %) library-id))
all-colors)))
(defn- process-shape-colors
"Execute an update function on all colors of a shape."
[shape process-fn]
(let [process-fill (fn [shape [position fill]]
(process-fn shape
position
(fill->color fill)
set-fill-color
attach-fill-color
detach-fill-color))
process-stroke (fn [shape [position stroke]]
(process-fn shape
position
(stroke->color stroke)
set-stroke-color
attach-stroke-color
detach-stroke-color))
process-shadow (fn [shape [position shadow]]
(process-fn shape
position
(shadow->color shadow)
set-shadow-color
attach-shadow-color
detach-shadow-color))
process-grid (fn [shape [position grid]]
(process-fn shape
position
(grid->color grid)
set-grid-color
attach-grid-color
detach-grid-color))
process-text-node (fn [node]
(as-> node $
(reduce process-fill $ (d/enumerate (:fills $)))
(reduce process-stroke $ (d/enumerate (:strokes $)))))
process-text (fn [shape]
(let [content (:content shape)
new-content (txt/transform-nodes process-text-node content)]
(if (not= content new-content)
(assoc shape :content new-content)
shape)))]
(as-> shape $
(reduce process-fill $ (d/enumerate (:fills $)))
(reduce process-stroke $ (d/enumerate (:strokes $)))
(reduce process-shadow $ (d/enumerate (:shadow $)))
(reduce process-grid $ (d/enumerate (:grids $)))
(process-text $))))
(defn remap-colors
"Change the shape so that any use of the given color now points to
the given library."
[shape library-id color]
(letfn [(remap-color [shape position shape-color _ attach-fn _]
(if (= (:ref-id shape-color) (:id color))
(attach-fn shape
position
(:id color)
library-id)
shape))]
(process-shape-colors shape remap-color)))
(defn sync-shape-colors
"Look for usage of any color of the given library inside the shape,
and, in this case, copy the library color into the shape."
[shape library-id library-colors]
(letfn [(sync-color [shape position shape-color set-fn _ detach-fn]
(if (= (:ref-file shape-color) library-id)
(let [library-color (get library-colors (:ref-id shape-color))]
(if (some? library-color)
(set-fn shape
position
(:color library-color)
(:opacity library-color)
(:gradient library-color)
(:image library-color))
(detach-fn shape position)))
shape))]
(process-shape-colors shape sync-color)))
(defn- stroke->color-att
[stroke file-id libraries]
(let [ref-file (:stroke-color-ref-file stroke)
ref-id (:stroke-color-ref-id stroke)
shared-colors (dm/get-in libraries [ref-file :data :colors])
is-shared? (contains? shared-colors ref-id)
has-color? (or (:stroke-color stroke)
(:stroke-color-gradient stroke))
attrs (cond-> (stroke->color stroke)
(not (or is-shared? (= ref-file file-id)))
(dissoc :ref-id :ref-file))]
(when has-color?
{:attrs attrs
:prop :stroke
:shape-id (:shape-id stroke)
:index (:index stroke)})))
(defn- shadow->color-att
[shadow file-id libraries]
(let [color (get shadow :color)
ref-file (get color :ref-file)
ref-id (get color :ref-id)
shared-colors (dm/get-in libraries [ref-file :data :colors])
is-shared? (contains? shared-colors ref-id)
attrs (cond-> (shadow->color shadow)
(not (or is-shared? (= ref-file file-id)))
(dissoc :ref-file :ref-id))]
{:attrs attrs
:prop :shadow
:shape-id (:shape-id shadow)
:index (:index shadow)}))
(defn- text->color-att
[fill file-id libraries]
(let [ref-file (:fill-color-ref-file fill)
ref-id (:fill-color-ref-id fill)
shared-colors (dm/get-in libraries [ref-file :data :colors])
is-shared? (contains? shared-colors ref-id)
attrs (cond-> (fill->color fill)
(not (or is-shared? (= ref-file file-id)))
(dissoc :ref-file :ref-id))]
{:attrs attrs
:prop :content
:shape-id (:shape-id fill)
:index (:index fill)}))
(defn- treat-node
[node shape-id]
(map-indexed #(assoc %2 :shape-id shape-id :index %1) node))
(defn- extract-text-colors
[text file-id libraries]
(->> (txt/node-seq txt/is-text-node? (:content text))
(map :fills)
(mapcat #(treat-node % (:id text)))
(map #(text->color-att % file-id libraries))))
(defn- fill->color-att
[fill file-id libraries]
(let [ref-file (:fill-color-ref-file fill)
ref-id (:fill-color-ref-id fill)
shared-colors (dm/get-in libraries [ref-file :data :colors])
is-shared? (contains? shared-colors ref-id)
has-color? (or (:fill-color fill)
(:fill-color-gradient fill))
attrs (cond-> (fill->color fill)
(not (or is-shared? (= ref-file file-id)))
(dissoc :ref-file :ref-id))]
(when has-color?
{:attrs attrs
:prop :fill
:shape-id (:shape-id fill)
:index (:index fill)})))
(defn extract-all-colors
[shapes file-id libraries]
(reduce
(fn [result shape]
(let [fill-obj (map-indexed #(assoc %2 :shape-id (:id shape) :index %1) (:fills shape))
stroke-obj (map-indexed #(assoc %2 :shape-id (:id shape) :index %1) (:strokes shape))
shadow-obj (map-indexed #(assoc %2 :shape-id (:id shape) :index %1) (:shadow shape))]
(if (= :text (:type shape))
(-> result
(into (map #(stroke->color-att % file-id libraries)) stroke-obj)
(into (map #(shadow->color-att % file-id libraries)) shadow-obj)
(into (extract-text-colors shape file-id libraries)))
(-> result
(into (map #(fill->color-att % file-id libraries)) fill-obj)
(into (map #(stroke->color-att % file-id libraries)) stroke-obj)
(into (map #(shadow->color-att % file-id libraries)) shadow-obj)))))
[]
shapes))
(defn colors-seq
[file-data]
(vals (:colors file-data)))
(defn- touch
(defn valid-hex-color?
[color]
(assoc color :modified-at (dt/now)))
(and (string? color)
(some? (re-matches hex-color-re color))))
(defn add-color
[file-data color]
(update file-data :colors assoc (:id color) (touch color)))
(defn parse-rgb
[color]
(let [result (re-matches rgb-color-re color)]
(when (some? result)
(let [r (parse-long (nth result 1))
g (parse-long (nth result 2))
b (parse-long (nth result 3))]
(when (and (<= 0 r 255) (<= 0 g 255) (<= 0 b 255))
[r g b])))))
(defn get-color
[file-data color-id]
(get-in file-data [:colors color-id]))
(defn valid-rgb-color?
[color]
(if (string? color)
(let [result (parse-rgb color)]
(some? result))
false))
(defn get-ref-color
[library-data color]
(when (= (:ref-file color) (:id library-data))
(get-color library-data (:ref-id color))))
(defn- normalize-hex
[color]
(if (= (count color) 4) ; of the form #RGB
(-> color
(str/replace #"\#(.)(.)(.)" "#$1$1$2$2$3$3")
(str/lower))
(str/lower color)))
(defn set-color
[file-data color]
(d/assoc-in-when file-data [:colors (:id color)] (touch color)))
(defn rgb->str
[[r g b a]]
(if (some? a)
(str/ffmt "rgba(%,%,%,%)" r g b a)
(str/ffmt "rgb(%,%,%)" r g b)))
(defn update-color
[file-data color-id f & args]
(d/update-in-when file-data [:colors color-id] #(-> (apply f % args)
(touch))))
(defn rgb->hsv
[[red green blue]]
(let [max (d/max red green blue)
min (d/min red green blue)
val max]
(if (= min max)
[0 0 val]
(let [delta (- max min)
sat (/ delta max)
hue (if (= red max)
(/ (- green blue) delta)
(if (= green max)
(+ 2 (/ (- blue red) delta))
(+ 4 (/ (- red green) delta))))
hue (* 60 hue)
hue (if (< hue 0)
(+ hue 360)
hue)
hue (if (> hue 360)
(- hue 360)
hue)]
[hue sat val]))))
(defn delete-color
[file-data color-id]
(update file-data :colors dissoc color-id))
(defn hsv->rgb
[[h s brightness]]
(if (= s 0)
[brightness brightness brightness]
(let [sextant (int (mth/floor (/ h 60)))
remainder (- (/ h 60) sextant)
brightness (d/nilv brightness 0)
val1 (int (* brightness (- 1 s)))
val2 (int (* brightness (- 1 (* s remainder))))
val3 (int (* brightness (- 1 (* s (- 1 remainder)))))]
(case sextant
1 [val2 brightness val1]
2 [val1 brightness val3]
3 [val1 val2 brightness]
4 [val3 val1 brightness]
5 [brightness val1 val2]
6 [brightness val3 val1]
0 [brightness val3 val1]))))
(defn used-colors-changed-since
"Find all usages of any color in the library by the given shape, of colors
that have ben modified after the date."
[shape library since-date]
(->> (get-all-colors shape)
(keep #(get-ref-color (:data library) %))
(remove #(< (:modified-at %) since-date)) ;; Note that :modified-at may be nil
(map (fn [color] {:shape-id (:id shape)
:asset-id (:id color)
:asset-type :color}))))
(defn hex->rgb
[color]
(try
(let [rgb #?(:clj (Integer/parseInt (subs color 1) 16)
:cljs (js/parseInt (subs color 1) 16))
r (bit-shift-right rgb 16)
g (bit-and (bit-shift-right rgb 8) 255)
b (bit-and rgb 255)]
[r g b])
(catch #?(:clj Throwable :cljs :default) _cause
[0 0 0])))
(defn hex->lum
[color]
(let [[r g b] (hex->rgb color)]
(mth/sqrt (+ (* 0.241 r)
(* 0.691 g)
(* 0.068 b)))))
(defn- int->hex
"Convert integer to hex string"
[v]
#?(:clj (Integer/toHexString v)
:cljs (.toString v 16)))
(defn rgb->hex
[[r g b]]
(let [r (int r)
g (int g)
b (int b)]
(if (or (not= r (bit-and r 255))
(not= g (bit-and g 255))
(not= b (bit-and b 255)))
(throw (ex-info "not valid rgb" {:r r :g g :b b}))
(let [rgb (bit-or (bit-shift-left r 16)
(bit-shift-left g 8) b)]
(if (< r 16)
(dm/str "#" (subs (int->hex (bit-or 0x1000000 rgb)) 1))
(dm/str "#" (int->hex rgb)))))))
(defn rgb->hsl
[[r g b]]
(let [norm-r (/ r 255.0)
norm-g (/ g 255.0)
norm-b (/ b 255.0)
max (d/max norm-r norm-g norm-b)
min (d/min norm-r norm-g norm-b)
l (/ (+ max min) 2.0)
h (if (= max min) 0
(if (= max norm-r)
(* 60 (/ (- norm-g norm-b) (- max min)))
(if (= max norm-g)
(+ 120 (* 60 (/ (- norm-b norm-r) (- max min))))
(+ 240 (* 60 (/ (- norm-r norm-g) (- max min)))))))
s (if (and (> l 0) (<= l 0.5))
(/ (- max min) (* 2 l))
(/ (- max min) (- 2 (* 2 l))))]
[(mod (+ h 360) 360) s l]))
(defn hex->hsv
[v]
(-> v hex->rgb rgb->hsv))
(defn hex->rgba
[data opacity]
(-> (hex->rgb data)
(conj opacity)))
(defn hex->hsl [hex]
(try
(-> hex hex->rgb rgb->hsl)
(catch #?(:clj Throwable :cljs :default) _e
[0 0 0])))
(defn hex->hsla
[data opacity]
(-> (hex->hsl data)
(conj opacity)))
(defn format-hsla
[[h s l a]]
(let [precision 2
rounded-h (int h)
rounded-s (d/format-number (* 100 s) precision)
rounded-l (d/format-number (* 100 l) precision)
rounded-a (d/format-number a precision)]
(str/concat "" rounded-h ", " rounded-s "%, " rounded-l "%, " rounded-a)))
(defn format-rgba
[[r g b a]]
(let [precision 2
rounded-a (d/format-number a precision)]
(str/ffmt "%, %, %, %" r g b rounded-a)))
(defn- hue->rgb
"Helper for hsl->rgb"
[v1 v2 vh]
(let [vh (if (< vh 0)
(+ vh 1)
(if (> vh 1)
(- vh 1)
vh))]
(cond
(< (* 6 vh) 1) (+ v1 (* (- v2 v1) 6 vh))
(< (* 2 vh) 1) v2
(< (* 3 vh) 2) (+ v1 (* (- v2 v1) (- (/ 2 3) vh) 6))
:else v1)))
(defn hsl->rgb
[[h s l]]
(if (= s 0)
(let [o (* l 255)]
[o o o])
(let [norm-h (/ h 360.0)
temp2 (if (< l 0.5)
(* l (+ 1 s))
(- (+ l s)
(* s l)))
temp1 (- (* l 2) temp2)]
[(mth/round (* 255 (hue->rgb temp1 temp2 (+ norm-h (/ 1 3)))))
(mth/round (* 255 (hue->rgb temp1 temp2 norm-h)))
(mth/round (* 255 (hue->rgb temp1 temp2 (- norm-h (/ 1 3)))))])))
(defn hsl->hex
[v]
(-> v hsl->rgb rgb->hex))
(defn hsl->hsv
[hsl]
(-> hsl hsl->rgb rgb->hsv))
(defn hsv->hex
[hsv]
(-> hsv hsv->rgb rgb->hex))
(defn hsv->hsl
[hsv]
(-> hsv hsv->hex hex->hsl))
(defn expand-hex
[v]
(cond
(re-matches #"^[0-9A-Fa-f]$" v)
(dm/str v v v v v v)
(re-matches #"^[0-9A-Fa-f]{2}$" v)
(dm/str v v v)
(re-matches #"^[0-9A-Fa-f]{3}$" v)
(let [a (nth v 0)
b (nth v 1)
c (nth v 2)]
(dm/str a a b b c c))
:else
v))
(defn prepend-hash
[color]
(if (= "#" (subs color 0 1))
color
(dm/str "#" color)))
(defn remove-hash
[color]
(if (str/starts-with? color "#")
(subs color 1)
color))
(defn color-string?
[color]
(and (string? color)
(or (valid-hex-color? color)
(valid-rgb-color? color)
(contains? names color))))
(defn parse
[color]
(when (string? color)
(if (or (valid-hex-color? color)
(valid-hex-color? (dm/str "#" color)))
(normalize-hex color)
(or (some-> (parse-rgb color) (rgb->hex))
(get names (str/lower color))))))
(def color-names
(into [] (keys names)))
(def empty-color
(into {} (map #(vector % nil)) [:color :id :file-id :gradient :opacity]))
(defn next-rgb
"Given a color in rgb returns the next color"
[[r g b]]
(cond
(and (= 255 r) (= 255 g) (= 255 b))
(throw (ex-info "cannot get next color" {:r r :g g :b b}))
(and (= 255 g) (= 255 b))
[(inc r) 0 0]
(= 255 b)
[r (inc g) 0]
:else
[r g (inc b)]))
(defn reduce-range
[value range]
(/ (mth/floor (* value range)) range))
(defn sort-colors
[a b]
(let [[ah _ av] (hex->hsv (:color a))
[bh _ bv] (hex->hsv (:color b))
ah (reduce-range (/ ah 60) 8)
bh (reduce-range (/ bh 60) 8)
av (/ av 255)
bv (/ bv 255)
a (+ (* ah 100) (* av 10))
b (+ (* bh 100) (* bv 10))]
(compare a b)))
(defn interpolate-color
[c1 c2 offset]
(cond
(<= offset (:offset c1)) (assoc c1 :offset offset)
(>= offset (:offset c2)) (assoc c2 :offset offset)
:else
(let [tr-offset (/ (- offset (:offset c1)) (- (:offset c2) (:offset c1)))
[r1 g1 b1] (hex->rgb (:color c1))
[r2 g2 b2] (hex->rgb (:color c2))
a1 (:opacity c1)
a2 (:opacity c2)
r (+ r1 (* (- r2 r1) tr-offset))
g (+ g1 (* (- g2 g1) tr-offset))
b (+ b1 (* (- b2 b1) tr-offset))
a (+ a1 (* (- a2 a1) tr-offset))]
{:color (rgb->hex [r g b])
:opacity a
:r r
:g g
:b b
:alpha a
:offset offset})))
(defn- offset-spread
[from to num]
(->> (range 0 num)
(map #(mth/precision (+ from (* (/ (- to from) (dec num)) %)) 2))))
(defn uniform-spread?
"Checks if the gradient stops are spread uniformly"
[stops]
(let [cs (count stops)
from (first stops)
to (last stops)
expect-vals (offset-spread (:offset from) (:offset to) cs)
calculate-expected
(fn [expected-offset stop]
(and (mth/close? (:offset stop) expected-offset)
(let [ec (interpolate-color from to expected-offset)]
(and (= (:color ec) (:color stop))
(= (:opacity ec) (:opacity stop))))))]
(->> (map calculate-expected expect-vals stops)
(every? true?))))
(defn uniform-spread
"Assign an uniform spread to the offset values for the gradient"
[from to num-stops]
(->> (offset-spread (:offset from) (:offset to) num-stops)
(mapv (fn [offset]
(interpolate-color from to offset)))))
(defn interpolate-gradient
[stops offset]
(let [idx (d/index-of-pred stops #(<= offset (:offset %)))
start (if (= idx 0) (first stops) (get stops (dec idx)))
end (if (nil? idx) (last stops) (get stops idx))]
(interpolate-color start end offset)))

25
common/src/app/common/types/file.cljc
View file

@ -16,15 +16,17 @@
[app.common.geom.shapes.tree-seq :as gsts]
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.text :as ct]
[app.common.types.color :as ctc]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.container :as ctn]
[app.common.types.library :as ctlb]
[app.common.types.page :as ctp]
[app.common.types.pages-list :as ctpl]
[app.common.types.plugins :refer [schema:plugin-data]]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.types.text :as txt]
[app.common.types.tokens-lib :refer [schema:tokens-lib]]
[app.common.types.typographies-list :as ctyl]
[app.common.types.typography :as cty]
@ -521,7 +523,7 @@
(defmethod uses-asset? :color
[_ shape library-id color]
(ctc/uses-library-color? shape library-id (:id color)))
(cts/uses-library-color? shape library-id (:id color)))
(defmethod uses-asset? :typography
[_ shape library-id typography]
@ -533,10 +535,10 @@
Returns a list ((asset ((container shapes) (container shapes)...))...)"
[file-data library-data asset-type]
(let [assets-seq (case asset-type
:component (ctkl/components-seq library-data)
:color (ctc/colors-seq library-data)
:typography (ctyl/typographies-seq library-data))
(let [assets (case asset-type
:component (ctkl/components-seq library-data)
:color (vals (ctlb/get-colors library-data))
:typography (ctyl/typographies-seq library-data))
find-usages-in-container
(fn [container asset]
@ -553,7 +555,7 @@
(let [instances (find-asset-usages file-data asset)]
(when (d/not-empty? instances)
[[asset instances]])))
assets-seq)))
assets)))
(defn used-in?
"Checks if a specific asset is used in a given file (by any shape in its pages or in
@ -574,7 +576,7 @@
(letfn [(used-assets-shape [shape]
(concat
(ctkl/used-components-changed-since shape library since-date)
(ctc/used-colors-changed-since shape library since-date)
(ctlb/used-colors-changed-since shape library since-date)
(ctyl/used-typographies-changed-since shape library since-date)))
(used-assets-container [container]
@ -693,11 +695,12 @@
(add-component-grid file-data (sort-by #(:name (first %)) used-components))))
;: FIXME: this can be moved to library
(defn- absorb-colors
[file-data used-colors]
(let [absorb-color
(fn [file-data [color usages]]
(let [remap-shape #(ctc/remap-colors % (:id file-data) color)
(let [remap-shape #(cts/remap-colors % (:id file-data) color)
remap-shapes
(fn [file-data [container shapes]]
@ -710,7 +713,7 @@
%
shapes)))]
(as-> file-data $
(ctc/add-color $ color)
(ctlb/add-color $ color)
(reduce remap-shapes $ usages))))]
(reduce absorb-color
@ -1046,7 +1049,7 @@
(let [detach-text
(fn [content]
(->> content
(ct/transform-nodes
(txt/transform-nodes
#(cond-> %
(not= file-id (:fill-color-ref-file %))
(dissoc :fill-color-ref-id :fill-color-ref-file)

56
common/src/app/common/types/fills.cljc
View file

@ -5,11 +5,15 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.types.fills
(:refer-clojure :exclude [assoc update])
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.flags :as flags]
[app.common.schema :as sm]
[app.common.types.color :as types.color]
[app.common.types.fills.impl :as impl]
[clojure.core :as c]
[clojure.set :as set]))
(def ^:const MAX-GRADIENT-STOPS impl/MAX-GRADIENT-STOPS)
@ -85,12 +89,13 @@
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FIXME: duplicated of `assoc`
(defn assoc-fill
[fills position fill]
(if (nil? fills)
(impl/from-plain [fill])
(-> (coerce fills)
(assoc position fill))))
(c/assoc position fill))))
(defn get-image-ids
[fills]
@ -108,3 +113,52 @@
(defn write-to
[fills buffer offset]
(impl/-write-to fills buffer offset))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TRANSFORMATION & CREATION HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn assoc
[fills position fill]
(if (contains? flags/*current* :frontend-binary-fills)
(if (nil? fills)
(impl/from-plain [fill])
(-> (coerce fills)
(c/assoc position fill)))
(if (nil? fills)
[fill]
(-> (coerce fills)
(c/assoc position fill)))))
(defn update
[fills f & args]
(let [fills (vec fills)
fills (apply f fills args)]
(if (contains? flags/*current* :frontend-binary-fills)
(impl/from-plain fills)
fills)))
(defn create
[& elements]
(let [fills (vec elements)]
(if (contains? flags/*current* :frontend-binary-fills)
(impl/from-plain fills)
fills)))
(defn prepend
"Prepend a fill to existing fills"
[fills fill]
(let [fills (into [fill] fills)]
(if (contains? flags/*current* :frontend-binary-fills)
(impl/from-plain fills)
fills)))
(defn fill->color
[fill]
(d/without-nils
{:color (:fill-color fill)
:opacity (:fill-opacity fill)
:gradient (:fill-color-gradient fill)
:image (:fill-image fill)
:ref-id (:fill-color-ref-id fill)
:ref-file (:fill-color-ref-file fill)}))

5
common/src/app/common/types/grid.cljc
View file

@ -6,9 +6,8 @@
(ns app.common.types.grid
(:require
[app.common.colors :as clr]
[app.common.schema :as sm]
[app.common.types.color :refer [schema:hex-color]]))
[app.common.types.color :as clr]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMA
@ -16,7 +15,7 @@
(def schema:grid-color
[:map {:title "PageGridColor"}
[:color schema:hex-color]
[:color clr/schema:hex-color]
[:opacity ::sm/safe-number]])
(def schema:column-params

87
common/src/app/common/types/library.cljc Normal file
View file

@ -0,0 +1,87 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.common.types.library
"Exposes file library type data helpers.
WARNING: It belongs to FILE types in hierarchy of types so: file
types can import this ns but, but this ns can't import file types."
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.time :as dt]
[app.common.types.shape :as types.shape]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COLOR LIBRARY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn get-colors
[file-data]
(:colors file-data))
(defn get-color
[file-data color-id]
(dm/get-in file-data [:colors color-id]))
(defn get-ref-color
[library-data color]
(when (= (:ref-file color) (:id library-data))
(get-color library-data (:ref-id color))))
(defn- touch
[color]
(assoc color :modified-at (dt/now)))
(defn add-color
[file-data color]
(update file-data :colors assoc (:id color) (touch color)))
(defn set-color
[file-data color]
(d/assoc-in-when file-data [:colors (:id color)] (touch color)))
(defn update-color
[file-data color-id f & args]
(d/update-in-when file-data [:colors color-id] #(-> (apply f % args)
(touch))))
(defn delete-color
[file-data color-id]
(update file-data :colors dissoc color-id))
(defn used-colors-changed-since
"Find all usages of any color in the library by the given shape, of colors
that have ben modified after the date."
[shape library since-date]
(->> (types.shape/get-all-colors shape)
(keep #(get-ref-color (:data library) %))
(remove #(< (:modified-at %) since-date)) ;; Note that :modified-at may be nil
(map (fn [color]
{:shape-id (:id shape)
:asset-id (:id color)
:asset-type :color}))))
;: FIXME: revisit the API of this, i think we should pass the whole
;; library data here instead of only colors
(defn sync-colors
"Look for usage of any color of the given library inside the shape,
and, in this case, copy the library color into the shape."
[shape library-id library-colors]
(letfn [(sync-color [shape position shape-color set-fn _ detach-fn]
(if (= (:ref-file shape-color) library-id)
(let [library-color (get library-colors (:ref-id shape-color))]
(if (some? library-color)
(set-fn shape
position
(:color library-color)
(:opacity library-color)
(:gradient library-color)
(:image library-color))
(detach-fn shape position)))
shape))]
(types.shape/process-shape-colors shape sync-color)))

2
common/src/app/common/types/modifiers.cljc
View file

@ -17,8 +17,8 @@
[app.common.geom.shapes.effects :as gse]
[app.common.geom.shapes.strokes :as gss]
[app.common.math :as mth]
[app.common.text :as txt]
[app.common.types.shape.layout :as ctl]
[app.common.types.text :as txt]
[clojure.core :as c]))
;; --- Modifiers

2
common/src/app/common/types/path/bool.cljc
View file

@ -6,11 +6,11 @@
(ns app.common.types.path.bool
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
[app.common.math :as mth]
[app.common.types.color :as clr]
[app.common.types.path.helpers :as helpers]
[app.common.types.path.segment :as segment]
[app.common.types.path.subpath :as subpath]))

211
common/src/app/common/types/shape.cljc
View file

@ -7,7 +7,6 @@
(ns app.common.types.shape
(:require
#?(:clj [app.common.fressian :as fres])
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.files.helpers :as cfh]
[app.common.geom.matrix :as gmt]
@ -18,10 +17,9 @@
[app.common.record :as cr]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.text :as txt]
[app.common.transit :as t]
[app.common.types.color :as types.color]
[app.common.types.fills :refer [schema:fill]]
[app.common.types.color :as clr]
[app.common.types.fills :refer [schema:fill fill->color]]
[app.common.types.grid :as ctg]
[app.common.types.path :as path]
[app.common.types.path.segment :as path.segment]
@ -33,6 +31,7 @@
[app.common.types.shape.layout :as ctsl]
[app.common.types.shape.shadow :as ctss]
[app.common.types.shape.text :as ctsx]
[app.common.types.text :as txt]
[app.common.types.token :as cto]
[app.common.types.variant :as ctv]
[app.common.uuid :as uuid]
@ -148,9 +147,9 @@
[::sm/one-of stroke-caps]]
[:stroke-cap-end {:optional true}
[::sm/one-of stroke-caps]]
[:stroke-color {:optional true} types.color/schema:hex-color]
[:stroke-color-gradient {:optional true} types.color/schema:gradient]
[:stroke-image {:optional true} types.color/schema:image]])
[:stroke-color {:optional true} clr/schema:hex-color]
[:stroke-color-gradient {:optional true} clr/schema:gradient]
[:stroke-image {:optional true} clr/schema:image]])
(def stroke-attrs
"A set of attrs that corresponds to stroke data type"
@ -755,3 +754,201 @@
(d/patch-object (select-keys props basic-extract-props))
(cond-> (cfh/text-shape? shape) (patch-text-props props))
(cond-> (cfh/frame-shape? shape) (patch-layout-props props)))))
(defn- set-fill-color
[shape position color opacity gradient image]
(update-in shape [:fills position]
(fn [fill]
(d/without-nils (assoc fill
:fill-color color
:fill-opacity opacity
:fill-color-gradient gradient
:fill-image image)))))
(defn- attach-fill-color
[shape position ref-id ref-file]
(d/update-in-when shape [:fills position]
(fn [fill]
(-> fill
(assoc :fill-color-ref-file ref-file)
(assoc :fill-color-ref-id ref-id)))))
(defn- detach-fill-color
[shape position]
(d/update-in-when shape [:fills position] dissoc :fill-color-ref-id :fill-color-ref-file))
(defn- set-stroke-color
[shape position color opacity gradient image]
(d/update-in-when shape [:strokes position]
(fn [stroke]
(-> stroke
(assoc :stroke-color color)
(assoc :stroke-opacity opacity)
(assoc :stroke-color-gradient gradient)
(assoc :stroke-image image)
(d/without-nils)))))
(defn- attach-stroke-color
[shape position ref-id ref-file]
(d/update-in-when shape [:strokes position]
(fn [stroke]
(-> stroke
(assoc :stroke-color-ref-id ref-id)
(assoc :stroke-color-ref-file ref-file)))))
(defn- detach-stroke-color
[shape position]
(d/update-in-when shape [:strokes position] dissoc :stroke-color-ref-id :stroke-color-ref-file))
(defn- set-shadow-color
[shape position color opacity gradient]
(d/update-in-when shape [:shadow position :color]
(fn [shadow-color]
(-> shadow-color
(assoc :color color)
(assoc :opacity opacity)
(assoc :gradient gradient)
(d/without-nils)))))
(defn- attach-shadow-color
[shape position ref-id ref-file]
(d/update-in-when shape [:shadow position :color]
(fn [color]
(-> color
(assoc :ref-id ref-id)
(assoc :ref-file ref-file)))))
(defn- detach-shadow-color
[shape position]
(d/update-in-when shape [:shadow position :color] dissoc :ref-id :ref-file))
(defn- set-grid-color
[shape position color opacity gradient]
(d/update-in-when shape [:grids position :params :color]
(fn [grid-color]
(-> grid-color
(assoc :color color)
(assoc :opacity opacity)
(assoc :gradient gradient)
(d/without-nils)))))
(defn- attach-grid-color
[shape position ref-id ref-file]
(d/update-in-when shape [:grids position :params :color]
(fn [color]
(-> color
(assoc :ref-id ref-id)
(assoc :ref-file ref-file)))))
(defn- detach-grid-color
[shape position]
(d/update-in-when shape [:grids position :params :color] dissoc :ref-id :ref-file))
(defn process-shape-colors
"Execute an update function on all colors of a shape."
[shape process-fn]
(let [process-fill (fn [shape [position fill]]
(process-fn shape
position
(fill->color fill)
set-fill-color
attach-fill-color
detach-fill-color))
process-stroke (fn [shape [position stroke]]
(process-fn shape
position
(clr/stroke->color stroke)
set-stroke-color
attach-stroke-color
detach-stroke-color))
process-shadow (fn [shape [position shadow]]
(process-fn shape
position
(clr/shadow->color shadow)
set-shadow-color
attach-shadow-color
detach-shadow-color))
process-grid (fn [shape [position grid]]
(process-fn shape
position
(clr/grid->color grid)
set-grid-color
attach-grid-color
detach-grid-color))
process-text-node (fn [node]
(as-> node $
(reduce process-fill $ (d/enumerate (:fills $)))
(reduce process-stroke $ (d/enumerate (:strokes $)))))
process-text (fn [shape]
(let [content (:content shape)
new-content (txt/transform-nodes process-text-node content)]
(if (not= content new-content)
(assoc shape :content new-content)
shape)))]
(as-> shape $
(reduce process-fill $ (d/enumerate (:fills $)))
(reduce process-stroke $ (d/enumerate (:strokes $)))
(reduce process-shadow $ (d/enumerate (:shadow $)))
(reduce process-grid $ (d/enumerate (:grids $)))
(process-text $))))
(defn- get-text-node-colors
"Get all colors used by a node of a text shape"
[node]
(concat (map fill->color (:fills node))
(map clr/stroke->color (:strokes node))))
(defn get-all-colors
"Get all colors used by a shape, in any section."
[shape]
;; FIXME: all this functions should be really in color?
(concat (map fill->color (:fills shape))
(map clr/stroke->color (:strokes shape))
(map clr/shadow->color (:shadow shape))
(when (= (:type shape) :frame)
(map clr/grid->color (:grids shape)))
(when (= (:type shape) :text)
(reduce (fn [colors node]
(concat colors (get-text-node-colors node)))
()
(txt/node-seq (:content shape))))))
(defn uses-library-color?
"Check if the shape uses the given library color."
[shape library-id color-id]
(let [all-colors (get-all-colors shape)]
(some #(and (= (:ref-id %) color-id)
(= (:ref-file %) library-id))
all-colors)))
(defn uses-library-colors?
"Check if the shape uses any color in the given library."
[shape library-id]
(let [all-colors (get-all-colors shape)]
(some #(and (some? (:ref-id %))
(= (:ref-file %) library-id))
all-colors)))
(defn remap-colors
"Change the shape so that any use of the given color now points to
the given library."
[shape library-id color]
(letfn [(remap-color [shape position shape-color _ attach-fn _]
(if (= (:ref-id shape-color) (:id color))
(attach-fn shape
position
(:id color)
library-id)
shape))]
(process-shape-colors shape remap-color)))

2
common/src/app/common/types/shape/attrs.cljc
View file

@ -6,7 +6,7 @@
(ns app.common.types.shape.attrs
(:require
[app.common.colors :as clr]))
[app.common.types.color :as clr]))
(def default-color clr/gray-20)

262
common/src/app/common/types/text.cljc
View file

@ -6,8 +6,180 @@
(ns app.common.types.text
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[clojure.set :as set]))
[app.common.types.color :as clr]
[clojure.set :as set]
[clojure.walk :as walk]
[cuerdas.core :as str]))
;; -- Attrs
(def text-typography-attrs
[:typography-ref-id
:typography-ref-file])
(def text-fill-attrs
[:fill-color
:fill-opacity
:fill-color-ref-id
:fill-color-ref-file
:fill-color-gradient])
(def text-font-attrs
[:font-id
:font-family
:font-variant-id
:font-size
:font-weight
:font-style])
(def text-align-attrs
[:text-align])
(def text-direction-attrs
[:text-direction])
(def text-spacing-attrs
[:line-height
:letter-spacing])
(def text-valign-attrs
[:vertical-align])
(def text-decoration-attrs
[:text-decoration])
(def text-transform-attrs
[:text-transform])
(def text-fills
[:fills])
(def shape-attrs
[:grow-type])
(def root-attrs
text-valign-attrs)
(def paragraph-attrs
(d/concat-vec
text-align-attrs
text-direction-attrs))
(def text-node-attrs
(d/concat-vec
text-typography-attrs
text-font-attrs
text-spacing-attrs
text-decoration-attrs
text-transform-attrs
text-fills))
(def text-all-attrs (d/concat-set shape-attrs root-attrs paragraph-attrs text-node-attrs))
(def text-style-attrs
(d/concat-vec root-attrs paragraph-attrs text-node-attrs))
(def default-root-attrs
{:vertical-align "top"})
(def default-text-attrs
{:typography-ref-file nil
:typography-ref-id nil
:font-id "sourcesanspro"
:font-family "sourcesanspro"
:font-variant-id "regular"
:font-size "14"
:font-weight "400"
:font-style "normal"
:line-height "1.2"
:letter-spacing "0"
:text-transform "none"
:text-align "left"
:text-decoration "none"
:text-direction "ltr"
:fills [{:fill-color clr/black
:fill-opacity 1}]})
(def default-attrs
(merge default-root-attrs default-text-attrs))
(def typography-fields
[:font-id
:font-family
:font-variant-id
:font-size
:font-weight
:font-style
:line-height
:letter-spacing
:text-transform])
(def default-typography
(merge
{:name "Source Sans Pro Regular"}
(select-keys default-text-attrs typography-fields)))
(defn node-seq
([root] (node-seq identity root))
([match? root]
(->> (tree-seq map? :children root)
(filter match?)
(seq))))
(defn is-text-node?
[node]
(and (nil? (:type node))
(string? (:text node))))
(defn is-paragraph-set-node?
[node]
(= "paragraph-set" (:type node)))
(defn is-paragraph-node?
[node]
(= "paragraph" (:type node)))
(defn is-root-node?
[node]
(= "root" (:type node)))
(defn is-node?
[node]
(or ^boolean (is-text-node? node)
^boolean (is-paragraph-node? node)
^boolean (is-paragraph-set-node? node)
^boolean (is-root-node? node)))
(defn is-content-node?
"Only matches content nodes, ignoring the paragraph-set nodes."
[node]
(or ^boolean (is-text-node? node)
^boolean (is-paragraph-node? node)
^boolean (is-root-node? node)))
(defn transform-nodes
([transform root]
(transform-nodes identity transform root))
([pred transform root]
(walk/postwalk
(fn [item]
(if (and (is-node? item) (pred item))
(transform item)
item))
root)))
(defn update-text-content
[shape pred-fn update-fn attrs]
(let [update-attrs-fn #(update-fn % attrs)
transform #(transform-nodes pred-fn update-attrs-fn %)]
(-> shape
(update :content transform))))
(defn generate-shape-name
[text]
(subs text 0 (min 280 (count text))))
(defn- compare-text-content
"Given two content text structures, conformed by maps and vectors,
@ -158,3 +330,91 @@
(if (= :children k)
[k (vec (map #(copy-attrs-keys %1 attrs) v))]
[k (get attrs k v)]))))
(defn content->text
"Given a root node of a text content extracts the texts with its associated styles"
[content]
(letfn [(add-node [acc node]
(cond
(is-paragraph-node? node)
(conj acc [])
(is-text-node? node)
(let [i (dec (count acc))]
(update acc i conj (:text node)))
:else
acc))]
(->> (node-seq content)
(reduce add-node [])
(map #(str/join "" %))
(str/join "\n"))))
(defn content->text+styles
"Given a root node of a text content extracts the texts with its associated styles"
[node]
(letfn
[(rec-style-text-map [acc node style]
(let [node-style (merge style (select-keys node text-all-attrs))
head (or (-> acc first) [{} ""])
[head-style head-text] head
new-acc
(cond
(not (is-text-node? node))
(reduce #(rec-style-text-map %1 %2 node-style) acc (:children node))
(not= head-style node-style)
(cons [node-style (:text node "")] acc)
:else
(cons [node-style (dm/str head-text "" (:text node))] (rest acc)))
;; We add an end-of-line when finish a paragraph
new-acc
(if (= (:type node) "paragraph")
(let [[hs ht] (first new-acc)]
(cons [hs (dm/str ht "\n")] (rest new-acc)))
new-acc)]
new-acc))]
(-> (rec-style-text-map [] node {})
reverse)))
(defn change-text
"Changes the content of the text shape to use the text as argument. Will use the styles of the
first paragraph and text that is present in the shape (and override the rest)"
[content text]
(let [root-styles (select-keys content root-attrs)
paragraph-style
(merge
default-text-attrs
(select-keys (->> content (node-seq is-paragraph-node?) first) text-all-attrs))
text-style
(merge
default-text-attrs
(select-keys (->> content (node-seq is-text-node?) first) text-all-attrs))
paragraph-texts
(str/split text "\n")
paragraphs
(->> paragraph-texts
(mapv
(fn [pt]
(merge
paragraph-style
{:type "paragraph"
:children [(merge {:text pt} text-style)]}))))]
(d/patch-object
{:type "root"
:children
[{:type "paragraph-set"
:children paragraphs}]}
root-styles)))

4
common/src/app/common/types/typographies_list.cljc
View file

@ -7,8 +7,8 @@
(ns app.common.types.typographies-list
(:require
[app.common.data :as d]
[app.common.text :as txt]
[app.common.time :as dt]))
[app.common.time :as dt]
[app.common.types.text :as txt]))
(defn typographies-seq
[file-data]

5
common/src/app/common/types/typography.cljc
View file

@ -8,8 +8,8 @@
(:require
[app.common.data :as d]
[app.common.schema :as sm]
[app.common.text :as txt]
[app.common.types.plugins :as ctpg]
[app.common.types.text :as txt]
[app.common.uuid :as uuid]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -59,6 +59,8 @@
:text-transform (or text-transform "none")}
(d/without-nils)))
;; FIXME: this function should not be here it belongs to shape and not typography
(defn uses-library-typographies?
"Check if the shape uses any typography in the given library."
[shape library-id]
@ -70,6 +72,7 @@
#(and (some? (:typography-ref-id %))
(= (:typography-ref-file %) library-id))))))
;; FIXME: this function should not be here it belongs to shape and not typography
(defn uses-library-typography?
"Check if the shape uses the given library typography."
[shape library-id typography-id]

3
common/test/common_tests/colors_test.cljc
View file

@ -7,7 +7,8 @@
(ns common-tests.colors-test
(:require
#?(:cljs [goog.color :as gcolors])
[app.common.colors :as colors]
[app.common.data :as d]
[app.common.types.color :as colors]
[clojure.test :as t]))
(t/deftest valid-hex-color

2
common/test/common_tests/logic/token_apply_test.cljc
View file

@ -14,8 +14,8 @@
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.test-helpers.tokens :as tht]
[app.common.text :as txt]
[app.common.types.container :as ctn]
[app.common.types.text :as txt]
[app.common.types.token :as cto]
[app.common.types.tokens-lib :as ctob]
[clojure.test :as t]))

6
common/test/common_tests/types/absorb_assets_test.cljc
View file

@ -12,12 +12,12 @@
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.text :as txt]
[app.common.types.color :as ctc]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf]
[app.common.types.library :as ctl]
[app.common.types.pages-list :as ctpl]
[app.common.types.text :as txt]
[app.common.types.typographies-list :as ctyl]
[clojure.test :as t]))
@ -80,7 +80,7 @@
_ (thf/validate-file! file')
;; Get
colors' (ctc/colors-seq (ctf/file-data file'))
colors' (vals (ctl/get-colors (ctf/file-data file')))
shape1' (ths/get-shape file' :shape1)
fill' (first (:fills shape1'))]

39
common/test/common_tests/types/text_test.cljc
View file

@ -12,21 +12,32 @@
[app.common.types.text :as cttx]
[clojure.test :as t :include-macros true]))
(def content-base (-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
(txt/change-text "hello world")
(assoc :position-data nil)
:content))
(def content-base
(-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
(get :content)
(cttx/change-text "hello world")))
(def content-changed-text (assoc-in content-base [:children 0 :children 0 :children 0 :text] "changed"))
(def content-changed-attr (assoc-in content-base [:children 0 :children 0 :children 0 :font-size] "32"))
(def content-changed-both (-> content-base
(assoc-in [:children 0 :children 0 :children 0 :text] "changed")
(assoc-in [:children 0 :children 0 :children 0 :font-size] "32")))
(def line (get-in content-base [:children 0 :children 0 :children 0]))
(def content-changed-structure (update-in content-base [:children 0 :children 0 :children]
#(conj % (assoc line :font-weight "700"))))
(def content-changed-structure-same-attrs (update-in content-base [:children 0 :children 0 :children]
#(conj % line)))
(def content-changed-text
(assoc-in content-base [:children 0 :children 0 :children 0 :text] "changed"))
(def content-changed-attr
(assoc-in content-base [:children 0 :children 0 :children 0 :font-size] "32"))
(def content-changed-both
(-> content-base
(assoc-in [:children 0 :children 0 :children 0 :text] "changed")
(assoc-in [:children 0 :children 0 :children 0 :font-size] "32")))
(def line
(get-in content-base [:children 0 :children 0 :children 0]))
(def content-changed-structure
(update-in content-base [:children 0 :children 0 :children]
#(conj % (assoc line :font-weight "700"))))
(def content-changed-structure-same-attrs
(update-in content-base [:children 0 :children 0 :children] #(conj % line)))
(t/deftest test-get-diff-type
(let [diff-text (cttx/get-diff-type content-base content-changed-text)