♻️ Make svg to shapes conversion code multiplatform

- Move clojure code to common
- Rewrite some native-js code into optimized clojure
This commit is contained in:
Andrey Antukh 2023-10-11 13:39:56 +02:00 committed by Andrés Moya
parent 44845d5d94
commit 3ceb4cf895
62 changed files with 2037 additions and 1011 deletions

View file

@ -5,125 +5,20 @@
;; Copyright (c) KALEIDOS INC
(ns app.util.color
"Color conversion utils."
"FIXME: this is legacy namespace, all functions of this ns should be
relocated under app.common.types on the respective colors related
namespace. All generic color conversion and other helpers are moved to
app.common.colors namespace."
(:require
[app.common.colors :as cc]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.util.i18n :as i18n :refer [tr]]
[app.util.object :as obj]
[app.util.strings :as ust]
[cuerdas.core :as str]
[goog.color :as gcolor]))
(defn rgb->str
[color]
{:pre [(vector? color)]}
(if (= (count color) 3)
(apply str/format "rgb(%s,%s,%s)" color)
(apply str/format "rgba(%s,%s,%s,%s)" color)))
(defn rgb->hsv
[[r g b]]
(into [] (gcolor/rgbToHsv r g b)))
(defn hsv->rgb
[[h s v]]
(into [] (gcolor/hsvToRgb h s v)))
(defn hex->rgb
[v]
(try
(into [] (gcolor/hexToRgb v))
(catch :default _e [0 0 0])))
(defn rgb->hex
[[r g b]]
(gcolor/rgbToHex r g b))
(defn hex->hsv
[v]
(into [] (gcolor/hexToHsv v)))
(defn hex->rgba
[^string data ^number opacity]
(-> (hex->rgb data)
(conj opacity)))
(defn hex->hsl [hex]
(try
(into [] (gcolor/hexToHsl hex))
(catch :default _e [0 0 0])))
(defn hex->hsla
[^string data ^number opacity]
(-> (hex->hsl data)
(conj opacity)))
(defn format-hsla
[[h s l a]]
(let [precision 2
rounded-s (* 100 (ust/format-precision s precision))
rounded-l (* 100 (ust/format-precision l precision))]
(str/fmt "%s, %s%, %s%, %s" h rounded-s rounded-l a)))
(defn hsl->rgb
[[h s l]]
(gcolor/hslToRgb h s l))
(defn hsl->hex
[[h s l]]
(gcolor/hslToHex h s l))
(defn hex?
[v]
(and (string? v)
(re-seq #"^#[0-9A-Fa-f]{6}$" v)))
(defn hsl->hsv
[[h s l]]
(gcolor/hslToHsv h s l))
(defn hsv->hex
[[h s v]]
(gcolor/hsvToHex h s v))
(defn hsv->hsl
[hsv]
(hex->hsl (hsv->hex hsv)))
(defn expand-hex
[v]
(cond
(re-matches #"^[0-9A-Fa-f]$" v)
(str v v v v v v)
(re-matches #"^[0-9A-Fa-f]{2}$" v)
(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)]
(str a a b b c c))
:else
v))
(defn prepend-hash
[color]
(gcolor/prependHashIfNecessaryHelper color))
(defn remove-hash
[color]
(if (str/starts-with? color "#")
(subs color 1)
color))
[cuerdas.core :as str]))
(defn gradient->css [{:keys [type stops]}]
(let [parse-stop
(fn [{:keys [offset color opacity]}]
(let [[r g b] (hex->rgb color)]
(let [[r g b] (cc/hex->rgb color)]
(str/fmt "rgba(%s, %s, %s, %s) %s" r g b opacity (str (* offset 100) "%"))))
stops-css (str/join "," (map parse-stop stops))]
@ -147,7 +42,7 @@
(gradient->css gradient)
(not= color :multiple)
(let [[r g b] (hex->rgb (or color value))]
(let [[r g b] (cc/hex->rgb (or color value))]
(str/fmt "rgba(%s, %s, %s, %s)" r g b opacity))
:else "transparent")))
@ -160,56 +55,27 @@
(not= color :multiple)
(case format
:rgba (let [[r g b] (hex->rgb color)]
:rgba (let [[r g b] (cc/hex->rgb color)]
(str/fmt "rgba(%s, %s, %s, %s)" r g b opacity))
:hsla (let [[h s l] (hex->hsl color)]
:hsla (let [[h s l] (cc/hex->hsl color)]
(str/fmt "hsla(%s, %s, %s, %s)" h (* 100 s) (* 100 l) opacity))
:hex (str color (str/upper (d/opacity-to-hex opacity))))
:else "transparent")))
(defn multiple? [{:keys [id file-id value color gradient]}]
(defn multiple?
[{:keys [id file-id value color gradient]}]
(or (= value :multiple)
(= color :multiple)
(= gradient :multiple)
(= id :multiple)
(= file-id :multiple)))
(defn color?
[color]
(and (string? color)
(gcolor/isValidColor color)))
(defn parse-color
[color]
(when (color? color)
(let [result (gcolor/parse color)]
(dm/str (.-hex ^js result)))))
(def color-names
(obj/get-keys ^js gcolor/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 get-color-name
[color]
(or (:color-library-name color)

View file

@ -6,15 +6,15 @@
(ns app.util.import.parser
(:require
[app.common.colors :as cc]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.svg.path :as svg.path]
[app.common.types.shape.interactions :as ctsi]
[app.common.uuid :as uuid]
[app.util.color :as uc]
[app.util.json :as json]
[app.util.path.parser :as upp]
[cuerdas.core :as str]))
(def url-regex
@ -278,7 +278,7 @@
(defn parse-path
[props center svg-data]
(let [content (upp/parse-path (:d svg-data))]
(let [content (svg.path/parse (:d svg-data))]
(-> props
(assoc :content content)
(assoc :center center))))
@ -454,7 +454,7 @@
:fill-color nil
:fill-opacity nil)
(uc/hex? fill)
(cc/valid-hex-color? fill)
(assoc :fill-color fill
:fill-opacity (-> svg-data (:fill-opacity "1") d/parse-double))

View file

@ -6,8 +6,8 @@
(ns app.util.path.format
(:require
[app.common.path.commands :as upc]
[app.common.path.subpaths :refer [pt=]]
[app.common.svg.path.command :as upc]
[app.common.svg.path.subpath :refer [pt=]]
[app.util.array :as arr]))
(def path-precision 3)

View file

@ -1,317 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.util.path.parser
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.path.commands :as upc]
[app.common.svg :as csvg]
[app.util.path.arc-to-curve :refer [a2c]]
[cuerdas.core :as str]))
;;
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
;; Matches numbers for path values allows values like... -.01, 10, +12.22
;; 0 and 1 are special because can refer to flags
(def num-regex #"[+-]?(\d+(\.\d+)?|\.\d+)(e[+-]?\d+)?")
(def flag-regex #"[01]")
(defn extract-params [cmd-str extract-commands]
(loop [result []
extract-idx 0
current {}
remain (-> cmd-str (subs 1) (str/trim))]
(let [[param type] (nth extract-commands extract-idx)
regex (case type
:flag flag-regex
#_:number num-regex)
match (re-find regex remain)]
(if match
(let [value (-> match first csvg/fix-dot-number d/read-string)
remain (str/replace-first remain regex "")
current (assoc current param value)
extract-idx (inc extract-idx)
[result current extract-idx]
(if (>= extract-idx (count extract-commands))
[(conj result current) {} 0]
[result current extract-idx])]
(recur result
extract-idx
current
remain))
(cond-> result
(seq current) (conj current))))))
;; Path specification
;; https://www.w3.org/TR/SVG11/paths.html
(defmulti parse-command (comp str/upper first))
(defmethod parse-command "M" [cmd]
(let [relative (str/starts-with? cmd "m")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(into [{:command :move-to
:relative relative
:params (first param-list)}]
(for [params (rest param-list)]
{:command :line-to
:relative relative
:params params}))))
(defmethod parse-command "Z" [_]
[{:command :close-path}])
(defmethod parse-command "L" [cmd]
(let [relative (str/starts-with? cmd "l")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :line-to
:relative relative
:params params})))
(defmethod parse-command "H" [cmd]
(let [relative (str/starts-with? cmd "h")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-horizontal
:relative relative
:params params})))
(defmethod parse-command "V" [cmd]
(let [relative (str/starts-with? cmd "v")
param-list (extract-params cmd [[:value :number]])]
(for [params param-list]
{:command :line-to-vertical
:relative relative
:params params})))
(defmethod parse-command "C" [cmd]
(let [relative (str/starts-with? cmd "c")
param-list (extract-params cmd [[:c1x :number]
[:c1y :number]
[:c2x :number]
[:c2y :number]
[:x :number]
[:y :number]])
]
(for [params param-list]
{:command :curve-to
:relative relative
:params params})))
(defmethod parse-command "S" [cmd]
(let [relative (str/starts-with? cmd "s")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-curve-to
:relative relative
:params params})))
(defmethod parse-command "Q" [cmd]
(let [relative (str/starts-with? cmd "q")
param-list (extract-params cmd [[:cx :number]
[:cy :number]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "T" [cmd]
(let [relative (str/starts-with? cmd "t")
param-list (extract-params cmd [[:x :number]
[:y :number]])]
(for [params param-list]
{:command :smooth-quadratic-bezier-curve-to
:relative relative
:params params})))
(defmethod parse-command "A" [cmd]
(let [relative (str/starts-with? cmd "a")
param-list (extract-params cmd [[:rx :number]
[:ry :number]
[:x-axis-rotation :number]
[:large-arc-flag :flag]
[:sweep-flag :flag]
[:x :number]
[:y :number]])]
(for [params param-list]
{:command :elliptical-arc
:relative relative
:params params})))
(defn smooth->curve
[{:keys [params]} pos handler]
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
{:c1x c1x
:c1y c1y
:c2x (:cx params)
:c2y (:cy params)}))
(defn quadratic->curve
[sp ep cp]
(let [cp1 (-> (gpt/to-vec sp cp)
(gpt/scale (/ 2 3))
(gpt/add sp))
cp2 (-> (gpt/to-vec ep cp)
(gpt/scale (/ 2 3))
(gpt/add ep))]
{:c1x (:x cp1)
:c1y (:y cp1)
:c2x (:x cp2)
:c2y (:y cp2)}))
(defn arc->beziers [from-p command]
(let [to-command
(fn [[_ _ c1x c1y c2x c2y x y]]
{:command :curve-to
:relative (:relative command)
:params {:c1x c1x :c1y c1y
:c2x c2x :c2y c2y
:x x :y y}})
{from-x :x from-y :y} from-p
{:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
result (a2c from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
(mapv to-command result)))
(defn simplify-commands
"Removes some commands and convert relative to absolute coordinates"
[commands]
(let [simplify-command
;; prev-pos : previous position for the current path. Necessary for relative commands
;; prev-start : previous move-to necessary for Z commands
;; prev-cc : previous command control point for cubic beziers
;; prev-qc : previous command control point for quadratic curves
(fn [[result prev-pos prev-start prev-cc prev-qc] [command _prev]]
(let [command (assoc command :prev-pos prev-pos)
command
(cond-> command
(:relative command)
(-> (assoc :relative false)
(d/update-in-when [:params :c1x] + (:x prev-pos))
(d/update-in-when [:params :c1y] + (:y prev-pos))
(d/update-in-when [:params :c2x] + (:x prev-pos))
(d/update-in-when [:params :c2y] + (:y prev-pos))
(d/update-in-when [:params :cx] + (:x prev-pos))
(d/update-in-when [:params :cy] + (:y prev-pos))
(d/update-in-when [:params :x] + (:x prev-pos))
(d/update-in-when [:params :y] + (:y prev-pos))
(cond->
(= :line-to-horizontal (:command command))
(d/update-in-when [:params :value] + (:x prev-pos))
(= :line-to-vertical (:command command))
(d/update-in-when [:params :value] + (:y prev-pos)))))
params (:params command)
orig-command command
command
(cond-> command
(= :line-to-horizontal (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :x] (:value params))
(assoc-in [:params :y] (:y prev-pos)))
(= :line-to-vertical (:command command))
(-> (assoc :command :line-to)
(update :params dissoc :value)
(assoc-in [:params :y] (:value params))
(assoc-in [:params :x] (:x prev-pos)))
(= :smooth-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (smooth->curve command prev-pos prev-cc)))
(= :quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params dissoc :cx :cy)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (gpt/point (:cx params) (:cy params)))))
(= :smooth-quadratic-bezier-curve-to (:command command))
(-> (assoc :command :curve-to)
(update :params merge (quadratic->curve prev-pos (gpt/point params) (upg/calculate-opposite-handler prev-pos prev-qc)))))
result (if (= :elliptical-arc (:command command))
(into result (arc->beziers prev-pos command))
(conj result command))
next-cc (case (:command orig-command)
:smooth-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:curve-to
(gpt/point (get-in orig-command [:params :c2x]) (get-in orig-command [:params :c2y]))
(:line-to-horizontal :line-to-vertical)
(gpt/point (get-in command [:params :x]) (get-in command [:params :y]))
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-qc (case (:command orig-command)
:quadratic-bezier-curve-to
(gpt/point (get-in orig-command [:params :cx]) (get-in orig-command [:params :cy]))
:smooth-quadratic-bezier-curve-to
(upg/calculate-opposite-handler prev-pos prev-qc)
(gpt/point (get-in orig-command [:params :x]) (get-in orig-command [:params :y])))
next-pos (if (= :close-path (:command command))
prev-start
(upc/command->point prev-pos command))
next-start (if (= :move-to (:command command)) next-pos prev-start)]
[result next-pos next-start next-cc next-qc]))
start (first commands)
start (cond-> start
(:relative start)
(assoc :relative false))
start-pos (gpt/point (:params start))]
(->> (map vector (rest commands) commands)
(reduce simplify-command [[start] start-pos start-pos start-pos start-pos])
(first))))
(defn parse-path [path-str]
(if (empty? path-str)
path-str
(let [clean-path-str
(-> path-str
(str/trim)
;; Change "commas" for spaces
(str/replace #"," " ")
;; Remove all consecutive spaces
(str/replace #"\s+" " "))
commands (re-seq commands-regex clean-path-str)]
(-> (mapcat parse-command commands)
(simplify-commands)))))

View file

@ -9,7 +9,7 @@
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.path.commands :as upc]
[app.common.svg.path.command :as upc]
[clojure.set :as set]))
(defn remove-line-curves