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

♻️ Refactor path utils

Browse source
This commit is contained in:
alonso.torres 2021-04-16 14:06:32 +02:00
parent 0455aaa4cd
commit de11e85d2b
21 changed files with 1076 additions and 980 deletions
Download patch file Download diff file Expand all files Collapse all files

5
frontend/src/app/main/data/workspace/drawing/curve.cljs
View file

@ -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))))))

15
frontend/src/app/main/data/workspace/path/drawing.cljs
View file

@ -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])

32
frontend/src/app/main/data/workspace/path/edition.cljs
View file

@ -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]

6
frontend/src/app/main/data/workspace/path/helpers.cljs
View file

@ -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

4
frontend/src/app/main/data/workspace/path/streams.cljs
View file

@ -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

16
frontend/src/app/main/data/workspace/path/tools.cljs
View file

@ -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

4
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -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))

5
frontend/src/app/main/ui/shapes/path.cljs
View file

@ -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"}])))

4
frontend/src/app/main/ui/workspace/shapes/path.cljs
View file

@ -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")}

24
frontend/src/app/main/ui/workspace/shapes/path/editor.cljs
View file

@ -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 #{}))

4
frontend/src/app/main/ui/workspace/viewport/outline.cljs
View file

@ -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

5
frontend/src/app/main/ui/workspace/viewport/path_actions.cljs
View file

@ -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?

917
frontend/src/app/util/geom/path.cljs
View file

@ -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))))

4
frontend/src/app/util/a2c.js → frontend/src/app/util/path/arc_to_curve.js
View file

@ -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;

147
frontend/src/app/util/path/commands.cljs Normal file
View file

@ -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)))))

74
frontend/src/app/util/path/format.cljs Normal file
View file

@ -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 "")))

60
frontend/src/app/util/path/geom.cljs Normal file
View file

@ -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 [])))

317
frontend/src/app/util/path/parser.cljs Normal file
View file

@ -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))))

4
frontend/src/app/util/geom/path_impl_simplify.js → frontend/src/app/util/path/path_impl_simplify.js
View file

@ -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) {

24
frontend/src/app/util/path/simplify_curve.cljs Normal file
View file

@ -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)))))

385
frontend/src/app/util/path/tools.cljs Normal file
View file

@ -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))))