From de11e85d2b906033d5cff50225fb694b9a76e1e1 Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Fri, 16 Apr 2021 14:06:32 +0200 Subject: [PATCH] :recycle: Refactor path utils --- .../main/data/workspace/drawing/curve.cljs | 5 +- .../app/main/data/workspace/path/drawing.cljs | 15 +- .../app/main/data/workspace/path/edition.cljs | 32 +- .../app/main/data/workspace/path/helpers.cljs | 6 +- .../app/main/data/workspace/path/streams.cljs | 4 +- .../app/main/data/workspace/path/tools.cljs | 16 +- .../app/main/data/workspace/svg_upload.cljs | 4 +- frontend/src/app/main/ui/shapes/path.cljs | 5 +- .../app/main/ui/workspace/shapes/path.cljs | 4 +- .../main/ui/workspace/shapes/path/editor.cljs | 24 +- .../main/ui/workspace/viewport/outline.cljs | 4 +- .../ui/workspace/viewport/path_actions.cljs | 5 +- frontend/src/app/util/geom/path.cljs | 917 ------------------ .../app/util/{a2c.js => path/arc_to_curve.js} | 4 +- frontend/src/app/util/path/commands.cljs | 147 +++ frontend/src/app/util/path/format.cljs | 74 ++ frontend/src/app/util/path/geom.cljs | 60 ++ frontend/src/app/util/path/parser.cljs | 317 ++++++ .../util/{geom => path}/path_impl_simplify.js | 4 +- .../src/app/util/path/simplify_curve.cljs | 24 + frontend/src/app/util/path/tools.cljs | 385 ++++++++ 21 files changed, 1076 insertions(+), 980 deletions(-) delete mode 100644 frontend/src/app/util/geom/path.cljs rename frontend/src/app/util/{a2c.js => path/arc_to_curve.js} (98%) create mode 100644 frontend/src/app/util/path/commands.cljs create mode 100644 frontend/src/app/util/path/format.cljs create mode 100644 frontend/src/app/util/path/geom.cljs create mode 100644 frontend/src/app/util/path/parser.cljs rename frontend/src/app/util/{geom => path}/path_impl_simplify.js (96%) create mode 100644 frontend/src/app/util/path/simplify_curve.cljs create mode 100644 frontend/src/app/util/path/tools.cljs diff --git a/frontend/src/app/main/data/workspace/drawing/curve.cljs b/frontend/src/app/main/data/workspace/drawing/curve.cljs index 02c7bb92d8..8808b0d0f7 100644 --- a/frontend/src/app/main/data/workspace/drawing/curve.cljs +++ b/frontend/src/app/main/data/workspace/drawing/curve.cljs @@ -12,7 +12,7 @@ [app.common.geom.shapes :as gsh] [app.common.geom.shapes.path :as gsp] [app.main.streams :as ms] - [app.util.geom.path :as path] + [app.util.path.simplify-curve :as ups] [app.main.data.workspace.drawing.common :as common] [app.main.data.workspace.common :as dwc] [app.common.pages :as cp])) @@ -67,7 +67,7 @@ state [:workspace-drawing :object] (fn [shape] (-> shape - (update :segments #(path/simplify % simplify-tolerance)) + (update :segments #(ups/simplify % simplify-tolerance)) (curve-to-path))))) (defn handle-drawing-curve [] @@ -85,3 +85,4 @@ (rx/of (setup-frame-curve) finish-drawing-curve common/handle-finish-drawing)))))) + diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs index c0945a33bc..9f359c3afb 100644 --- a/frontend/src/app/main/data/workspace/path/drawing.cljs +++ b/frontend/src/app/main/data/workspace/path/drawing.cljs @@ -20,7 +20,8 @@ [app.main.data.workspace.path.tools :as tools] [app.main.data.workspace.path.undo :as undo] [app.main.streams :as ms] - [app.util.geom.path :as ugp] + [app.util.path.commands :as upc] + [app.util.path.geom :as upg] [beicon.core :as rx] [potok.core :as ptk])) @@ -67,7 +68,7 @@ make-curve (fn [command] - (let [params (ugp/make-curve-params + (let [params (upc/make-curve-params (get-in content [index :params]) (get-in content [(dec index) :params]))] (-> command @@ -85,7 +86,7 @@ shape (get-in state (st/get-path state)) content (:content shape) index (dec (count content)) - node-position (ugp/command->point (nth content index)) + node-position (upc/command->point (nth content index)) handler-position (cond-> (gpt/point x y) shift? (helpers/position-fixed-angle node-position)) {dx :x dy :y} (gpt/subtract handler-position node-position) @@ -104,7 +105,7 @@ modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) handler (get-in state [:workspace-local :edit-path id :drag-handler])] (-> state - (update-in (st/get-path state :content) ugp/apply-content-modifiers modifiers) + (update-in (st/get-path state :content) upc/apply-content-modifiers modifiers) (update-in [:workspace-local :edit-path id] dissoc :drag-handler) (update-in [:workspace-local :edit-path id] dissoc :content-modifiers) (assoc-in [:workspace-local :edit-path id :prev-handler] handler) @@ -133,7 +134,7 @@ content (get-in state (st/get-path state :content)) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) - points (ugp/content->points content) + points (upg/content->points content) drag-events-stream (->> (streams/position-stream snap-toggled points) @@ -166,7 +167,7 @@ mouse-up (->> stream (rx/filter #(or (helpers/end-path-event? %) (ms/mouse-up? %)))) content (get-in state (st/get-path state :content)) - points (ugp/content->points content) + points (upg/content->points content) id (st/get-path-id state) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) @@ -223,7 +224,7 @@ end-path-events (->> stream (rx/filter helpers/end-path-event?)) content (get-in state (st/get-path state :content)) - points (ugp/content->points content) + points (upg/content->points content) id (st/get-path-id state) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled]) diff --git a/frontend/src/app/main/data/workspace/path/edition.cljs b/frontend/src/app/main/data/workspace/path/edition.cljs index f11e6c86d3..57162153f0 100644 --- a/frontend/src/app/main/data/workspace/path/edition.cljs +++ b/frontend/src/app/main/data/workspace/path/edition.cljs @@ -19,7 +19,9 @@ [app.main.data.workspace.path.drawing :as drawing] [app.main.data.workspace.path.undo :as undo] [app.main.streams :as ms] - [app.util.geom.path :as ugp] + [app.util.path.commands :as upc] + [app.util.path.geom :as upg] + [app.util.path.tools :as upt] [beicon.core :as rx] [potok.core :as ptk])) @@ -44,7 +46,7 @@ [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) point (gpt/point (+ (get-in content [index :params cx]) dx) (+ (get-in content [index :params cy]) dy)) - opposite-index (ugp/opposite-index content index prefix)] + opposite-index (upc/opposite-index content index prefix)] (cond-> state :always (-> (update-in [:workspace-local :edit-path id :content-modifiers index] assoc @@ -65,10 +67,10 @@ content-modifiers (get-in state [:workspace-local :edit-path id :content-modifiers]) content (:content shape) - new-content (ugp/apply-content-modifiers content content-modifiers) + new-content (upc/apply-content-modifiers content content-modifiers) - old-points (->> content ugp/content->points) - new-points (->> new-content ugp/content->points) + old-points (->> content upg/content->points) + new-points (->> new-content upg/content->points) point-change (->> (map hash-map old-points new-points) (reduce merge)) [rch uch] (changes/generate-path-changes page-id shape (:content shape) new-content)] @@ -79,8 +81,8 @@ (defn move-selected-path-point [from-point to-point] (letfn [(modify-content-point [content {dx :x dy :y} modifiers point] - (let [point-indices (ugp/point-indices content point) ;; [indices] - handler-indices (ugp/handler-indices content point) ;; [[index prefix]] + (let [point-indices (upc/point-indices content point) ;; [indices] + handler-indices (upc/handler-indices content point) ;; [[index prefix]] modify-point (fn [modifiers index] @@ -146,7 +148,7 @@ selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{}) content (get-in state (st/get-path state :content)) - points (ugp/content->points content)] + points (upg/content->points content)] (rx/concat ;; This stream checks the consecutive mouse positions to do the draging @@ -170,16 +172,16 @@ start-delta-y (get-in modifiers [index cy] 0) content (get-in state (st/get-path state :content)) - points (ugp/content->points content) + points (upg/content->points content) - opposite-index (ugp/opposite-index content index prefix) + opposite-index (upc/opposite-index content index prefix) opposite-prefix (if (= prefix :c1) :c2 :c1) - opposite-handler (-> content (get opposite-index) (ugp/get-handler opposite-prefix)) + opposite-handler (-> content (get opposite-index) (upc/get-handler opposite-prefix)) - point (-> content (get (if (= prefix :c1) (dec index) index)) (ugp/command->point)) - handler (-> content (get index) (ugp/get-handler prefix)) + point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point)) + handler (-> content (get index) (upc/get-handler prefix)) - current-distance (when opposite-handler (gpt/distance (ugp/opposite-handler point handler) opposite-handler)) + current-distance (when opposite-handler (gpt/distance (upg/opposite-handler point handler) opposite-handler)) match-opposite? (and opposite-handler (mth/almost-zero? current-distance)) snap-toggled (get-in state [:workspace-local :edit-path id :snap-toggled])] @@ -243,7 +245,7 @@ ptk/UpdateEvent (update [_ state] (let [id (st/get-path-id state)] - (update-in state (st/get-path state :content) ugp/split-segments #{from-p to-p} t))) + (update-in state (st/get-path state :content) upt/split-segments #{from-p to-p} t))) ptk/WatchEvent (watch [_ state stream] diff --git a/frontend/src/app/main/data/workspace/path/helpers.cljs b/frontend/src/app/main/data/workspace/path/helpers.cljs index 0fe040d426..57b31b9088 100644 --- a/frontend/src/app/main/data/workspace/path/helpers.cljs +++ b/frontend/src/app/main/data/workspace/path/helpers.cljs @@ -14,7 +14,7 @@ [app.main.data.workspace.path.state :refer [get-path]] [app.main.data.workspace.path.common :as common] [app.main.streams :as ms] - [app.util.geom.path :as ugp] + [app.util.path.commands :as upc] [potok.core :as ptk])) ;; CONSTANTS @@ -94,7 +94,7 @@ add-line? {:command :line-to :params position} add-curve? {:command :curve-to - :params (ugp/make-curve-params position prev-handler)} + :params (upc/make-curve-params position prev-handler)} :else {:command :move-to :params position}))) @@ -110,7 +110,7 @@ [content index prefix match-opposite? dx dy] (let [[cx cy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y]) [ocx ocy] (if (= prefix :c1) [:c2x :c2y] [:c1x :c1y]) - opposite-index (ugp/opposite-index content index prefix)] + opposite-index (upc/opposite-index content index prefix)] (cond-> {} :always diff --git a/frontend/src/app/main/data/workspace/path/streams.cljs b/frontend/src/app/main/data/workspace/path/streams.cljs index f7c7a83c22..d61d1a82aa 100644 --- a/frontend/src/app/main/data/workspace/path/streams.cljs +++ b/frontend/src/app/main/data/workspace/path/streams.cljs @@ -16,7 +16,7 @@ [app.common.math :as mth] [app.main.snap :as snap] [okulary.core :as l] - [app.util.geom.path :as ugp])) + [app.util.path.geom :as upg])) (defonce drag-threshold 5) @@ -103,7 +103,7 @@ ranges-stream (->> content-stream - (rx/map ugp/content->points) + (rx/map upg/content->points) (rx/map snap/create-ranges))] (->> ms/mouse-position diff --git a/frontend/src/app/main/data/workspace/path/tools.cljs b/frontend/src/app/main/data/workspace/path/tools.cljs index 90ea6a1913..059636565a 100644 --- a/frontend/src/app/main/data/workspace/path/tools.cljs +++ b/frontend/src/app/main/data/workspace/path/tools.cljs @@ -10,7 +10,7 @@ [app.main.data.workspace.path.changes :as changes] [app.main.data.workspace.path.common :as common] [app.main.data.workspace.path.state :as st] - [app.util.geom.path :as ugp] + [app.util.path.tools :as upt] [app.common.geom.point :as gpt] [beicon.core :as rx] [potok.core :as ptk])) @@ -32,27 +32,27 @@ (defn make-corner [] (process-path-tool (fn [content points] - (reduce ugp/make-corner-point content points)))) + (reduce upt/make-corner-point content points)))) (defn make-curve [] (process-path-tool (fn [content points] - (reduce ugp/make-curve-point content points)))) + (reduce upt/make-curve-point content points)))) (defn add-node [] - (process-path-tool (fn [content points] (ugp/split-segments content points 0.5)))) + (process-path-tool (fn [content points] (upt/split-segments content points 0.5)))) (defn remove-node [] - (process-path-tool ugp/remove-nodes)) + (process-path-tool upt/remove-nodes)) (defn merge-nodes [] - (process-path-tool ugp/merge-nodes)) + (process-path-tool upt/merge-nodes)) (defn join-nodes [] - (process-path-tool ugp/join-nodes)) + (process-path-tool upt/join-nodes)) (defn separate-nodes [] - (process-path-tool ugp/separate-nodes)) + (process-path-tool upt/separate-nodes)) (defn toggle-snap [] (ptk/reify ::toggle-snap diff --git a/frontend/src/app/main/data/workspace/svg_upload.cljs b/frontend/src/app/main/data/workspace/svg_upload.cljs index f2dca9d4ef..1b3a479bf0 100644 --- a/frontend/src/app/main/data/workspace/svg_upload.cljs +++ b/frontend/src/app/main/data/workspace/svg_upload.cljs @@ -16,7 +16,7 @@ [app.main.data.workspace.common :as dwc] [app.main.repo :as rp] [app.util.color :as uc] - [app.util.geom.path :as ugp] + [app.util.path.parser :as upp] [app.util.object :as obj] [app.util.svg :as usvg] [app.util.uri :as uu] @@ -163,7 +163,7 @@ (defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}] (when (and (contains? attrs :d) (not (empty? (:d attrs)) )) (let [svg-transform (usvg/parse-transform (:transform attrs)) - path-content (ugp/path->content (:d attrs)) + path-content (upp/parse-path (:d attrs)) content (cond-> path-content svg-transform (gsh/transform-content svg-transform)) diff --git a/frontend/src/app/main/ui/shapes/path.cljs b/frontend/src/app/main/ui/shapes/path.cljs index 98643cb7fe..c5de929e14 100644 --- a/frontend/src/app/main/ui/shapes/path.cljs +++ b/frontend/src/app/main/ui/shapes/path.cljs @@ -11,7 +11,7 @@ [app.main.ui.shapes.attrs :as attrs] [app.main.ui.shapes.custom-stroke :refer [shape-custom-stroke]] [app.util.object :as obj] - [app.util.geom.path :as ugp])) + [app.util.path.format :as upf])) ;; --- Path Shape @@ -22,7 +22,7 @@ background? (unchecked-get props "background?") {:keys [id x y width height]} (:selrect shape) content (:content shape) - pdata (mf/use-memo (mf/deps content) #(ugp/content->path content)) + pdata (mf/use-memo (mf/deps content) #(upf/format-path content)) props (-> (attrs/extract-style-attrs shape) (obj/merge! #js {:d pdata}))] @@ -39,3 +39,4 @@ :base-props props :elem-name "path"}]))) + diff --git a/frontend/src/app/main/ui/workspace/shapes/path.cljs b/frontend/src/app/main/ui/workspace/shapes/path.cljs index 33de97772b..22232ca011 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path.cljs @@ -13,7 +13,7 @@ [app.main.ui.shapes.shape :refer [shape-container]] [app.main.ui.workspace.shapes.path.common :as pc] [app.util.dom :as dom] - [app.util.geom.path :as ugp] + [app.util.path.commands :as upc] [rumext.alpha :as mf])) (mf/defc path-wrapper @@ -24,7 +24,7 @@ content-modifiers (mf/deref content-modifiers-ref) editing-id (mf/deref refs/selected-edition) editing? (= editing-id (:id shape)) - shape (update shape :content ugp/apply-content-modifiers content-modifiers)] + shape (update shape :content upc/apply-content-modifiers content-modifiers)] [:> shape-container {:shape shape :pointer-events (when editing? "none")} diff --git a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs index cb471cad79..7457e35d7a 100644 --- a/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/path/editor.cljs @@ -17,7 +17,9 @@ [app.main.ui.hooks :as hooks] [app.main.ui.workspace.shapes.path.common :as pc] [app.util.dom :as dom] - [app.util.geom.path :as ugp] + [app.util.path.geom :as upg] + [app.util.path.commands :as upc] + [app.util.path.format :as upf] [app.util.keyboard :as kbd] [clojure.set :refer [map-invert]] [goog.events :as events] @@ -133,10 +135,10 @@ :stroke pc/black-color :stroke-width (/ 1 zoom) :stroke-dasharray (/ 4 zoom)} - :d (ugp/content->path [{:command :move-to - :params {:x (:x from) - :y (:y from)}} - command])}]) + :d (upf/format-path [{:command :move-to + :params {:x (:x from) + :y (:y from)}} + command])}]) [:& path-point {:position (:params command) :preview? true :zoom zoom}]]) @@ -179,10 +181,10 @@ selected-points (or selected-points #{}) base-content (:content shape) - base-points (mf/use-memo (mf/deps base-content) #(->> base-content ugp/content->points)) + base-points (mf/use-memo (mf/deps base-content) #(->> base-content upg/content->points)) - content (ugp/apply-content-modifiers base-content content-modifiers) - content-points (mf/use-memo (mf/deps content) #(->> content ugp/content->points)) + content (upc/apply-content-modifiers base-content content-modifiers) + content-points (mf/use-memo (mf/deps content) #(->> content upg/content->points)) point->base (->> (map hash-map content-points base-points) (reduce merge)) base->point (map-invert point->base) @@ -190,15 +192,15 @@ points (into #{} content-points) last-command (last content) - last-p (->> content last ugp/command->point) - handlers (ugp/content->handlers content) + last-p (->> content last upc/command->point) + handlers (upc/content->handlers content) start-p? (not (some? last-point)) [snap-selected snap-points] (cond (some? drag-handler) [#{drag-handler} points] - (some? preview) [#{(ugp/command->point preview)} points] + (some? preview) [#{(upc/command->point preview)} points] (some? moving-handler) [#{moving-handler} points] :else [(->> selected-points (map base->point) (into #{})) diff --git a/frontend/src/app/main/ui/workspace/viewport/outline.cljs b/frontend/src/app/main/ui/workspace/viewport/outline.cljs index 11af2cd59a..e292b16dcd 100644 --- a/frontend/src/app/main/ui/workspace/viewport/outline.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/outline.cljs @@ -9,7 +9,7 @@ [app.common.geom.shapes :as gsh] [app.common.pages :as cp] [app.main.refs :as refs] - [app.util.geom.path :as ugp] + [app.util.path.format :as upf] [app.util.object :as obj] [clojure.set :as set] [rumext.alpha :as mf] @@ -27,7 +27,7 @@ path-data (mf/use-memo (mf/deps shape) - #(when path? (ugp/content->path (:content shape)))) + #(when path? (upf/format-path (:content shape)))) {:keys [id x y width height]} shape diff --git a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs index 85e4ff2200..640eb5cffe 100644 --- a/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/path_actions.cljs @@ -12,12 +12,11 @@ [app.main.store :as st] [app.main.ui.icons :as i] [app.main.ui.workspace.shapes.path.common :as pc] - [app.util.geom.path :as ugp] + [app.util.path.tools :as upt] [rumext.alpha :as mf])) (defn check-enabled [content selected-points] - (let [segments (ugp/get-segments content selected-points) - + (let [segments (upt/get-segments content selected-points) points-selected? (not (empty? selected-points)) segments-selected? (not (empty? segments))] {:make-corner points-selected? diff --git a/frontend/src/app/util/geom/path.cljs b/frontend/src/app/util/geom/path.cljs deleted file mode 100644 index c4a9a7249a..0000000000 --- a/frontend/src/app/util/geom/path.cljs +++ /dev/null @@ -1,917 +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) UXBOX Labs SL - -(ns app.util.geom.path - (:require - [app.common.data :as d] - [app.common.geom.point :as gpt] - [app.common.geom.shapes.path :as gshp] - [app.util.a2c :refer [a2c]] - [app.util.geom.path-impl-simplify :as impl-simplify] - [app.util.svg :as usvg] - [cuerdas.core :as str] - [clojure.set :as set] - [app.common.math :as mth])) - -(defn calculate-opposite-handler - "Given a point and its handler, gives the symetric handler" - [point handler] - (let [handler-vector (gpt/to-vec point handler)] - (gpt/add point (gpt/negate handler-vector)))) - -(defn simplify - "Simplifies a drawing done with the pen tool" - ([points] - (simplify points 0.1)) - ([points tolerance] - (let [points (into-array points)] - (into [] (impl-simplify/simplify points tolerance true))))) - -;; -(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 usvg/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 - (not (empty? current)) (conj current)))))) - -(defn command->point [command] - (when-not (nil? command) - (let [{{:keys [x y]} :params} command] - (gpt/point x y)))) - -(defn command->param-list [command] - (let [params (:params command)] - (case (:command command) - (:move-to :line-to :smooth-quadratic-bezier-curve-to) - (str (:x params) "," - (:y params)) - - :close-path - "" - - (:line-to-horizontal :line-to-vertical) - (str (:value params)) - - :curve-to - (str (:c1x params) "," - (:c1y params) "," - (:c2x params) "," - (:c2y params) "," - (:x params) "," - (:y params)) - - (:smooth-curve-to :quadratic-bezier-curve-to) - (str (:cx params) "," - (:cy params) "," - (:x params) "," - (:y params)) - - :elliptical-arc - (str (:rx params) "," - (:ry params) "," - (:x-axis-rotation params) "," - (:large-arc-flag params) "," - (:sweep-flag params) "," - (:x params) "," - (:y params))))) - -;; 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]])] - - (d/concat [{: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" [cmd] - [{: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 command->string [{:keys [command relative params] :as entry}] - (let [command-str (case command - :move-to "M" - :close-path "Z" - :line-to "L" - :line-to-horizontal "H" - :line-to-vertical "V" - :curve-to "C" - :smooth-curve-to "S" - :quadratic-bezier-curve-to "Q" - :smooth-quadratic-bezier-curve-to "T" - :elliptical-arc "A") - command-str (if relative (str/lower command-str) command-str) - param-list (command->param-list entry)] - (str command-str param-list))) - -(defn cmd-pos [prev-pos {:keys [relative params]}] - (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params] - (if relative - (-> prev-pos (update :x + x) (update :y + y)) - (gpt/point x y)))) - -(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 smooth->curve - [{:keys [params]} pos handler] - (let [{c1x :x c1y :y} (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 simplify-commands - "Removes some commands and convert relative to absolute coordinates" - [commands] - (let [simplify-command - ;; prev-pos : previous position for the current path. Necesary for relative commands - ;; prev-start : previous move-to necesary 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) (calculate-opposite-handler prev-pos prev-qc))))) - - result (if (= :elliptical-arc (:command command)) - (d/concat 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 - (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 - (cmd-pos 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-pos (gpt/point (:params start))] - - (->> (map vector (rest commands) commands) - (reduce simplify-command [[start] start-pos start-pos start-pos start-pos]) - (first)))) - -(defn path->content [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)))) - -(defn content->path [content] - (->> content - (mapv command->string) - (str/join ""))) - -(defn make-move-to [to] - {:command :move-to - :relative false - :params {:x (:x to) - :y (:y to)}}) - -(defn make-line-to [to] - {:command :line-to - :relative false - :params {:x (:x to) - :y (:y to)}}) - -(defn make-curve-params - ([point] - (make-curve-params point point point)) - - ([point handler] (make-curve-params point handler point)) - - ([point h1 h2] - {:x (:x point) - :y (:y point) - :c1x (:x h1) - :c1y (:y h1) - :c2x (:x h2) - :c2y (:y h2)})) - -(defn make-curve-to [to h1 h2] - {:command :curve-to - :relative false - :params (make-curve-params to h1 h2)}) - -(defn split-line-to [from-p cmd val] - (let [to-p (command->point cmd) - sp (gpt/line-val from-p to-p val)] - [(make-line-to sp) cmd])) - -(defn split-curve-to [from-p cmd val] - (let [params (:params cmd) - end (gpt/point (:x params) (:y params)) - h1 (gpt/point (:c1x params) (:c1y params)) - h2 (gpt/point (:c2x params) (:c2y params)) - [[_ to1 h11 h21] - [_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 val)] - [(make-curve-to to1 h11 h21) - (make-curve-to to2 h12 h22)])) - -(defn opposite-handler - "Calculates the coordinates of the opposite handler" - [point handler] - (let [phv (gpt/to-vec point handler)] - (gpt/add point (gpt/negate phv)))) - -(defn opposite-handler-keep-distance - "Calculates the coordinates of the opposite handler but keeping the old distance" - [point handler old-opposite] - (let [old-distance (gpt/distance point old-opposite) - phv (gpt/to-vec point handler) - phv2 (gpt/multiply - (gpt/unit (gpt/negate phv)) - (gpt/point old-distance))] - (gpt/add point phv2))) - -(defn apply-content-modifiers [content modifiers] - (letfn [(apply-to-index [content [index params]] - (if (contains? content index) - (cond-> content - (and - (or (:c1x params) (:c1y params) (:c2x params) (:c2y params)) - (= :line-to (get-in content [index :params :command]))) - (-> (assoc-in [index :command] :curve-to) - (assoc-in [index :params] :curve-to) (make-curve-params - (get-in content [index :params]) - (get-in content [(dec index) :params]))) - - (:x params) (update-in [index :params :x] + (:x params)) - (:y params) (update-in [index :params :y] + (:y params)) - - (:c1x params) (update-in [index :params :c1x] + (:c1x params)) - (:c1y params) (update-in [index :params :c1y] + (:c1y params)) - - (:c2x params) (update-in [index :params :c2x] + (:c2x params)) - (:c2y params) (update-in [index :params :c2y] + (:c2y params))) - content))] - (let [content (if (vector? content) content (into [] content))] - (reduce apply-to-index content modifiers)))) - -(defn content->points [content] - (->> content - (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y)))) - (remove nil?) - (into []))) - -(defn get-handler [{:keys [params] :as command} prefix] - (let [cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y)] - (when (and command - (contains? params cx) - (contains? params cy)) - (gpt/point (get params cx) - (get params cy))))) - -(defn content->handlers - "Retrieve a map where for every point will retrieve a list of - the handlers that are associated with that point. - point -> [[index, prefix]]" - [content] - (->> (d/with-prev content) - (d/enumerate) - (mapcat (fn [[index [cur-cmd pre-cmd]]] - (if (and pre-cmd (= :curve-to (:command cur-cmd))) - (let [cur-pos (command->point cur-cmd) - pre-pos (command->point pre-cmd)] - (-> [[pre-pos [index :c1]] - [cur-pos [index :c2]]])) - []))) - - (group-by first) - (d/mapm #(mapv second %2)))) - -(defn point-indices - [content point] - (->> (d/enumerate content) - (filter (fn [[_ cmd]] (= point (command->point cmd)))) - (mapv (fn [[index _]] index)))) - -(defn handler-indices - [content point] - (->> (d/with-prev content) - (d/enumerate) - (mapcat (fn [[index [cur-cmd pre-cmd]]] - (if (and (some? pre-cmd) (= :curve-to (:command cur-cmd))) - (let [cur-pos (command->point cur-cmd) - pre-pos (command->point pre-cmd)] - (cond-> [] - (= pre-pos point) (conj [index :c1]) - (= cur-pos point) (conj [index :c2]))) - []))))) - -(defn opposite-index - "Calculate sthe opposite index given a prefix and an index" - [content index prefix] - (let [point (if (= prefix :c2) - (command->point (nth content index)) - (command->point (nth content (dec index)))) - - handlers (-> (content->handlers content) - (get point)) - - opposite-prefix (if (= prefix :c1) :c2 :c1)] - (when (<= (count handlers) 2) - (->> handlers - (d/seek (fn [[index prefix]] (= prefix opposite-prefix))) - (first))))) - -(defn remove-line-curves - "Remove all curves that have both handlers in the same position that the - beggining and end points. This makes them really line-to commands" - [content] - (let [with-prev (d/enumerate (d/with-prev content)) - process-command - (fn [content [index [command prev]]] - - (let [cur-point (command->point command) - pre-point (command->point prev) - handler-c1 (get-handler command :c1) - handler-c2 (get-handler command :c2)] - (if (and (= :curve-to (:command command)) - (= cur-point handler-c2) - (= pre-point handler-c1)) - (assoc content index {:command :line-to - :params cur-point}) - content)))] - - (reduce process-command content with-prev))) - -(defn make-corner-point - "Changes the content to make a point a 'corner'" - [content point] - (let [handlers (-> (content->handlers content) - (get point)) - change-content - (fn [content [index prefix]] - (let [cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y)] - (-> content - (assoc-in [index :params cx] (:x point)) - (assoc-in [index :params cy] (:y point)))))] - (as-> content $ - (reduce change-content $ handlers) - (remove-line-curves $)))) - -(defn make-curve-point - "Changes the content to make the point a 'curve'. The handlers will be positioned - in the same vector that results from te previous->next points but with fixed length." - [content point] - (let [content-next (d/enumerate (d/with-prev-next content)) - - make-curve - (fn [command previous] - (if (= :line-to (:command command)) - (let [cur-point (command->point command) - pre-point (command->point previous)] - (-> command - (assoc :command :curve-to) - (assoc :params (make-curve-params cur-point pre-point)))) - command)) - - update-handler - (fn [command prefix handler] - (if (= :curve-to (:command command)) - (let [cx (d/prefix-keyword prefix :x) - cy (d/prefix-keyword prefix :y)] - (-> command - (assoc-in [:params cx] (:x handler)) - (assoc-in [:params cy] (:y handler)))) - command)) - - calculate-vector - (fn [point next prev] - (let [base-vector (if (or (nil? next) (nil? prev) (= next prev)) - (-> (gpt/to-vec point (or next prev)) - (gpt/normal-left)) - (gpt/to-vec next prev))] - (-> base-vector - (gpt/unit) - (gpt/multiply (gpt/point 100))))) - - redfn (fn [content [index [command prev next]]] - (if (= point (command->point command)) - (let [prev-point (if (= :move-to (:command command)) nil (command->point prev)) - next-point (if (= :move-to (:command next)) nil (command->point next)) - handler-vector (calculate-vector point next-point prev-point) - handler (gpt/add point handler-vector) - handler-opposite (gpt/add point (gpt/negate handler-vector))] - (-> content - (d/update-when index make-curve prev) - (d/update-when index update-handler :c2 handler) - (d/update-when (inc index) make-curve command) - (d/update-when (inc index) update-handler :c1 handler-opposite))) - - content))] - (as-> content $ - (reduce redfn $ content-next) - (remove-line-curves $)))) - -(defn get-segments - "Given a content and a set of points return all the segments in the path - that uses the points" - [content points] - (let [point-set (set points)] - - (loop [segments [] - prev-point nil - start-point nil - cur-cmd (first content) - content (rest content)] - - (let [;; Close-path makes a segment from the last point to the initial path point - cur-point (if (= :close-path (:command cur-cmd)) - start-point - (command->point cur-cmd)) - - ;; If there is a move-to we don't have a segment - prev-point (if (= :move-to (:command cur-cmd)) - nil - prev-point) - - ;; We update the start point - start-point (if (= :move-to (:command cur-cmd)) - cur-point - start-point) - - is-segment? (and (some? prev-point) - (contains? point-set prev-point) - (contains? point-set cur-point)) - - segments (cond-> segments - is-segment? - (conj [prev-point cur-point cur-cmd]))] - - (if (some? cur-cmd) - (recur segments - cur-point - start-point - (first content) - (rest content)) - - segments))))) - -(defn split-segments - "Given a content creates splits commands between points with new segments" - [content points value] - (let [split-command - (fn [[start end cmd]] - (case (:command cmd) - :line-to [cmd (split-line-to start cmd value)] - :curve-to [cmd (split-curve-to start cmd value)] - :close-path [cmd [(make-line-to (gpt/line-val start end value)) cmd]] - nil)) - - cmd-changes - (->> (get-segments content points) - (into {} (comp (map split-command) - (filter (comp not nil?))))) - - process-segments - (fn [command] - (if (contains? cmd-changes command) - (get cmd-changes command) - [command]))] - - (into [] (mapcat process-segments) content))) - -(defn remove-nodes - "Removes from content the points given. Will try to reconstruct the paths - to keep everything consistent" - [content points] - - (let [content (d/with-prev content)] - - (loop [result [] - last-handler nil - [cur-cmd prev-cmd] (first content) - content (rest content)] - - (if (nil? cur-cmd) - ;; The result with be an array of arrays were every entry is a subpath - (->> result - ;; remove empty and only 1 node subpaths - (filter #(> (count %) 1)) - ;; flatten array-of-arrays plain array - (flatten) - (into [])) - - (let [move? (= :move-to (:command cur-cmd)) - curve? (= :curve-to (:command cur-cmd)) - - ;; When the old command was a move we start a subpath - result (if move? (conj result []) result) - - subpath (peek result) - - point (command->point cur-cmd) - - old-prev-point (command->point prev-cmd) - new-prev-point (command->point (peek subpath)) - - remove? (contains? points point) - - - ;; We store the first handler for the first curve to be removed to - ;; use it for the first handler of the regenerated path - cur-handler (cond - (and (not last-handler) remove? curve?) - (select-keys (:params cur-cmd) [:c1x :c1y]) - - (not remove?) - nil - - :else - last-handler) - - cur-cmd (cond-> cur-cmd - ;; If we're starting a subpath and it's not a move make it a move - (and (not move?) (empty? subpath)) - (assoc :command :move-to - :params (select-keys (:params cur-cmd) [:x :y])) - - ;; If have a curve the first handler will be relative to the previous - ;; point. We change the handler to the new previous point - (and curve? (not (empty? subpath)) (not= old-prev-point new-prev-point)) - (update :params merge last-handler)) - - head-idx (dec (count result)) - - result (cond-> result - (not remove?) - (update head-idx conj cur-cmd))] - (recur result - cur-handler - (first content) - (rest content))))))) - -(defn join-nodes - "Creates new segments between points that weren't previously" - [content points] - - (let [segments-set (into #{} - (map (fn [[p1 p2 _]] [p1 p2])) - (get-segments content points)) - - create-line-command (fn [point other] - [(make-move-to point) - (make-line-to other)]) - - not-segment? (fn [point other] (and (not (contains? segments-set [point other])) - (not (contains? segments-set [other point])))) - - new-content (->> (d/map-perm create-line-command not-segment? points) - (flatten) - (into []))] - - (d/concat content new-content))) - - -(defn separate-nodes - "Removes the segments between the points given" - [content points] - - (let [content (d/with-prev content)] - (loop [result [] - [cur-cmd prev-cmd] (first content) - content (rest content)] - - (if (nil? cur-cmd) - (->> result - (filter #(> (count %) 1)) - (flatten) - (into [])) - - (let [prev-point (command->point prev-cmd) - cur-point (command->point cur-cmd) - - cur-cmd (cond-> cur-cmd - (and (contains? points prev-point) - (contains? points cur-point)) - - (assoc :command :move-to - :params (select-keys (:params cur-cmd) [:x :y]))) - - move? (= :move-to (:command cur-cmd)) - - result (if move? (conj result []) result) - head-idx (dec (count result)) - - result (-> result - (update head-idx conj cur-cmd))] - (recur result - (first content) - (rest content))))))) - - -(defn- add-to-set - "Given a list of sets adds the value to the target set" - [set-list target value] - (->> set-list - (mapv (fn [it] - (cond-> it - (= it target) (conj value)))))) - -(defn- join-sets - "Given a list of sets join two sets in the list into a new one" - [set-list target other] - (conj (->> set-list - (filterv #(and (not= % target) - (not= % other)))) - (set/union target other))) - -(defn group-segments [segments] - (loop [result [] - [point-a point-b :as segment] (first segments) - segments (rest segments)] - - (if (nil? segment) - result - - (let [set-a (d/seek #(contains? % point-a) result) - set-b (d/seek #(contains? % point-b) result) - - result (cond-> result - (and (nil? set-a) (nil? set-b)) - (conj #{point-a point-b}) - - (and (some? set-a) (nil? set-b)) - (add-to-set set-a point-b) - - (and (nil? set-a) (some? set-b)) - (add-to-set set-b point-a) - - (and (some? set-a) (some? set-b) (not= set-a set-b)) - (join-sets set-a set-b))] - (recur result - (first segments) - (rest segments)))))) - -(defn calculate-merge-points [group-segments points] - (let [index-merge-point (fn [group] (vector group (-> (gpt/center-points group) - (update :x mth/round) - (update :y mth/round)))) - index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments))) - - group->merge-point (into {} (map index-merge-point) group-segments) - point->group (into {} (map index-group) points)] - (d/mapm #(group->merge-point %2) point->group))) - -;; TODO: Improve the replace for curves -(defn replace-points - "Replaces the points in a path for its merge-point" - [content point->merge-point] - (let [replace-command - (fn [cmd] - (let [point (command->point cmd)] - (if (contains? point->merge-point point) - (let [merge-point (get point->merge-point point)] - (-> cmd (update :params assoc :x (:x merge-point) :y (:y merge-point)))) - cmd)))] - (->> content - (mapv replace-command)))) - -(defn merge-nodes - "Reduces the continguous segments in points to a single point" - [content points] - (let [point->merge-point (-> content - (get-segments points) - (group-segments) - (calculate-merge-points points))] - (-> content - (separate-nodes points) - (replace-points point->merge-point)))) - diff --git a/frontend/src/app/util/a2c.js b/frontend/src/app/util/path/arc_to_curve.js similarity index 98% rename from frontend/src/app/util/a2c.js rename to frontend/src/app/util/path/arc_to_curve.js index 62c3dcae91..a4aa02f853 100644 --- a/frontend/src/app/util/a2c.js +++ b/frontend/src/app/util/path/arc_to_curve.js @@ -10,11 +10,11 @@ "use strict"; -goog.provide("app.util.a2c"); +goog.provide("app.util.path.arc_to_curve"); // https://raw.githubusercontent.com/fontello/svgpath/master/lib/a2c.js goog.scope(function() { - const self = app.util.a2c; + const self = app.util.path.arc_to_curve; var TAU = Math.PI * 2; diff --git a/frontend/src/app/util/path/commands.cljs b/frontend/src/app/util/path/commands.cljs new file mode 100644 index 0000000000..7d933991ad --- /dev/null +++ b/frontend/src/app/util/path/commands.cljs @@ -0,0 +1,147 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.path.commands + (:require + [app.common.data :as d] + [app.common.geom.point :as gpt] + [app.common.geom.shapes.path :as gshp] + [app.util.svg :as usvg] + [cuerdas.core :as str] + [clojure.set :as set] + [app.common.math :as mth])) + +(defn command->point + ([prev-pos {:keys [relative params] :as command}] + (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params] + (if relative + (-> prev-pos (update :x + x) (update :y + y)) + (command->point command)))) + + ([command] + (when-not (nil? command) + (let [{{:keys [x y]} :params} command] + (gpt/point x y))))) + + +(defn make-move-to [to] + {:command :move-to + :relative false + :params {:x (:x to) + :y (:y to)}}) + +(defn make-line-to [to] + {:command :line-to + :relative false + :params {:x (:x to) + :y (:y to)}}) + +(defn make-curve-params + ([point] + (make-curve-params point point point)) + + ([point handler] (make-curve-params point handler point)) + + ([point h1 h2] + {:x (:x point) + :y (:y point) + :c1x (:x h1) + :c1y (:y h1) + :c2x (:x h2) + :c2y (:y h2)})) + +(defn make-curve-to [to h1 h2] + {:command :curve-to + :relative false + :params (make-curve-params to h1 h2)}) + +(defn apply-content-modifiers [content modifiers] + (letfn [(apply-to-index [content [index params]] + (if (contains? content index) + (cond-> content + (and + (or (:c1x params) (:c1y params) (:c2x params) (:c2y params)) + (= :line-to (get-in content [index :params :command]))) + (-> (assoc-in [index :command] :curve-to) + (assoc-in [index :params] :curve-to) (make-curve-params + (get-in content [index :params]) + (get-in content [(dec index) :params]))) + + (:x params) (update-in [index :params :x] + (:x params)) + (:y params) (update-in [index :params :y] + (:y params)) + + (:c1x params) (update-in [index :params :c1x] + (:c1x params)) + (:c1y params) (update-in [index :params :c1y] + (:c1y params)) + + (:c2x params) (update-in [index :params :c2x] + (:c2x params)) + (:c2y params) (update-in [index :params :c2y] + (:c2y params))) + content))] + (let [content (if (vector? content) content (into [] content))] + (reduce apply-to-index content modifiers)))) + + +(defn get-handler [{:keys [params] :as command} prefix] + (let [cx (d/prefix-keyword prefix :x) + cy (d/prefix-keyword prefix :y)] + (when (and command + (contains? params cx) + (contains? params cy)) + (gpt/point (get params cx) + (get params cy))))) + +(defn content->handlers + "Retrieve a map where for every point will retrieve a list of + the handlers that are associated with that point. + point -> [[index, prefix]]" + [content] + (->> (d/with-prev content) + (d/enumerate) + (mapcat (fn [[index [cur-cmd pre-cmd]]] + (if (and pre-cmd (= :curve-to (:command cur-cmd))) + (let [cur-pos (command->point cur-cmd) + pre-pos (command->point pre-cmd)] + (-> [[pre-pos [index :c1]] + [cur-pos [index :c2]]])) + []))) + + (group-by first) + (d/mapm #(mapv second %2)))) + +(defn point-indices + [content point] + (->> (d/enumerate content) + (filter (fn [[_ cmd]] (= point (command->point cmd)))) + (mapv (fn [[index _]] index)))) + +(defn handler-indices + [content point] + (->> (d/with-prev content) + (d/enumerate) + (mapcat (fn [[index [cur-cmd pre-cmd]]] + (if (and (some? pre-cmd) (= :curve-to (:command cur-cmd))) + (let [cur-pos (command->point cur-cmd) + pre-pos (command->point pre-cmd)] + (cond-> [] + (= pre-pos point) (conj [index :c1]) + (= cur-pos point) (conj [index :c2]))) + []))))) + +(defn opposite-index + "Calculate sthe opposite index given a prefix and an index" + [content index prefix] + (let [point (if (= prefix :c2) + (command->point (nth content index)) + (command->point (nth content (dec index)))) + + handlers (-> (content->handlers content) + (get point)) + + opposite-prefix (if (= prefix :c1) :c2 :c1)] + (when (<= (count handlers) 2) + (->> handlers + (d/seek (fn [[index prefix]] (= prefix opposite-prefix))) + (first))))) + diff --git a/frontend/src/app/util/path/format.cljs b/frontend/src/app/util/path/format.cljs new file mode 100644 index 0000000000..8728033b87 --- /dev/null +++ b/frontend/src/app/util/path/format.cljs @@ -0,0 +1,74 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.path.format + (:require + [app.common.data :as d] + [app.common.geom.point :as gpt] + [app.common.geom.shapes.path :as gshp] + [app.util.svg :as usvg] + [cuerdas.core :as str] + [clojure.set :as set] + [app.common.math :as mth] + )) + +(defn command->param-list [command] + (let [params (:params command)] + (case (:command command) + (:move-to :line-to :smooth-quadratic-bezier-curve-to) + (str (:x params) "," + (:y params)) + + :close-path + "" + + (:line-to-horizontal :line-to-vertical) + (str (:value params)) + + :curve-to + (str (:c1x params) "," + (:c1y params) "," + (:c2x params) "," + (:c2y params) "," + (:x params) "," + (:y params)) + + (:smooth-curve-to :quadratic-bezier-curve-to) + (str (:cx params) "," + (:cy params) "," + (:x params) "," + (:y params)) + + :elliptical-arc + (str (:rx params) "," + (:ry params) "," + (:x-axis-rotation params) "," + (:large-arc-flag params) "," + (:sweep-flag params) "," + (:x params) "," + (:y params))))) + +(defn command->string [{:keys [command relative params] :as entry}] + (let [command-str (case command + :move-to "M" + :close-path "Z" + :line-to "L" + :line-to-horizontal "H" + :line-to-vertical "V" + :curve-to "C" + :smooth-curve-to "S" + :quadratic-bezier-curve-to "Q" + :smooth-quadratic-bezier-curve-to "T" + :elliptical-arc "A") + command-str (if relative (str/lower command-str) command-str) + param-list (command->param-list entry)] + (str command-str param-list))) + + +(defn format-path [content] + (->> content + (mapv command->string) + (str/join ""))) diff --git a/frontend/src/app/util/path/geom.cljs b/frontend/src/app/util/path/geom.cljs new file mode 100644 index 0000000000..af99972ee2 --- /dev/null +++ b/frontend/src/app/util/path/geom.cljs @@ -0,0 +1,60 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.path.geom + (:require + [app.common.data :as d] + [app.common.geom.point :as gpt] + [app.common.geom.shapes.path :as gshp] + [app.util.svg :as usvg] + [cuerdas.core :as str] + [clojure.set :as set] + [app.common.math :as mth] + [app.util.path.commands :as upc])) + +(defn calculate-opposite-handler + "Given a point and its handler, gives the symetric handler" + [point handler] + (let [handler-vector (gpt/to-vec point handler)] + (gpt/add point (gpt/negate handler-vector)))) + +(defn split-line-to [from-p cmd val] + (let [to-p (upc/command->point cmd) + sp (gpt/line-val from-p to-p val)] + [(upc/make-line-to sp) cmd])) + +(defn split-curve-to [from-p cmd val] + (let [params (:params cmd) + end (gpt/point (:x params) (:y params)) + h1 (gpt/point (:c1x params) (:c1y params)) + h2 (gpt/point (:c2x params) (:c2y params)) + [[_ to1 h11 h21] + [_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 val)] + [(upc/make-curve-to to1 h11 h21) + (upc/make-curve-to to2 h12 h22)])) + +(defn opposite-handler + "Calculates the coordinates of the opposite handler" + [point handler] + (let [phv (gpt/to-vec point handler)] + (gpt/add point (gpt/negate phv)))) + +(defn opposite-handler-keep-distance + "Calculates the coordinates of the opposite handler but keeping the old distance" + [point handler old-opposite] + (let [old-distance (gpt/distance point old-opposite) + phv (gpt/to-vec point handler) + phv2 (gpt/multiply + (gpt/unit (gpt/negate phv)) + (gpt/point old-distance))] + (gpt/add point phv2))) + +(defn content->points [content] + (->> content + (map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y)))) + (remove nil?) + (into []))) + diff --git a/frontend/src/app/util/path/parser.cljs b/frontend/src/app/util/path/parser.cljs new file mode 100644 index 0000000000..09f491555a --- /dev/null +++ b/frontend/src/app/util/path/parser.cljs @@ -0,0 +1,317 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.path.parser + (:require + [app.common.data :as d] + [app.common.geom.point :as gpt] + [app.common.geom.shapes.path :as gshp] + [app.util.path.arc-to-curve :refer [a2c]] + [app.util.path.commands :as upc] + [app.util.svg :as usvg] + [cuerdas.core :as str] + [clojure.set :as set] + [app.common.math :as mth] + [app.util.path.geom :as upg] + )) + +;; +(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 usvg/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 + (not (empty? 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]])] + + (d/concat [{: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" [cmd] + [{: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. Necesary for relative commands + ;; prev-start : previous move-to necesary 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)) + (d/concat 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-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] + (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)))) + diff --git a/frontend/src/app/util/geom/path_impl_simplify.js b/frontend/src/app/util/path/path_impl_simplify.js similarity index 96% rename from frontend/src/app/util/geom/path_impl_simplify.js rename to frontend/src/app/util/path/path_impl_simplify.js index 12fe81c8db..2ceb4a3782 100644 --- a/frontend/src/app/util/geom/path_impl_simplify.js +++ b/frontend/src/app/util/path/path_impl_simplify.js @@ -11,10 +11,10 @@ "use strict"; -goog.provide("app.util.geom.path_impl_simplify"); +goog.provide("app.util.path.path_impl_simplify"); goog.scope(function() { - const self = app.util.geom.path_impl_simplify; + const self = app.util.path.path_impl_simplify; // square distance between 2 points function getSqDist(p1, p2) { diff --git a/frontend/src/app/util/path/simplify_curve.cljs b/frontend/src/app/util/path/simplify_curve.cljs new file mode 100644 index 0000000000..c3a400a118 --- /dev/null +++ b/frontend/src/app/util/path/simplify_curve.cljs @@ -0,0 +1,24 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.path.simplify-curve + (:require + [app.common.data :as d] + [app.common.geom.point :as gpt] + [app.common.geom.shapes.path :as gshp] + [app.util.path.path-impl-simplify :as impl-simplify] + [app.util.svg :as usvg] + [cuerdas.core :as str] + [clojure.set :as set] + [app.common.math :as mth])) + +(defn simplify + "Simplifies a drawing done with the pen tool" + ([points] + (simplify points 0.1)) + ([points tolerance] + (let [points (into-array points)] + (into [] (impl-simplify/simplify points tolerance true))))) diff --git a/frontend/src/app/util/path/tools.cljs b/frontend/src/app/util/path/tools.cljs new file mode 100644 index 0000000000..8224d4c9c9 --- /dev/null +++ b/frontend/src/app/util/path/tools.cljs @@ -0,0 +1,385 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) UXBOX Labs SL + +(ns app.util.path.tools + (:require + [app.common.data :as d] + [app.common.geom.point :as gpt] + [app.common.geom.shapes.path :as gshp] + [app.util.svg :as usvg] + [cuerdas.core :as str] + [clojure.set :as set] + [app.common.math :as mth] + [app.util.path.commands :as upc] + [app.util.path.geom :as upg] + )) + +(defn remove-line-curves + "Remove all curves that have both handlers in the same position that the + beggining and end points. This makes them really line-to commands" + [content] + (let [with-prev (d/enumerate (d/with-prev content)) + process-command + (fn [content [index [command prev]]] + + (let [cur-point (upc/command->point command) + pre-point (upc/command->point prev) + handler-c1 (upc/get-handler command :c1) + handler-c2 (upc/get-handler command :c2)] + (if (and (= :curve-to (:command command)) + (= cur-point handler-c2) + (= pre-point handler-c1)) + (assoc content index {:command :line-to + :params cur-point}) + content)))] + + (reduce process-command content with-prev))) + +(defn make-corner-point + "Changes the content to make a point a 'corner'" + [content point] + (let [handlers (-> (upc/content->handlers content) + (get point)) + change-content + (fn [content [index prefix]] + (let [cx (d/prefix-keyword prefix :x) + cy (d/prefix-keyword prefix :y)] + (-> content + (assoc-in [index :params cx] (:x point)) + (assoc-in [index :params cy] (:y point)))))] + (as-> content $ + (reduce change-content $ handlers) + (remove-line-curves $)))) + +(defn make-curve-point + "Changes the content to make the point a 'curve'. The handlers will be positioned + in the same vector that results from te previous->next points but with fixed length." + [content point] + (let [content-next (d/enumerate (d/with-prev-next content)) + + make-curve + (fn [command previous] + (if (= :line-to (:command command)) + (let [cur-point (upc/command->point command) + pre-point (upc/command->point previous)] + (-> command + (assoc :command :curve-to) + (assoc :params (upc/make-curve-params cur-point pre-point)))) + command)) + + update-handler + (fn [command prefix handler] + (if (= :curve-to (:command command)) + (let [cx (d/prefix-keyword prefix :x) + cy (d/prefix-keyword prefix :y)] + (-> command + (assoc-in [:params cx] (:x handler)) + (assoc-in [:params cy] (:y handler)))) + command)) + + calculate-vector + (fn [point next prev] + (let [base-vector (if (or (nil? next) (nil? prev) (= next prev)) + (-> (gpt/to-vec point (or next prev)) + (gpt/normal-left)) + (gpt/to-vec next prev))] + (-> base-vector + (gpt/unit) + (gpt/multiply (gpt/point 100))))) + + redfn (fn [content [index [command prev next]]] + (if (= point (upc/command->point command)) + (let [prev-point (if (= :move-to (:command command)) nil (upc/command->point prev)) + next-point (if (= :move-to (:command next)) nil (upc/command->point next)) + handler-vector (calculate-vector point next-point prev-point) + handler (gpt/add point handler-vector) + handler-opposite (gpt/add point (gpt/negate handler-vector))] + (-> content + (d/update-when index make-curve prev) + (d/update-when index update-handler :c2 handler) + (d/update-when (inc index) make-curve command) + (d/update-when (inc index) update-handler :c1 handler-opposite))) + + content))] + (as-> content $ + (reduce redfn $ content-next) + (remove-line-curves $)))) + +(defn get-segments + "Given a content and a set of points return all the segments in the path + that uses the points" + [content points] + (let [point-set (set points)] + + (loop [segments [] + prev-point nil + start-point nil + cur-cmd (first content) + content (rest content)] + + (let [;; Close-path makes a segment from the last point to the initial path point + cur-point (if (= :close-path (:command cur-cmd)) + start-point + (upc/command->point cur-cmd)) + + ;; If there is a move-to we don't have a segment + prev-point (if (= :move-to (:command cur-cmd)) + nil + prev-point) + + ;; We update the start point + start-point (if (= :move-to (:command cur-cmd)) + cur-point + start-point) + + is-segment? (and (some? prev-point) + (contains? point-set prev-point) + (contains? point-set cur-point)) + + segments (cond-> segments + is-segment? + (conj [prev-point cur-point cur-cmd]))] + + (if (some? cur-cmd) + (recur segments + cur-point + start-point + (first content) + (rest content)) + + segments))))) + +(defn split-segments + "Given a content creates splits commands between points with new segments" + [content points value] + (let [split-command + (fn [[start end cmd]] + (case (:command cmd) + :line-to [cmd (upg/split-line-to start cmd value)] + :curve-to [cmd (upg/split-curve-to start cmd value)] + :close-path [cmd [(upc/make-line-to (gpt/line-val start end value)) cmd]] + nil)) + + cmd-changes + (->> (get-segments content points) + (into {} (comp (map split-command) + (filter (comp not nil?))))) + + process-segments + (fn [command] + (if (contains? cmd-changes command) + (get cmd-changes command) + [command]))] + + (into [] (mapcat process-segments) content))) + +(defn remove-nodes + "Removes from content the points given. Will try to reconstruct the paths + to keep everything consistent" + [content points] + + (let [content (d/with-prev content)] + + (loop [result [] + last-handler nil + [cur-cmd prev-cmd] (first content) + content (rest content)] + + (if (nil? cur-cmd) + ;; The result with be an array of arrays were every entry is a subpath + (->> result + ;; remove empty and only 1 node subpaths + (filter #(> (count %) 1)) + ;; flatten array-of-arrays plain array + (flatten) + (into [])) + + (let [move? (= :move-to (:command cur-cmd)) + curve? (= :curve-to (:command cur-cmd)) + + ;; When the old command was a move we start a subpath + result (if move? (conj result []) result) + + subpath (peek result) + + point (upc/command->point cur-cmd) + + old-prev-point (upc/command->point prev-cmd) + new-prev-point (upc/command->point (peek subpath)) + + remove? (contains? points point) + + + ;; We store the first handler for the first curve to be removed to + ;; use it for the first handler of the regenerated path + cur-handler (cond + (and (not last-handler) remove? curve?) + (select-keys (:params cur-cmd) [:c1x :c1y]) + + (not remove?) + nil + + :else + last-handler) + + cur-cmd (cond-> cur-cmd + ;; If we're starting a subpath and it's not a move make it a move + (and (not move?) (empty? subpath)) + (assoc :command :move-to + :params (select-keys (:params cur-cmd) [:x :y])) + + ;; If have a curve the first handler will be relative to the previous + ;; point. We change the handler to the new previous point + (and curve? (not (empty? subpath)) (not= old-prev-point new-prev-point)) + (update :params merge last-handler)) + + head-idx (dec (count result)) + + result (cond-> result + (not remove?) + (update head-idx conj cur-cmd))] + (recur result + cur-handler + (first content) + (rest content))))))) + +(defn join-nodes + "Creates new segments between points that weren't previously" + [content points] + + (let [segments-set (into #{} + (map (fn [[p1 p2 _]] [p1 p2])) + (get-segments content points)) + + create-line-command (fn [point other] + [(upc/make-move-to point) + (upc/make-line-to other)]) + + not-segment? (fn [point other] (and (not (contains? segments-set [point other])) + (not (contains? segments-set [other point])))) + + new-content (->> (d/map-perm create-line-command not-segment? points) + (flatten) + (into []))] + + (d/concat content new-content))) + + +(defn separate-nodes + "Removes the segments between the points given" + [content points] + + (let [content (d/with-prev content)] + (loop [result [] + [cur-cmd prev-cmd] (first content) + content (rest content)] + + (if (nil? cur-cmd) + (->> result + (filter #(> (count %) 1)) + (flatten) + (into [])) + + (let [prev-point (upc/command->point prev-cmd) + cur-point (upc/command->point cur-cmd) + + cur-cmd (cond-> cur-cmd + (and (contains? points prev-point) + (contains? points cur-point)) + + (assoc :command :move-to + :params (select-keys (:params cur-cmd) [:x :y]))) + + move? (= :move-to (:command cur-cmd)) + + result (if move? (conj result []) result) + head-idx (dec (count result)) + + result (-> result + (update head-idx conj cur-cmd))] + (recur result + (first content) + (rest content))))))) + + +(defn- add-to-set + "Given a list of sets adds the value to the target set" + [set-list target value] + (->> set-list + (mapv (fn [it] + (cond-> it + (= it target) (conj value)))))) + +(defn- join-sets + "Given a list of sets join two sets in the list into a new one" + [set-list target other] + (conj (->> set-list + (filterv #(and (not= % target) + (not= % other)))) + (set/union target other))) + +(defn group-segments [segments] + (loop [result [] + [point-a point-b :as segment] (first segments) + segments (rest segments)] + + (if (nil? segment) + result + + (let [set-a (d/seek #(contains? % point-a) result) + set-b (d/seek #(contains? % point-b) result) + + result (cond-> result + (and (nil? set-a) (nil? set-b)) + (conj #{point-a point-b}) + + (and (some? set-a) (nil? set-b)) + (add-to-set set-a point-b) + + (and (nil? set-a) (some? set-b)) + (add-to-set set-b point-a) + + (and (some? set-a) (some? set-b) (not= set-a set-b)) + (join-sets set-a set-b))] + (recur result + (first segments) + (rest segments)))))) + +(defn calculate-merge-points [group-segments points] + (let [index-merge-point (fn [group] (vector group (-> (gpt/center-points group) + (update :x mth/round) + (update :y mth/round)))) + index-group (fn [point] (vector point (d/seek #(contains? % point) group-segments))) + + group->merge-point (into {} (map index-merge-point) group-segments) + point->group (into {} (map index-group) points)] + (d/mapm #(group->merge-point %2) point->group))) + +;; TODO: Improve the replace for curves +(defn replace-points + "Replaces the points in a path for its merge-point" + [content point->merge-point] + (let [replace-command + (fn [cmd] + (let [point (upc/command->point cmd)] + (if (contains? point->merge-point point) + (let [merge-point (get point->merge-point point)] + (-> cmd (update :params assoc :x (:x merge-point) :y (:y merge-point)))) + cmd)))] + (->> content + (mapv replace-command)))) + +(defn merge-nodes + "Reduces the continguous segments in points to a single point" + [content points] + (let [point->merge-point (-> content + (get-segments points) + (group-segments) + (calculate-merge-points points))] + (-> content + (separate-nodes points) + (replace-points point->merge-point)))) +