mirror of
https://github.com/penpot/penpot.git
synced 2025-05-27 21:26:13 +02:00
✨ Updates selrects, groups to path
This commit is contained in:
parent
1db2895606
commit
6fd35ae5d9
28 changed files with 327 additions and 239 deletions
|
@ -10,6 +10,7 @@
|
|||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.pages :as cp]
|
||||
[app.common.pages.changes-builder :as cb]
|
||||
[app.common.path.shapes-to-path :as stp]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.main.data.workspace.changes :as dch]
|
||||
[app.main.data.workspace.common :as dwc]
|
||||
|
@ -18,24 +19,6 @@
|
|||
[cuerdas.core :as str]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
(def ^:const style-properties
|
||||
[:fill-color
|
||||
:fill-opacity
|
||||
:fill-color-gradient
|
||||
:fill-color-ref-file
|
||||
:fill-color-ref-id
|
||||
:stroke-color
|
||||
:stroke-color-ref-file
|
||||
:stroke-color-ref-id
|
||||
:stroke-opacity
|
||||
:stroke-style
|
||||
:stroke-width
|
||||
:stroke-alignment
|
||||
:stroke-cap-start
|
||||
:stroke-cap-end
|
||||
:shadow
|
||||
:blur])
|
||||
|
||||
(defn selected-shapes
|
||||
[state]
|
||||
(let [objects (wsh/lookup-page-objects state)]
|
||||
|
@ -47,10 +30,10 @@
|
|||
(sort-by ::index))))
|
||||
|
||||
(defn create-bool-data
|
||||
[type name shapes]
|
||||
(let [head (first shapes)
|
||||
head-data (select-keys head style-properties)
|
||||
selrect (gsh/selection-rect shapes)]
|
||||
[type name shapes objects]
|
||||
(let [shapes (mapv #(stp/convert-to-path % objects) shapes)
|
||||
head (first shapes)
|
||||
head-data (select-keys head stp/style-properties)]
|
||||
(-> {:id (uuid/next)
|
||||
:type :bool
|
||||
:bool-type type
|
||||
|
@ -60,7 +43,7 @@
|
|||
::index (::index head)
|
||||
:shapes []}
|
||||
(merge head-data)
|
||||
(gsh/setup selrect))))
|
||||
(gsh/update-bool-selrect shapes objects))))
|
||||
|
||||
(defn create-bool
|
||||
[bool-type]
|
||||
|
@ -69,14 +52,14 @@
|
|||
|
||||
(watch [it state _]
|
||||
(let [page-id (:current-page-id state)
|
||||
objects (wsh/lookup-page-objects state page-id)
|
||||
objects (wsh/lookup-page-objects state)
|
||||
base-name (-> bool-type d/name str/capital (str "-1"))
|
||||
name (-> (dwc/retrieve-used-names objects)
|
||||
(dwc/generate-unique-name base-name))
|
||||
shapes (selected-shapes state)]
|
||||
|
||||
(when-not (empty? shapes)
|
||||
(let [boolean-data (create-bool-data bool-type name shapes)
|
||||
(let [boolean-data (create-bool-data bool-type name shapes objects)
|
||||
shape-id (:id boolean-data)
|
||||
changes (-> (cb/empty-changes it page-id)
|
||||
(cb/add-obj boolean-data)
|
||||
|
|
|
@ -7,7 +7,10 @@
|
|||
(ns app.main.data.workspace.path.drawing
|
||||
(:require
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.pages :as cp]
|
||||
[app.common.path.commands :as upc]
|
||||
[app.common.path.shapes-to-path :as upsp]
|
||||
[app.common.spec :as us]
|
||||
[app.main.data.workspace.changes :as dch]
|
||||
[app.main.data.workspace.common :as dwc]
|
||||
|
@ -21,9 +24,6 @@
|
|||
[app.main.data.workspace.path.undo :as undo]
|
||||
[app.main.data.workspace.state-helpers :as wsh]
|
||||
[app.main.streams :as ms]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.geom :as upg]
|
||||
[app.util.path.shapes-to-path :as upsp]
|
||||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
|
|
|
@ -8,6 +8,10 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.path.commands :as upc]
|
||||
[app.common.path.shapes-to-path :as upsp]
|
||||
[app.common.path.subpaths :as ups]
|
||||
[app.main.data.workspace.changes :as dch]
|
||||
[app.main.data.workspace.common :as dwc]
|
||||
[app.main.data.workspace.path.changes :as changes]
|
||||
|
@ -19,10 +23,6 @@
|
|||
[app.main.data.workspace.path.undo :as undo]
|
||||
[app.main.data.workspace.state-helpers :as wsh]
|
||||
[app.main.streams :as ms]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.geom :as upg]
|
||||
[app.util.path.shapes-to-path :as upsp]
|
||||
[app.util.path.subpaths :as ups]
|
||||
[app.util.path.tools :as upt]
|
||||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]))
|
||||
|
|
|
@ -10,10 +10,10 @@
|
|||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.math :as mth]
|
||||
[app.common.path.commands :as upc]
|
||||
[app.common.path.subpaths :as ups]
|
||||
[app.main.data.workspace.path.common :as common]
|
||||
[app.main.streams :as ms]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.subpaths :as ups]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
(defn end-path-event? [event]
|
||||
|
|
|
@ -0,0 +1,21 @@
|
|||
;; 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.main.data.workspace.path.shapes-to-path
|
||||
(:require
|
||||
[app.common.path.shapes-to-path :as upsp]
|
||||
[app.main.data.workspace.changes :as dch]
|
||||
[app.main.data.workspace.state-helpers :as wsh]
|
||||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
(defn convert-selected-to-path []
|
||||
(ptk/reify ::convert-selected-to-path
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [objects (wsh/lookup-page-objects state)
|
||||
selected (wsh/lookup-selected state)]
|
||||
(rx/of (dch/update-shapes selected #(upsp/convert-to-path % objects)))))))
|
|
@ -7,7 +7,7 @@
|
|||
(ns app.main.data.workspace.path.state
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.util.path.shapes-to-path :as upsp]))
|
||||
[app.common.path.shapes-to-path :as upsp]))
|
||||
|
||||
(defn get-path-id
|
||||
"Retrieves the currently editing path id"
|
||||
|
@ -31,7 +31,8 @@
|
|||
[state & ks]
|
||||
(let [path-loc (get-path-location state)
|
||||
shape (-> (get-in state path-loc)
|
||||
(upsp/convert-to-path))]
|
||||
;; Empty map because we know the current shape will not have children
|
||||
(upsp/convert-to-path {}))]
|
||||
|
||||
(if (empty? ks)
|
||||
shape
|
||||
|
|
|
@ -7,12 +7,12 @@
|
|||
(ns app.main.data.workspace.path.streams
|
||||
(:require
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.math :as mth]
|
||||
[app.main.data.workspace.path.state :as state]
|
||||
[app.main.snap :as snap]
|
||||
[app.main.store :as st]
|
||||
[app.main.streams :as ms]
|
||||
[app.util.path.geom :as upg]
|
||||
[beicon.core :as rx]
|
||||
[okulary.core :as l]
|
||||
[potok.core :as ptk]))
|
||||
|
|
|
@ -6,13 +6,13 @@
|
|||
|
||||
(ns app.main.data.workspace.path.tools
|
||||
(:require
|
||||
[app.common.path.shapes-to-path :as upsp]
|
||||
[app.common.path.subpaths :as ups]
|
||||
[app.main.data.workspace.changes :as dch]
|
||||
[app.main.data.workspace.common :as dwc]
|
||||
[app.main.data.workspace.path.changes :as changes]
|
||||
[app.main.data.workspace.path.state :as st]
|
||||
[app.main.data.workspace.state-helpers :as wsh]
|
||||
[app.util.path.shapes-to-path :as upsp]
|
||||
[app.util.path.subpaths :as ups]
|
||||
[app.util.path.tools :as upt]
|
||||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]))
|
||||
|
|
|
@ -243,16 +243,34 @@
|
|||
|
||||
([ids {:keys [with-modifiers?]
|
||||
:or { with-modifiers? false }}]
|
||||
(l/derived (fn [state]
|
||||
(let [objects (wsh/lookup-page-objects state)
|
||||
modifiers (:workspace-modifiers state)
|
||||
objects (cond-> objects
|
||||
with-modifiers?
|
||||
(gsh/merge-modifiers modifiers))
|
||||
xform (comp (map #(get objects %))
|
||||
(remove nil?))]
|
||||
(into [] xform ids)))
|
||||
st/state =)))
|
||||
(let [selector
|
||||
(fn [state]
|
||||
(let [objects (wsh/lookup-page-objects state)
|
||||
modifiers (:workspace-modifiers state)
|
||||
objects (cond-> objects
|
||||
with-modifiers?
|
||||
(gsh/merge-modifiers modifiers))
|
||||
xform (comp (map #(get objects %))
|
||||
(remove nil?))]
|
||||
(into [] xform ids)))]
|
||||
(l/derived selector st/state =))))
|
||||
|
||||
(defn select-children [id]
|
||||
(let [selector
|
||||
(fn [state]
|
||||
(let [objects (wsh/lookup-page-objects state)
|
||||
children (cp/select-children id objects)
|
||||
modifiers (-> (:workspace-modifiers state))
|
||||
|
||||
{selected :selected disp-modifiers :modifiers}
|
||||
(-> (:workspace-local state)
|
||||
(select-keys [:modifiers :selected]))
|
||||
|
||||
modifiers (merge modifiers
|
||||
(into #{} (map #(vector % disp-modifiers)) selected))]
|
||||
|
||||
(gsh/merge-modifiers children modifiers)))]
|
||||
(l/derived selector st/state =)))
|
||||
|
||||
(def selected-data
|
||||
(l/derived #(let [selected (wsh/lookup-selected %)
|
||||
|
|
|
@ -6,11 +6,10 @@
|
|||
|
||||
(ns app.main.ui.shapes.bool
|
||||
(:require
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.path.bool :as pb]
|
||||
[app.common.path.shapes-to-path :as stp]
|
||||
[app.main.ui.hooks :refer [use-equal-memo]]
|
||||
[app.util.object :as obj]
|
||||
[app.util.path.bool :as pb]
|
||||
[app.util.path.shapes-to-path :as stp]
|
||||
[rumext.alpha :as mf]))
|
||||
|
||||
(defn bool-shape
|
||||
|
@ -20,32 +19,25 @@
|
|||
[props]
|
||||
(let [frame (obj/get props "frame")
|
||||
shape (obj/get props "shape")
|
||||
childs (obj/get props "childs")]
|
||||
childs (obj/get props "childs")
|
||||
|
||||
(when (> (count childs) 1)
|
||||
(let [shape-1 (stp/convert-to-path (nth childs 0))
|
||||
shape-2 (stp/convert-to-path (nth childs 1))
|
||||
childs (use-equal-memo childs)
|
||||
|
||||
content-1 (use-equal-memo (-> shape-1 gsh/transform-shape :content))
|
||||
content-2 (use-equal-memo (-> shape-2 gsh/transform-shape :content))
|
||||
bool-content
|
||||
(mf/use-memo
|
||||
(mf/deps childs)
|
||||
(fn []
|
||||
(->> shape
|
||||
:shapes
|
||||
(map #(get childs %))
|
||||
(map #(stp/convert-to-path % childs))
|
||||
(mapv :content)
|
||||
(pb/content-bool (:bool-type shape)))))]
|
||||
|
||||
content
|
||||
(mf/use-memo
|
||||
(mf/deps content-1 content-2)
|
||||
#(pb/content-bool (:bool-type shape) content-1 content-2))]
|
||||
|
||||
[:*
|
||||
[:& shape-wrapper {:shape (-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content content))
|
||||
:frame frame}]
|
||||
|
||||
#_[:g
|
||||
(for [point (app.util.path.geom/content->points content)]
|
||||
[:circle {:cx (:x point)
|
||||
:cy (:y point)
|
||||
:r 1
|
||||
:style {:fill "blue"}}])]])))))
|
||||
[:& shape-wrapper {:shape (-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content bool-content))
|
||||
:frame frame}])))
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -10,6 +10,7 @@
|
|||
[app.main.data.modal :as modal]
|
||||
[app.main.data.workspace :as dw]
|
||||
[app.main.data.workspace.libraries :as dwl]
|
||||
[app.main.data.workspace.path.shapes-to-path :as dwpe]
|
||||
[app.main.data.workspace.shortcuts :as sc]
|
||||
[app.main.data.workspace.undo :as dwu]
|
||||
[app.main.refs :as refs]
|
||||
|
@ -147,6 +148,7 @@
|
|||
do-boolean-difference (st/emitf (dw/create-bool :difference))
|
||||
do-boolean-intersection (st/emitf (dw/create-bool :intersection))
|
||||
do-boolean-exclude (st/emitf (dw/create-bool :exclude))
|
||||
do-transform-to-path (st/emitf (dwpe/convert-selected-to-path))
|
||||
]
|
||||
[:*
|
||||
[:& menu-entry {:title (tr "workspace.shape.menu.copy")
|
||||
|
@ -214,6 +216,9 @@
|
|||
:shortcut (sc/get-tooltip :start-editing)
|
||||
:on-click do-start-editing}])
|
||||
|
||||
[:& menu-entry {:title "Transform to path"
|
||||
:on-click do-transform-to-path}]
|
||||
|
||||
[:& menu-entry {:title (tr "workspace.shape.menu.path")}
|
||||
[:& menu-entry {:title (tr "workspace.shape.menu.union")
|
||||
:shortcut (sc/get-tooltip :boolean-union)
|
||||
|
@ -230,8 +235,7 @@
|
|||
|
||||
[:& menu-separator]
|
||||
;; TODO
|
||||
[:& menu-entry {:title "Flatten"}]
|
||||
[:& menu-entry {:title "Transform to path"}]]
|
||||
[:& menu-entry {:title "Flatten"}]]
|
||||
|
||||
(if (:hidden shape)
|
||||
[:& menu-entry {:title (tr "workspace.shape.menu.show")
|
||||
|
|
|
@ -33,17 +33,11 @@
|
|||
(let [shape (unchecked-get props "shape")
|
||||
frame (unchecked-get props "frame")
|
||||
|
||||
childs-ref (mf/use-memo (mf/deps shape) #(refs/objects-by-id (:shapes shape) {:with-modifiers? true}))
|
||||
{:keys [selected modifiers]} (mf/deref refs/local-displacement)
|
||||
childs-ref (mf/use-memo
|
||||
(mf/deps (:id shape))
|
||||
#(refs/select-children (:id shape)))
|
||||
|
||||
add-modifiers
|
||||
(fn [{:keys [id] :as shape}]
|
||||
(cond-> shape
|
||||
(contains? selected id)
|
||||
(update :modifiers merge modifiers)))
|
||||
|
||||
childs (->> (mf/deref childs-ref)
|
||||
(mapv add-modifiers))]
|
||||
childs (mf/deref childs-ref)]
|
||||
|
||||
[:> shape-container {:shape shape}
|
||||
[:& shape-component
|
||||
|
|
|
@ -6,11 +6,11 @@
|
|||
|
||||
(ns app.main.ui.workspace.shapes.path
|
||||
(:require
|
||||
[app.common.path.commands :as upc]
|
||||
[app.main.refs :as refs]
|
||||
[app.main.ui.shapes.path :as path]
|
||||
[app.main.ui.shapes.shape :refer [shape-container]]
|
||||
[app.main.ui.workspace.shapes.path.common :as pc]
|
||||
[app.util.path.commands :as upc]
|
||||
[rumext.alpha :as mf]))
|
||||
|
||||
(mf/defc path-wrapper
|
||||
|
|
|
@ -8,7 +8,9 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as gshp]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.path.commands :as upc]
|
||||
[app.common.path.shapes-to-path :as ups]
|
||||
[app.main.data.workspace.path :as drp]
|
||||
[app.main.snap :as snap]
|
||||
[app.main.store :as st]
|
||||
|
@ -18,10 +20,7 @@
|
|||
[app.main.ui.workspace.shapes.path.common :as pc]
|
||||
[app.util.dom :as dom]
|
||||
[app.util.keyboard :as kbd]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.format :as upf]
|
||||
[app.util.path.geom :as upg]
|
||||
[app.util.path.shapes-to-path :as ups]
|
||||
[clojure.set :refer [map-invert]]
|
||||
[goog.events :as events]
|
||||
[rumext.alpha :as mf])
|
||||
|
@ -217,16 +216,16 @@
|
|||
|
||||
shape (cond-> shape
|
||||
(not= :path (:type shape))
|
||||
ups/convert-to-path
|
||||
(ups/convert-to-path {})
|
||||
|
||||
:always
|
||||
hooks/use-equal-memo)
|
||||
|
||||
base-content (:content shape)
|
||||
base-points (mf/use-memo (mf/deps base-content) #(->> base-content upg/content->points))
|
||||
base-points (mf/use-memo (mf/deps base-content) #(->> base-content gsp/content->points))
|
||||
|
||||
content (upc/apply-content-modifiers base-content content-modifiers)
|
||||
content-points (mf/use-memo (mf/deps content) #(->> content upg/content->points))
|
||||
content-points (mf/use-memo (mf/deps content) #(->> content gsp/content->points))
|
||||
|
||||
point->base (->> (map hash-map content-points base-points) (reduce merge))
|
||||
base->point (map-invert point->base)
|
||||
|
@ -269,7 +268,7 @@
|
|||
ms/mouse-position
|
||||
(mf/deps shape zoom)
|
||||
(fn [position]
|
||||
(when-let [point (gshp/path-closest-point shape position)]
|
||||
(when-let [point (gsp/path-closest-point shape position)]
|
||||
(reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
|
||||
|
||||
[:g.path-editor {:ref editor-ref}
|
||||
|
|
|
@ -1,220 +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.path.bool
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.geom :as upg]
|
||||
[app.util.path.subpaths :as ups]))
|
||||
|
||||
(defn- split-command
|
||||
[cmd values]
|
||||
(case (:command cmd)
|
||||
:line-to (upg/split-line-to-ranges (:prev cmd) cmd values)
|
||||
:curve-to (upg/split-curve-to-ranges (:prev cmd) cmd values)
|
||||
[cmd]))
|
||||
|
||||
(defn split [seg-1 seg-2]
|
||||
(let [[ts-seg-1 ts-seg-2]
|
||||
(cond
|
||||
(and (= :line-to (:command seg-1))
|
||||
(= :line-to (:command seg-2)))
|
||||
(gsp/line-line-intersect (gsp/command->line seg-1) (gsp/command->line seg-2))
|
||||
|
||||
(and (= :line-to (:command seg-1))
|
||||
(= :curve-to (:command seg-2)))
|
||||
(gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
|
||||
|
||||
(and (= :curve-to (:command seg-1))
|
||||
(= :line-to (:command seg-2)))
|
||||
(let [[seg-2' seg-1']
|
||||
(gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
|
||||
;; Need to reverse because we send the arguments reversed
|
||||
[seg-1' seg-2'])
|
||||
|
||||
(and (= :curve-to (:command seg-1))
|
||||
(= :curve-to (:command seg-2)))
|
||||
(gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
|
||||
|
||||
:else
|
||||
[[] []])]
|
||||
|
||||
[(split-command seg-1 ts-seg-1)
|
||||
(split-command seg-2 ts-seg-2)]))
|
||||
|
||||
(defn add-previous
|
||||
([content]
|
||||
(add-previous content nil))
|
||||
([content first]
|
||||
(->> (d/with-prev content)
|
||||
(mapv (fn [[cmd prev]]
|
||||
(cond-> cmd
|
||||
(and (nil? prev) (some? first))
|
||||
(assoc :prev first)
|
||||
|
||||
(some? prev)
|
||||
(assoc :prev (gsp/command->point prev))))))))
|
||||
|
||||
(defn content-intersect-split
|
||||
"Given two path contents will return the intersect between them"
|
||||
[content-a content-b]
|
||||
|
||||
(if (or (empty? content-a) (empty? content-b))
|
||||
[content-a content-b]
|
||||
|
||||
(loop [current (first content-a)
|
||||
pending (rest content-a)
|
||||
content-b content-b
|
||||
new-content-a []]
|
||||
|
||||
(if (not (some? current))
|
||||
[new-content-a content-b]
|
||||
|
||||
(let [[new-current new-pending new-content-b]
|
||||
|
||||
(loop [current current
|
||||
pending pending
|
||||
other (first content-b)
|
||||
head-content []
|
||||
tail-content (rest content-b)]
|
||||
|
||||
(if (not (some? other))
|
||||
;; Finished recorring second content
|
||||
[current pending head-content]
|
||||
|
||||
;; We split the current
|
||||
(let [[new-as new-bs] (split current other)
|
||||
new-as (add-previous new-as (:prev current))
|
||||
new-bs (add-previous new-bs (:prev other))]
|
||||
|
||||
(if (> (count new-as) 1)
|
||||
;; We add the new-a's to the stack and change the b then we iterate to the top
|
||||
(recur (first new-as)
|
||||
(d/concat [] (rest new-as) pending)
|
||||
(first tail-content)
|
||||
(d/concat [] head-content new-bs)
|
||||
(rest tail-content))
|
||||
|
||||
;; No current segment-segment split we continue searching
|
||||
(recur current
|
||||
pending
|
||||
(first tail-content)
|
||||
(conj head-content other)
|
||||
(rest tail-content))))))]
|
||||
|
||||
(recur (first new-pending)
|
||||
(rest new-pending)
|
||||
new-content-b
|
||||
(conj new-content-a new-current)))))))
|
||||
|
||||
(defn is-segment?
|
||||
[cmd]
|
||||
(and (contains? cmd :prev)
|
||||
(contains? #{:line-to :curve-to} (:command cmd))))
|
||||
|
||||
(defn contains-segment?
|
||||
[segment content]
|
||||
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/curve-values 0.5)))]
|
||||
(gsp/is-point-in-content? point content)))
|
||||
|
||||
(defn create-union [content-a content-a-split content-b content-b-split]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content-b that are not inside content-a
|
||||
(d/concat
|
||||
[]
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b))))
|
||||
(->> content-b-split (filter #(not (contains-segment? % content-a))))))
|
||||
|
||||
(defn create-difference [content-a content-a-split content-b content-b-split]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content b that are inside content-a
|
||||
(d/concat
|
||||
[]
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b))))
|
||||
(->> content-b-split (filter #(contains-segment? % content-a)))))
|
||||
|
||||
(defn create-intersection [content-a content-a-split content-b content-b-split]
|
||||
;; Pick all segments in content-a that are inside content-b
|
||||
;; Pick all segments in content-b that are inside content-a
|
||||
(d/concat
|
||||
[]
|
||||
(->> content-a-split (filter #(contains-segment? % content-b)))
|
||||
(->> content-b-split (filter #(contains-segment? % content-a)))))
|
||||
|
||||
(defn reverse-command
|
||||
"Reverses a single command"
|
||||
[command]
|
||||
|
||||
(let [{old-x :x old-y :y} (:params command)
|
||||
{:keys [x y]} (:prev command)
|
||||
{:keys [c1x c1y c2x c2y]} (:params command)]
|
||||
|
||||
(-> command
|
||||
(assoc :prev (gpt/point old-x old-y))
|
||||
(update :params assoc :x x :y y)
|
||||
|
||||
(cond-> (= :curve-to (:command command))
|
||||
(update :params assoc
|
||||
:c1x c2x :c1y c2y
|
||||
:c2x c1x :c2y c1y)))))
|
||||
|
||||
(defn create-exclusion [content-a content-b]
|
||||
;; Pick all segments but reverse content-b (so it makes an exclusion)
|
||||
(let [content-b' (->> (reverse content-b)
|
||||
(mapv reverse-command))]
|
||||
(d/concat [] content-a content-b')))
|
||||
|
||||
|
||||
(defn fix-move-to
|
||||
[content]
|
||||
;; Remove the field `:prev` and makes the necesaries `move-to`
|
||||
;; then clean the subpaths
|
||||
|
||||
(loop [current (first content)
|
||||
content (rest content)
|
||||
prev nil
|
||||
result []]
|
||||
|
||||
(if (nil? current)
|
||||
result
|
||||
|
||||
(let [result (if (not= (:prev current) prev)
|
||||
(conj result (upc/make-move-to (:prev current)))
|
||||
result)]
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(gsp/command->point current)
|
||||
(conj result (dissoc current :prev)))))))
|
||||
|
||||
(defn content-bool
|
||||
[bool-type content-a content-b]
|
||||
|
||||
(let [content-a (add-previous content-a)
|
||||
content-b (add-previous content-b)
|
||||
|
||||
;; Split content in new segments in the intersection with the other path
|
||||
[content-a-split content-b-split] (content-intersect-split content-a content-b)
|
||||
content-a-split (->> content-a-split add-previous (filter is-segment?))
|
||||
content-b-split (->> content-b-split add-previous (filter is-segment?))
|
||||
|
||||
bool-content
|
||||
(case bool-type
|
||||
:union (create-union content-a content-a-split content-b content-b-split)
|
||||
:difference (create-difference content-a content-a-split content-b content-b-split)
|
||||
:intersection (create-intersection content-a content-a-split content-b content-b-split)
|
||||
:exclude (create-exclusion content-a-split content-b-split))]
|
||||
|
||||
(->> (fix-move-to bool-content)
|
||||
(ups/close-subpaths))))
|
|
@ -1,202 +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.path.commands
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]))
|
||||
|
||||
(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 update-curve-to
|
||||
[command h1 h2]
|
||||
(-> command
|
||||
(assoc :command :curve-to)
|
||||
(assoc-in [:params :c1x] (:x h1))
|
||||
(assoc-in [:params :c1y] (:y h1))
|
||||
(assoc-in [:params :c2x] (:x h2))
|
||||
(assoc-in [:params :c2y] (:y h2))))
|
||||
|
||||
(defn make-curve-to
|
||||
[to h1 h2]
|
||||
{:command :curve-to
|
||||
:relative false
|
||||
:params (make-curve-params to h1 h2)})
|
||||
|
||||
(defn update-handler
|
||||
[command prefix point]
|
||||
(let [[cox coy] (if (= prefix :c1) [:c1x :c1y] [:c2x :c2y])]
|
||||
(-> command
|
||||
(assoc-in [:params cox] (:x point))
|
||||
(assoc-in [:params coy] (:y point)))))
|
||||
|
||||
(defn apply-content-modifiers
|
||||
"Apply to content a map with point translations"
|
||||
[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 :command])))
|
||||
|
||||
(-> (assoc-in [index :command] :curve-to)
|
||||
(assoc-in [index :params]
|
||||
(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
|
||||
"Return an index where the key is the positions and the values the handlers"
|
||||
[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))))
|
||||
|
||||
point->handlers (content->handlers content)
|
||||
|
||||
handlers (->> point
|
||||
(point->handlers )
|
||||
(filter (fn [[ci cp]] (and (not= index ci) (not= prefix cp)) )))]
|
||||
|
||||
(cond
|
||||
(= (count handlers) 1)
|
||||
(->> handlers first)
|
||||
|
||||
(and (= :c1 prefix) (= (count content) index))
|
||||
[(dec index) :c2]
|
||||
|
||||
:else nil)))
|
||||
|
||||
|
||||
(defn get-commands
|
||||
"Returns the commands involving a point with its indices"
|
||||
[content point]
|
||||
(->> (d/enumerate content)
|
||||
(filterv (fn [[_ cmd]] (= (command->point cmd) point)))))
|
||||
|
||||
|
||||
(defn prefix->coords [prefix]
|
||||
(case prefix
|
||||
:c1 [:c1x :c1y]
|
||||
:c2 [:c2x :c2y]
|
||||
nil))
|
||||
|
||||
(defn handler->point [content index prefix]
|
||||
(when (and (some? index)
|
||||
(some? prefix)
|
||||
(contains? content index))
|
||||
(let [[cx cy] (prefix->coords prefix)]
|
||||
(if (= :curve-to (get-in content [index :command]))
|
||||
(gpt/point (get-in content [index :params cx])
|
||||
(get-in content [index :params cy]))
|
||||
|
||||
(gpt/point (get-in content [index :params :x])
|
||||
(get-in content [index :params :y]))))))
|
||||
|
||||
(defn handler->node [content index prefix]
|
||||
(if (= prefix :c1)
|
||||
(command->point (get content (dec index)))
|
||||
(command->point (get content index))))
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
|
||||
(ns app.util.path.format
|
||||
(:require
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.subpaths :refer [pt=]]
|
||||
[app.common.path.commands :as upc]
|
||||
[app.common.path.subpaths :refer [pt=]]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn command->param-list [command]
|
||||
|
|
|
@ -1,97 +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.path.geom
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as gshp]
|
||||
[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
|
||||
"Given a point and a line-to command will create a two new line-to commands
|
||||
that will split the original line into two given a value between 0-1"
|
||||
[from-p cmd t-val]
|
||||
(let [to-p (upc/command->point cmd)
|
||||
sp (gpt/lerp from-p to-p t-val)]
|
||||
[(upc/make-line-to sp) cmd]))
|
||||
|
||||
(defn split-curve-to
|
||||
"Given the point and a curve-to command will split the curve into two new
|
||||
curve-to commands given a value between 0-1"
|
||||
[from-p cmd t-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 t-val)]
|
||||
[(upc/make-curve-to to1 h11 h21)
|
||||
(upc/make-curve-to to2 h12 h22)]))
|
||||
|
||||
(defn split-line-to-ranges
|
||||
"Splits a line into several lines given the points in `values`
|
||||
for example (split-line-to-ranges p c [0 0.25 0.5 0.75 1] will split
|
||||
the line into 4 lines"
|
||||
[from-p cmd values]
|
||||
(let [to-p (upc/command->point cmd)]
|
||||
(->> (conj values 1)
|
||||
(mapv (fn [val]
|
||||
(-> (gpt/lerp from-p to-p val)
|
||||
#_(gpt/round 2)
|
||||
(upc/make-line-to)))))))
|
||||
|
||||
(defn split-curve-to-ranges
|
||||
"Splits a curve into several curves given the points in `values`
|
||||
for example (split-curve-to-ranges p c [0 0.25 0.5 0.75 1] will split
|
||||
the curve into 4 curves that draw the same curve"
|
||||
[from-p cmd values]
|
||||
(if (empty? values)
|
||||
[cmd]
|
||||
(let [to-p (upc/command->point cmd)
|
||||
params (:params cmd)
|
||||
h1 (gpt/point (:c1x params) (:c1y params))
|
||||
h2 (gpt/point (:c2x params) (:c2y params))
|
||||
|
||||
values-set (->> (conj values 1) (into (sorted-set)))]
|
||||
(->> (d/with-prev values-set)
|
||||
(mapv
|
||||
(fn [[t1 t0]]
|
||||
(let [t0 (if (nil? t0) 0 t0)
|
||||
[_ to-p h1' h2'] (gshp/subcurve-range from-p to-p h1 h2 t0 t1)]
|
||||
(upc/make-curve-to (-> to-p #_(gpt/round 2)) h1' h2'))))))))
|
||||
|
||||
(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
|
||||
"Returns the points in the given content"
|
||||
[content]
|
||||
(->> content
|
||||
(map #(when (-> % :params :x)
|
||||
(gpt/point (-> % :params :x) (-> % :params :y))))
|
||||
(remove nil?)
|
||||
(into [])))
|
||||
|
|
@ -8,9 +8,9 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.path.commands :as upc]
|
||||
[app.util.path.arc-to-curve :refer [a2c]]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.geom :as upg]
|
||||
[app.util.svg :as usvg]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
|
|
|
@ -1,146 +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.path.shapes-to-path
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.util.path.commands :as pc]))
|
||||
|
||||
(def bezier-circle-c 0.551915024494)
|
||||
(def dissoc-attrs [:x :y :width :height
|
||||
:rx :ry :r1 :r2 :r3 :r4
|
||||
:medata])
|
||||
(def allowed-transform-types #{:rect
|
||||
:circle
|
||||
:image})
|
||||
|
||||
(defn make-corner-arc
|
||||
"Creates a curvle corner for border radius"
|
||||
[from to corner radius]
|
||||
(let [x (case corner
|
||||
:top-left (:x from)
|
||||
:top-right (- (:x from) radius)
|
||||
:bottom-right (- (:x to) radius)
|
||||
:bottom-left (:x to))
|
||||
|
||||
y (case corner
|
||||
:top-left (- (:y from) radius)
|
||||
:top-right (:y from)
|
||||
:bottom-right (- (:y to) (* 2 radius))
|
||||
:bottom-left (- (:y to) radius))
|
||||
|
||||
width (* radius 2)
|
||||
height (* radius 2)
|
||||
|
||||
c bezier-circle-c
|
||||
c1x (+ x (* (/ width 2) (- 1 c)))
|
||||
c2x (+ x (* (/ width 2) (+ 1 c)))
|
||||
c1y (+ y (* (/ height 2) (- 1 c)))
|
||||
c2y (+ y (* (/ height 2) (+ 1 c)))
|
||||
|
||||
h1 (case corner
|
||||
:top-left (assoc from :y c1y)
|
||||
:top-right (assoc from :x c2x)
|
||||
:bottom-right (assoc from :y c2y)
|
||||
:bottom-left (assoc from :x c1x))
|
||||
|
||||
h2 (case corner
|
||||
:top-left (assoc to :x c1x)
|
||||
:top-right (assoc to :y c1y)
|
||||
:bottom-right (assoc to :x c2x)
|
||||
:bottom-left (assoc to :y c2y))]
|
||||
|
||||
(pc/make-curve-to to h1 h2)))
|
||||
|
||||
(defn circle->path
|
||||
"Creates the bezier curves to approximate a circle shape"
|
||||
[x y width height]
|
||||
(let [mx (+ x (/ width 2))
|
||||
my (+ y (/ height 2))
|
||||
ex (+ x width)
|
||||
ey (+ y height)
|
||||
|
||||
p1 (gpt/point mx y)
|
||||
p2 (gpt/point ex my)
|
||||
p3 (gpt/point mx ey)
|
||||
p4 (gpt/point x my)
|
||||
|
||||
c bezier-circle-c
|
||||
c1x (+ x (* (/ width 2) (- 1 c)))
|
||||
c2x (+ x (* (/ width 2) (+ 1 c)))
|
||||
c1y (+ y (* (/ height 2) (- 1 c)))
|
||||
c2y (+ y (* (/ height 2) (+ 1 c)))]
|
||||
|
||||
[(pc/make-move-to p1)
|
||||
(pc/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
|
||||
(pc/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
|
||||
(pc/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
|
||||
(pc/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
|
||||
|
||||
(defn rect->path
|
||||
"Creates a bezier curve that approximates a rounded corner rectangle"
|
||||
[x y width height r1 r2 r3 r4]
|
||||
(let [p1 (gpt/point x (+ y r1))
|
||||
p2 (gpt/point (+ x r1) y)
|
||||
|
||||
p3 (gpt/point (+ width x (- r2)) y)
|
||||
p4 (gpt/point (+ width x) (+ y r2))
|
||||
|
||||
p5 (gpt/point (+ width x) (+ height y (- r3)))
|
||||
p6 (gpt/point (+ width x (- r3)) (+ height y))
|
||||
|
||||
p7 (gpt/point (+ x r4) (+ height y))
|
||||
p8 (gpt/point x (+ height y (- r4)))]
|
||||
(-> []
|
||||
(conj (pc/make-move-to p1))
|
||||
(cond-> (not= p1 p2)
|
||||
(conj (make-corner-arc p1 p2 :top-left r1)))
|
||||
(conj (pc/make-line-to p3))
|
||||
(cond-> (not= p3 p4)
|
||||
(conj (make-corner-arc p3 p4 :top-right r2)))
|
||||
(conj (pc/make-line-to p5))
|
||||
(cond-> (not= p5 p6)
|
||||
(conj (make-corner-arc p5 p6 :bottom-right r3)))
|
||||
(conj (pc/make-line-to p7))
|
||||
(cond-> (not= p7 p8)
|
||||
(conj (make-corner-arc p7 p8 :bottom-left r4)))
|
||||
(conj (pc/make-line-to p1)))))
|
||||
|
||||
(defn convert-to-path
|
||||
"Transforms the given shape to a path"
|
||||
[{:keys [type x y width height r1 r2 r3 r4 rx metadata] :as shape}]
|
||||
|
||||
(if (contains? allowed-transform-types type)
|
||||
(let [r1 (or r1 rx 0)
|
||||
r2 (or r2 rx 0)
|
||||
r3 (or r3 rx 0)
|
||||
r4 (or r4 rx 0)
|
||||
|
||||
new-content
|
||||
(case type
|
||||
:circle
|
||||
(circle->path x y width height)
|
||||
(rect->path x y width height r1 r2 r3 r4))
|
||||
|
||||
;; Apply the transforms that had the shape
|
||||
transform (:transform shape)
|
||||
new-content (cond-> new-content
|
||||
(some? transform)
|
||||
(gsp/transform-content (gmt/transform-in (gsh/center-shape shape) transform)))]
|
||||
|
||||
(-> shape
|
||||
(d/without-keys dissoc-attrs)
|
||||
(assoc :type :path)
|
||||
(assoc :content new-content)
|
||||
(cond-> (= :image type) (-> (assoc :fill-image metadata)
|
||||
(dissoc :metadata)))))
|
||||
;; Do nothing if the shape is not of a correct type
|
||||
shape))
|
||||
|
|
@ -1,160 +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.path.subpaths
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.util.path.commands :as upc]))
|
||||
|
||||
(defn pt=
|
||||
"Check if two points are close"
|
||||
[p1 p2]
|
||||
(< (gpt/distance p1 p2) 0.1))
|
||||
|
||||
(defn make-subpath
|
||||
"Creates a subpath either from a single command or with all the data"
|
||||
([command]
|
||||
(let [p (upc/command->point command)]
|
||||
(make-subpath p p [command])))
|
||||
([from to data]
|
||||
{:from from
|
||||
:to to
|
||||
:data data}))
|
||||
|
||||
(defn add-subpath-command
|
||||
"Adds a command to the subpath"
|
||||
[subpath command]
|
||||
(let [command (if (= :close-path (:command command))
|
||||
(upc/make-line-to (:from subpath))
|
||||
command)
|
||||
p (upc/command->point command)]
|
||||
(-> subpath
|
||||
(assoc :to p)
|
||||
(update :data conj command))))
|
||||
|
||||
(defn reverse-command
|
||||
"Reverses a single command"
|
||||
[command prev]
|
||||
|
||||
(let [{:keys [x y]} (:params prev)
|
||||
{:keys [c1x c1y c2x c2y]} (:params command)]
|
||||
|
||||
(-> command
|
||||
(update :params assoc :x x :y y)
|
||||
|
||||
(cond-> (= :curve-to (:command command))
|
||||
(update :params assoc
|
||||
:c1x c2x :c1y c2y
|
||||
:c2x c1x :c2y c1y)))))
|
||||
|
||||
(defn reverse-subpath
|
||||
"Reverses a subpath starting with move-to"
|
||||
[subpath]
|
||||
|
||||
(let [reverse-commands
|
||||
(fn [result [command prev]]
|
||||
(if (some? prev)
|
||||
(conj result (reverse-command command prev))
|
||||
result))
|
||||
|
||||
new-data (->> subpath :data d/with-prev reverse
|
||||
(reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
|
||||
|
||||
(make-subpath (:to subpath) (:from subpath) new-data)))
|
||||
|
||||
(defn get-subpaths
|
||||
"Retrieves every subpath inside the current content"
|
||||
[content]
|
||||
(let [reduce-subpath
|
||||
(fn [subpaths current]
|
||||
(let [is-move? (= :move-to (:command current))
|
||||
last-idx (dec (count subpaths))]
|
||||
(if is-move?
|
||||
(conj subpaths (make-subpath current))
|
||||
(update subpaths last-idx add-subpath-command current))))]
|
||||
(->> content
|
||||
(reduce reduce-subpath []))))
|
||||
|
||||
(defn subpaths-join
|
||||
"Join two subpaths together when the first finish where the second starts"
|
||||
[subpath other]
|
||||
(assert (pt= (:to subpath) (:from other)))
|
||||
(-> subpath
|
||||
(update :data d/concat (rest (:data other)))
|
||||
(assoc :to (:to other))))
|
||||
|
||||
(defn- merge-paths
|
||||
"Tries to merge into candidate the subpaths. Will return the candidate with the subpaths merged
|
||||
and removed from subpaths the subpaths merged"
|
||||
[candidate subpaths]
|
||||
(let [merge-with-candidate
|
||||
(fn [[candidate result] current]
|
||||
(cond
|
||||
(pt= (:to current) (:from current))
|
||||
;; Subpath is already a closed path
|
||||
[candidate (conj result current)]
|
||||
|
||||
(pt= (:to candidate) (:from current))
|
||||
[(subpaths-join candidate current) result]
|
||||
|
||||
(pt= (:from candidate) (:to current))
|
||||
[(subpaths-join current candidate) result]
|
||||
|
||||
(pt= (:to candidate) (:to current))
|
||||
[(subpaths-join candidate (reverse-subpath current)) result]
|
||||
|
||||
(pt= (:from candidate) (:from current))
|
||||
[(subpaths-join (reverse-subpath current) candidate) result]
|
||||
|
||||
:else
|
||||
[candidate (conj result current)]))]
|
||||
|
||||
(->> subpaths
|
||||
(reduce merge-with-candidate [candidate []]))))
|
||||
|
||||
(defn close-subpaths
|
||||
"Searches a path for posible supaths that can create closed loops and merge them"
|
||||
[content]
|
||||
(let [subpaths (get-subpaths content)
|
||||
closed-subpaths
|
||||
(loop [result []
|
||||
current (first subpaths)
|
||||
subpaths (rest subpaths)]
|
||||
|
||||
(if (some? current)
|
||||
(let [[new-current new-subpaths]
|
||||
(if (pt= (:from current) (:to current))
|
||||
[current subpaths]
|
||||
(merge-paths current subpaths))]
|
||||
|
||||
(if (= current new-current)
|
||||
;; If equal we haven't found any matching subpaths we advance
|
||||
(recur (conj result new-current)
|
||||
(first new-subpaths)
|
||||
(rest new-subpaths))
|
||||
|
||||
;; If different we need to pass again the merge to check for additional
|
||||
;; subpaths to join
|
||||
(recur result
|
||||
new-current
|
||||
new-subpaths)))
|
||||
result))]
|
||||
|
||||
(->> closed-subpaths
|
||||
(mapcat :data)
|
||||
(into []))))
|
||||
|
||||
(defn reverse-content
|
||||
"Given a content reverse the order of the commands"
|
||||
[content]
|
||||
|
||||
(->> content
|
||||
(get-subpaths)
|
||||
(mapv reverse-subpath)
|
||||
(reverse)
|
||||
(mapcat :data)
|
||||
(into [])))
|
|
@ -8,9 +8,9 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.math :as mth]
|
||||
[app.util.path.commands :as upc]
|
||||
[app.util.path.geom :as upg]
|
||||
[app.common.path.commands :as upc]
|
||||
[clojure.set :as set]))
|
||||
|
||||
(defn remove-line-curves
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue