github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-09-19 02:16:14 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/frontend/src/app/render_wasm/text_editor.cljs

759 lines
32 KiB
Clojure
Raw Blame History

;; 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 Sucursal en España SL
(ns app.render-wasm.text-editor
"Text editor WASM bindings"
(:require
[app.common.types.fills.impl :as types.fills.impl]
[app.common.types.text :as txt]
[app.common.uuid :as uuid]
[app.main.fonts :as main-fonts]
[app.render-wasm.api.fonts :as fonts]
[app.render-wasm.helpers :as h]
[app.render-wasm.mem :as mem]
[app.render-wasm.serializers :as sr]
[app.render-wasm.serializers.color :as sr-clr]
[app.render-wasm.wasm :as wasm]
[app.util.color :as uc]
[app.util.dom :as dom]))
(def multiple-state-multiple (sr/translate-multiple-state :multiple))
(def ^:const TEXT_EDITOR_STYLES_METADATA_SIZE (* 31 4))
(def ^:const TEXT_EDITOR_STYLES_FILL_SOLID 0)
(def ^:const TEXT_EDITOR_STYLES_FILL_LINEAR_GRADIENT 1)
(def ^:const TEXT_EDITOR_STYLES_FILL_RADIAL_GRADIENT 2)
(def ^:const TEXT_EDITOR_STYLES_FILL_IMAGE 3)
(defn- rgba->fill-color
[rgba]
(let [rgb (bit-and rgba 0x00ffffff)
hex (.toString rgb 16)]
(str "#" (.padStart hex 6 "0"))))
(defn- rgba->opacity
[rgba]
(let [alpha (bit-and (bit-shift-right rgba 24) 0xff)]
(/ (js/Math.round (* (/ alpha 255) 100)) 100)))
(defn- u8->opacity
[alpha]
(/ (js/Math.round (* (/ alpha 255) 100)) 100))
(defn- read-fill-from-heap
[heap-u8 heap-u32 heap-i32 heap-f32 fill-byte-offset]
(let [fill-type (aget heap-u8 fill-byte-offset)
fill-u32-offset (mem/->offset-32 fill-byte-offset)]
(case fill-type
TEXT_EDITOR_STYLES_FILL_SOLID
(let [rgba (aget heap-u32 (+ fill-u32-offset 1))]
{:fill-color (rgba->fill-color rgba)
:fill-opacity (rgba->opacity rgba)})
TEXT_EDITOR_STYLES_FILL_LINEAR_GRADIENT
(let [gradient-u32-offset (mem/->offset-32 (+ fill-byte-offset 4))
start-x (aget heap-f32 gradient-u32-offset)
start-y (aget heap-f32 (+ gradient-u32-offset 1))
end-x (aget heap-f32 (+ gradient-u32-offset 2))
end-y (aget heap-f32 (+ gradient-u32-offset 3))
alpha (aget heap-u8 (+ fill-byte-offset 20))
width (aget heap-f32 (+ gradient-u32-offset 5))
stop-count (aget heap-u8 (+ fill-byte-offset 28))
stops (->> (range stop-count)
(map (fn [idx]
(let [stop-offset (+ fill-byte-offset 32 (* idx 8))
stop-u32-offset (mem/->offset-32 stop-offset)
rgba (aget heap-u32 stop-u32-offset)
offset (aget heap-f32 (+ stop-u32-offset 1))]
{:color (rgba->fill-color rgba)
:opacity (rgba->opacity rgba)
:offset (/ (js/Math.round (* offset 100)) 100)})))
(into []))]
{:fill-opacity (u8->opacity alpha)
:fill-color-gradient {:start-x start-x
:start-y start-y
:end-x end-x
:end-y end-y
:width width
:stops stops
:type :linear}})
TEXT_EDITOR_STYLES_FILL_RADIAL_GRADIENT
(let [gradient-u32-offset (mem/->offset-32 (+ fill-byte-offset 4))
start-x (aget heap-f32 gradient-u32-offset)
start-y (aget heap-f32 (+ gradient-u32-offset 1))
end-x (aget heap-f32 (+ gradient-u32-offset 2))
end-y (aget heap-f32 (+ gradient-u32-offset 3))
alpha (aget heap-u8 (+ fill-byte-offset 20))
width (aget heap-f32 (+ gradient-u32-offset 5))
stop-count (aget heap-u8 (+ fill-byte-offset 28))
stops (->> (range stop-count)
(map (fn [idx]
(let [stop-offset (+ fill-byte-offset 32 (* idx 8))
stop-u32-offset (mem/->offset-32 stop-offset)
rgba (aget heap-u32 stop-u32-offset)
offset (aget heap-f32 (+ stop-u32-offset 1))]
{:color (rgba->fill-color rgba)
:opacity (rgba->opacity rgba)
:offset (/ (js/Math.round (* offset 100)) 100)})))
(into []))]
{:fill-opacity (u8->opacity alpha)
:fill-color-gradient {:start-x start-x
:start-y start-y
:end-x end-x
:end-y end-y
:width width
:stops stops
:type :radial}})
TEXT_EDITOR_STYLES_FILL_IMAGE
(let [a (aget heap-u32 (+ fill-u32-offset 1))
b (aget heap-u32 (+ fill-u32-offset 2))
c (aget heap-u32 (+ fill-u32-offset 3))
d (aget heap-u32 (+ fill-u32-offset 4))
alpha (aget heap-u8 (+ fill-byte-offset 20))
flags (aget heap-u8 (+ fill-byte-offset 21))
width (aget heap-i32 (+ fill-u32-offset 6))
height (aget heap-i32 (+ fill-u32-offset 7))]
{:fill-opacity (u8->opacity alpha)
:fill-image {:id (uuid/from-unsigned-parts a b c d)
:width width
:height height
:keep-aspect-ratio (not (zero? (bit-and flags 0x01)))
:name "sample"}})
nil)))
(def ^:private selection-color-css-var "--text-editor-selection-background-color")
(defn- resolve-theme-color
"Resolve a themed CSS color variable (read from the document body) into a
32-bit argb value for the WASM text editor, preserving the variable's alpha
channel."
[css-var]
(when-let [{:keys [color opacity]}
(uc/parse-css-color-opacity
(dom/get-css-variable css-var js/document.body))]
(sr-clr/hex->u32argb color opacity)))
;; ARGB u32 for opaque white, painted with a Difference blend mode so the caret
;; always shows the inverted color of the background.
(def ^:private caret-invert-color 0xffffffff)
(defn text-editor-apply-theme
"Push the current theme's selection color (read from the CSS custom properties
on the document body) into the WASM text editor, together with the default
caret: white with invert, so it shows the inverted color of the background.
The caret only switches to a solid text color (invert off) via
`text-editor-apply-caret-color`. The editor theme is a persistent singleton,
so call once after init and again on every color-scheme change."
[]
(when wasm/context-initialized?
(let [selection (resolve-theme-color selection-color-css-var)]
(when selection
(h/call wasm/internal-module "_text_editor_apply_theme" selection caret-invert-color true)))))
(defn- solid-fill?
[fill]
(some? (:fill-color fill)))
(defn resolve-caret-color
"Compute the caret color from the text `fills` at the caret (as returned by
`text-editor-get-current-styles`), as `{:color <argb-u32> :invert? bool}`:
- when there is at least one solid fill, match the topmost (visible) one,
painted normally (`:invert? false`);
- otherwise (no fill, gradient, image fills, mixed selection, …) use white
with `:invert? true`, which the renderer paints with a Difference blend so
the caret is the inverted color of whatever is behind it."
[fills]
(if-let [solid (and (sequential? fills)
(some #(when (solid-fill? %) %) fills))]
{:color (sr-clr/hex->u32argb (:fill-color solid) (:fill-opacity solid))
:invert? false}
{:color caret-invert-color
:invert? true}))
(defn text-editor-apply-caret-color
"Update the WASM text-editor caret color so it matches the text at the caret
(see `resolve-caret-color`). Re-applies the current theme selection color
unchanged, since the WASM theme is a singleton holding both."
[fills]
(when wasm/context-initialized?
(let [selection (resolve-theme-color selection-color-css-var)
{:keys [color invert?]} (resolve-caret-color fills)]
(when selection
(h/call wasm/internal-module "_text_editor_apply_theme" selection color invert?)))))
(defn text-editor-focus
[id]
(when (wasm/ready?)
(let [buffer (uuid/get-u32 id)]
(when-not (h/call wasm/internal-module "_text_editor_focus"
(aget buffer 0)
(aget buffer 1)
(aget buffer 2)
(aget buffer 3))
(throw (js/Error. "TextEditor focus failed"))))))
(defn text-editor-set-cursor-from-offset
"Sets caret position from shape relative coordinates"
[{:keys [x y]}]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_set_cursor_from_offset" x y)))
(defn text-editor-set-cursor-from-point
"Sets caret position from screen (canvas) coordinates"
[{:keys [x y]}]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_set_cursor_from_point" x y)))
(defn text-editor-toggle-overtype-mode
"Toggles overtype mode"
[]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_toggle_overtype_mode")))
(defn text-editor-pointer-down
[{:keys [x y]}]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_pointer_down" x y)))
(defn text-editor-pointer-move
[{:keys [x y]}]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_pointer_move" x y)))
(defn text-editor-pointer-up
[{:keys [x y]}]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_pointer_up" x y)))
(defn text-editor-update-blink
[timestamp-ms]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_update_blink" timestamp-ms)))
(defn text-editor-render-overlay
[]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_render_overlay")))
(defn text-editor-render-caret
"Re-compose the frame from the Backbuffer (the last full render) and draw the
caret/selection overlay on top, submitting one atomic frame. Pixel identical
to the last full render at any zoom, so the blink does not flash."
[]
(when wasm/context-initialized?
(h/call wasm/internal-module "_text_editor_render_caret")))
(defn text-editor-poll-event
[]
(when (wasm/ready?)
(let [res (h/call wasm/internal-module "_text_editor_poll_event")]
res)))
(defn- text-editor-get-style-property
([state value]
(text-editor-get-style-property state value value))
([state value default-value]
(case state
0 default-value
1 value
2 :multiple
0)))
(defn- text-editor-compute-font-variant-id
[font-id font-weight font-style]
(let [font-data (main-fonts/get-font-data font-id)
variant (main-fonts/find-closest-variant font-data font-weight font-style)]
(or (:id variant)
(:name variant)
"regular")))
(defn text-editor-get-current-styles
[]
(when (wasm/ready?)
(let [ptr (h/call wasm/internal-module "_text_editor_get_current_styles")]
(when (and ptr (not (zero? ptr)))
(let [heap-u8 (mem/get-heap-u8)
heap-u32 (mem/get-heap-u32)
heap-i32 (mem/get-heap-i32)
heap-f32 (mem/get-heap-f32)
u32-offset (mem/->offset-32 ptr)
vertical-align (aget heap-u32 u32-offset)
text-align-state (aget heap-u32 (+ u32-offset 1))
text-direction-state (aget heap-u32 (+ u32-offset 2))
text-decoration-state (aget heap-u32 (+ u32-offset 3))
text-transform-state (aget heap-u32 (+ u32-offset 4))
font-family-id-state (aget heap-u32 (+ u32-offset 5))
font-size-state (aget heap-u32 (+ u32-offset 6))
font-weight-state (aget heap-u32 (+ u32-offset 7))
;; Unused: the variant id is stored as a zero uuid for every span
_font-variant-id-state (aget heap-u32 (+ u32-offset 8))
line-height-state (aget heap-u32 (+ u32-offset 9))
letter-spacing-state (aget heap-u32 (+ u32-offset 10))
font-style-state (aget heap-u32 (+ u32-offset 11))
num-fills (aget heap-u32 (+ u32-offset 12))
multiple-fills (aget heap-u32 (+ u32-offset 13))
text-align-value (aget heap-u32 (+ u32-offset 14))
text-direction-value (aget heap-u32 (+ u32-offset 15))
text-decoration-value (aget heap-u32 (+ u32-offset 16))
text-transform-value (aget heap-u32 (+ u32-offset 17))
font-family-id-a (aget heap-u32 (+ u32-offset 18))
font-family-id-b (aget heap-u32 (+ u32-offset 19))
font-family-id-c (aget heap-u32 (+ u32-offset 20))
font-family-id-d (aget heap-u32 (+ u32-offset 21))
font-family-id-value (uuid/from-unsigned-parts font-family-id-a font-family-id-b font-family-id-c font-family-id-d)
font-style-raw-value (aget heap-u32 (+ u32-offset 22))
font-size-value (aget heap-f32 (+ u32-offset 23))
font-weight-value (aget heap-i32 (+ u32-offset 24))
line-height-value (aget heap-f32 (+ u32-offset 29))
letter-spacing-value (aget heap-f32 (+ u32-offset 30))
font-id (fonts/uuid->font-id font-family-id-value)
font-style-value (sr/untranslate-font-style (text-editor-get-style-property font-style-state font-style-raw-value))
font-variant-id-computed (text-editor-compute-font-variant-id font-id font-weight-value font-style-value)
;; A font variant is defined by its family + weight + style, so it
;; is "mixed" when any of those is mixed. When the family itself is
;; mixed there is no single font to resolve variants against, so we
;; also report the variant as mixed.
font-variant-multiple? (or (= font-family-id-state multiple-state-multiple)
(= font-weight-state multiple-state-multiple)
(= font-style-state multiple-state-multiple))
fills (->> (range num-fills)
(map (fn [idx]
(read-fill-from-heap
heap-u8 heap-u32 heap-i32 heap-f32
(+ ptr
TEXT_EDITOR_STYLES_METADATA_SIZE
(* idx types.fills.impl/FILL-U8-SIZE)))))
(filter some?)
(into []))
;; The order of these two variables is important, do not
;; reorder them.
selected-colors (if (= multiple-fills 1) fills nil)
fills (if (= multiple-fills 1) :multiple fills)
result {:vertical-align (sr/untranslate-vertical-align vertical-align)
:text-align (sr/untranslate-text-align (text-editor-get-style-property text-align-state text-align-value))
:text-direction (sr/untranslate-text-direction (text-editor-get-style-property text-direction-state text-direction-value))
:text-decoration (sr/untranslate-text-decoration (text-editor-get-style-property text-decoration-state text-decoration-value))
:text-transform (sr/untranslate-text-transform (text-editor-get-style-property text-transform-state text-transform-value))
:line-height (text-editor-get-style-property line-height-state line-height-value)
:letter-spacing (text-editor-get-style-property letter-spacing-state letter-spacing-value)
:font-size (text-editor-get-style-property font-size-state font-size-value)
:font-weight (text-editor-get-style-property font-weight-state font-weight-value)
:font-style font-style-value
:font-family (text-editor-get-style-property font-family-id-state font-id)
:font-id (text-editor-get-style-property font-family-id-state font-id)
:font-variant-id (if font-variant-multiple? :multiple font-variant-id-computed)
:typography-ref-file nil
:typography-ref-id nil
:selected-colors selected-colors
:fills fills}]
(mem/free)
result)))))
(defn text-editor-encode-text-pre
[text]
(when (and (not (empty? text))
(wasm/ready?))
(let [encoder (js/TextEncoder.)
buf (.encode encoder text)
heapu8 (mem/get-heap-u8)
size (mem/size buf)
offset (mem/alloc size)]
(mem/write-buffer offset heapu8 buf))))
(defn text-editor-encode-text-post
[text]
(when (and (not (empty? text))
(wasm/ready?))
(mem/free)))
(defn text-editor-composition-start
[]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_composition_start")))
(defn text-editor-composition-update
[text]
(when (wasm/ready?)
(text-editor-encode-text-pre text)
(h/call wasm/internal-module "_text_editor_composition_update")
(text-editor-encode-text-post text)))
(defn text-editor-composition-end
[text]
(when (wasm/ready?)
(text-editor-encode-text-pre text)
(h/call wasm/internal-module "_text_editor_composition_end")
(text-editor-encode-text-post text)))
(defn text-editor-insert-text
[text]
(when (wasm/ready?)
(text-editor-encode-text-pre text)
(h/call wasm/internal-module "_text_editor_insert_text")
(text-editor-encode-text-post text)))
(defn text-editor-delete-backward
([]
(text-editor-delete-backward false))
([word-boundary]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_delete_backward" word-boundary))))
(defn text-editor-delete-forward
([]
(text-editor-delete-forward false))
([word-boundary]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_delete_forward" word-boundary))))
(defn text-editor-insert-paragraph []
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_insert_paragraph")))
(defn text-editor-move-cursor
[direction word-boundary extend-selection]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_move_cursor" direction word-boundary (if extend-selection 1 0))))
(defn text-editor-select-all
[]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_select_all")))
(defn text-editor-select-word-boundary
[{:keys [x y]}]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_select_word_boundary" x y)))
(defn text-editor-blur
[]
(when (wasm/ready?)
(when-not (h/call wasm/internal-module "_text_editor_blur")
(throw (js/Error. "TextEditor blur failed")))))
(defn text-editor-dispose
[]
(when (wasm/ready?)
(h/call wasm/internal-module "_text_editor_dispose")))
(defn text-editor-has-focus?
([id]
(when (wasm/ready?)
(not (zero? (h/call wasm/internal-module "_text_editor_has_focus_with_id" id)))))
([]
(when (wasm/ready?)
(not (zero? (h/call wasm/internal-module "_text_editor_has_focus"))))))
(defn text-editor-has-selection?
([]
(when (wasm/ready?)
(not (zero? (h/call wasm/internal-module "_text_editor_has_selection"))))))
(defn text-editor-export-content
[]
(when (wasm/ready?)
(let [ptr (h/call wasm/internal-module "_text_editor_export_content")]
(when (and ptr (not (zero? ptr)))
(let [json-str (mem/read-string ptr)]
(mem/free)
(js/JSON.parse json-str))))))
(defn text-editor-export-selection
"Export only the currently selected text as plain text from the WASM editor. Requires WASM support (_text_editor_export_selection)."
[]
(when (wasm/ready?)
(let [ptr (h/call wasm/internal-module "_text_editor_export_selection")]
(when (and ptr (not (zero? ptr)))
(let [text (mem/read-string ptr)]
(mem/free)
text)))))
(defn text-editor-get-active-shape-id
[]
(when (wasm/ready?)
(try
(let [byte-offset (mem/alloc 16)
u32-offset (mem/->offset-32 byte-offset)
heap (mem/get-heap-u32)]
(h/call wasm/internal-module "_text_editor_get_active_shape_id" byte-offset)
(let [a (aget heap u32-offset)
b (aget heap (+ u32-offset 1))
c (aget heap (+ u32-offset 2))
d (aget heap (+ u32-offset 3))
result (when (or (not= a 0) (not= b 0) (not= c 0) (not= d 0))
(uuid/from-unsigned-parts a b c d))]
(mem/free)
result))
(catch js/Error e
(js/console.error "[text-editor-get-active-shape-id] Error:" e)
nil))))
(defn text-editor-get-selection
[]
(when (wasm/ready?)
(let [byte-offset (mem/alloc 16)
u32-offset (mem/->offset-32 byte-offset)
heap (mem/get-heap-u32)
has-selection? (h/call wasm/internal-module "_text_editor_get_selection" byte-offset)]
(if has-selection?
(let [result {:anchor-para (aget heap u32-offset)
:anchor-offset (aget heap (+ u32-offset 1))
:focus-para (aget heap (+ u32-offset 2))
:focus-offset (aget heap (+ u32-offset 3))}]
(mem/free)
result)
(do
(mem/free)
nil)))))
;; This is used as a intermediate cache between Clojure global state and WASM state.
(def ^:private shape-text-contents (atom {}))
(defn cache-shape-text-content!
[shape-id content]
(when (some? content)
(swap! shape-text-contents assoc shape-id content)))
(defn get-cached-content
[shape-id]
(get @shape-text-contents shape-id))
(defn update-cached-content!
[shape-id content]
(swap! shape-text-contents assoc shape-id content))
(defn- merge-exported-texts-into-content
"Merge exported span texts back into the existing content tree.
The WASM editor may split or merge paragraphs (Enter / Backspace at
paragraph boundary), so the exported structure can differ from the
original. When extra paragraphs or spans appear we clone styling from
the nearest existing sibling; when fewer appear we truncate.
exported-texts vector of vectors [[\"span1\" \"span2\"] [\"p2s1\"]]
content existing Penpot content map (root -> paragraph-set -> …)"
[content exported-texts]
(let [para-set (first (get content :children))
orig-paras (get para-set :children)
num-orig (count orig-paras)
last-orig-para (when (seq orig-paras) (last orig-paras))
template-span (when last-orig-para
(-> last-orig-para :children last))
new-paras
(mapv (fn [para-idx exported-span-texts]
(let [orig-para (if (< para-idx num-orig)
(nth orig-paras para-idx)
(dissoc last-orig-para :children))
orig-spans (get orig-para :children)
num-orig-spans (count orig-spans)
last-orig-span (when (seq orig-spans) (last orig-spans))]
(assoc orig-para :children
(mapv (fn [span-idx new-text]
(let [orig-span (if (< span-idx num-orig-spans)
(nth orig-spans span-idx)
(or last-orig-span template-span))]
(assoc orig-span :text new-text)))
(range (count exported-span-texts))
exported-span-texts))))
(range (count exported-texts))
exported-texts)
new-para-set (assoc para-set :children new-paras)]
(assoc content :children [new-para-set])))
(defn- default-empty-text-content
"Build a default, empty text content tree used as a merge template.
A text shape created by a single click starts with `:content` nil, so
`set-shape-text-content` never seeds the content cache for it. Without a
template `text-editor-sync-content` would bail and the characters typed into
the WASM editor would never reach the shape. This provides the default
(Source Sans Pro) styling the WASM editor uses for a fresh empty shape."
[]
(let [attrs (txt/get-default-text-attrs)]
{:type "root"
:children [{:type "paragraph-set"
:children [(merge attrs
{:type "paragraph"
:children [(merge attrs {:text ""})]})]}]}))
(defn text-editor-sync-content
"Sync text content from the WASM text editor back to the frontend shape.
Exports the current span texts from WASM, merges them into the shape's
cached content tree (preserving per-span styling), and returns the
shape-id and the fully merged content map ready for
v2-update-text-shape-content."
[]
(when (and (wasm/ready?) (text-editor-has-focus?))
(let [shape-id (text-editor-get-active-shape-id)
new-texts (text-editor-export-content)]
(when (and shape-id new-texts)
(let [texts-clj (js->clj new-texts)
;; A brand-new empty text shape (single click) has no cached
;; content yet, so fall back to a default template so the first
;; keystrokes are synced back to the shape instead of dropped.
content (or (get-cached-content shape-id)
(default-empty-text-content))]
(when content
(let [merged (merge-exported-texts-into-content content texts-clj)]
(swap! shape-text-contents assoc shape-id merged)
{:shape-id shape-id
:content merged})))))))
(defn- normalize-selection
"Given anchor/focus para+offset, return {:start-para :start-offset :end-para :end-offset}
ordered so start <= end."
[{:keys [anchor-para anchor-offset focus-para focus-offset]}]
(if (or (< anchor-para focus-para)
(and (= anchor-para focus-para) (<= anchor-offset focus-offset)))
{:start-para anchor-para :start-offset anchor-offset
:end-para focus-para :end-offset focus-offset}
{:start-para focus-para :start-offset focus-offset
:end-para anchor-para :end-offset anchor-offset}))
(defn apply-attrs-to-paragraph
"Apply `styles` (attrs map, or a fn per span) within [sel-start, sel-end), splitting spans."
[para sel-start sel-end styles]
(let [spans (:children para)
result (loop [spans spans
pos 0
acc []]
(if (empty? spans)
acc
(let [span (first spans)
text (:text span)
span-len (count text)
span-end (+ pos span-len)
ol-start (max pos sel-start)
ol-end (min span-end sel-end)
has-overlap? (< ol-start ol-end)]
(if (not has-overlap?)
(recur (rest spans) span-end (conj acc span))
(let [before (when (> ol-start pos)
(assoc span :text (subs text 0 (- ol-start pos))))
selected (-> (if (fn? styles)
(styles span)
(merge span styles))
(assoc :text (subs text (- ol-start pos) (- ol-end pos))))
after (when (< ol-end span-end)
(assoc span :text (subs text (- ol-end pos))))]
(recur (rest spans) span-end
(-> acc
(into (keep identity [before selected after])))))))))]
(assoc para :children result)))
(defn- para-char-count
[para]
(apply + (map (fn [span] (count (:text span))) (:children para))))
(defn- paragraph-selected-spans
"Return the spans of `para` that overlap the [sel-start, sel-end) char range."
[para sel-start sel-end]
(loop [spans (:children para)
pos 0
acc []]
(if (empty? spans)
acc
(let [span (first spans)
span-end (+ pos (count (:text span)))
overlap? (< (max pos sel-start) (min span-end sel-end))]
(recur (rest spans) span-end (cond-> acc overlap? (conj span)))))))
(defn selection-fills
"The selection's fills: shared vector if all spans match, `:multiple` if not, nil if empty."
[content {:keys [start-para start-offset end-para end-offset]}]
(let [paragraphs (:children (first (:children content)))
selected (mapcat (fn [idx para]
(cond
(or (< idx start-para) (> idx end-para)) nil
(= start-para end-para) (paragraph-selected-spans para start-offset end-offset)
(= idx start-para) (paragraph-selected-spans para start-offset (para-char-count para))
(= idx end-para) (paragraph-selected-spans para 0 end-offset)
:else (paragraph-selected-spans para 0 (para-char-count para))))
(range (count paragraphs))
paragraphs)
fills-set (into #{} (map :fills) selected)]
(cond
(empty? selected) nil
(= 1 (count fills-set)) (first fills-set)
:else :multiple)))
(defn apply-styles-to-selection
"Apply `styles` (attrs map, or a fn per span) to the selected spans; `:with-fills?` also returns `:fills`."
[styles use-shape-fn set-shape-text-content-fn & [{:keys [with-fills?]}]]
(when (wasm/ready?)
(let [;; Drop nil-valued attrs so they are never merged onto text spans.
;; The DOM editor path strips these in `attrs->styles`; the WASM merge
;; here (`apply-attrs-to-paragraph`) does not, so an unresolved attr
;; (e.g. nil :font-family/:font-weight/:font-style from an unloaded
;; font) would corrupt the span and fail the backend schema.
styles (if (fn? styles)
styles
(into {} (remove (comp nil? val)) styles))
shape-id (text-editor-get-active-shape-id)
selection (text-editor-get-selection)]
(when (and shape-id selection)
(let [content (get-cached-content shape-id)]
(when content
(let [normalized-selection (normalize-selection selection)
{:keys [start-para start-offset end-para end-offset]} normalized-selection
collapsed? (and (= start-para end-para) (= start-offset end-offset))
paragraph-set (first (:children content))
paragraphs (:children paragraph-set)
new-paragraphs
(when (not collapsed?)
(mapv (fn [idx para]
(cond
;; paragraph outside the range of paragraphs.
(or (< idx start-para) (> idx end-para))
para
;; same paragraph.
(= start-para end-para)
(apply-attrs-to-paragraph para start-offset end-offset styles)
;; first paragraph
(= idx start-para)
(apply-attrs-to-paragraph para start-offset (para-char-count para) styles)
;; final paragraph
(= idx end-para)
(apply-attrs-to-paragraph para 0 end-offset styles)
;; any other paragraph
:else
(apply-attrs-to-paragraph para 0 (para-char-count para) styles)))
(range (count paragraphs))
paragraphs))
new-content (when new-paragraphs
(assoc content :children
[(assoc paragraph-set :children new-paragraphs)]))]
(when new-content
(update-cached-content! shape-id new-content)
(use-shape-fn shape-id)
(set-shape-text-content-fn shape-id new-content)
(cond-> {:shape-id shape-id
:content new-content}
with-fills?
(assoc :fills (selection-fills new-content normalized-selection)))))))))))
Reference in New Issue View Git Blame Copy Permalink