mirror of
https://github.com/penpot/penpot.git
synced 2025-06-01 06:41:39 +02:00
🎉 Add full integration with path data type feature
This commit is contained in:
Andrey Antukh
parent
f545d7b3ea
commit
1fc0203c38
64 changed files with 2622 additions and 2237 deletions
|
|
@ -434,12 +434,12 @@
|
|||
(d/without-nils))))))
|
||||
|
||||
(defn encode-file
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
|
||||
(let [file (if (contains? (:features file) "fdata/objects-map")
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id features] :as file}]
|
||||
(let [file (if (contains? features "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
file (if (contains? features "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! cfg id)
|
||||
|
|
|
|||
|
|
@ -20,7 +20,6 @@
|
|||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.path :as gshp]
|
||||
[app.common.logging :as l]
|
||||
[app.common.logic.libraries :as cll]
|
||||
[app.common.math :as mth]
|
||||
|
|
@ -36,9 +35,9 @@
|
|||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.shape.path :as ctsp]
|
||||
[app.common.types.shape.text :as ctsx]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
|
|
@ -127,10 +126,10 @@
|
|||
(sm/lazy-validator ::ctsx/content))
|
||||
|
||||
(def valid-path-content?
|
||||
(sm/lazy-validator ::ctsp/content))
|
||||
(sm/lazy-validator ::path/segments))
|
||||
|
||||
(def valid-path-segment?
|
||||
(sm/lazy-validator ::ctsp/segment))
|
||||
(sm/lazy-validator ::path/segment))
|
||||
|
||||
(def valid-rgb-color-string?
|
||||
(sm/lazy-validator ::ctc/rgb-color))
|
||||
|
|
@ -580,12 +579,10 @@
|
|||
(let [shape (update shape :content fix-path-content)]
|
||||
(if (not (valid-path-content? (:content shape)))
|
||||
shape
|
||||
(let [[points selrect] (gshp/content->points+selrect shape (:content shape))]
|
||||
(-> shape
|
||||
(dissoc :bool-content)
|
||||
(dissoc :bool-type)
|
||||
(assoc :points points)
|
||||
(assoc :selrect selrect)))))
|
||||
(-> shape
|
||||
(dissoc :bool-content)
|
||||
(dissoc :bool-type)
|
||||
(path/update-geometry))))
|
||||
|
||||
;; When we fount a bool shape with no content,
|
||||
;; we convert it to a simple rect
|
||||
|
|
|
|||
|
|
@ -9,7 +9,9 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.logging :as l]
|
||||
[app.common.types.path :as path]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as-alias sql]
|
||||
[app.storage :as sto]
|
||||
|
|
@ -30,7 +32,7 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn enable-objects-map
|
||||
[file]
|
||||
[file & _opts]
|
||||
(let [update-page
|
||||
(fn [page]
|
||||
(if (and (pmap/pointer-map? page)
|
||||
|
|
@ -136,10 +138,39 @@
|
|||
|
||||
(defn enable-pointer-map
|
||||
"Enable the fdata/pointer-map feature on the file."
|
||||
[file]
|
||||
[file & _opts]
|
||||
(-> file
|
||||
(update :data (fn [fdata]
|
||||
(-> fdata
|
||||
(update :pages-index d/update-vals pmap/wrap)
|
||||
(d/update-when :components pmap/wrap))))
|
||||
(update :features conj "fdata/pointer-map")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PATH-DATA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn enable-path-data
|
||||
"Enable the fdata/path-data feature on the file."
|
||||
[file & _opts]
|
||||
(letfn [(update-object [object]
|
||||
(if (or (cfh/path-shape? object)
|
||||
(cfh/bool-shape? object))
|
||||
(update object :content path/content)
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
;; NOTE: if we found a pointer and it is not modified, we
|
||||
;; skip updating objects for not creating additional
|
||||
;; pointers
|
||||
(if (and (pmap/pointer-map? container)
|
||||
(not (pmap/modified? container)))
|
||||
container
|
||||
(d/update-when container :objects d/update-vals update-object)))]
|
||||
|
||||
(-> file
|
||||
(update :data (fn [data]
|
||||
(-> data
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
(update :features conj "fdata/path-data"))))
|
||||
|
|
|
|||
|
|
@ -156,6 +156,10 @@
|
|||
[file-id & {:as opts}]
|
||||
(process-file! file-id feat.fdata/enable-pointer-map opts))
|
||||
|
||||
(defn enable-path-data-feature-on-file!
|
||||
[file-id & {:as opts}]
|
||||
(process-file! file-id feat.fdata/enable-path-data opts))
|
||||
|
||||
(defn enable-storage-features-on-file!
|
||||
[file-id & {:as opts}]
|
||||
(enable-objects-map-feature-on-file! file-id opts)
|
||||
|
|
@ -416,10 +420,11 @@
|
|||
"Apply a function to the file. Optionally save the changes or not.
|
||||
The function receives the decoded and migrated file data."
|
||||
[file-id update-fn & {:keys [rollback?] :or {rollback? true} :as opts}]
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [system]
|
||||
(binding [h/*system* system]
|
||||
(h/process-file! system file-id update-fn opts)))))
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [system]
|
||||
(binding [h/*system* system]
|
||||
(h/process-file! system file-id update-fn opts))))))
|
||||
|
||||
(defn process-team-files!
|
||||
"Apply a function to each file of the specified team."
|
||||
|
|
|
|||
|
|
@ -46,6 +46,7 @@
|
|||
#{"fdata/objects-map"
|
||||
"fdata/pointer-map"
|
||||
"fdata/shape-data-type"
|
||||
"fdata/path-data"
|
||||
"components/v2"
|
||||
"styles/v2"
|
||||
"layout/grid"
|
||||
|
|
@ -86,8 +87,9 @@
|
|||
;; without migration applied)
|
||||
(def no-migration-features
|
||||
(-> #{"layout/grid"
|
||||
"design-tokens/v1"
|
||||
"fdata/shape-data-type"
|
||||
"design-tokens/v1"}
|
||||
"fdata/path-data"}
|
||||
(into frontend-only-features)
|
||||
(into backend-only-features)))
|
||||
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
[app.common.types.file :as ctf]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.pages-list :as ctpl]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
[cuerdas.core :as str]))
|
||||
|
|
@ -272,7 +273,8 @@
|
|||
|
||||
:else
|
||||
(let [objects (lookup-objects file)
|
||||
content (gsh/calc-bool-content bool objects)
|
||||
;; FIXME: this makes a duplicate operation
|
||||
content (path/calc-bool-content bool objects)
|
||||
bool' (gsh/update-bool-selrect bool children objects)]
|
||||
(commit-change
|
||||
file
|
||||
|
|
|
|||
|
|
@ -8,7 +8,6 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.changes :as cfc]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
|
|
|
|||
|
|
@ -16,7 +16,6 @@
|
|||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.geom.shapes.text :as gsht]
|
||||
[app.common.logging :as l]
|
||||
[app.common.math :as mth]
|
||||
|
|
@ -27,6 +26,8 @@
|
|||
[app.common.types.component :as ctk]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.shadow :as ctss]
|
||||
|
|
@ -129,8 +130,8 @@
|
|||
[data _]
|
||||
(letfn [(migrate-path [shape]
|
||||
(if-not (contains? shape :content)
|
||||
(let [content (gsp/segments->content (:segments shape) (:close? shape))
|
||||
selrect (gsh/content->selrect content)
|
||||
(let [content (path.segment/segments->content (:segments shape) (:close? shape))
|
||||
selrect (path.segment/content->selrect content)
|
||||
points (grc/rect->points selrect)]
|
||||
(-> shape
|
||||
(dissoc :segments)
|
||||
|
|
@ -201,7 +202,7 @@
|
|||
(if (= (:type shape) :path)
|
||||
(let [{:keys [width height]} (grc/points->rect (:points shape))]
|
||||
(if (or (mth/almost-zero? width) (mth/almost-zero? height))
|
||||
(let [selrect (gsh/content->selrect (:content shape))
|
||||
(let [selrect (path.segment/content->selrect (:content shape))
|
||||
points (grc/rect->points selrect)
|
||||
transform (gmt/matrix)
|
||||
transform-inv (gmt/matrix)]
|
||||
|
|
@ -1281,8 +1282,8 @@
|
|||
(d/update-when container :objects update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index update-vals update-container)
|
||||
(update :components update-vals update-container))))
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(defmethod migrate-data "0003-fix-root-shape"
|
||||
[data _]
|
||||
|
|
@ -1306,6 +1307,21 @@
|
|||
(d/update-when :components d/update-vals update-container)
|
||||
(d/without-nils))))
|
||||
|
||||
(defmethod migrate-data "0003-convert-path-content"
|
||||
[data _]
|
||||
(letfn [(update-object [object]
|
||||
(if (or (cfh/bool-shape? object)
|
||||
(cfh/path-shape? object))
|
||||
(update object :content path/content)
|
||||
object))
|
||||
|
||||
(update-container [container]
|
||||
(d/update-when container :objects update-vals update-object))]
|
||||
|
||||
(-> data
|
||||
(update :pages-index d/update-vals update-container)
|
||||
(d/update-when :components d/update-vals update-container))))
|
||||
|
||||
(def available-migrations
|
||||
(into (d/ordered-set)
|
||||
["legacy-2"
|
||||
|
|
@ -1363,4 +1379,5 @@
|
|||
"0001-remove-tokens-from-groups"
|
||||
"0002-normalize-bool-content"
|
||||
"0002-clean-shape-interactions"
|
||||
"0003-fix-root-shape"]))
|
||||
"0003-fix-root-shape"
|
||||
"0003-convert-path-content"]))
|
||||
|
|
|
|||
|
|
@ -15,6 +15,8 @@
|
|||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
;; FIXME: move to logic?
|
||||
|
||||
(defn prepare-add-shape
|
||||
[changes shape objects]
|
||||
(let [index (:index (meta shape))
|
||||
|
|
@ -35,6 +37,7 @@
|
|||
(pcb/update-shapes [(:parent-id shape)] #(ctl/push-into-cell % [id] row column)))
|
||||
(cond-> (ctl/grid-layout? objects (:parent-id shape))
|
||||
(pcb/update-shapes [(:parent-id shape)] ctl/assign-cells {:with-objects? true})))]
|
||||
|
||||
[shape changes]))
|
||||
|
||||
(defn prepare-move-shapes-into-frame
|
||||
|
|
@ -44,6 +47,7 @@
|
|||
to-move (->> shapes
|
||||
(map (d/getf objects))
|
||||
(not-empty))]
|
||||
|
||||
(if to-move
|
||||
(-> changes
|
||||
(cond-> (and remove-layout-data?
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.geom.point
|
||||
(:refer-clojure :exclude [divide min max abs])
|
||||
(:refer-clojure :exclude [divide min max abs zero?])
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
#?(:cljs [cljs.core :as c]
|
||||
|
|
@ -470,6 +470,11 @@
|
|||
(and ^boolean (mth/almost-zero? (dm/get-prop p :x))
|
||||
^boolean (mth/almost-zero? (dm/get-prop p :y))))
|
||||
|
||||
(defn zero?
|
||||
[p]
|
||||
(and ^boolean (= 0 (dm/get-prop p :x))
|
||||
^boolean (= 0 (dm/get-prop p :y))))
|
||||
|
||||
(defn lerp
|
||||
"Calculates a linear interpolation between two points given a tvalue"
|
||||
[p1 p2 t]
|
||||
|
|
|
|||
|
|
@ -10,13 +10,11 @@
|
|||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.bool :as gsb]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.constraints :as gct]
|
||||
[app.common.geom.shapes.corners :as gsc]
|
||||
[app.common.geom.shapes.fit-frame :as gsff]
|
||||
[app.common.geom.shapes.intersect :as gsi]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.geom.shapes.transforms :as gtr]
|
||||
[app.common.math :as mth]))
|
||||
|
||||
|
|
@ -180,12 +178,6 @@
|
|||
;; Constratins
|
||||
(dm/export gct/calc-child-modifiers)
|
||||
|
||||
;; PATHS
|
||||
;; FIXME: rename
|
||||
(dm/export gsp/content->selrect)
|
||||
(dm/export gsp/transform-content)
|
||||
(dm/export gsp/open-path?)
|
||||
|
||||
;; Intersection
|
||||
(dm/export gsi/overlaps?)
|
||||
(dm/export gsi/overlaps-path?)
|
||||
|
|
@ -193,9 +185,6 @@
|
|||
(dm/export gsi/has-point-rect?)
|
||||
(dm/export gsi/rect-contains-shape?)
|
||||
|
||||
;; Bool
|
||||
(dm/export gsb/calc-bool-content)
|
||||
|
||||
;; Constraints
|
||||
(dm/export gct/default-constraints-h)
|
||||
(dm/export gct/default-constraints-v)
|
||||
|
|
|
|||
|
|
@ -1,29 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.geom.shapes.bool
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.helpers :as cpf]
|
||||
[app.common.svg.path.bool :as pb]
|
||||
[app.common.svg.path.shapes-to-path :as stp]))
|
||||
|
||||
(defn calc-bool-content
|
||||
[shape objects]
|
||||
|
||||
(let [extract-content-xf
|
||||
(comp (map (d/getf objects))
|
||||
(filter (comp not :hidden))
|
||||
(remove cpf/svg-raw-shape?)
|
||||
(map #(stp/convert-to-path % objects))
|
||||
(map :content))
|
||||
|
||||
shapes-content
|
||||
(into [] extract-content-xf (:shapes shape))]
|
||||
(pb/content-bool (:bool-type shape) shapes-content)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -10,8 +10,8 @@
|
|||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.math :as mth]))
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.path :as path]))
|
||||
|
||||
(defn shape-stroke-margin
|
||||
[shape stroke-width]
|
||||
|
|
@ -104,7 +104,7 @@
|
|||
(let [strokes (:strokes shape)
|
||||
|
||||
open-path? (and ^boolean (cfh/path-shape? shape)
|
||||
^boolean (gsp/open-path? shape))
|
||||
^boolean (path/shape-with-open-path? shape))
|
||||
|
||||
stroke-width
|
||||
(->> strokes
|
||||
|
|
|
|||
|
|
@ -13,9 +13,9 @@
|
|||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.path :as gpp]
|
||||
[app.common.geom.shapes.text :as gte]
|
||||
[app.common.math :as mth]))
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.path.segment :as path.segm]))
|
||||
|
||||
(defn orientation
|
||||
"Given three ordered points gives the orientation
|
||||
|
|
@ -186,7 +186,7 @@
|
|||
rect-lines (points->lines rect-points)
|
||||
path-lines (if simple?
|
||||
(points->lines (:points shape))
|
||||
(gpp/path->lines shape))
|
||||
(path.segm/path->lines shape))
|
||||
start-point (-> shape :content (first) :params (gpt/point))]
|
||||
|
||||
(or (intersects-lines? rect-lines path-lines)
|
||||
|
|
|
|||
|
|
@ -12,11 +12,10 @@
|
|||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.bool :as gshb]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.path :as gpa]
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.modifiers :as ctm]))
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.path :as path]))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
|
|
@ -77,7 +76,11 @@
|
|||
position-data)
|
||||
position-data))))
|
||||
|
||||
;; FIXME: revist usage of mutability
|
||||
;; FIXME: review performance of this; this function is executing too
|
||||
;; many times, including when the point vector is 0,0. This function
|
||||
;; can be implemented in function of transform which is already mor
|
||||
;; performant
|
||||
|
||||
(defn move
|
||||
"Move the shape relatively to its current
|
||||
position applying the provided delta."
|
||||
|
|
@ -96,7 +99,7 @@
|
|||
(d/update-when :y d/safe+ dy)
|
||||
(d/update-when :position-data move-position-data mvec)
|
||||
(cond-> (or (= :bool type) (= :path type))
|
||||
(update :content gpa/move-content mvec)))))
|
||||
(update :content path/move-content mvec)))))
|
||||
|
||||
;; --- Absolute Movement
|
||||
|
||||
|
|
@ -321,7 +324,7 @@
|
|||
(update shape :position-data transform-position-data transform-mtx)
|
||||
shape)
|
||||
shape (if (or (= type :path) (= type :bool))
|
||||
(update shape :content gpa/transform-content transform-mtx)
|
||||
(update shape :content path/transform-content transform-mtx)
|
||||
(assoc shape
|
||||
:x (dm/get-prop selrect :x)
|
||||
:y (dm/get-prop selrect :y)
|
||||
|
|
@ -354,7 +357,7 @@
|
|||
360)
|
||||
|
||||
shape (if (or (= type :path) (= type :bool))
|
||||
(update shape :content gpa/transform-content transform-mtx)
|
||||
(update shape :content path/transform-content transform-mtx)
|
||||
(assoc shape
|
||||
:x (dm/get-prop selrect :x)
|
||||
:y (dm/get-prop selrect :y)
|
||||
|
|
@ -446,22 +449,11 @@
|
|||
|
||||
(defn update-bool-selrect
|
||||
"Calculates the selrect+points for the boolean shape"
|
||||
[shape children objects]
|
||||
[shape _children objects]
|
||||
|
||||
(let [content
|
||||
(gshb/calc-bool-content shape objects)
|
||||
|
||||
shape
|
||||
(assoc shape :content content)
|
||||
|
||||
[points selrect]
|
||||
(gpa/content->points+selrect shape content)]
|
||||
|
||||
(if (and (some? selrect) (d/not-empty? points))
|
||||
(-> shape
|
||||
(assoc :selrect selrect)
|
||||
(assoc :points points))
|
||||
(update-group-selrect shape children))))
|
||||
(let [content (path/calc-bool-content shape objects)
|
||||
shape (assoc shape :content content)]
|
||||
(path/update-geometry shape)))
|
||||
|
||||
(defn update-shapes-geometry
|
||||
[objects ids]
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@
|
|||
#?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.schema.openapi :as-alias oapi]
|
||||
|
|
@ -832,7 +833,8 @@
|
|||
|
||||
gen (sg/one-of
|
||||
(sg/small-int :max max :min min)
|
||||
(sg/small-double :max max :min min))]
|
||||
(->> (sg/small-double :max max :min min)
|
||||
(sg/fmap #(mth/precision % 2))))]
|
||||
|
||||
{:pred pred
|
||||
:type-properties
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.schema.generators
|
||||
(:refer-clojure :exclude [set subseq uuid filter map let boolean])
|
||||
(:refer-clojure :exclude [set subseq uuid filter map let boolean vector])
|
||||
#?(:cljs (:require-macros [app.common.schema.generators]))
|
||||
(:require
|
||||
[app.common.schema.registry :as sr]
|
||||
|
|
@ -126,3 +126,7 @@
|
|||
(defn tuple
|
||||
[& opts]
|
||||
(apply tg/tuple opts))
|
||||
|
||||
(defn vector
|
||||
[& opts]
|
||||
(apply tg/vector opts))
|
||||
|
|
|
|||
|
|
@ -1,204 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.svg.path.command
|
||||
(: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 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]
|
||||
(let [params {:x (-> command :params :x)
|
||||
:y (-> command :params :y)
|
||||
:c1x (:x h1)
|
||||
:c1y (:y h1)
|
||||
:c2x (:x h2)
|
||||
:c2y (:y h2)}]
|
||||
(-> command
|
||||
(assoc :command :curve-to)
|
||||
(assoc :params params))))
|
||||
|
||||
(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
|
||||
"Calculates the 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))))
|
||||
|
||||
|
|
@ -12,10 +12,9 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.svg :as csvg]
|
||||
[app.common.svg.path.arc-to-bezier :as a2b]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
|
||||
|
|
@ -160,7 +159,7 @@
|
|||
|
||||
(defn smooth->curve
|
||||
[{:keys [params]} pos handler]
|
||||
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
|
||||
(let [{c1x :x c1y :y} (path.segm/calculate-opposite-handler pos handler)]
|
||||
{:c1x c1x
|
||||
:c1y c1y
|
||||
:c2x (:cx params)
|
||||
|
|
@ -262,7 +261,7 @@
|
|||
|
||||
(= :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)))))
|
||||
(update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segm/calculate-opposite-handler prev-pos prev-qc)))))
|
||||
|
||||
result (if (= :elliptical-arc (:command command))
|
||||
(into result (arc->beziers prev-pos command))
|
||||
|
|
@ -285,13 +284,13 @@
|
|||
(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)
|
||||
(path.segm/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))
|
||||
(path.segm/get-point prev-pos command))
|
||||
|
||||
next-start (if (= :move-to (:command command)) next-pos prev-start)]
|
||||
|
||||
|
|
|
|||
|
|
@ -12,10 +12,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.common.svg :as csvg]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(def commands-regex #"(?i)[mzlhvcsqta][^mzlhvcsqta]*")
|
||||
|
|
@ -185,7 +184,7 @@
|
|||
|
||||
(defn smooth->curve
|
||||
[{:keys [params]} pos handler]
|
||||
(let [{c1x :x c1y :y} (upg/calculate-opposite-handler pos handler)]
|
||||
(let [{c1x :x c1y :y} (path.segm/calculate-opposite-handler pos handler)]
|
||||
{:c1x c1x
|
||||
:c1y c1y
|
||||
:c2x (:cx params)
|
||||
|
|
@ -413,7 +412,7 @@
|
|||
|
||||
(= :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)))))
|
||||
(update :params merge (quadratic->curve prev-pos (gpt/point params) (path.segm/calculate-opposite-handler prev-pos prev-qc)))))
|
||||
|
||||
result (if (= :elliptical-arc (:command command))
|
||||
(into result (arc->beziers prev-pos command))
|
||||
|
|
@ -436,13 +435,13 @@
|
|||
(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)
|
||||
(path.segm/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))
|
||||
(path.segm/get-point prev-pos command))
|
||||
|
||||
next-start (if (= :move-to (:command command)) next-pos prev-start)]
|
||||
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@
|
|||
[app.common.schema :as sm :refer [max-safe-int min-safe-int]]
|
||||
[app.common.svg :as csvg]
|
||||
[app.common.svg.path :as path]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
[cuerdas.core :as str]))
|
||||
|
|
@ -220,9 +221,9 @@
|
|||
(let [transform (csvg/parse-transform (:transform attrs))
|
||||
content (cond-> (path/parse (:d attrs))
|
||||
(some? transform)
|
||||
(gsh/transform-content transform))
|
||||
(path.segm/transform-content transform))
|
||||
|
||||
selrect (gsh/content->selrect content)
|
||||
selrect (path.segm/content->selrect content)
|
||||
points (grc/rect->points selrect)
|
||||
origin (gpt/negate (gpt/point svg-data))
|
||||
attrs (-> (dissoc attrs :d :transform)
|
||||
|
|
|
|||
209
common/src/app/common/types/path.cljc
Normal file
209
common/src/app/common/types/path.cljc
Normal file
|
|
@ -0,0 +1,209 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.types.path
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cpf]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.types.path.bool :as bool]
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.impl :as impl]
|
||||
[app.common.types.path.segment :as segment]
|
||||
[app.common.types.path.shape-to-path :as stp]
|
||||
[app.common.types.path.subpath :as subpath]))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
(defn content?
|
||||
[o]
|
||||
(impl/path-data? o))
|
||||
|
||||
(defn content
|
||||
"Create path content from plain data or bytes, returns itself if it
|
||||
is already PathData instance"
|
||||
[data]
|
||||
(impl/path-data data))
|
||||
|
||||
(defn from-bytes
|
||||
[data]
|
||||
(impl/from-bytes data))
|
||||
|
||||
(defn check-path-content
|
||||
[content]
|
||||
(impl/check-content-like content))
|
||||
|
||||
(defn get-byte-size
|
||||
"Get byte size of a path content"
|
||||
[content]
|
||||
(impl/-get-byte-size content))
|
||||
|
||||
(defn write-to
|
||||
[content buffer offset]
|
||||
(impl/-write-to content buffer offset))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TRANSFORMATIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn close-subpaths
|
||||
"Given a content, searches a path for possible subpaths that can
|
||||
create closed loops and merge them; then return the transformed path
|
||||
conten as PathData instance"
|
||||
[content]
|
||||
(-> (subpath/close-subpaths content)
|
||||
(impl/from-plain)))
|
||||
|
||||
(defn apply-content-modifiers
|
||||
"Apply delta modifiers over the path content"
|
||||
[content modifiers]
|
||||
(assert (impl/check-content-like content))
|
||||
|
||||
(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]
|
||||
(helpers/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))]
|
||||
|
||||
(impl/path-data
|
||||
(reduce apply-to-index (vec content) modifiers))))
|
||||
|
||||
(defn transform-content
|
||||
"Applies a transformation matrix over content and returns a new
|
||||
content as PathData instance."
|
||||
[content transform]
|
||||
(segment/transform-content content transform))
|
||||
|
||||
(defn move-content
|
||||
[content move-vec]
|
||||
(if (gpt/zero? move-vec)
|
||||
content
|
||||
(segment/move-content content move-vec)))
|
||||
|
||||
(defn update-geometry
|
||||
"Update shape with new geometry calculated from provided content"
|
||||
([shape content]
|
||||
(update-geometry (assoc shape :content content)))
|
||||
([shape]
|
||||
(let [flip-x
|
||||
(get shape :flip-x)
|
||||
|
||||
flip-y
|
||||
(get shape :flip-y)
|
||||
|
||||
;; NOTE: we ensure that content is PathData instance
|
||||
content
|
||||
(impl/path-data
|
||||
(get shape :content))
|
||||
|
||||
;; Ensure plain format once
|
||||
transform
|
||||
(cond-> (:transform shape (gmt/matrix))
|
||||
flip-x (gmt/scale (gpt/point -1 1))
|
||||
flip-y (gmt/scale (gpt/point 1 -1)))
|
||||
|
||||
transform-inverse
|
||||
(cond-> (gmt/matrix)
|
||||
flip-x (gmt/scale (gpt/point -1 1))
|
||||
flip-y (gmt/scale (gpt/point 1 -1))
|
||||
:always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
|
||||
|
||||
center
|
||||
(or (some-> (dm/get-prop shape :selrect) grc/rect->center)
|
||||
(segment/content-center content))
|
||||
|
||||
base-content
|
||||
(segment/transform-content content (gmt/transform-in center transform-inverse))
|
||||
|
||||
;; Calculates the new selrect with points given the old center
|
||||
points
|
||||
(-> (segment/content->selrect base-content)
|
||||
(grc/rect->points)
|
||||
(gco/transform-points center transform))
|
||||
|
||||
points-center
|
||||
(gco/points->center points)
|
||||
|
||||
;; Points is now the selrect but the center is different so we can create the selrect
|
||||
;; through points
|
||||
selrect
|
||||
(-> points
|
||||
(gco/transform-points points-center transform-inverse)
|
||||
(grc/points->rect))]
|
||||
|
||||
(-> shape
|
||||
(assoc :content content)
|
||||
(assoc :points points)
|
||||
(assoc :selrect selrect)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PATH SHAPE HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- calc-bool-content*
|
||||
"Calculate the boolean content from shape and objects. Returns plain
|
||||
vector of segments"
|
||||
[shape objects]
|
||||
(let [extract-content-xf
|
||||
(comp (map (d/getf objects))
|
||||
(remove :hidden)
|
||||
(remove cpf/svg-raw-shape?)
|
||||
(map #(stp/convert-to-path % objects))
|
||||
(map :content))
|
||||
|
||||
contents
|
||||
(sequence extract-content-xf (:shapes shape))]
|
||||
|
||||
(bool/calculate-content (:bool-type shape) contents)))
|
||||
|
||||
(defn calc-bool-content
|
||||
"Calculate the boolean content from shape and objects. Returns a
|
||||
packed PathData instance"
|
||||
[shape objects]
|
||||
(-> (calc-bool-content* shape objects)
|
||||
(impl/path-data)))
|
||||
|
||||
(defn shape-with-open-path?
|
||||
[shape]
|
||||
(let [svg? (contains? shape :svg-attrs)
|
||||
;; No close subpaths for svgs imported
|
||||
maybe-close (if svg? identity subpath/close-subpaths)]
|
||||
(and (= :path (:type shape))
|
||||
(not (->> shape
|
||||
:content
|
||||
(maybe-close)
|
||||
(subpath/get-subpaths)
|
||||
(every? subpath/is-closed?))))))
|
||||
|
||||
(defn convert-to-path
|
||||
"Transform a shape to a path shape"
|
||||
([shape]
|
||||
(convert-to-path shape {}))
|
||||
([shape objects]
|
||||
(-> (stp/convert-to-path shape objects)
|
||||
(update :content impl/path-data))))
|
||||
|
||||
|
|
@ -4,15 +4,42 @@
|
|||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.svg.path.bool
|
||||
(ns app.common.types.path.bool
|
||||
(:require
|
||||
[app.common.colors :as clr]
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.math :as mth]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.svg.path.subpath :as ups]))
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.segment :as segment]
|
||||
[app.common.types.path.subpath :as subpath]))
|
||||
|
||||
(def default-fills
|
||||
[{:fill-color clr/black}])
|
||||
|
||||
(def style-group-properties
|
||||
[:shadow :blur])
|
||||
|
||||
(def style-properties
|
||||
(into style-group-properties
|
||||
[:fill-color
|
||||
:fill-opacity
|
||||
:fill-color-gradient
|
||||
:fill-color-ref-file
|
||||
:fill-color-ref-id
|
||||
:fill-image
|
||||
:fills
|
||||
:stroke-color
|
||||
:stroke-color-ref-file
|
||||
:stroke-color-ref-id
|
||||
:stroke-opacity
|
||||
:stroke-style
|
||||
:stroke-width
|
||||
:stroke-alignment
|
||||
:stroke-cap-start
|
||||
:stroke-cap-end
|
||||
:strokes]))
|
||||
|
||||
(defn add-previous
|
||||
([content]
|
||||
|
|
@ -25,87 +52,92 @@
|
|||
(assoc :prev first)
|
||||
|
||||
(some? prev)
|
||||
(assoc :prev (gsp/command->point prev))))))))
|
||||
(assoc :prev (helpers/command->point prev))))))))
|
||||
|
||||
(defn close-paths
|
||||
"Removes the :close-path commands and replace them for line-to so we can calculate
|
||||
the intersections"
|
||||
[content]
|
||||
|
||||
(loop [head (first content)
|
||||
content (rest content)
|
||||
result []
|
||||
last-move nil
|
||||
last-p nil]
|
||||
(loop [segments (seq content)
|
||||
result []
|
||||
last-move nil
|
||||
last-point nil]
|
||||
(if-let [segment (first segments)]
|
||||
(let [point
|
||||
(helpers/command->point segment)
|
||||
|
||||
(if (nil? head)
|
||||
result
|
||||
(let [head-p (gsp/command->point head)
|
||||
head (cond
|
||||
(and (= :close-path (:command head))
|
||||
(or (nil? last-p) ;; Ignore consecutive close-paths
|
||||
(< (gpt/distance last-p last-move) 0.01)))
|
||||
nil
|
||||
segment
|
||||
(cond
|
||||
(and (= :close-path (:command segment))
|
||||
(or (nil? last-point) ;; Ignore consecutive close-paths
|
||||
(< (gpt/distance last-point last-move) 0.01)))
|
||||
nil
|
||||
|
||||
(= :close-path (:command head))
|
||||
(upc/make-line-to last-move)
|
||||
(= :close-path (:command segment))
|
||||
(helpers/make-line-to last-move)
|
||||
|
||||
:else
|
||||
head)]
|
||||
:else
|
||||
segment)]
|
||||
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(cond-> result (some? head) (conj head))
|
||||
(if (= :move-to (:command head))
|
||||
head-p
|
||||
(recur (rest segments)
|
||||
(cond-> result (some? segment) (conj segment))
|
||||
(if (= :move-to (:command segment))
|
||||
point
|
||||
last-move)
|
||||
head-p)))))
|
||||
point))
|
||||
result)))
|
||||
|
||||
(defn- split-command
|
||||
[cmd values]
|
||||
(case (:command cmd)
|
||||
:line-to (gsp/split-line-to-ranges (:prev cmd) cmd values)
|
||||
:curve-to (gsp/split-curve-to-ranges (:prev cmd) cmd values)
|
||||
:line-to (helpers/split-line-to-ranges (:prev cmd) cmd values)
|
||||
:curve-to (helpers/split-curve-to-ranges (:prev cmd) cmd values)
|
||||
[cmd]))
|
||||
|
||||
(defn split-ts [seg-1 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))
|
||||
(defn- split-ts
|
||||
[seg-1 seg-2]
|
||||
(let [cmd-1 (get seg-1 :command)
|
||||
cmd-2 (get seg-2 :command)]
|
||||
(cond
|
||||
(and (= :line-to cmd-1)
|
||||
(= :line-to cmd-2))
|
||||
(helpers/line-line-intersect (helpers/command->line seg-1)
|
||||
(helpers/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 (= :line-to cmd-1)
|
||||
(= :curve-to cmd-2))
|
||||
(helpers/line-curve-intersect (helpers/command->line seg-1)
|
||||
(helpers/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 cmd-1)
|
||||
(= :line-to cmd-2))
|
||||
(let [[seg-2' seg-1']
|
||||
(helpers/line-curve-intersect (helpers/command->line seg-2)
|
||||
(helpers/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))
|
||||
(and (= :curve-to cmd-1)
|
||||
(= :curve-to cmd-2))
|
||||
(helpers/curve-curve-intersect (helpers/command->bezier seg-1)
|
||||
(helpers/command->bezier seg-2))
|
||||
|
||||
:else
|
||||
[[] []]))
|
||||
:else
|
||||
[[] []])))
|
||||
|
||||
(defn content-intersect-split
|
||||
[content-a content-b sr-a sr-b]
|
||||
|
||||
(let [command->selrect (memoize gsp/command->selrect)]
|
||||
(let [command->selrect (memoize helpers/command->selrect)]
|
||||
|
||||
(letfn [(overlap-segment-selrect?
|
||||
[segment selrect]
|
||||
(letfn [(overlap-segment-selrect? [segment selrect]
|
||||
(if (= :move-to (:command segment))
|
||||
false
|
||||
(let [r1 (command->selrect segment)]
|
||||
(grc/overlaps-rects? r1 selrect))))
|
||||
|
||||
(overlap-segments?
|
||||
[seg-1 seg-2]
|
||||
(overlap-segments? [seg-1 seg-2]
|
||||
(if (or (= :move-to (:command seg-1))
|
||||
(= :move-to (:command seg-2)))
|
||||
false
|
||||
|
|
@ -113,17 +145,14 @@
|
|||
r2 (command->selrect seg-2)]
|
||||
(grc/overlaps-rects? r1 r2))))
|
||||
|
||||
(split
|
||||
[seg-1 seg-2]
|
||||
(split [seg-1 seg-2]
|
||||
(if (not (overlap-segments? seg-1 seg-2))
|
||||
[seg-1]
|
||||
(let [[ts-seg-1 _] (split-ts seg-1 seg-2)]
|
||||
(-> (split-command seg-1 ts-seg-1)
|
||||
(add-previous (:prev seg-1))))))
|
||||
|
||||
(split-segment-on-content
|
||||
[segment content content-sr]
|
||||
|
||||
(split-segment-on-content [segment content content-sr]
|
||||
(if (overlap-segment-selrect? segment content-sr)
|
||||
(->> content
|
||||
(filter #(overlap-segments? segment %))
|
||||
|
|
@ -133,8 +162,7 @@
|
|||
[segment]))
|
||||
[segment]))
|
||||
|
||||
(split-content
|
||||
[content-a content-b sr-b]
|
||||
(split-content [content-a content-b sr-b]
|
||||
(into []
|
||||
(mapcat #(split-segment-on-content % content-b sr-b))
|
||||
content-a))]
|
||||
|
|
@ -151,28 +179,28 @@
|
|||
[segment content content-sr content-geom]
|
||||
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
:line-to (-> (helpers/command->line segment)
|
||||
(helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/curve-values 0.5)))]
|
||||
:curve-to (-> (helpers/command->bezier segment)
|
||||
(helpers/curve-values 0.5)))]
|
||||
|
||||
(and (grc/contains-point? content-sr point)
|
||||
(or
|
||||
(gsp/is-point-in-geom-data? point content-geom)
|
||||
(gsp/is-point-in-border? point content)))))
|
||||
(helpers/is-point-in-geom-data? point content-geom)
|
||||
(helpers/is-point-in-border? point content)))))
|
||||
|
||||
(defn inside-segment?
|
||||
[segment content-sr content-geom]
|
||||
(let [point (case (:command segment)
|
||||
:line-to (-> (gsp/command->line segment)
|
||||
(gsp/line-values 0.5))
|
||||
:line-to (-> (helpers/command->line segment)
|
||||
(helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier segment)
|
||||
(gsp/curve-values 0.5)))]
|
||||
:curve-to (-> (helpers/command->bezier segment)
|
||||
(helpers/curve-values 0.5)))]
|
||||
|
||||
(and (grc/contains-point? content-sr point)
|
||||
(gsp/is-point-in-geom-data? point content-geom))))
|
||||
(helpers/is-point-in-geom-data? point content-geom))))
|
||||
|
||||
(defn overlap-segment?
|
||||
"Finds if the current segment is overlapping against other
|
||||
|
|
@ -185,8 +213,8 @@
|
|||
(contains? #{:line-to :curve-to} (:command segment)))
|
||||
|
||||
(case (:command segment)
|
||||
:line-to (let [[p1 q1] (gsp/command->line segment)
|
||||
[p2 q2] (gsp/command->line other)]
|
||||
:line-to (let [[p1 q1] (helpers/command->line segment)
|
||||
[p2 q2] (helpers/command->line other)]
|
||||
|
||||
(when (or (and (< (gpt/distance p1 p2) 0.1)
|
||||
(< (gpt/distance q1 q2) 0.1))
|
||||
|
|
@ -194,8 +222,8 @@
|
|||
(< (gpt/distance q1 p2) 0.1)))
|
||||
[segment other]))
|
||||
|
||||
:curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
|
||||
[p2 q2 h12 h22] (gsp/command->bezier other)]
|
||||
:curve-to (let [[p1 q1 h11 h21] (helpers/command->bezier segment)
|
||||
[p2 q2 h12 h22] (helpers/command->bezier other)]
|
||||
|
||||
(when (or (and (< (gpt/distance p1 p2) 0.1)
|
||||
(< (gpt/distance q1 q2) 0.1)
|
||||
|
|
@ -227,11 +255,11 @@
|
|||
result
|
||||
|
||||
(let [result (if (not= (:prev current) prev)
|
||||
(conj result (upc/make-move-to (:prev current)))
|
||||
(conj result (helpers/make-move-to (:prev current)))
|
||||
result)]
|
||||
(recur (first content)
|
||||
(rest content)
|
||||
(gsp/command->point current)
|
||||
(helpers/command->point current)
|
||||
(conj result (dissoc current :prev)))))))
|
||||
|
||||
(defn remove-duplicated-segments
|
||||
|
|
@ -273,20 +301,43 @@
|
|||
segments
|
||||
result))))))
|
||||
|
||||
(defn close-content
|
||||
[content]
|
||||
(into []
|
||||
(mapcat :data)
|
||||
(->> content
|
||||
(subpath/close-subpaths)
|
||||
(subpath/get-subpaths))))
|
||||
|
||||
(defn- content->geom-data
|
||||
[content]
|
||||
|
||||
(->> content
|
||||
(close-content)
|
||||
(filter #(not= (= :line-to (:command %))
|
||||
(= :curve-to (:command %))))
|
||||
(mapv (fn [segment]
|
||||
{:command (:command segment)
|
||||
:segment segment
|
||||
:geom (if (= :line-to (:command segment))
|
||||
(helpers/command->line segment)
|
||||
(helpers/command->bezier segment))
|
||||
:selrect (helpers/command->selrect segment)}))))
|
||||
|
||||
(defn create-union [content-a content-a-split content-b content-b-split sr-a sr-b]
|
||||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content-b that are not inside content-a
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)
|
||||
(let [content-a-geom (content->geom-data content-a)
|
||||
content-b-geom (content->geom-data content-b)
|
||||
|
||||
content
|
||||
(concat
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
|
||||
(->> content-b-split (filter #(not (contains-segment? % content-a sr-a content-a-geom)))))
|
||||
|
||||
content-geom (gsp/content->geom-data content)
|
||||
content-geom (content->geom-data content)
|
||||
|
||||
content-sr (gsp/content->selrect (fix-move-to content))
|
||||
content-sr (segment/content->selrect (fix-move-to content))
|
||||
|
||||
;; Overlapping segments should be added when they are part of the border
|
||||
border-content
|
||||
|
|
@ -302,8 +353,8 @@
|
|||
;; Pick all segments in content-a that are not inside content-b
|
||||
;; Pick all segments in content b that are inside content-a
|
||||
;; removing overlapping
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)]
|
||||
(let [content-a-geom (content->geom-data content-a)
|
||||
content-b-geom (content->geom-data content-b)]
|
||||
(d/concat-vec
|
||||
(->> content-a-split (filter #(not (contains-segment? % content-b sr-b content-b-geom))))
|
||||
|
||||
|
|
@ -315,13 +366,12 @@
|
|||
(defn create-intersection [content-a content-a-split content-b content-b-split sr-a sr-b]
|
||||
;; Pick all segments in content-a that are inside content-b
|
||||
;; Pick all segments in content-b that are inside content-a
|
||||
(let [content-a-geom (gsp/content->geom-data content-a)
|
||||
content-b-geom (gsp/content->geom-data content-b)]
|
||||
(let [content-a-geom (content->geom-data content-a)
|
||||
content-b-geom (content->geom-data content-b)]
|
||||
(d/concat-vec
|
||||
(->> content-a-split (filter #(contains-segment? % content-b sr-b content-b-geom)))
|
||||
(->> content-b-split (filter #(contains-segment? % content-a sr-a content-a-geom))))))
|
||||
|
||||
|
||||
(defn create-exclusion [content-a content-b]
|
||||
;; Pick all segments
|
||||
(d/concat-vec content-a content-b))
|
||||
|
|
@ -331,26 +381,37 @@
|
|||
|
||||
(let [;; We need to reverse the second path when making a difference/intersection/exclude
|
||||
;; and both shapes are in the same direction
|
||||
should-reverse? (and (not= :union bool-type)
|
||||
(= (ups/clockwise? content-b)
|
||||
(ups/clockwise? content-a)))
|
||||
should-reverse?
|
||||
(and (not= :union bool-type)
|
||||
(= (subpath/clockwise? content-b)
|
||||
(subpath/clockwise? content-a)))
|
||||
|
||||
content-a (-> content-a
|
||||
(close-paths)
|
||||
(add-previous))
|
||||
content-a
|
||||
(-> content-a
|
||||
(close-paths)
|
||||
(add-previous))
|
||||
|
||||
content-b (-> content-b
|
||||
(close-paths)
|
||||
(cond-> should-reverse? (ups/reverse-content))
|
||||
(add-previous))
|
||||
content-b
|
||||
(-> content-b
|
||||
(close-paths)
|
||||
(cond-> should-reverse? (subpath/reverse-content))
|
||||
(add-previous))
|
||||
|
||||
sr-a (gsp/content->selrect content-a)
|
||||
sr-b (gsp/content->selrect content-b)
|
||||
sr-a
|
||||
(segment/content->selrect content-a)
|
||||
|
||||
sr-b
|
||||
(segment/content->selrect 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 sr-a sr-b)
|
||||
content-a-split (->> content-a-split add-previous (filter is-segment?))
|
||||
content-b-split (->> content-b-split add-previous (filter is-segment?))
|
||||
[content-a-split content-b-split]
|
||||
(content-intersect-split content-a content-b sr-a sr-b)
|
||||
|
||||
content-a-split
|
||||
(->> content-a-split add-previous (filter is-segment?))
|
||||
|
||||
content-b-split
|
||||
(->> content-b-split add-previous (filter is-segment?))
|
||||
|
||||
content
|
||||
(case bool-type
|
||||
|
|
@ -362,14 +423,16 @@
|
|||
(-> content
|
||||
remove-duplicated-segments
|
||||
fix-move-to
|
||||
ups/close-subpaths)))
|
||||
subpath/close-subpaths)))
|
||||
|
||||
(defn content-bool
|
||||
(defn calculate-content
|
||||
"Create a bool content from a collection of contents and specified
|
||||
type."
|
||||
[bool-type contents]
|
||||
;; We apply the boolean operation in to each pair and the result to the next
|
||||
;; element
|
||||
(if (seq contents)
|
||||
(->> contents
|
||||
(reduce (partial content-bool-pair bool-type))
|
||||
(into []))
|
||||
(vec))
|
||||
[]))
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -4,84 +4,99 @@
|
|||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.types.shape.path
|
||||
(ns app.common.types.path.impl
|
||||
"Contains schemas and data type implementation for PathData binary
|
||||
and plain formats"
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
#?(:clj [clojure.data.json :as json])
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.transit :as t])
|
||||
[app.common.schema.generators :as sg]
|
||||
[app.common.svg.path :as svg.path]
|
||||
[app.common.transit :as t]
|
||||
[app.common.types.path :as-alias path])
|
||||
(:import
|
||||
#?(:cljs [goog.string StringBuffer]
|
||||
:clj [java.nio ByteBuffer])))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SCHEMA: PLAIN FORMAT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(def ^:const SEGMENT-BYTE-SIZE 28)
|
||||
|
||||
(def schema:line-to-segment
|
||||
[:map
|
||||
[:command [:= :line-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]]]])
|
||||
(defprotocol IPathData
|
||||
(-write-to [_ buffer offset] "write the content to the specified buffer")
|
||||
(-get-byte-size [_] "get byte size"))
|
||||
|
||||
(def schema:close-path-segment
|
||||
[:map
|
||||
[:command [:= :close-path]]])
|
||||
(defprotocol ITransformable
|
||||
(-transform [_ m] "apply a transform"))
|
||||
|
||||
(def schema:move-to-segment
|
||||
[:map
|
||||
[:command [:= :move-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]]]])
|
||||
(defn- transform!
|
||||
"Apply a transformation to a segment located under specified offset"
|
||||
[buffer offset m]
|
||||
(let [a (dm/get-prop m :a)
|
||||
b (dm/get-prop m :b)
|
||||
c (dm/get-prop m :c)
|
||||
d (dm/get-prop m :d)
|
||||
e (dm/get-prop m :e)
|
||||
f (dm/get-prop m :f)
|
||||
t #?(:clj (.getShort ^ByteBuffer buffer offset)
|
||||
:cljs (.getInt16 buffer offset))]
|
||||
|
||||
(def schema:curve-to-segment
|
||||
[:map
|
||||
[:command [:= :curve-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x ::sm/safe-number]
|
||||
[:y ::sm/safe-number]
|
||||
[:c1x ::sm/safe-number]
|
||||
[:c1y ::sm/safe-number]
|
||||
[:c2x ::sm/safe-number]
|
||||
[:c2y ::sm/safe-number]]]])
|
||||
(case t
|
||||
(1 2)
|
||||
(let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))
|
||||
x (+ (* x a) (* y c) e)
|
||||
y (+ (* x b) (* y d) f)]
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 20) x)
|
||||
:cljs (.setFloat32 buffer (+ offset 20) x))
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 24) y)
|
||||
:cljs (.setFloat32 buffer (+ offset 24) y)))
|
||||
|
||||
(def schema:path-segment
|
||||
[:multi {:title "PathSegment"
|
||||
:dispatch :command
|
||||
:decode/json #(update % :command keyword)}
|
||||
[:line-to schema:line-to-segment]
|
||||
[:close-path schema:close-path-segment]
|
||||
[:move-to schema:move-to-segment]
|
||||
[:curve-to schema:curve-to-segment]])
|
||||
3
|
||||
(let [c1x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 4))
|
||||
:cljs (.getFloat32 buffer (+ offset 4)))
|
||||
c1y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 8))
|
||||
:cljs (.getFloat32 buffer (+ offset 8)))
|
||||
c2x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 12))
|
||||
:cljs (.getFloat32 buffer (+ offset 12)))
|
||||
c2y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 16))
|
||||
:cljs (.getFloat32 buffer (+ offset 16)))
|
||||
x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))
|
||||
|
||||
(def schema:path-content
|
||||
[:vector schema:path-segment])
|
||||
c1x (+ (* c1x a) (* c1y c) e)
|
||||
c1y (+ (* c1x b) (* c1y d) f)
|
||||
c2x (+ (* c2x a) (* c2y c) e)
|
||||
c2y (+ (* c2x b) (* c2y d) f)
|
||||
x (+ (* x a) (* y c) e)
|
||||
y (+ (* x b) (* y d) f)]
|
||||
|
||||
(def check-path-content
|
||||
(sm/check-fn schema:path-content))
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 4) c1x)
|
||||
:cljs (.setFloat32 buffer (+ offset 4) c1x))
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 8) c1y)
|
||||
:cljs (.setFloat32 buffer (+ offset 8) c1y))
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 12) c2x)
|
||||
:cljs (.setFloat32 buffer (+ offset 12) c2x))
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 16) c2y)
|
||||
:cljs (.setFloat32 buffer (+ offset 16) c2y))
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 20) x)
|
||||
:cljs (.setFloat32 buffer (+ offset 20) x))
|
||||
#?(:clj (.putFloat ^ByteBuffer buffer (+ offset 24) y)
|
||||
:cljs (.setFloat32 buffer (+ offset 24) y)))
|
||||
|
||||
(sm/register! ::segment schema:path-segment)
|
||||
(sm/register! ::content schema:path-content)
|
||||
nil)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TYPE: PATH-DATA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def ^:const SEGMENT-BYTE-SIZE 28)
|
||||
|
||||
(defprotocol IPathData
|
||||
(-write-to [_ buffer offset] "write the content to the specified buffer")
|
||||
(-bytes [_] "get path data as byte array"))
|
||||
|
||||
(defrecord PathSegment [command params])
|
||||
|
||||
(defn- get-path-string
|
||||
(defn- to-string
|
||||
"Format the path data structure to string"
|
||||
[buffer size]
|
||||
(let [builder #?(:clj (java.lang.StringBuilder. (int (* size 4)))
|
||||
|
|
@ -143,6 +158,7 @@
|
|||
(.toString builder)))
|
||||
|
||||
(defn- read-segment
|
||||
"Read segment from binary buffer at specified index"
|
||||
[buffer index]
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)
|
||||
type #?(:clj (.getShort ^ByteBuffer buffer offset)
|
||||
|
|
@ -152,13 +168,15 @@
|
|||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
(->PathSegment :move-to {:x x :y y}))
|
||||
{:command :move-to
|
||||
:params {:x x :y y}})
|
||||
|
||||
2 (let [x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 20))
|
||||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
(->PathSegment :line-to {:x x :y y}))
|
||||
{:command :line-to
|
||||
:params {:x x :y y}})
|
||||
|
||||
3 (let [c1x #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 4))
|
||||
:cljs (.getFloat32 buffer (+ offset 4)))
|
||||
|
|
@ -172,38 +190,71 @@
|
|||
:cljs (.getFloat32 buffer (+ offset 20)))
|
||||
y #?(:clj (.getFloat ^ByteBuffer buffer (+ offset 24))
|
||||
:cljs (.getFloat32 buffer (+ offset 24)))]
|
||||
{:command :curve-to
|
||||
:params {:x x :y y :c1x c1x :c1y c1y :c2x c2x :c2y c2y}})
|
||||
|
||||
(->PathSegment :curve-to {:x x :y y :c1x c1x :c1y c1y :c2x c2x :c2y c2y}))
|
||||
|
||||
4 (->PathSegment :close-path {}))))
|
||||
4 {:command :close-path
|
||||
:params {}})))
|
||||
|
||||
(defn- in-range?
|
||||
[size i]
|
||||
(and (< i size) (>= i 0)))
|
||||
|
||||
(defn- clone-buffer
|
||||
[buffer]
|
||||
#?(:clj
|
||||
(let [src (.array ^ByteBuffer buffer)
|
||||
len (alength ^bytes src)
|
||||
dst (byte-array len)]
|
||||
(System/arraycopy src 0 dst 0 len)
|
||||
(ByteBuffer/wrap dst))
|
||||
:cljs
|
||||
(let [src-view (js/Uint32Array. buffer)
|
||||
dst-buff (js/ArrayBuffer. (.-byteLength buffer))
|
||||
dst-view (js/Uint32Array. dst-buff)]
|
||||
(.set dst-view src-view)
|
||||
dst-buff)))
|
||||
|
||||
#?(:clj
|
||||
(deftype PathData [size buffer]
|
||||
(deftype PathData [size buffer ^:unsynchronized-mutable hash]
|
||||
Object
|
||||
(toString [_]
|
||||
(get-path-string buffer size))
|
||||
(to-string buffer size))
|
||||
|
||||
clojure.lang.Sequential
|
||||
clojure.lang.IPersistentCollection
|
||||
|
||||
(empty [_]
|
||||
(throw (ex-info "not implemented" {})))
|
||||
(equiv [_ other]
|
||||
(equals [_ other]
|
||||
(if (instance? PathData other)
|
||||
(.equals ^ByteBuffer buffer (.-buffer ^PathData other))
|
||||
false))
|
||||
|
||||
(seq [this]
|
||||
(when (pos? size)
|
||||
(->> (range size)
|
||||
(map (fn [i] (nth this i))))))
|
||||
ITransformable
|
||||
(-transform [_ m]
|
||||
(let [buffer (clone-buffer buffer)]
|
||||
(loop [index 0]
|
||||
(when (< index size)
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)]
|
||||
(transform! buffer offset m)
|
||||
(recur (inc index)))))
|
||||
(PathData. size buffer nil)))
|
||||
|
||||
(cons [_ _val]
|
||||
(throw (ex-info "not implemented" {})))
|
||||
json/JSONWriter
|
||||
(-write [this writter options]
|
||||
(json/-write (.toString this) writter options))
|
||||
|
||||
clojure.lang.IHashEq
|
||||
(hasheq [this]
|
||||
(when-not hash
|
||||
(set! hash (clojure.lang.Murmur3/hashOrdered (seq this))))
|
||||
hash)
|
||||
|
||||
clojure.lang.Sequential
|
||||
clojure.lang.Seqable
|
||||
(seq [_]
|
||||
(when (pos? size)
|
||||
((fn next-seq [i]
|
||||
(when (< i size)
|
||||
(cons (read-segment buffer i)
|
||||
(lazy-seq (next-seq (inc i))))))
|
||||
0)))
|
||||
|
||||
clojure.lang.IReduceInit
|
||||
(reduce [_ f start]
|
||||
|
|
@ -230,33 +281,47 @@
|
|||
clojure.lang.Counted
|
||||
(count [_] size)
|
||||
|
||||
|
||||
IPathData
|
||||
(-write-to [_ _ _]
|
||||
(throw (RuntimeException. "not implemented")))
|
||||
(-get-byte-size [_]
|
||||
(* size SEGMENT-BYTE-SIZE))
|
||||
|
||||
(-bytes [_]
|
||||
(.array ^ByteBuffer buffer)))
|
||||
(-write-to [_ _ _]
|
||||
(throw (RuntimeException. "not implemented"))))
|
||||
|
||||
:cljs
|
||||
(deftype PathData [size buffer dview]
|
||||
#_:clj-kondo/ignore
|
||||
(deftype PathData [size buffer dview ^:mutable __hash]
|
||||
Object
|
||||
(toString [_]
|
||||
(get-path-string dview size))
|
||||
(to-string dview size))
|
||||
|
||||
IPathData
|
||||
(-write-to [_ into-buffer offset]
|
||||
(assert (instance? js/ArrayBuffer into-buffer) "expected an instance of Uint32Array")
|
||||
(let [size (.-byteLength buffer)
|
||||
mem (js/Uint32Array. into-buffer offset size)]
|
||||
(.set mem (js/Uint32Array. buffer))))
|
||||
(-get-byte-size [_]
|
||||
(.-byteLength buffer))
|
||||
|
||||
(-bytes [_]
|
||||
(js/Uint8Array. buffer))
|
||||
(-write-to [_ into-buffer offset]
|
||||
;; NOTE: we still use u8 because until the heap refactor merge
|
||||
;; we can't guarrantee the alignment of offset on 4 bytes
|
||||
(assert (instance? js/ArrayBuffer into-buffer))
|
||||
(let [size (.-byteLength buffer)
|
||||
mem (js/Uint8Array. into-buffer offset size)]
|
||||
(.set mem (js/Uint8Array. buffer))))
|
||||
|
||||
ITransformable
|
||||
(-transform [this m]
|
||||
(let [buffer (clone-buffer buffer)
|
||||
dview (js/DataView. buffer)]
|
||||
(loop [index 0]
|
||||
|
||||
(when (< index size)
|
||||
(let [offset (* index SEGMENT-BYTE-SIZE)]
|
||||
(transform! dview offset m)
|
||||
(recur (inc index)))))
|
||||
(PathData. size buffer dview nil)))
|
||||
|
||||
cljs.core/ISequential
|
||||
cljs.core/IEquiv
|
||||
(-equiv [_ other]
|
||||
(-equiv [this other]
|
||||
(if (instance? PathData other)
|
||||
(let [obuffer (.-buffer other)]
|
||||
(if (= (.-byteLength obuffer)
|
||||
|
|
@ -298,8 +363,8 @@
|
|||
result)))
|
||||
|
||||
cljs.core/IHash
|
||||
(-hash [_]
|
||||
(throw (ex-info "not-implemented" {})))
|
||||
(-hash [coll]
|
||||
(caching-hash coll hash-ordered-coll __hash))
|
||||
|
||||
cljs.core/ICounted
|
||||
(-count [_] size)
|
||||
|
|
@ -319,22 +384,136 @@
|
|||
(-seq [this]
|
||||
(when (pos? size)
|
||||
(->> (range size)
|
||||
(map (fn [i] (cljs.core/-nth this i))))))))
|
||||
(map (fn [i] (cljs.core/-nth this i))))))
|
||||
|
||||
(defn- from-bytes
|
||||
cljs.core/IPrintWithWriter
|
||||
(-pr-writer [this writer _]
|
||||
(cljs.core/-write writer (str "#penpot/path-data \"" (.toString this) "\"")))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SCHEMA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def schema:safe-number
|
||||
[:schema {:gen/gen (sg/small-int :max 100 :min -100)}
|
||||
::sm/safe-number])
|
||||
|
||||
(def ^:private schema:line-to-segment
|
||||
[:map
|
||||
[:command [:= :line-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x schema:safe-number]
|
||||
[:y schema:safe-number]]]])
|
||||
|
||||
(def ^:private schema:close-path-segment
|
||||
[:map
|
||||
[:command [:= :close-path]]])
|
||||
|
||||
(def ^:private schema:move-to-segment
|
||||
[:map
|
||||
[:command [:= :move-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x schema:safe-number]
|
||||
[:y schema:safe-number]]]])
|
||||
|
||||
(def ^:private schema:curve-to-segment
|
||||
[:map
|
||||
[:command [:= :curve-to]]
|
||||
[:params
|
||||
[:map
|
||||
[:x schema:safe-number]
|
||||
[:y schema:safe-number]
|
||||
[:c1x schema:safe-number]
|
||||
[:c1y schema:safe-number]
|
||||
[:c2x schema:safe-number]
|
||||
[:c2y schema:safe-number]]]])
|
||||
|
||||
(def ^:private schema:segment
|
||||
[:multi {:title "PathSegment"
|
||||
:dispatch :command
|
||||
:decode/json #(update % :command keyword)}
|
||||
[:line-to schema:line-to-segment]
|
||||
[:close-path schema:close-path-segment]
|
||||
[:move-to schema:move-to-segment]
|
||||
[:curve-to schema:curve-to-segment]])
|
||||
|
||||
(def schema:segments
|
||||
[:vector {:gen/gen (->> (sg/generator schema:segment)
|
||||
(sg/vector)
|
||||
(sg/filter not-empty)
|
||||
(sg/filter (fn [[e1]]
|
||||
(= (:command e1) :move-to))))}
|
||||
schema:segment])
|
||||
|
||||
(def schema:content-like
|
||||
[:sequential schema:segment])
|
||||
|
||||
(def check-content-like
|
||||
(sm/check-fn schema:content-like))
|
||||
|
||||
(def check-segment
|
||||
(sm/check-fn schema:segment))
|
||||
|
||||
(def ^:private check-segments
|
||||
(sm/check-fn schema:segments))
|
||||
|
||||
(sm/register! ::path/segment schema:segment)
|
||||
(sm/register! ::path/segments schema:segments)
|
||||
|
||||
(defn path-data?
|
||||
[o]
|
||||
(instance? PathData o))
|
||||
|
||||
(declare from-string)
|
||||
(declare from-plain)
|
||||
|
||||
(sm/register!
|
||||
{:type ::path/content
|
||||
:pred path-data?
|
||||
:type-properties
|
||||
{:gen/gen (->> (sg/generator schema:segments)
|
||||
(sg/filter not-empty)
|
||||
(sg/fmap #(from-plain %)))
|
||||
:encode/json identity
|
||||
:decode/json (fn [s]
|
||||
(cond
|
||||
(string? s)
|
||||
(from-string s)
|
||||
|
||||
(vector? s)
|
||||
(from-plain s)
|
||||
|
||||
:else
|
||||
s))}})
|
||||
|
||||
(def check-path-content
|
||||
(sm/check-fn ::path/content))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; CONSTRUCTORS & PREDICATES
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn from-string
|
||||
[s]
|
||||
(from-plain (svg.path/parse s)))
|
||||
|
||||
(defn from-bytes
|
||||
[buffer]
|
||||
#?(:clj
|
||||
(cond
|
||||
(instance? ByteBuffer buffer)
|
||||
(let [size (.capacity ^ByteBuffer buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count buffer))
|
||||
(PathData. count buffer nil))
|
||||
|
||||
(bytes? buffer)
|
||||
(let [size (alength ^bytes buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count
|
||||
(ByteBuffer/wrap buffer)))
|
||||
(ByteBuffer/wrap buffer)
|
||||
nil))
|
||||
|
||||
:else
|
||||
(throw (java.lang.IllegalArgumentException. "invalid data provided")))
|
||||
|
|
@ -346,37 +525,40 @@
|
|||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count
|
||||
buffer
|
||||
(js/DataView. buffer)))
|
||||
(js/DataView. buffer)
|
||||
nil))
|
||||
|
||||
(instance? js/DataView buffer)
|
||||
(let [dview buffer
|
||||
buffer (.-buffer dview)
|
||||
size (.-byteLength buffer)
|
||||
count (long (/ size SEGMENT-BYTE-SIZE))]
|
||||
(PathData. count buffer dview))
|
||||
(PathData. count buffer dview nil))
|
||||
|
||||
(instance? js/Uint8Array buffer)
|
||||
(from-bytes (.-buffer buffer))
|
||||
|
||||
(instance? js/Int8Array buffer)
|
||||
(from-bytes (.-buffer buffer))
|
||||
|
||||
:else
|
||||
(throw (js/Error. "invalid data provided")))))
|
||||
|
||||
;; FIXME: consider implementing with reduce
|
||||
;; FIXME: consider ensure fixed precision for avoid doing it on formatting
|
||||
|
||||
(defn- from-plain
|
||||
(defn from-plain
|
||||
"Create a PathData instance from plain data structures"
|
||||
[content]
|
||||
(assert (check-path-content content))
|
||||
[segments]
|
||||
(assert (check-segments segments))
|
||||
|
||||
(let [content (vec content)
|
||||
total (count content)
|
||||
(let [total (count segments)
|
||||
#?@(:cljs [buffer (new js/ArrayBuffer (* total SEGMENT-BYTE-SIZE))
|
||||
dview (new js/DataView buffer)]
|
||||
:clj [buffer (ByteBuffer/allocate (* total SEGMENT-BYTE-SIZE))])]
|
||||
(loop [index 0]
|
||||
(when (< index total)
|
||||
(let [segment (nth content index)
|
||||
(let [segment (nth segments index)
|
||||
offset (* index SEGMENT-BYTE-SIZE)]
|
||||
(case (get segment :command)
|
||||
:move-to
|
||||
|
|
@ -438,21 +620,30 @@
|
|||
PathData instance"
|
||||
[data]
|
||||
(cond
|
||||
(instance? PathData data)
|
||||
(path-data? data)
|
||||
data
|
||||
|
||||
(nil? data)
|
||||
(from-plain [])
|
||||
|
||||
(sequential? data)
|
||||
(from-plain data)
|
||||
|
||||
:else
|
||||
(from-bytes data)))
|
||||
(throw (ex-info "unexpected data" {:data data}))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SERIALIZATION
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/add-handlers!
|
||||
{:id "penpot/path-data"
|
||||
:class PathData
|
||||
:wfn (fn [^PathData pdata]
|
||||
(-bytes pdata))
|
||||
:rfn path-data})
|
||||
(let [buffer (.-buffer pdata)]
|
||||
#?(:cljs (js/Uint8Array. buffer)
|
||||
:clj (.array ^ByteBuffer buffer))))
|
||||
:rfn from-bytes})
|
||||
|
||||
#?(:clj
|
||||
(fres/add-handlers!
|
||||
|
|
@ -465,4 +656,5 @@
|
|||
(fres/write-bytes! w bytes)))
|
||||
:rfn (fn [r]
|
||||
(let [^bytes bytes (fres/read-object! r)]
|
||||
(path-data (ByteBuffer/wrap bytes))))}))
|
||||
(from-bytes (ByteBuffer/wrap bytes))))}))
|
||||
|
||||
856
common/src/app/common/types/path/segment.cljc
Normal file
856
common/src/app/common/types/path/segment.cljc
Normal file
|
|
@ -0,0 +1,856 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.types.path.segment
|
||||
"A collection of helpers for work with plain segment type"
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.impl :as impl]
|
||||
[clojure.set :as set]))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
(defn get-point
|
||||
"Get a point for a segment"
|
||||
([prev-pos {:keys [relative params] :as segment}]
|
||||
(let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
|
||||
(if relative
|
||||
(-> prev-pos (update :x + x) (update :y + y))
|
||||
(get-point segment))))
|
||||
|
||||
([segment]
|
||||
(when segment
|
||||
(let [{:keys [x y]} (:params segment)]
|
||||
(gpt/point x y)))))
|
||||
|
||||
(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 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)))))
|
||||
|
||||
;; FIXME: rename segments->handlers
|
||||
(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 (get-point cur-cmd)
|
||||
pre-pos (get-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 (get-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 (get-point cur-cmd)
|
||||
pre-pos (get-point pre-cmd)]
|
||||
(cond-> []
|
||||
(= pre-pos point) (conj [index :c1])
|
||||
(= cur-pos point) (conj [index :c2])))
|
||||
[])))))
|
||||
|
||||
(defn opposite-index
|
||||
"Calculates the opposite index given a prefix and an index"
|
||||
[content index prefix]
|
||||
|
||||
(let [point (if (= prefix :c2)
|
||||
(get-point (nth content index))
|
||||
(get-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]] (= (get-point cmd) point)))))
|
||||
|
||||
;; FIXME: candidate to be optimized with native data type operation
|
||||
(defn handler->point
|
||||
[content index prefix]
|
||||
(when (and (some? index)
|
||||
(some? prefix))
|
||||
(when (and (<= 0 index)
|
||||
(< index (count content)))
|
||||
(let [segment (nth content index)
|
||||
params (get segment :params)]
|
||||
(if (= :curve-to (:command segment))
|
||||
(let [[cx cy] (helpers/prefix->coords prefix)]
|
||||
(gpt/point (get params cx)
|
||||
(get params cy)))
|
||||
(gpt/point (get params :x)
|
||||
(get params :y)))))))
|
||||
|
||||
;; FIXME: revisit this function
|
||||
(defn handler->node
|
||||
[content index prefix]
|
||||
(if (= prefix :c1)
|
||||
(get-point (nth content (dec index)))
|
||||
(get-point (nth content index))))
|
||||
|
||||
(defn calculate-opposite-handler
|
||||
"Given a point and its handler, gives the symmetric handler"
|
||||
[point handler]
|
||||
(let [handler-vector (gpt/to-vec point handler)]
|
||||
(gpt/add point (gpt/negate handler-vector))))
|
||||
|
||||
(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))))
|
||||
|
||||
;; FIXME: revisit, this function is executed many times per render on
|
||||
;; path editor it is easy to be implemented in function of PathData
|
||||
;; type in a more efficient way
|
||||
|
||||
(defn content->points
|
||||
"Returns the points in the given content"
|
||||
[content]
|
||||
(letfn [(segment->point [seg]
|
||||
(let [params (get seg :params)
|
||||
x (get params :x)
|
||||
y (get params :y)]
|
||||
(when (d/num? x y)
|
||||
(gpt/point x y))))]
|
||||
(some->> (seq content)
|
||||
(into [] (keep segment->point)))))
|
||||
|
||||
(defn segments->content
|
||||
([segments]
|
||||
(segments->content segments false))
|
||||
|
||||
([segments closed?]
|
||||
(let [initial (first segments)
|
||||
lines (rest segments)]
|
||||
|
||||
(d/concat-vec
|
||||
[{:command :move-to
|
||||
:params (select-keys initial [:x :y])}]
|
||||
|
||||
(->> lines
|
||||
(map #(hash-map :command :line-to
|
||||
:params (select-keys % [:x :y]))))
|
||||
|
||||
(when closed?
|
||||
[{:command :close-path}])))))
|
||||
|
||||
;; FIXME: incorrect API, don't need full shape
|
||||
(defn path->lines
|
||||
"Given a path returns a list of lines that approximate the path"
|
||||
[shape]
|
||||
(loop [command (first (:content shape))
|
||||
pending (rest (:content shape))
|
||||
result []
|
||||
last-start nil
|
||||
prev-point nil]
|
||||
|
||||
(if-let [{:keys [command params]} command]
|
||||
(let [point (if (= :close-path command)
|
||||
last-start
|
||||
(gpt/point params))
|
||||
|
||||
result (case command
|
||||
:line-to (conj result [prev-point point])
|
||||
:curve-to (let [h1 (gpt/point (:c1x params) (:c1y params))
|
||||
h2 (gpt/point (:c2x params) (:c2y params))]
|
||||
(into result (helpers/curve->lines prev-point point h1 h2)))
|
||||
:move-to (cond-> result
|
||||
last-start (conj [prev-point last-start]))
|
||||
result)
|
||||
last-start (if (= :move-to command)
|
||||
point
|
||||
last-start)]
|
||||
(recur (first pending)
|
||||
(rest pending)
|
||||
result
|
||||
last-start
|
||||
point))
|
||||
|
||||
(conj result [prev-point last-start]))))
|
||||
|
||||
(def ^:const path-closest-point-accuracy 0.01)
|
||||
|
||||
;; FIXME: move to helpers?, this function need performance review, it
|
||||
;; is executed so many times on path edition
|
||||
(defn- curve-closest-point
|
||||
[position start end h1 h2]
|
||||
(let [d (memoize (fn [t] (gpt/distance position (helpers/curve-values start end h1 h2 t))))]
|
||||
(loop [t1 0.0
|
||||
t2 1.0]
|
||||
(if (<= (mth/abs (- t1 t2)) path-closest-point-accuracy)
|
||||
(-> (helpers/curve-values start end h1 h2 t1)
|
||||
;; store the segment info
|
||||
(with-meta {:t t1 :from-p start :to-p end}))
|
||||
|
||||
(let [ht (+ t1 (/ (- t2 t1) 2))
|
||||
ht1 (+ t1 (/ (- t2 t1) 4))
|
||||
ht2 (+ t1 (/ (* 3 (- t2 t1)) 4))
|
||||
|
||||
[t1 t2] (cond
|
||||
(< (d ht1) (d ht2))
|
||||
[t1 ht]
|
||||
|
||||
(< (d ht2) (d ht1))
|
||||
[ht t2]
|
||||
|
||||
(and (< (d ht) (d t1)) (< (d ht) (d t2)))
|
||||
[ht1 ht2]
|
||||
|
||||
(< (d t1) (d t2))
|
||||
[t1 ht]
|
||||
|
||||
:else
|
||||
[ht t2])]
|
||||
(recur (double t1)
|
||||
(double t2)))))))
|
||||
|
||||
(defn- line-closest-point
|
||||
"Point on line"
|
||||
[position from-p to-p]
|
||||
|
||||
(let [e1 (gpt/to-vec from-p to-p)
|
||||
e2 (gpt/to-vec from-p position)
|
||||
|
||||
len2 (+ (mth/sq (:x e1)) (mth/sq (:y e1)))
|
||||
t (/ (gpt/dot e1 e2) len2)]
|
||||
|
||||
(if (and (>= t 0) (<= t 1) (not (mth/almost-zero? len2)))
|
||||
(-> (gpt/add from-p (gpt/scale e1 t))
|
||||
(with-meta {:t t
|
||||
:from-p from-p
|
||||
:to-p to-p}))
|
||||
|
||||
;; There is no perpendicular projection in the line so the closest
|
||||
;; point will be one of the extremes
|
||||
(if (<= (gpt/distance position from-p) (gpt/distance position to-p))
|
||||
from-p
|
||||
to-p))))
|
||||
|
||||
;; FIXME: incorrect API, complete shape is not necessary here
|
||||
(defn path-closest-point
|
||||
"Given a path and a position"
|
||||
[shape position]
|
||||
|
||||
(let [point+distance
|
||||
(fn [[cur-cmd prev-cmd]]
|
||||
(let [from-p (helpers/command->point prev-cmd)
|
||||
to-p (helpers/command->point cur-cmd)
|
||||
h1 (gpt/point (get-in cur-cmd [:params :c1x])
|
||||
(get-in cur-cmd [:params :c1y]))
|
||||
h2 (gpt/point (get-in cur-cmd [:params :c2x])
|
||||
(get-in cur-cmd [:params :c2y]))
|
||||
point
|
||||
(case (:command cur-cmd)
|
||||
:line-to
|
||||
(line-closest-point position from-p to-p)
|
||||
|
||||
:curve-to
|
||||
(curve-closest-point position from-p to-p h1 h2)
|
||||
|
||||
nil)]
|
||||
(when point
|
||||
[point (gpt/distance point position)])))
|
||||
|
||||
find-min-point
|
||||
(fn [[min-p min-dist :as acc] [cur-p cur-dist :as cur]]
|
||||
(if (and (some? acc) (or (not cur) (<= min-dist cur-dist)))
|
||||
[min-p min-dist]
|
||||
[cur-p cur-dist]))]
|
||||
|
||||
(->> (:content shape)
|
||||
(d/with-prev)
|
||||
(map point+distance)
|
||||
(reduce find-min-point)
|
||||
(first))))
|
||||
|
||||
(defn- remove-line-curves
|
||||
"Remove all curves that have both handlers in the same position that the
|
||||
beginning 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 (get-point command)
|
||||
pre-point (get-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 (into {} 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- line->curve
|
||||
[from-p segment]
|
||||
|
||||
(let [to-p (get-point segment)
|
||||
|
||||
v (gpt/to-vec from-p to-p)
|
||||
d (gpt/distance from-p to-p)
|
||||
|
||||
dv1 (-> (gpt/normal-left v)
|
||||
(gpt/scale (/ d 3)))
|
||||
|
||||
h1 (gpt/add from-p dv1)
|
||||
|
||||
dv2 (-> (gpt/to-vec to-p h1)
|
||||
(gpt/unit)
|
||||
(gpt/scale (/ d 3)))
|
||||
|
||||
h2 (gpt/add to-p dv2)]
|
||||
(-> segment
|
||||
(assoc :command :curve-to)
|
||||
(update :params (fn [params]
|
||||
;; ensure plain map
|
||||
(-> (into {} params)
|
||||
(assoc :c1x (:x h1))
|
||||
(assoc :c1y (:y h1))
|
||||
(assoc :c2x (:x h2))
|
||||
(assoc :c2y (:y h2))))))))
|
||||
|
||||
(defn is-curve?
|
||||
[content point]
|
||||
(let [handlers (-> (content->handlers content)
|
||||
(get point))
|
||||
handler-points (map #(handler->point content (first %) (second %)) handlers)]
|
||||
(some #(not= point %) handler-points)))
|
||||
|
||||
(def ^:private xf:mapcat-points
|
||||
(comp
|
||||
(mapcat #(vector (:next-p %) (:prev-p %)))
|
||||
(remove nil?)))
|
||||
|
||||
(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 the previous->next points but with fixed length."
|
||||
[content point]
|
||||
|
||||
(let [indices (point-indices content point)
|
||||
vectors (map (fn [index]
|
||||
(let [segment (nth content index)
|
||||
prev-i (dec index)
|
||||
prev (when (not (= :move-to (:command segment)))
|
||||
(get content prev-i))
|
||||
next-i (inc index)
|
||||
next (get content next-i)
|
||||
|
||||
next (when (not (= :move-to (:command next)))
|
||||
next)]
|
||||
{:index index
|
||||
:prev-i (when (some? prev) prev-i)
|
||||
:prev-c prev
|
||||
:prev-p (get-point prev)
|
||||
:next-i (when (some? next) next-i)
|
||||
:next-c next
|
||||
:next-p (get-point next)
|
||||
:segment segment}))
|
||||
indices)
|
||||
|
||||
points (into #{} xf:mapcat-points vectors)]
|
||||
|
||||
(if (= (count points) 2)
|
||||
(let [v1 (gpt/to-vec (first points) point)
|
||||
v2 (gpt/to-vec (first points) (second points))
|
||||
vp (gpt/project v1 v2)
|
||||
vh (gpt/subtract v1 vp)
|
||||
|
||||
add-curve
|
||||
(fn [content {:keys [index prev-p next-p next-i]}]
|
||||
(let [cur-segment (get content index)
|
||||
next-segment (get content next-i)
|
||||
|
||||
;; New handlers for prev-point and next-point
|
||||
prev-h (when (some? prev-p) (gpt/add prev-p vh))
|
||||
next-h (when (some? next-p) (gpt/add next-p vh))
|
||||
|
||||
;; Correct 1/3 to the point improves the curve
|
||||
prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
|
||||
next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
|
||||
|
||||
prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
|
||||
next-h (when (some? next-h) (gpt/add next-h next-correction))]
|
||||
(cond-> content
|
||||
(and (= :line-to (:command cur-segment)) (some? prev-p))
|
||||
(update index helpers/update-curve-to prev-p prev-h)
|
||||
|
||||
(and (= :line-to (:command next-segment)) (some? next-p))
|
||||
(update next-i helpers/update-curve-to next-h next-p)
|
||||
|
||||
(and (= :curve-to (:command cur-segment)) (some? prev-p))
|
||||
(update index update-handler :c2 prev-h)
|
||||
|
||||
(and (= :curve-to (:command next-segment)) (some? next-p))
|
||||
(update next-i update-handler :c1 next-h))))]
|
||||
|
||||
(reduce add-curve content vectors))
|
||||
|
||||
(let [add-curve
|
||||
(fn [content {:keys [index segment prev-p next-c next-i]}]
|
||||
(cond-> content
|
||||
(= :line-to (:command segment))
|
||||
(update index #(line->curve prev-p %))
|
||||
|
||||
(= :curve-to (:command segment))
|
||||
(update index #(line->curve prev-p %))
|
||||
|
||||
(= :line-to (:command next-c))
|
||||
(update next-i #(line->curve point %))
|
||||
|
||||
(= :curve-to (:command next-c))
|
||||
(update next-i #(line->curve point %))))]
|
||||
(reduce add-curve content vectors)))))
|
||||
|
||||
;; FIXME: revisit the impl of this function
|
||||
(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
|
||||
index 0
|
||||
cur-cmd (first content)
|
||||
content (rest content)]
|
||||
|
||||
(let [command (:command cur-cmd)
|
||||
close-path? (= command :close-path)
|
||||
move-to? (= command :move-to)
|
||||
|
||||
;; Close-path makes a segment from the last point to the initial path point
|
||||
cur-point (if close-path?
|
||||
start-point
|
||||
(get-point cur-cmd))
|
||||
|
||||
;; If there is a move-to we don't have a segment
|
||||
prev-point (if move-to?
|
||||
nil
|
||||
prev-point)
|
||||
|
||||
;; We update the start point
|
||||
start-point (if move-to?
|
||||
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 {:start prev-point
|
||||
:end cur-point
|
||||
:cmd cur-cmd
|
||||
:index index}))]
|
||||
|
||||
(if (some? cur-cmd)
|
||||
(recur segments
|
||||
cur-point
|
||||
start-point
|
||||
(inc index)
|
||||
(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 [{:keys [start end cmd index]}]
|
||||
(case (:command cmd)
|
||||
:line-to [index (helpers/split-line-to start cmd value)]
|
||||
:curve-to [index (helpers/split-curve-to start cmd value)]
|
||||
:close-path [index [(helpers/make-line-to (gpt/lerp start end value)) cmd]]
|
||||
nil))
|
||||
|
||||
cmd-changes
|
||||
(->> (get-segments content points)
|
||||
(into {} (comp (map split-command)
|
||||
(filter (comp not nil?)))))
|
||||
|
||||
process-segments
|
||||
(fn [[index command]]
|
||||
(if (contains? cmd-changes index)
|
||||
(get cmd-changes index)
|
||||
[command]))]
|
||||
|
||||
(into [] (mapcat process-segments) (d/enumerate content))))
|
||||
|
||||
;; FIXME: rename to next-segment
|
||||
(defn next-node
|
||||
"Calculates the next-node to be inserted."
|
||||
[content position prev-point prev-handler]
|
||||
(let [position (select-keys position [:x :y])
|
||||
last-command (-> content last :command)
|
||||
add-line? (and prev-point (not prev-handler) (not= last-command :close-path))
|
||||
add-curve? (and prev-point prev-handler (not= last-command :close-path))]
|
||||
(cond
|
||||
add-line? {:command :line-to
|
||||
:params position}
|
||||
add-curve? {:command :curve-to
|
||||
:params (helpers/make-curve-params position prev-handler)}
|
||||
:else {:command :move-to
|
||||
:params position})))
|
||||
(defn remove-nodes
|
||||
"Removes from content the points given. Will try to reconstruct the paths
|
||||
to keep everything consistent"
|
||||
[content points]
|
||||
|
||||
(if (empty? points)
|
||||
content
|
||||
|
||||
(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 (get-point cur-cmd)
|
||||
|
||||
old-prev-point (get-point prev-cmd)
|
||||
new-prev-point (get-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? (seq 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 (juxt :start :end))
|
||||
(get-segments content points))
|
||||
|
||||
create-line-command (fn [point other]
|
||||
[(helpers/make-move-to point)
|
||||
(helpers/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 []))]
|
||||
|
||||
(into 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 (get-point prev-cmd)
|
||||
cur-point (get-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 :start point-b :end :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)))
|
||||
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 (get-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 contiguous segments in points to a single point"
|
||||
[content points]
|
||||
(let [segments (get-segments content points)]
|
||||
(if (seq segments)
|
||||
(let [point->merge-point (-> segments
|
||||
(group-segments)
|
||||
(calculate-merge-points points))]
|
||||
(-> content
|
||||
(separate-nodes points)
|
||||
(replace-points point->merge-point)))
|
||||
content)))
|
||||
|
||||
(defn transform-content
|
||||
"Applies a transformation matrix over content and returns a new
|
||||
content as PathData instance."
|
||||
[content transform]
|
||||
(if (some? transform)
|
||||
(impl/-transform content transform)
|
||||
content))
|
||||
|
||||
(defn move-content
|
||||
"Applies a displacement over content and returns a new content as
|
||||
PathData instance. Implemented in function of `transform-content`."
|
||||
[content move-vec]
|
||||
(let [transform (gmt/translate-matrix move-vec)]
|
||||
(transform-content content transform)))
|
||||
|
||||
;; FIXME: add optimizations
|
||||
(defn content->selrect
|
||||
[content]
|
||||
(let [extremities
|
||||
(loop [points #{}
|
||||
from-p nil
|
||||
move-p nil
|
||||
content (seq content)]
|
||||
(if content
|
||||
(let [last-p (last content)
|
||||
content (if (= :move-to (:command last-p))
|
||||
(butlast content)
|
||||
content)
|
||||
command (first content)
|
||||
to-p (helpers/command->point command)
|
||||
|
||||
[from-p move-p command-pts]
|
||||
(case (:command command)
|
||||
:move-to [to-p to-p (when to-p [to-p])]
|
||||
:close-path [move-p move-p (when move-p [move-p])]
|
||||
:line-to [to-p move-p (when (and from-p to-p) [from-p to-p])]
|
||||
:curve-to [to-p move-p
|
||||
(let [c1 (helpers/command->point command :c1)
|
||||
c2 (helpers/command->point command :c2)
|
||||
curve [from-p to-p c1 c2]]
|
||||
(when (and from-p to-p c1 c2)
|
||||
(into [from-p to-p]
|
||||
(->> (helpers/curve-extremities curve)
|
||||
(map #(helpers/curve-values curve %))))))]
|
||||
[to-p move-p []])]
|
||||
|
||||
(recur (apply conj points command-pts) from-p move-p (next content)))
|
||||
points))
|
||||
|
||||
;; We haven't found any extremes so we turn the commands to points
|
||||
extremities
|
||||
(if (empty? extremities)
|
||||
(->> content (keep helpers/command->point))
|
||||
extremities)]
|
||||
|
||||
;; If no points are returned we return an empty rect.
|
||||
(if (d/not-empty? extremities)
|
||||
(grc/points->rect extremities)
|
||||
(grc/make-rect))))
|
||||
|
||||
(defn content-center
|
||||
[content]
|
||||
(-> content
|
||||
content->selrect
|
||||
grc/rect->center))
|
||||
|
||||
(defn append-segment
|
||||
[content segment]
|
||||
(let [content (cond
|
||||
(impl/path-data? content)
|
||||
(vec content)
|
||||
|
||||
(nil? content)
|
||||
[]
|
||||
|
||||
:else
|
||||
content)]
|
||||
(conj content (impl/check-segment segment))))
|
||||
|
|
@ -4,58 +4,33 @@
|
|||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.svg.path.shapes-to-path
|
||||
(ns app.common.types.path.shape-to-path
|
||||
(:require
|
||||
[app.common.colors :as clr]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.corners :as gso]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.svg.path.bool :as pb]
|
||||
[app.common.svg.path.command :as pc]
|
||||
[app.common.types.path.bool :as bool]
|
||||
[app.common.types.path.helpers :as helpers]
|
||||
[app.common.types.path.segment :as segm]
|
||||
[app.common.types.shape.radius :as ctsr]))
|
||||
|
||||
(def ^:const bezier-circle-c 0.551915024494)
|
||||
(def ^:const ^:private bezier-circle-c
|
||||
0.551915024494)
|
||||
|
||||
(def dissoc-attrs
|
||||
(def ^:private dissoc-attrs
|
||||
[:x :y :width :height
|
||||
:rx :ry :r1 :r2 :r3 :r4
|
||||
:metadata])
|
||||
|
||||
(def allowed-transform-types
|
||||
#{:rect
|
||||
:circle
|
||||
:image})
|
||||
(defn without-position-attrs
|
||||
[shape]
|
||||
(d/without-keys shape dissoc-attrs))
|
||||
|
||||
(def style-group-properties
|
||||
[:shadow
|
||||
:blur])
|
||||
|
||||
(def style-properties
|
||||
(into style-group-properties
|
||||
[:fill-color
|
||||
:fill-opacity
|
||||
:fill-color-gradient
|
||||
:fill-color-ref-file
|
||||
:fill-color-ref-id
|
||||
:fill-image
|
||||
:fills
|
||||
:stroke-color
|
||||
:stroke-color-ref-file
|
||||
:stroke-color-ref-id
|
||||
:stroke-opacity
|
||||
:stroke-style
|
||||
:stroke-width
|
||||
:stroke-alignment
|
||||
:stroke-cap-start
|
||||
:stroke-cap-end
|
||||
:strokes]))
|
||||
|
||||
(def default-bool-fills [{:fill-color clr/black}])
|
||||
|
||||
(defn make-corner-arc
|
||||
(defn- make-corner-arc
|
||||
"Creates a curvle corner for border radius"
|
||||
[from to corner radius]
|
||||
(let [x (case corner
|
||||
|
|
@ -91,9 +66,9 @@
|
|||
:bottom-right (assoc to :x c2x)
|
||||
:bottom-left (assoc to :y c2y))]
|
||||
|
||||
(pc/make-curve-to to h1 h2)))
|
||||
(helpers/make-curve-to to h1 h2)))
|
||||
|
||||
(defn circle->path
|
||||
(defn- circle->path
|
||||
"Creates the bezier curves to approximate a circle shape"
|
||||
[{:keys [x y width height]}]
|
||||
(let [mx (+ x (/ width 2))
|
||||
|
|
@ -112,13 +87,13 @@
|
|||
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))]))
|
||||
[(helpers/make-move-to p1)
|
||||
(helpers/make-curve-to p2 (assoc p1 :x c2x) (assoc p2 :y c1y))
|
||||
(helpers/make-curve-to p3 (assoc p2 :y c2y) (assoc p3 :x c2x))
|
||||
(helpers/make-curve-to p4 (assoc p3 :x c1x) (assoc p4 :y c2y))
|
||||
(helpers/make-curve-to p1 (assoc p4 :y c1y) (assoc p1 :x c1x))]))
|
||||
|
||||
(defn draw-rounded-rect-path
|
||||
(defn- draw-rounded-rect-path
|
||||
([x y width height r]
|
||||
(draw-rounded-rect-path x y width height r r r r))
|
||||
|
||||
|
|
@ -135,21 +110,21 @@
|
|||
p7 (gpt/point (+ x r4) (+ height y))
|
||||
p8 (gpt/point x (+ height y (- r4)))]
|
||||
(-> []
|
||||
(conj (pc/make-move-to p1))
|
||||
(conj (helpers/make-move-to p1))
|
||||
(cond-> (not= p1 p2)
|
||||
(conj (make-corner-arc p1 p2 :top-left r1)))
|
||||
(conj (pc/make-line-to p3))
|
||||
(conj (helpers/make-line-to p3))
|
||||
(cond-> (not= p3 p4)
|
||||
(conj (make-corner-arc p3 p4 :top-right r2)))
|
||||
(conj (pc/make-line-to p5))
|
||||
(conj (helpers/make-line-to p5))
|
||||
(cond-> (not= p5 p6)
|
||||
(conj (make-corner-arc p5 p6 :bottom-right r3)))
|
||||
(conj (pc/make-line-to p7))
|
||||
(conj (helpers/make-line-to p7))
|
||||
(cond-> (not= p7 p8)
|
||||
(conj (make-corner-arc p7 p8 :bottom-left r4)))
|
||||
(conj (pc/make-line-to p1))))))
|
||||
(conj (helpers/make-line-to p1))))))
|
||||
|
||||
(defn rect->path
|
||||
(defn- rect->path
|
||||
"Creates a bezier curve that approximates a rounded corner rectangle"
|
||||
[{:keys [x y width height] :as shape}]
|
||||
(case (ctsr/radius-mode shape)
|
||||
|
|
@ -165,7 +140,10 @@
|
|||
|
||||
(declare convert-to-path)
|
||||
|
||||
(defn fix-first-relative
|
||||
;; FIXME: this looks unnecesary because penpot already normalizes all
|
||||
;; path content to be absolute. There are no relative segments on
|
||||
;; penpot.
|
||||
(defn- fix-first-relative
|
||||
"Fix an issue with the simplify commands not changing the first relative"
|
||||
[content]
|
||||
(let [head (first content)]
|
||||
|
|
@ -173,17 +151,19 @@
|
|||
(and head (:relative head))
|
||||
(update 0 assoc :relative false))))
|
||||
|
||||
(defn group-to-path
|
||||
(defn- group-to-path
|
||||
[group objects]
|
||||
(let [xform (comp (map #(get objects %))
|
||||
(map #(-> (convert-to-path % objects))))
|
||||
(let [xform (comp (map (d/getf objects))
|
||||
(map #(convert-to-path % objects)))
|
||||
|
||||
child-as-paths (into [] xform (:shapes group))
|
||||
head (last child-as-paths)
|
||||
head-data (select-keys head style-properties)
|
||||
head (peek child-as-paths)
|
||||
head-data (select-keys head bool/style-properties)
|
||||
content (into []
|
||||
(comp (filter #(= :path (:type %)))
|
||||
(mapcat #(fix-first-relative (:content %))))
|
||||
(comp (filter cfh/path-shape?)
|
||||
(map :content)
|
||||
(map vec)
|
||||
(mapcat fix-first-relative))
|
||||
child-as-paths)]
|
||||
(-> group
|
||||
(assoc :type :path)
|
||||
|
|
@ -191,54 +171,65 @@
|
|||
(merge head-data)
|
||||
(d/without-keys dissoc-attrs))))
|
||||
|
||||
(defn bool-to-path
|
||||
(defn- bool-to-path
|
||||
[shape objects]
|
||||
|
||||
(let [children (->> (:shapes shape)
|
||||
(map #(get objects %))
|
||||
(map #(convert-to-path % objects)))
|
||||
bool-type (:bool-type shape)
|
||||
content (pb/content-bool bool-type (mapv :content children))]
|
||||
(let [children
|
||||
(->> (:shapes shape)
|
||||
(map (d/getf objects))
|
||||
(map #(convert-to-path % objects)))
|
||||
|
||||
bool-type
|
||||
(:bool-type shape)
|
||||
|
||||
content
|
||||
(bool/calculate-content bool-type (map :content children))]
|
||||
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content content)
|
||||
(dissoc :bool-type)
|
||||
(d/without-keys dissoc-attrs))))
|
||||
|
||||
(defn convert-to-path
|
||||
"Transforms the given shape to a path"
|
||||
([shape]
|
||||
(convert-to-path shape {}))
|
||||
([{:keys [type metadata] :as shape} objects]
|
||||
(assert (map? objects))
|
||||
(case type
|
||||
(:group :frame)
|
||||
(group-to-path shape objects)
|
||||
"Transforms the given shape to a path shape"
|
||||
[shape objects]
|
||||
(assert (map? objects))
|
||||
;; FIXME: add check-objects-like
|
||||
;; FIXME: add check-shape ?
|
||||
|
||||
:bool
|
||||
(bool-to-path shape objects)
|
||||
(let [type (dm/get-prop shape :type)]
|
||||
|
||||
(:rect :circle :image :text)
|
||||
(let [new-content
|
||||
(case type
|
||||
:circle (circle->path shape)
|
||||
#_:else (rect->path shape))
|
||||
(case type
|
||||
(:group :frame)
|
||||
(group-to-path shape objects)
|
||||
|
||||
;; Apply the transforms that had the shape
|
||||
transform
|
||||
(cond-> (:transform shape (gmt/matrix))
|
||||
(:flip-x shape) (gmt/scale (gpt/point -1 1))
|
||||
(:flip-y shape) (gmt/scale (gpt/point 1 -1)))
|
||||
:bool
|
||||
(bool-to-path shape objects)
|
||||
|
||||
new-content (cond-> new-content
|
||||
(some? transform)
|
||||
(gsp/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
|
||||
(:rect :circle :image :text)
|
||||
(let [content
|
||||
(if (= type :circle)
|
||||
(circle->path shape)
|
||||
(rect->path shape))
|
||||
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content new-content)
|
||||
(cond-> (= :image type)
|
||||
(assoc :fill-image metadata))
|
||||
(d/without-keys dissoc-attrs)))
|
||||
;; Apply the transforms that had the shape
|
||||
transform
|
||||
(cond-> (:transform shape (gmt/matrix))
|
||||
(:flip-x shape) (gmt/scale (gpt/point -1 1))
|
||||
(:flip-y shape) (gmt/scale (gpt/point 1 -1)))
|
||||
|
||||
;; For the rest return the plain shape
|
||||
shape)))
|
||||
content
|
||||
(cond-> content
|
||||
(some? transform)
|
||||
(segm/transform-content (gmt/transform-in (gco/shape->center shape) transform)))]
|
||||
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :content content)
|
||||
(cond-> (= :image type)
|
||||
(assoc :fill-image (get shape :metadata)))
|
||||
(d/without-keys dissoc-attrs)))
|
||||
|
||||
;; For the rest return the plain shape
|
||||
shape)))
|
||||
|
|
@ -4,11 +4,11 @@
|
|||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.svg.path.subpath
|
||||
(ns app.common.types.path.subpath
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.svg.path.command :as upc]))
|
||||
[app.common.types.path.helpers :as helpers]))
|
||||
|
||||
(defn pt=
|
||||
"Check if two points are close"
|
||||
|
|
@ -18,7 +18,7 @@
|
|||
(defn make-subpath
|
||||
"Creates a subpath either from a single command or with all the data"
|
||||
([command]
|
||||
(let [p (upc/command->point command)]
|
||||
(let [p (helpers/command->point command)]
|
||||
(make-subpath p p [command])))
|
||||
([from to data]
|
||||
{:from from
|
||||
|
|
@ -29,9 +29,9 @@
|
|||
"Adds a command to the subpath"
|
||||
[subpath command]
|
||||
(let [command (if (= :close-path (:command command))
|
||||
(upc/make-line-to (:from subpath))
|
||||
(helpers/make-line-to (:from subpath))
|
||||
command)
|
||||
p (upc/command->point command)]
|
||||
p (helpers/command->point command)]
|
||||
(-> subpath
|
||||
(assoc :to p)
|
||||
(update :data conj command))))
|
||||
|
|
@ -62,7 +62,7 @@
|
|||
result))
|
||||
|
||||
new-data (->> subpath :data d/with-prev reverse
|
||||
(reduce reverse-commands [(upc/make-move-to (:to subpath))]))]
|
||||
(reduce reverse-commands [(helpers/make-move-to (:to subpath))]))]
|
||||
|
||||
(make-subpath (:to subpath) (:from subpath) new-data)))
|
||||
|
||||
|
|
@ -125,6 +125,9 @@
|
|||
(defn is-closed? [subpath]
|
||||
(pt= (:from subpath) (:to subpath)))
|
||||
|
||||
(def ^:private xf-mapcat-data
|
||||
(mapcat :data))
|
||||
|
||||
(defn close-subpaths
|
||||
"Searches a path for possible subpaths that can create closed loops and merge them"
|
||||
[content]
|
||||
|
|
@ -153,20 +156,17 @@
|
|||
new-subpaths)))
|
||||
result))]
|
||||
|
||||
(->> closed-subpaths
|
||||
(mapcat :data)
|
||||
(into []))))
|
||||
|
||||
(into [] xf-mapcat-data closed-subpaths)))
|
||||
|
||||
;; FIXME: revisit this fn impl for perfromance
|
||||
(defn reverse-content
|
||||
"Given a content reverse the order of the commands"
|
||||
[content]
|
||||
|
||||
(->> content
|
||||
(get-subpaths)
|
||||
(->> (get-subpaths content)
|
||||
(mapv reverse-subpath)
|
||||
(reverse)
|
||||
(mapcat :data)
|
||||
(into [])))
|
||||
(into [] xf-mapcat-data)))
|
||||
|
||||
;; https://mathworld.wolfram.com/PolygonArea.html
|
||||
(defn clockwise?
|
||||
|
|
@ -181,10 +181,10 @@
|
|||
(if (nil? current)
|
||||
(> signed-area 0)
|
||||
|
||||
(let [{x1 :x y1 :y :as p} (upc/command->point current)
|
||||
(let [{x1 :x y1 :y :as p} (helpers/command->point current)
|
||||
last? (nil? (first subpath))
|
||||
first-point (if (nil? first-point) p first-point)
|
||||
{x2 :x y2 :y} (if last? first-point (upc/command->point (first subpath)))
|
||||
{x2 :x y2 :y} (if last? first-point (helpers/command->point (first subpath)))
|
||||
signed-area (+ signed-area (- (* x1 y2) (* x2 y1)))]
|
||||
|
||||
(recur (first subpath)
|
||||
|
|
@ -22,13 +22,14 @@
|
|||
[app.common.transit :as t]
|
||||
[app.common.types.color :as ctc]
|
||||
[app.common.types.grid :as ctg]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.types.plugins :as ctpg]
|
||||
[app.common.types.shape.attrs :refer [default-color]]
|
||||
[app.common.types.shape.blur :as ctsb]
|
||||
[app.common.types.shape.export :as ctse]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.layout :as ctsl]
|
||||
[app.common.types.shape.path :as ctsp]
|
||||
[app.common.types.shape.shadow :as ctss]
|
||||
[app.common.types.shape.text :as ctsx]
|
||||
[app.common.types.token :as cto]
|
||||
|
|
@ -234,7 +235,7 @@
|
|||
[:map {:title "BoolAttrs"}
|
||||
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
|
||||
[:bool-type [::sm/one-of bool-types]]
|
||||
[:content ::ctsp/content]])
|
||||
[:content ::path/content]])
|
||||
|
||||
(def ^:private schema:rect-attrs
|
||||
[:map {:title "RectAttrs"}])
|
||||
|
|
@ -259,7 +260,7 @@
|
|||
|
||||
(def ^:private schema:path-attrs
|
||||
[:map {:title "PathAttrs"}
|
||||
[:content ::ctsp/content]])
|
||||
[:content ::path/content]])
|
||||
|
||||
(def ^:private schema:text-attrs
|
||||
[:map {:title "TextAttrs"}
|
||||
|
|
@ -525,7 +526,7 @@
|
|||
(defn setup-path
|
||||
[{:keys [content selrect points] :as shape}]
|
||||
(let [selrect (or selrect
|
||||
(gsh/content->selrect content)
|
||||
(path.segment/content->selrect content)
|
||||
(grc/make-rect))
|
||||
points (or points (grc/rect->points selrect))]
|
||||
(-> shape
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@
|
|||
[app.common.geom.shapes.transforms :as gsht]
|
||||
[app.common.math :as mth :refer [close?]]
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape :as cts]
|
||||
[clojure.test :as t]))
|
||||
|
||||
|
|
@ -30,7 +31,7 @@
|
|||
(if (= type :path)
|
||||
(cts/setup-shape
|
||||
(into {:type :path
|
||||
:content (:content params default-path)}
|
||||
:content (path/content (:content params default-path))}
|
||||
params))
|
||||
(cts/setup-shape
|
||||
(into {:type type
|
||||
|
|
|
|||
|
|
@ -39,9 +39,9 @@
|
|||
[common-tests.types.absorb-assets-test]
|
||||
[common-tests.types.components-test]
|
||||
[common-tests.types.modifiers-test]
|
||||
[common-tests.types.path-data-test]
|
||||
[common-tests.types.shape-decode-encode-test]
|
||||
[common-tests.types.shape-interactions-test]
|
||||
[common-tests.types.shape-path-data-test]
|
||||
[common-tests.types.tokens-lib-test]
|
||||
[common-tests.uuid-test]))
|
||||
|
||||
|
|
@ -91,5 +91,5 @@
|
|||
'common-tests.types.tokens-lib-test
|
||||
'common-tests.types.components-test
|
||||
'common-tests.types.absorb-assets-test
|
||||
'common-tests.types.shape-path-data-test
|
||||
'common-tests.types.path-data-test
|
||||
'common-tests.uuid-test))
|
||||
|
|
|
|||
179
common/test/common_tests/types/path_data_test.cljc
Normal file
179
common/test/common_tests/types/path_data_test.cljc
Normal file
|
|
@ -0,0 +1,179 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns common-tests.types.path-data-test
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.transit :as trans]
|
||||
[app.common.types.path :as path]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(def sample-content
|
||||
[{:command :move-to :params {:x 480.0 :y 839.0}}
|
||||
{:command :line-to :params {:x 439.0 :y 802.0}}
|
||||
{:command :curve-to :params {:c1x 368.0 :c1y 737.0 :c2x 310.0 :c2y 681.0 :x 264.0 :y 634.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def sample-content-large
|
||||
[{:command :move-to :params {:x 480 :y 839}}
|
||||
{:command :line-to :params {:x 439 :y 802}}
|
||||
{:command :curve-to :params {:c1x 368 :c1y 737 :c2x 310 :c2y 681 :x 264 :y 634}}
|
||||
{:command :curve-to :params {:c1x 218 :c1y 587 :c2x 181 :c2y 545 :x 154 :y 508}}
|
||||
{:command :curve-to :params {:c1x 126 :c1y 471 :c2x 107 :c2y 438 :x 96 :y 408}}
|
||||
{:command :curve-to :params {:c1x 85 :c1y 378 :c2x 80 :c2y 347 :x 80 :y 317}}
|
||||
{:command :curve-to :params {:c1x 80 :c1y 256 :c2x 100 :c2y 206 :x 140 :y 166}}
|
||||
{:command :curve-to :params {:c1x 180 :c1y 126 :c2x 230 :c2y 106 :x 290 :y 106}}
|
||||
{:command :curve-to :params {:c1x 328 :c1y 106 :c2x 363 :c2y 115 :x 395 :y 133}}
|
||||
{:command :curve-to :params {:c1x 427 :c1y 151 :c2x 456 :c2y 177 :x 480 :y 211}}
|
||||
{:command :curve-to :params {:c1x 508 :c1y 175 :c2x 537 :c2y 148 :x 569 :y 131}}
|
||||
{:command :curve-to :params {:c1x 600 :c1y 114 :c2x 634 :c2y 106 :x 670 :y 106}}
|
||||
{:command :curve-to :params {:c1x 729 :c1y 106 :c2x 779 :c2y 126 :x 819 :y 166}}
|
||||
{:command :curve-to :params {:c1x 859 :c1y 206 :c2x 880 :c2y 256 :x 880 :y 317}}
|
||||
{:command :curve-to :params {:c1x 880 :c1y 347 :c2x 874 :c2y 378 :x 863 :y 408}}
|
||||
{:command :curve-to :params {:c1x 852 :c1y 438 :c2x 833 :c2y 471 :x 806 :y 508}}
|
||||
{:command :curve-to :params {:c1x 778 :c1y 545 :c2x 741 :c2y 587 :x 695 :y 634}}
|
||||
{:command :curve-to :params {:c1x 649 :c1y 681 :c2x 591 :c2y 737 :x 521 :y 802}}
|
||||
{:command :line-to :params {:x 480 :y 839}}
|
||||
{:command :close-path :params {}}
|
||||
{:command :move-to :params {:x 480.0 :y 760.0}}
|
||||
{:command :curve-to :params {:c1x 547 :c1y 698 :c2x 603 :c2y 644 :x 646 :y 600}}
|
||||
{:command :curve-to :params {:c1x 690 :c1y 556 :c2x 724 :c2y 517 :x 750 :y 484}}
|
||||
{:command :curve-to :params {:c1x 776 :c1y 450 :c2x 794 :c2y 420 :x 804 :y 394}}
|
||||
{:command :curve-to :params {:c1x 814 :c1y 368 :c2x 820 :c2y 342 :x 820 :y 317}}
|
||||
{:command :curve-to :params {:c1x 820 :c1y 273 :c2x 806 :c2y 236 :x 778 :y 2085}}
|
||||
{:command :curve-to :params {:c1x 750 :c1y 180 :c2x 714 :c2y 166 :x 670 :y 1660}}
|
||||
{:command :curve-to :params {:c1x 635 :c1y 166 :c2x 604 :c2y 176 :x 574 :y 1975}}
|
||||
{:command :curve-to :params {:c1x 545 :c1y 218 :c2x 522 :c2y 248 :x 504 :y 2860}}
|
||||
{:command :line-to :params {:x 455 :y 286}}
|
||||
{:command :curve-to :params {:c1x 437 :c1y 248 :c2x 414 :c2y 219 :x 385 :y 198}}
|
||||
{:command :curve-to :params {:c1x 355 :c1y 176 :c2x 324 :c2y 166 :x 289 :y 166}}
|
||||
{:command :curve-to :params {:c1x 245 :c1y 166 :c2x 210 :c2y 180 :x 182 :y 208}}
|
||||
{:command :curve-to :params {:c1x 154 :c1y 236 :c2x 140 :c2y 273 :x 140 :y 317}}
|
||||
{:command :curve-to :params {:c1x 140 :c1y 343 :c2x 145 :c2y 369 :x 155 :y 395}}
|
||||
{:command :curve-to :params {:c1x 165 :c1y 421 :c2x 183 :c2y 451 :x 209 :y 485}}
|
||||
{:command :curve-to :params {:c1x 235 :c1y 519 :c2x 270 :c2y 558 :x 314 :y 602}}
|
||||
{:command :curve-to :params {:c1x 358 :c1y 646 :c2x 413 :c2y 698 :x 480 :y 760}}
|
||||
{:command :close-path :params {}}
|
||||
{:command :move-to :params {:x 480 :y 463}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def sample-bytes
|
||||
[0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -16 0 0 68 81 -64 0
|
||||
0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -37 -128 0 68 72 -128 0
|
||||
0 3 0 0 67 -72 0 0 68 56 64 0 67 -101 0 0 68 42 64 0 67 -124 0 0 68 30 -128 0
|
||||
0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
|
||||
|
||||
;; This means it implements IReduceInit/IReduce protocols
|
||||
(t/deftest path-data-to-vector
|
||||
(let [pdata (path/content sample-content)
|
||||
result (vec pdata)]
|
||||
(t/is (= 4 (count result)))
|
||||
(t/is (= (get-in sample-content [0 :command])
|
||||
(get-in result [0 :command])))
|
||||
(t/is (= (get-in sample-content [1 :command])
|
||||
(get-in result [1 :command])))
|
||||
(t/is (= (get-in sample-content [2 :command])
|
||||
(get-in result [2 :command])))
|
||||
(t/is (= (get-in sample-content [3 :command])
|
||||
(get-in result [3 :command])))
|
||||
|
||||
(t/is (= (get-in sample-content [0 :params])
|
||||
(get-in result [0 :params])))
|
||||
(t/is (= (get-in sample-content [1 :params])
|
||||
(get-in result [1 :params])))
|
||||
(t/is (= (get-in sample-content [2 :params])
|
||||
(get-in result [2 :params])))
|
||||
(t/is (= (get-in sample-content [3 :params])
|
||||
(get-in result [3 :params])))))
|
||||
|
||||
(t/deftest path-data-plain-to-binary
|
||||
(let [pdata (path/content sample-content)]
|
||||
(t/is (= sample-bytes
|
||||
(vec
|
||||
#?(:cljs (js/Int8Array. (.-buffer pdata))
|
||||
:clj (.array (.-buffer pdata))))))
|
||||
(t/is (= sample-content
|
||||
(vec pdata)))))
|
||||
|
||||
(t/deftest path-data-from-binary
|
||||
(let [barray #?(:clj (byte-array sample-bytes)
|
||||
:cljs (js/Int8Array.from sample-bytes))
|
||||
content (path/from-bytes barray)]
|
||||
|
||||
(t/is (= (vec content) sample-content))))
|
||||
|
||||
(t/deftest path-data-transit-roundtrip
|
||||
(let [pdata (path/content sample-content)
|
||||
result1 (trans/encode-str pdata)
|
||||
expected (str "[\"~#penpot/path-data\",\"~bAAEAAAAAAAAAAAAAAAAAAAAAAA"
|
||||
"BD8AAARFHAAAACAAAAAAAAAAAAAAAAAAAAAAAAQ9uAAERIgAAAAwAA"
|
||||
"Q7gAAEQ4QABDmwAARCpAAEOEAABEHoAAAAQAAAAAAAAAAAAAAAAAAA"
|
||||
"AAAAAAAAAAAAAAAA==\"]")
|
||||
result2 (trans/decode-str result1)]
|
||||
(t/is (= expected result1))
|
||||
(t/is (= pdata result2))))
|
||||
|
||||
#?(:clj
|
||||
(t/deftest path-data-fresian
|
||||
(let [pdata (path/content sample-content)
|
||||
result1 (fres/encode pdata)
|
||||
result2 (fres/decode result1)]
|
||||
(t/is (= pdata result2)))))
|
||||
|
||||
(defn- transform-plain-content
|
||||
"Apply a transformation to a path content;
|
||||
|
||||
This is a copy of previous impl, that uses plain format to calculate
|
||||
the new transformed path content"
|
||||
[content transform]
|
||||
(let [set-tr
|
||||
(fn [params px py]
|
||||
(let [tr-point (-> (gpt/point (get params px) (get params py))
|
||||
(gpt/transform transform))]
|
||||
(assoc params
|
||||
px (:x tr-point)
|
||||
py (:y tr-point))))
|
||||
|
||||
transform-params
|
||||
(fn [{:keys [x c1x c2x] :as params}]
|
||||
(cond-> params
|
||||
(some? x) (set-tr :x :y)
|
||||
(some? c1x) (set-tr :c1x :c1y)
|
||||
(some? c2x) (set-tr :c2x :c2y)))]
|
||||
|
||||
(into []
|
||||
(map #(update % :params transform-params))
|
||||
content)))
|
||||
|
||||
(t/deftest path-transform-1
|
||||
(let [matrix (gmt/translate-matrix 10 10)
|
||||
content (path/content sample-content)
|
||||
|
||||
result1 (path/transform-content content matrix)
|
||||
result2 (transform-plain-content sample-content matrix)
|
||||
result3 (transform-plain-content content matrix)]
|
||||
|
||||
(t/is (= (vec result1) result2))
|
||||
(t/is (= result2 result3))))
|
||||
|
||||
(t/deftest path-transform-2
|
||||
(let [matrix (gmt/translate-matrix 10 10)
|
||||
content (path/content sample-content-large)
|
||||
|
||||
result1 (path/transform-content content matrix)
|
||||
result2 (transform-plain-content sample-content-large matrix)
|
||||
result3 (transform-plain-content content matrix)]
|
||||
|
||||
(t/is (= (vec result1) result2))
|
||||
(t/is (= result2 result3))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -12,10 +12,10 @@
|
|||
[app.common.schema.generators :as sg]
|
||||
[app.common.schema.test :as smt]
|
||||
[app.common.types.color :refer [schema:color schema:gradient]]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.plugins :refer [schema:plugin-data]]
|
||||
[app.common.types.shape :as tsh]
|
||||
[app.common.types.shape.interactions :refer [schema:animation schema:interaction]]
|
||||
[app.common.types.shape.path :refer [schema:path-content]]
|
||||
[app.common.types.shape.shadow :refer [schema:shadow]]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.test :as t]))
|
||||
|
|
@ -112,17 +112,14 @@
|
|||
(= interaction interaction-3)))
|
||||
{:num 500})))
|
||||
|
||||
|
||||
(t/deftest shape-path-content-json-roundtrip
|
||||
(let [encode (sm/encoder schema:path-content (sm/json-transformer))
|
||||
decode (sm/decoder schema:path-content (sm/json-transformer))]
|
||||
(let [encode (sm/encoder ::path/content (sm/json-transformer))
|
||||
decode (sm/decoder ::path/content (sm/json-transformer))]
|
||||
(smt/check!
|
||||
(smt/for [path-content (sg/generator schema:path-content)]
|
||||
(smt/for [path-content (sg/generator ::path/content)]
|
||||
(let [path-content-1 (encode path-content)
|
||||
path-content-2 (json-roundtrip path-content-1)
|
||||
path-content-3 (decode path-content-2)]
|
||||
;; (app.common.pprint/pprint path-content)
|
||||
;; (app.common.pprint/pprint path-content-3)
|
||||
(= path-content path-content-3)))
|
||||
{:num 500})))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,77 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns common-tests.types.shape-path-data-test
|
||||
(:require
|
||||
#?(:clj [app.common.fressian :as fres])
|
||||
[app.common.data :as d]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.transit :as trans]
|
||||
[app.common.types.shape.path :as path]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(def sample-content
|
||||
[{:command :move-to, :params {:x 480.0, :y 839.0}}
|
||||
{:command :line-to, :params {:x 439.0, :y 802.0}}
|
||||
{:command :curve-to, :params {:c1x 368.0, :c1y 737.0, :c2x 310.0, :c2y 681.0, :x 264.0, :y 634.0}}
|
||||
{:command :close-path :params {}}])
|
||||
|
||||
(def sample-bytes
|
||||
[0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -16 0 0 68 81 -64 0
|
||||
0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67 -37 -128 0 68 72 -128 0
|
||||
0 3 0 0 67 -72 0 0 68 56 64 0 67 -101 0 0 68 42 64 0 67 -124 0 0 68 30 -128 0
|
||||
0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0])
|
||||
|
||||
;; This means it implements IReduceInit/IReduce protocols
|
||||
(t/deftest path-data-to-vector
|
||||
(let [pdata (path/path-data sample-content)
|
||||
result (vec pdata)]
|
||||
(t/is (= 4 (count result)))
|
||||
(t/is (= (get-in sample-content [0 :command])
|
||||
(get-in result [0 :command])))
|
||||
(t/is (= (get-in sample-content [1 :command])
|
||||
(get-in result [1 :command])))
|
||||
(t/is (= (get-in sample-content [2 :command])
|
||||
(get-in result [2 :command])))
|
||||
(t/is (= (get-in sample-content [3 :command])
|
||||
(get-in result [3 :command])))
|
||||
|
||||
(t/is (= (get-in sample-content [0 :params])
|
||||
(get-in result [0 :params])))
|
||||
(t/is (= (get-in sample-content [1 :params])
|
||||
(get-in result [1 :params])))
|
||||
(t/is (= (get-in sample-content [2 :params])
|
||||
(get-in result [2 :params])))
|
||||
(t/is (= (get-in sample-content [3 :params])
|
||||
(get-in result [3 :params])))))
|
||||
|
||||
(t/deftest path-data-plain-to-binary
|
||||
(let [pdata (path/path-data sample-content)]
|
||||
(t/is (= sample-bytes
|
||||
(vec
|
||||
#?(:cljs (js/Int8Array. (.-buffer pdata))
|
||||
:clj (.array (.-buffer pdata))))))
|
||||
(t/is (= (->> sample-content
|
||||
(mapv path/map->PathSegment))
|
||||
(vec pdata)))))
|
||||
|
||||
(t/deftest path-data-transit-roundtrip
|
||||
(let [pdata (path/path-data sample-content)
|
||||
result1 (trans/encode-str pdata)
|
||||
expected "[\"~#penpot/path-data\",\"~bAAEAAAAAAAAAAAAAAAAAAAAAAABD8AAARFHAAAACAAAAAAAAAAAAAAAAAAAAAAAAQ9uAAERIgAAAAwAAQ7gAAEQ4QABDmwAARCpAAEOEAABEHoAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==\"]"
|
||||
result2 (trans/decode-str result1)]
|
||||
|
||||
(t/is (= expected result1))
|
||||
(t/is (= pdata result2))))
|
||||
|
||||
#?(:clj
|
||||
(t/deftest path-data-fresian
|
||||
(let [pdata (path/path-data sample-content)
|
||||
result1 (fres/encode pdata)
|
||||
result2 (fres/decode result1)]
|
||||
(t/is (= pdata result2)))))
|
||||
|
||||
|
|
@ -448,55 +448,7 @@
|
|||
},
|
||||
"~:rotation": 0,
|
||||
"~:grow-type": "~:fixed",
|
||||
"~:content": [
|
||||
{
|
||||
"~:command": "~:move-to",
|
||||
"~:params": {
|
||||
"~:x": 1121,
|
||||
"~:y": 554
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:line-to",
|
||||
"~:params": {
|
||||
"~:x": 1229,
|
||||
"~:y": 458
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:curve-to",
|
||||
"~:params": {
|
||||
"~:x": 1303,
|
||||
"~:y": 518,
|
||||
"~:c1x": 1229,
|
||||
"~:c1y": 458,
|
||||
"~:c2x": 1320,
|
||||
"~:c2y": 492
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:curve-to",
|
||||
"~:params": {
|
||||
"~:x": 1219,
|
||||
"~:y": 584,
|
||||
"~:c1x": 1286,
|
||||
"~:c1y": 544,
|
||||
"~:c2x": 1258,
|
||||
"~:c2y": 572
|
||||
}
|
||||
},
|
||||
{
|
||||
"~:command": "~:curve-to",
|
||||
"~:params": {
|
||||
"~:x": 1121,
|
||||
"~:y": 554,
|
||||
"~:c1x": 1180,
|
||||
"~:c1y": 596,
|
||||
"~:c2x": 1121,
|
||||
"~:c2y": 554
|
||||
}
|
||||
}
|
||||
],
|
||||
"~:content": ["~#penpot/path-data","~bAAEAAAAAAAAAAAAAAAAAAAAAAABEjCAARAqAAAACAAAAAAAAAAAAAAAAAAAAAAAARJmgAEPlAAAAAwAARJmgAEPlAABEpQAAQ/YAAESi4ABEAYAAAAMAAESgwABECAAARJ1AAEQPAABEmGAARBIAAAADAABEk4AARBUAAESMIABECoAARIwgAEQKgAA="],
|
||||
"~:name": "Path",
|
||||
"~:width": null,
|
||||
"~:type": "~:path",
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.svg.path.command :as upc]))
|
||||
[app.common.types.path :as path]))
|
||||
|
||||
(defn lookup-profile
|
||||
([state]
|
||||
|
|
@ -157,7 +157,7 @@
|
|||
shape)
|
||||
modifiers (dm/get-in content-modifiers [id :content-modifiers])
|
||||
shape (if (some? modifiers)
|
||||
(update shape :content upc/apply-content-modifiers modifiers)
|
||||
(update shape :content path/apply-content-modifiers modifiers)
|
||||
shape)]
|
||||
(assoc result id shape))
|
||||
result))
|
||||
|
|
|
|||
|
|
@ -10,9 +10,10 @@
|
|||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cph]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.svg.path.shapes-to-path :as stp]
|
||||
[app.common.types.component :as ctc]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.bool :as bool]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.uuid :as uuid]
|
||||
|
|
@ -30,7 +31,7 @@
|
|||
(or id (uuid/next))
|
||||
|
||||
shapes
|
||||
(mapv #(stp/convert-to-path % objects) shapes)
|
||||
(mapv #(path/convert-to-path % objects) shapes)
|
||||
|
||||
head
|
||||
(if (= type :difference) (first shapes) (last shapes))
|
||||
|
|
@ -38,7 +39,7 @@
|
|||
head
|
||||
(cond-> head
|
||||
(and (contains? head :svg-attrs) (empty? (:fills head)))
|
||||
(assoc :fills stp/default-bool-fills))
|
||||
(assoc :fills bool/default-fills))
|
||||
|
||||
shape
|
||||
{:id shape-id
|
||||
|
|
@ -51,7 +52,7 @@
|
|||
|
||||
shape
|
||||
(-> shape
|
||||
(merge (select-keys head stp/style-properties))
|
||||
(merge (select-keys head bool/style-properties))
|
||||
(cts/setup-shape)
|
||||
(gsh/update-bool-selrect shapes objects))]
|
||||
|
||||
|
|
@ -108,12 +109,12 @@
|
|||
[type group objects]
|
||||
(let [shapes (->> (:shapes group)
|
||||
(map #(get objects %))
|
||||
(mapv #(stp/convert-to-path % objects)))
|
||||
(mapv #(path/convert-to-path % objects)))
|
||||
head (if (= type :difference) (first shapes) (last shapes))
|
||||
head (cond-> head
|
||||
(and (contains? head :svg-attrs) (empty? (:fills head)))
|
||||
(assoc :fills stp/default-bool-fills))
|
||||
head-data (select-keys head stp/style-properties)]
|
||||
(assoc :fills bool/default-fills))
|
||||
head-data (select-keys head bool/style-properties)]
|
||||
|
||||
(-> group
|
||||
(assoc :type :bool)
|
||||
|
|
@ -136,7 +137,7 @@
|
|||
(-> shape
|
||||
(assoc :type :group)
|
||||
(dissoc :bool-type)
|
||||
(d/without-keys stp/style-group-properties)
|
||||
(d/without-keys bool/style-group-properties)
|
||||
(gsh/update-group-selrect
|
||||
(mapv (d/getf objects)
|
||||
(:shapes shape)))))
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.math :as mth]
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.main.data.helpers :as dsh]
|
||||
[app.main.data.workspace.shapes :as dwsh]
|
||||
|
|
@ -65,6 +66,10 @@
|
|||
(-> (assoc :height 17 :width 4 :grow-type :auto-width)
|
||||
(cts/setup-shape))
|
||||
|
||||
(or (cfh/path-shape? shape)
|
||||
(cfh/bool-shape? shape))
|
||||
(update :content path/content)
|
||||
|
||||
:always
|
||||
(dissoc :initialized? :click-draw?))]
|
||||
|
||||
|
|
|
|||
|
|
@ -9,11 +9,10 @@
|
|||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.flex-layout :as gslf]
|
||||
[app.common.geom.shapes.grid-layout :as gslg]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
|
|
@ -37,8 +36,8 @@
|
|||
(fn [object]
|
||||
(let [segments (-> (:segments object)
|
||||
(conj point))
|
||||
content (gsp/segments->content segments)
|
||||
selrect (gsh/content->selrect content)
|
||||
content (path.segm/segments->content segments)
|
||||
selrect (path.segm/content->selrect content)
|
||||
points (grc/rect->points selrect)]
|
||||
(-> object
|
||||
(assoc :segments segments)
|
||||
|
|
@ -81,8 +80,8 @@
|
|||
(update-in state [:workspace-drawing :object]
|
||||
(fn [{:keys [segments] :as shape}]
|
||||
(let [segments (ups/simplify segments simplify-tolerance)
|
||||
content (gsp/segments->content segments)
|
||||
selrect (gsh/content->selrect content)
|
||||
content (path.segm/segments->content segments)
|
||||
selrect (path.segm/content->selrect content)
|
||||
points (grc/rect->points selrect)]
|
||||
(-> shape
|
||||
(dissoc :segments)
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@
|
|||
[app.common.types.component :as ctk]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.modifiers :as ctm]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.shape.attrs :refer [editable-attrs]]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
|
|
@ -705,6 +706,9 @@
|
|||
(gsh/transform-shape modifiers)
|
||||
(cond-> (d/not-empty? pos-data)
|
||||
(assoc-position-data pos-data shape))
|
||||
(cond-> (or (cfh/path-shape? shape)
|
||||
(cfh/bool-shape? shape))
|
||||
(update :content path/content))
|
||||
(cond-> text-shape?
|
||||
(update-grow-type shape)))))]
|
||||
|
||||
|
|
|
|||
|
|
@ -6,12 +6,10 @@
|
|||
|
||||
(ns app.main.data.workspace.path.changes
|
||||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.types.path :as path]
|
||||
[app.main.data.changes :as dch]
|
||||
[app.main.data.helpers :as dsh]
|
||||
[app.main.data.workspace.path.common :refer [check-path-content!]]
|
||||
[app.main.data.workspace.path.helpers :as helpers]
|
||||
[app.main.data.workspace.path.state :as st]
|
||||
[beicon.v2.core :as rx]
|
||||
[potok.v2.core :as ptk]))
|
||||
|
|
@ -20,31 +18,25 @@
|
|||
"Generates changes to update the new content of the shape"
|
||||
[it objects page-id shape old-content new-content]
|
||||
|
||||
(dm/assert!
|
||||
"expected valid path content"
|
||||
(and (check-path-content! old-content)
|
||||
(check-path-content! new-content)))
|
||||
(assert (path/check-path-content old-content))
|
||||
(assert (path/check-path-content new-content))
|
||||
|
||||
(let [shape-id (:id shape)
|
||||
|
||||
[old-points old-selrect]
|
||||
(helpers/content->points+selrect shape old-content)
|
||||
|
||||
[new-points new-selrect]
|
||||
(helpers/content->points+selrect shape new-content)
|
||||
|
||||
;; We set the old values so the update-shapes works
|
||||
objects
|
||||
(-> objects
|
||||
(update
|
||||
shape-id
|
||||
assoc
|
||||
:content old-content
|
||||
:selrect old-selrect
|
||||
:points old-points))
|
||||
(update objects shape-id
|
||||
(fn [shape]
|
||||
(-> shape
|
||||
(assoc :content old-content)
|
||||
(path/update-geometry))))
|
||||
|
||||
changes (-> (pcb/empty-changes it page-id)
|
||||
(pcb/with-objects objects))]
|
||||
changes
|
||||
(-> (pcb/empty-changes it page-id)
|
||||
(pcb/with-objects objects))
|
||||
|
||||
new-content
|
||||
(path/content new-content)]
|
||||
|
||||
(cond
|
||||
;; https://tree.taiga.io/project/penpot/issue/2366
|
||||
|
|
@ -60,10 +52,9 @@
|
|||
(-> changes
|
||||
(pcb/update-shapes [shape-id]
|
||||
(fn [shape]
|
||||
(assoc shape
|
||||
:content new-content
|
||||
:selrect new-selrect
|
||||
:points new-points)))
|
||||
(-> shape
|
||||
(assoc :content new-content)
|
||||
(path/update-geometry))))
|
||||
(pcb/resize-parents [shape-id])))))
|
||||
|
||||
(defn save-path-content
|
||||
|
|
@ -88,6 +79,7 @@
|
|||
id (get-in state [:workspace-local :edition])
|
||||
old-content (get-in state [:workspace-local :edit-path id :old-content])
|
||||
shape (st/get-path state)]
|
||||
|
||||
(if (and (some? old-content) (some? (:id shape)))
|
||||
(let [changes (generate-path-changes it objects page-id shape old-content (:content shape))]
|
||||
(rx/of (dch/commit-changes changes)))
|
||||
|
|
|
|||
|
|
@ -6,44 +6,10 @@
|
|||
|
||||
(ns app.main.data.workspace.path.common
|
||||
(:require
|
||||
[app.common.schema :as sm]
|
||||
[app.common.svg.path.subpath :as ups]
|
||||
[app.common.types.path :as path]
|
||||
[app.main.data.workspace.path.state :as st]
|
||||
[potok.v2.core :as ptk]))
|
||||
|
||||
(def valid-commands
|
||||
#{:move-to
|
||||
:line-to
|
||||
:line-to-horizontal
|
||||
:line-to-vertical
|
||||
:curve-to
|
||||
:smooth-curve-to
|
||||
:quadratic-bezier-curve-to
|
||||
:smooth-quadratic-bezier-curve-to
|
||||
:elliptical-arc
|
||||
:close-path})
|
||||
|
||||
;; FIXME: should this schema be defined on common.types ?
|
||||
|
||||
(def ^:private
|
||||
schema:path-content
|
||||
[:vector {:title "PathContent"}
|
||||
[:map {:title "PathContentEntry"}
|
||||
[:command [::sm/one-of valid-commands]]
|
||||
;; FIXME: remove the `?` from prop name
|
||||
[:relative? {:optional true} :boolean]
|
||||
[:params {:optional true}
|
||||
[:map {:title "PathContentEntryParams"}
|
||||
[:x :double]
|
||||
[:y :double]
|
||||
[:c1x {:optional true} :double]
|
||||
[:c1y {:optional true} :double]
|
||||
[:c2x {:optional true} :double]
|
||||
[:c2y {:optional true} :double]]]]])
|
||||
|
||||
(def check-path-content!
|
||||
(sm/check-fn schema:path-content))
|
||||
|
||||
(defn init-path []
|
||||
(ptk/reify ::init-path))
|
||||
|
||||
|
|
@ -59,4 +25,4 @@
|
|||
(let [id (st/get-path-id state)]
|
||||
(-> state
|
||||
(update-in [:workspace-local :edit-path id] clean-edit-state)
|
||||
(update-in (st/get-path-location state :content) ups/close-subpaths))))))
|
||||
(update-in (st/get-path-location state :content) path/close-subpaths))))))
|
||||
|
|
|
|||
|
|
@ -9,9 +9,10 @@
|
|||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.flex-layout :as gsl]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.svg.path.shapes-to-path :as upsp]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
|
|
@ -19,7 +20,7 @@
|
|||
[app.main.data.workspace.drawing.common :as dwdc]
|
||||
[app.main.data.workspace.edition :as dwe]
|
||||
[app.main.data.workspace.path.changes :as changes]
|
||||
[app.main.data.workspace.path.common :as common :refer [check-path-content!]]
|
||||
[app.main.data.workspace.path.common :as common]
|
||||
[app.main.data.workspace.path.helpers :as helpers]
|
||||
[app.main.data.workspace.path.state :as st]
|
||||
[app.main.data.workspace.path.streams :as streams]
|
||||
|
|
@ -39,10 +40,10 @@
|
|||
fix-angle? shift?
|
||||
last-point (get-in state [:workspace-local :edit-path id :last-point])
|
||||
position (cond-> (gpt/point x y)
|
||||
fix-angle? (helpers/position-fixed-angle last-point))
|
||||
fix-angle? (path.helpers/position-fixed-angle last-point))
|
||||
shape (st/get-path state)
|
||||
{:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
|
||||
command (helpers/next-node shape position last-point prev-handler)]
|
||||
command (path.segment/next-node shape position last-point prev-handler)]
|
||||
(assoc-in state [:workspace-local :edit-path id :preview] command)))))
|
||||
|
||||
(defn add-node
|
||||
|
|
@ -54,7 +55,7 @@
|
|||
fix-angle? shift?
|
||||
{:keys [last-point prev-handler]} (get-in state [:workspace-local :edit-path id])
|
||||
position (cond-> (gpt/point x y)
|
||||
fix-angle? (helpers/position-fixed-angle last-point))]
|
||||
fix-angle? (path.helpers/position-fixed-angle last-point))]
|
||||
(if-not (= last-point position)
|
||||
(-> state
|
||||
(assoc-in [:workspace-local :edit-path id :last-point] position)
|
||||
|
|
@ -75,12 +76,12 @@
|
|||
|
||||
index (or index (count content))
|
||||
prefix (or prefix :c1)
|
||||
position (or position (upc/command->point (nth content (dec index))))
|
||||
position (or position (path.segment/get-point (nth content (dec index))))
|
||||
|
||||
old-handler (upc/handler->point content index prefix)
|
||||
old-handler (path.segment/handler->point content index prefix)
|
||||
|
||||
handler-position (cond-> (gpt/point x y)
|
||||
shift? (helpers/position-fixed-angle position))
|
||||
shift? (path.helpers/position-fixed-angle position))
|
||||
|
||||
{dx :x dy :y} (if (some? old-handler)
|
||||
(gpt/add (gpt/to-vec old-handler position)
|
||||
|
|
@ -102,7 +103,7 @@
|
|||
|
||||
modifiers (get-in state [:workspace-local :edit-path id :content-modifiers])
|
||||
content (-> (st/get-path state :content)
|
||||
(upc/apply-content-modifiers modifiers))
|
||||
(path/apply-content-modifiers modifiers))
|
||||
|
||||
handler (get-in state [:workspace-local :edit-path id :drag-handler])]
|
||||
(-> state
|
||||
|
|
@ -110,7 +111,7 @@
|
|||
(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)
|
||||
(update-in (st/get-path-location state) helpers/update-selrect))))
|
||||
(update-in (st/get-path-location state) path/update-geometry))))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
|
|
@ -128,7 +129,7 @@
|
|||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [content (st/get-path state :content)
|
||||
handlers (-> (upc/content->handlers content)
|
||||
handlers (-> (path.segment/content->handlers content)
|
||||
(get position))
|
||||
|
||||
[idx prefix] (when (= (count handlers) 1)
|
||||
|
|
@ -254,7 +255,12 @@
|
|||
(update [_ state]
|
||||
(let [objects (dsh/lookup-page-objects state)
|
||||
content (get-in state [:workspace-drawing :object :content] [])
|
||||
position (gpt/point (get-in content [0 :params] nil))
|
||||
|
||||
;; FIXME: use native operation for retrieve the first position
|
||||
position (-> (nth content 0)
|
||||
(get :params)
|
||||
(gpt/point))
|
||||
|
||||
frame-id (->> (ctst/top-nested-frame objects position)
|
||||
(ctn/get-first-not-copy-parent objects) ;; We don't want to change the structure of component copies
|
||||
:id)
|
||||
|
|
@ -274,11 +280,10 @@
|
|||
(ptk/reify ::handle-new-shape-result
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(let [content (get-in state [:workspace-drawing :object :content] [])]
|
||||
(let [content (dm/get-in state [:workspace-drawing :object :content])]
|
||||
|
||||
(dm/assert!
|
||||
"expected valid path content"
|
||||
(check-path-content! content))
|
||||
(assert (path/check-path-content content)
|
||||
"expected valid path content instance")
|
||||
|
||||
(if (> (count content) 1)
|
||||
(assoc-in state [:workspace-drawing :object :initialized?] true)
|
||||
|
|
@ -286,8 +291,8 @@
|
|||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [content (get-in state [:workspace-drawing :object :content] [])]
|
||||
(if (and (seq content) (> (count content) 1))
|
||||
(when-let [content (dm/get-in state [:workspace-drawing :object :content])]
|
||||
(if (> (count content) 1)
|
||||
(rx/of (setup-frame)
|
||||
(dwdc/handle-finish-drawing)
|
||||
(dwe/start-edition-mode shape-id)
|
||||
|
|
@ -300,9 +305,8 @@
|
|||
(ptk/reify ::handle-new-shape
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(let [shape (cts/setup-shape {:type :path})]
|
||||
(-> state
|
||||
(update :workspace-drawing assoc :object shape))))
|
||||
(let [shape (cts/setup-shape {:type :path :content (path/content nil)})]
|
||||
(update state :workspace-drawing assoc :object shape)))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
|
|
@ -334,12 +338,12 @@
|
|||
edit-mode (get-in state [:workspace-local :edit-path id :edit-mode])]
|
||||
(if (= :draw edit-mode)
|
||||
(rx/concat
|
||||
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
|
||||
(rx/of (dwsh/update-shapes [id] path/convert-to-path))
|
||||
(rx/of (handle-drawing id))
|
||||
(->> stream
|
||||
(rx/filter (ptk/type? ::common/finish-path))
|
||||
(rx/take 1)
|
||||
(rx/merge-map #(rx/of (check-changed-content)))))
|
||||
(rx/map check-changed-content)))
|
||||
(rx/empty))))))
|
||||
|
||||
(defn check-changed-content []
|
||||
|
|
|
|||
|
|
@ -10,10 +10,9 @@
|
|||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.svg.path.shapes-to-path :as upsp]
|
||||
[app.common.svg.path.subpath :as ups]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.main.data.changes :as dch]
|
||||
[app.main.data.helpers :as dsh]
|
||||
[app.main.data.workspace.edition :as dwe]
|
||||
|
|
@ -27,7 +26,6 @@
|
|||
[app.main.data.workspace.shapes :as dwsh]
|
||||
[app.main.streams :as ms]
|
||||
[app.util.mouse :as mse]
|
||||
[app.util.path.tools :as upt]
|
||||
[beicon.v2.core :as rx]
|
||||
[potok.v2.core :as ptk]))
|
||||
|
||||
|
|
@ -58,10 +56,10 @@
|
|||
content-modifiers (dm/get-in state [:workspace-local :edit-path id :content-modifiers])
|
||||
|
||||
content (:content shape)
|
||||
new-content (upc/apply-content-modifiers content content-modifiers)
|
||||
new-content (path/apply-content-modifiers content content-modifiers)
|
||||
|
||||
old-points (->> content upg/content->points)
|
||||
new-points (->> new-content upg/content->points)
|
||||
old-points (->> content path.segment/content->points)
|
||||
new-points (->> new-content path.segment/content->points)
|
||||
point-change (->> (map hash-map old-points new-points) (reduce merge))]
|
||||
|
||||
(when (and (some? new-content) (some? shape))
|
||||
|
|
@ -75,8 +73,8 @@
|
|||
|
||||
(defn modify-content-point
|
||||
[content {dx :x dy :y} modifiers point]
|
||||
(let [point-indices (upc/point-indices content point) ;; [indices]
|
||||
handler-indices (upc/handler-indices content point) ;; [[index prefix]]
|
||||
(let [point-indices (path.segment/point-indices content point) ;; [indices]
|
||||
handler-indices (path.segment/handler-indices content point) ;; [[index prefix]]
|
||||
|
||||
modify-point
|
||||
(fn [modifiers index]
|
||||
|
|
@ -116,7 +114,7 @@
|
|||
(let [id (st/get-path-id state)
|
||||
content (st/get-path state :content)
|
||||
to-point (cond-> to-point
|
||||
(:shift? to-point) (helpers/position-fixed-angle from-point))
|
||||
(:shift? to-point) (path.helpers/position-fixed-angle from-point))
|
||||
|
||||
delta (gpt/subtract to-point from-point)
|
||||
|
||||
|
|
@ -144,7 +142,7 @@
|
|||
selected? (contains? selected-points position)]
|
||||
(streams/drag-stream
|
||||
(rx/of
|
||||
(dwsh/update-shapes [id] upsp/convert-to-path)
|
||||
(dwsh/update-shapes [id] path/convert-to-path)
|
||||
(when-not selected? (selection/select-node position shift?))
|
||||
(drag-selected-points @ms/mouse-position))
|
||||
(rx/of (selection/select-node position shift?)))))))
|
||||
|
|
@ -163,7 +161,7 @@
|
|||
start-position (apply min-key #(gpt/distance start-position %) selected-points)
|
||||
|
||||
content (st/get-path state :content)
|
||||
points (upg/content->points content)]
|
||||
points (path.segment/content->points content)]
|
||||
|
||||
(rx/concat
|
||||
;; This stream checks the consecutive mouse positions to do the dragging
|
||||
|
|
@ -228,7 +226,7 @@
|
|||
mov-vec (gpt/multiply (get-displacement direction) scale)]
|
||||
|
||||
(rx/concat
|
||||
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
|
||||
(rx/of (dwsh/update-shapes [id] path/convert-to-path))
|
||||
(rx/merge
|
||||
(->> move-events
|
||||
(rx/take-until stopper)
|
||||
|
|
@ -256,22 +254,22 @@
|
|||
start-delta-y (dm/get-in modifiers [index cy] 0)
|
||||
|
||||
content (st/get-path state :content)
|
||||
points (upg/content->points content)
|
||||
points (path.segment/content->points content)
|
||||
|
||||
point (-> content (get (if (= prefix :c1) (dec index) index)) (upc/command->point))
|
||||
handler (-> content (get index) (upc/get-handler prefix))
|
||||
point (-> content (nth (if (= prefix :c1) (dec index) index)) (path.segment/get-point))
|
||||
handler (-> content (nth index) (path.segment/get-handler prefix))
|
||||
|
||||
[op-idx op-prefix] (upc/opposite-index content index prefix)
|
||||
opposite (upc/handler->point content op-idx op-prefix)]
|
||||
[op-idx op-prefix] (path.segment/opposite-index content index prefix)
|
||||
opposite (path.segment/handler->point content op-idx op-prefix)]
|
||||
|
||||
(streams/drag-stream
|
||||
(rx/concat
|
||||
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
|
||||
(rx/of (dwsh/update-shapes [id] path/convert-to-path))
|
||||
(->> (streams/move-handler-stream handler point handler opposite points)
|
||||
(rx/map
|
||||
(fn [{:keys [x y alt? shift?]}]
|
||||
(let [pos (cond-> (gpt/point x y)
|
||||
shift? (helpers/position-fixed-angle point))]
|
||||
shift? (path.helpers/position-fixed-angle point))]
|
||||
(modify-handler
|
||||
id
|
||||
index
|
||||
|
|
@ -294,19 +292,22 @@
|
|||
(ptk/reify ::start-path-edit
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(let [objects (dsh/lookup-page-objects state)
|
||||
(let [objects (dsh/lookup-page-objects state)
|
||||
edit-path (dm/get-in state [:workspace-local :edit-path id])
|
||||
content (st/get-path state :content)
|
||||
state (cond-> state
|
||||
(cfh/path-shape? objects id)
|
||||
(st/set-content (ups/close-subpaths content)))]
|
||||
content (st/get-path state :content)
|
||||
state (cond-> state
|
||||
(cfh/path-shape? objects id)
|
||||
(st/set-content (path/close-subpaths content)))]
|
||||
|
||||
(cond-> state
|
||||
(or (not edit-path) (= :draw (:edit-mode edit-path)))
|
||||
(or (not edit-path)
|
||||
(= :draw (:edit-mode edit-path)))
|
||||
(assoc-in [:workspace-local :edit-path id] {:edit-mode :move
|
||||
:selected #{}
|
||||
:snap-toggled false})
|
||||
|
||||
(and (some? edit-path) (= :move (:edit-mode edit-path)))
|
||||
(and (some? edit-path)
|
||||
(= :move (:edit-mode edit-path)))
|
||||
(assoc-in [:workspace-local :edit-path id :edit-mode] :draw))))
|
||||
|
||||
ptk/WatchEvent
|
||||
|
|
@ -343,7 +344,9 @@
|
|||
content (st/get-path state :content)]
|
||||
(-> state
|
||||
(assoc-in [:workspace-local :edit-path id :old-content] content)
|
||||
(st/set-content (-> content (upt/split-segments #{from-p to-p} t))))))
|
||||
(st/set-content (-> content
|
||||
(path.segment/split-segments #{from-p to-p} t)
|
||||
(path/content))))))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
|
|
@ -355,5 +358,5 @@
|
|||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [id (st/get-path-id state)]
|
||||
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path)
|
||||
(rx/of (dwsh/update-shapes [id] path/convert-to-path)
|
||||
(split-segments event))))))
|
||||
|
|
|
|||
|
|
@ -6,12 +6,11 @@
|
|||
|
||||
(ns app.main.data.workspace.path.helpers
|
||||
(:require
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.math :as mth]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.main.data.workspace.path.common :as common]
|
||||
[app.util.mouse :as mse]
|
||||
[potok.v2.core :as ptk]))
|
||||
|
|
@ -28,96 +27,13 @@
|
|||
(and ^boolean (mse/mouse-event? event)
|
||||
^boolean (mse/mouse-double-click-event? event)))))
|
||||
|
||||
(defn content-center
|
||||
[content]
|
||||
(-> content
|
||||
gsh/content->selrect
|
||||
grc/rect->center))
|
||||
|
||||
(defn content->points+selrect
|
||||
"Given the content of a shape, calculate its points and selrect"
|
||||
[shape content]
|
||||
(let [{:keys [flip-x flip-y]} shape
|
||||
transform
|
||||
(cond-> (:transform shape (gmt/matrix))
|
||||
flip-x (gmt/scale (gpt/point -1 1))
|
||||
flip-y (gmt/scale (gpt/point 1 -1)))
|
||||
|
||||
transform-inverse
|
||||
(cond-> (gmt/matrix)
|
||||
flip-x (gmt/scale (gpt/point -1 1))
|
||||
flip-y (gmt/scale (gpt/point 1 -1))
|
||||
:always (gmt/multiply (:transform-inverse shape (gmt/matrix))))
|
||||
|
||||
center (or (gsh/shape->center shape)
|
||||
(content-center content))
|
||||
|
||||
base-content (gsh/transform-content
|
||||
content
|
||||
(gmt/transform-in center transform-inverse))
|
||||
|
||||
;; Calculates the new selrect with points given the old center
|
||||
points (-> (gsh/content->selrect base-content)
|
||||
(grc/rect->points)
|
||||
(gsh/transform-points center transform))
|
||||
|
||||
points-center (gsh/points->center points)
|
||||
|
||||
;; Points is now the selrect but the center is different so we can create the selrect
|
||||
;; through points
|
||||
selrect (-> points
|
||||
(gsh/transform-points points-center transform-inverse)
|
||||
(grc/points->rect))]
|
||||
[points selrect]))
|
||||
|
||||
(defn update-selrect
|
||||
"Updates the selrect and points for a path"
|
||||
[shape]
|
||||
(let [[points selrect] (content->points+selrect shape (:content shape))]
|
||||
(assoc shape :points points :selrect selrect)))
|
||||
|
||||
(defn closest-angle
|
||||
[angle]
|
||||
(cond
|
||||
(or (> angle 337.5) (<= angle 22.5)) 0
|
||||
(and (> angle 22.5) (<= angle 67.5)) 45
|
||||
(and (> angle 67.5) (<= angle 112.5)) 90
|
||||
(and (> angle 112.5) (<= angle 157.5)) 135
|
||||
(and (> angle 157.5) (<= angle 202.5)) 180
|
||||
(and (> angle 202.5) (<= angle 247.5)) 225
|
||||
(and (> angle 247.5) (<= angle 292.5)) 270
|
||||
(and (> angle 292.5) (<= angle 337.5)) 315))
|
||||
|
||||
(defn position-fixed-angle [point from-point]
|
||||
(if (and from-point point)
|
||||
(let [angle (mod (+ 360 (- (gpt/angle point from-point))) 360)
|
||||
to-angle (closest-angle angle)
|
||||
distance (gpt/distance point from-point)]
|
||||
(gpt/angle->point from-point (mth/radians to-angle) distance))
|
||||
point))
|
||||
|
||||
(defn next-node
|
||||
"Calculates the next-node to be inserted."
|
||||
[shape position prev-point prev-handler]
|
||||
(let [position (select-keys position [:x :y])
|
||||
last-command (-> shape :content last :command)
|
||||
add-line? (and prev-point (not prev-handler) (not= last-command :close-path))
|
||||
add-curve? (and prev-point prev-handler (not= last-command :close-path))]
|
||||
(cond
|
||||
add-line? {:command :line-to
|
||||
:params position}
|
||||
add-curve? {:command :curve-to
|
||||
:params (upc/make-curve-params position prev-handler)}
|
||||
:else {:command :move-to
|
||||
:params position})))
|
||||
|
||||
(defn append-node
|
||||
"Creates a new node in the path. Usually used when drawing."
|
||||
[shape position prev-point prev-handler]
|
||||
(let [command (next-node shape position prev-point prev-handler)]
|
||||
(let [segment (path.segment/next-node (:content shape) position prev-point prev-handler)]
|
||||
(-> shape
|
||||
(update :content (fnil conj []) command)
|
||||
(update-selrect))))
|
||||
(update :content path.segment/append-segment segment)
|
||||
(path/update-geometry))))
|
||||
|
||||
(defn angle-points [common p1 p2]
|
||||
(mth/abs
|
||||
|
|
@ -125,7 +41,7 @@
|
|||
(gpt/to-vec common p1)
|
||||
(gpt/to-vec common p2))))
|
||||
|
||||
(defn calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy]
|
||||
(defn- calculate-opposite-delta [node handler opposite match-angle? match-distance? dx dy]
|
||||
(when (and (some? handler) (some? opposite))
|
||||
(let [;; To match the angle, the angle should be matching (angle between points 180deg)
|
||||
angle-handlers (angle-points node handler opposite)
|
||||
|
|
@ -159,14 +75,14 @@
|
|||
(defn move-handler-modifiers
|
||||
[content index prefix match-distance? match-angle? dx dy]
|
||||
|
||||
(let [[cx cy] (upc/prefix->coords prefix)
|
||||
[op-idx op-prefix] (upc/opposite-index content index prefix)
|
||||
(let [[cx cy] (path.helpers/prefix->coords prefix)
|
||||
[op-idx op-prefix] (path.segment/opposite-index content index prefix)
|
||||
|
||||
node (upc/handler->node content index prefix)
|
||||
handler (upc/handler->point content index prefix)
|
||||
opposite (upc/handler->point content op-idx op-prefix)
|
||||
node (path.segment/handler->node content index prefix)
|
||||
handler (path.segment/handler->point content index prefix)
|
||||
opposite (path.segment/handler->point content op-idx op-prefix)
|
||||
|
||||
[ocx ocy] (upc/prefix->coords op-prefix)
|
||||
[ocx ocy] (path.helpers/prefix->coords op-prefix)
|
||||
[odx ody] (calculate-opposite-delta node handler opposite match-angle? match-distance? dx dy)
|
||||
|
||||
hnv (if (some? handler)
|
||||
|
|
|
|||
|
|
@ -8,8 +8,8 @@
|
|||
(:require
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cph]
|
||||
[app.common.svg.path.shapes-to-path :as upsp]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.path :as path]
|
||||
[app.main.data.changes :as dch]
|
||||
[app.main.data.helpers :as dsh]
|
||||
[beicon.v2.core :as rx]
|
||||
|
|
@ -35,7 +35,8 @@
|
|||
changes
|
||||
(-> (pcb/empty-changes it page-id)
|
||||
(pcb/with-objects objects)
|
||||
(pcb/update-shapes selected #(upsp/convert-to-path % objects))
|
||||
;; FIXME: use with-objects? true
|
||||
(pcb/update-shapes selected #(path/convert-to-path % objects))
|
||||
(pcb/remove-objects children-ids))]
|
||||
|
||||
(rx/of (dch/commit-changes changes)))))))
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cph]
|
||||
[app.common.svg.path.shapes-to-path :as upsp]))
|
||||
[app.common.types.path.shape-to-path :as stp]))
|
||||
|
||||
(defn path-editing?
|
||||
"Returns true if we're editing a path or creating a new one."
|
||||
|
|
@ -63,8 +63,7 @@
|
|||
[state & ks]
|
||||
(let [path-loc (get-path-location state)
|
||||
shape (-> (get-in state path-loc)
|
||||
;; Empty map because we know the current shape will not have children
|
||||
(upsp/convert-to-path {}))]
|
||||
(stp/convert-to-path {}))]
|
||||
(if (empty? ks)
|
||||
shape
|
||||
(get-in shape ks))))
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[app.main.constants :refer [zoom-half-pixel-precision]]
|
||||
[app.main.data.workspace.path.state :as pst]
|
||||
[app.main.snap :as snap]
|
||||
|
|
@ -170,7 +170,7 @@
|
|||
|
||||
ranges-stream
|
||||
(->> content-stream
|
||||
(rx/map upg/content->points)
|
||||
(rx/map path.segm/content->points)
|
||||
(rx/map snap/create-ranges))]
|
||||
|
||||
(->> ms/mouse-position
|
||||
|
|
|
|||
|
|
@ -6,15 +6,16 @@
|
|||
|
||||
(ns app.main.data.workspace.path.tools
|
||||
(:require
|
||||
[app.common.svg.path.shapes-to-path :as upsp]
|
||||
[app.common.svg.path.subpath :as ups]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.main.data.changes :as dch]
|
||||
[app.main.data.helpers :as dsh]
|
||||
[app.main.data.workspace.edition :as dwe]
|
||||
[app.main.data.workspace.path.changes :as changes]
|
||||
[app.main.data.workspace.path.state :as st]
|
||||
[app.main.data.workspace.shapes :as dwsh]
|
||||
[app.util.path.tools :as upt]
|
||||
[beicon.v2.core :as rx]
|
||||
[potok.v2.core :as ptk]))
|
||||
|
||||
|
|
@ -26,19 +27,30 @@
|
|||
(ptk/reify ::process-path-tool
|
||||
ptk/WatchEvent
|
||||
(watch [it state _]
|
||||
(let [objects (dsh/lookup-page-objects state)
|
||||
id (st/get-path-id state)
|
||||
page-id (:current-page-id state)
|
||||
shape (st/get-path state)
|
||||
selected-points (get-in state [:workspace-local :edit-path id :selected-points] #{})
|
||||
points (or points selected-points)]
|
||||
(let [page-id (get state :current-page-id)
|
||||
objects (dsh/lookup-page-objects state page-id)
|
||||
|
||||
shape (st/get-path state)
|
||||
id (st/get-path-id state)
|
||||
|
||||
selected-points
|
||||
(dm/get-in state [:workspace-local :edit-path id :selected-points] #{})
|
||||
|
||||
points
|
||||
(or points selected-points)]
|
||||
|
||||
(when (and (seq points) (some? shape))
|
||||
(let [new-content (-> (tool-fn (:content shape) points)
|
||||
(ups/close-subpaths))
|
||||
changes (changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
|
||||
(let [new-content
|
||||
(-> (tool-fn (:content shape) points)
|
||||
(path/close-subpaths))
|
||||
|
||||
changes
|
||||
(changes/generate-path-changes it objects page-id shape (:content shape) new-content)]
|
||||
|
||||
(rx/concat
|
||||
(rx/of (dwsh/update-shapes [id] upsp/convert-to-path))
|
||||
(if (cfh/path-shape? shape)
|
||||
(rx/empty)
|
||||
(rx/of (dwsh/update-shapes [id] path/convert-to-path)))
|
||||
(rx/of (dch/commit-changes changes)
|
||||
(when (empty? new-content)
|
||||
(dwe/clear-edition-mode)))))))))))
|
||||
|
|
@ -50,7 +62,7 @@
|
|||
(process-path-tool
|
||||
(when point #{point})
|
||||
(fn [content points]
|
||||
(reduce upt/make-corner-point content points)))))
|
||||
(reduce path.segment/make-corner-point content points)))))
|
||||
|
||||
(defn make-curve
|
||||
([]
|
||||
|
|
@ -59,22 +71,22 @@
|
|||
(process-path-tool
|
||||
(when point #{point})
|
||||
(fn [content points]
|
||||
(reduce upt/make-curve-point content points)))))
|
||||
(reduce path.segment/make-curve-point content points)))))
|
||||
|
||||
(defn add-node []
|
||||
(process-path-tool (fn [content points] (upt/split-segments content points 0.5))))
|
||||
(process-path-tool (fn [content points] (path.segment/split-segments content points 0.5))))
|
||||
|
||||
(defn remove-node []
|
||||
(process-path-tool upt/remove-nodes))
|
||||
(process-path-tool path.segment/remove-nodes))
|
||||
|
||||
(defn merge-nodes []
|
||||
(process-path-tool upt/merge-nodes))
|
||||
(process-path-tool path.segment/merge-nodes))
|
||||
|
||||
(defn join-nodes []
|
||||
(process-path-tool upt/join-nodes))
|
||||
(process-path-tool path.segment/join-nodes))
|
||||
|
||||
(defn separate-nodes []
|
||||
(process-path-tool upt/separate-nodes))
|
||||
(process-path-tool path.segment/separate-nodes))
|
||||
|
||||
(defn toggle-snap []
|
||||
(ptk/reify ::toggle-snap
|
||||
|
|
|
|||
|
|
@ -47,40 +47,53 @@
|
|||
|
||||
(defn update-shapes
|
||||
([ids update-fn] (update-shapes ids update-fn nil))
|
||||
([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-touched undo-group with-objects? changed-sub-attr]
|
||||
:or {reg-objects? false save-undo? true stack-undo? false ignore-touched false with-objects? false}}]
|
||||
([ids update-fn
|
||||
{:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id
|
||||
ignore-touched undo-group with-objects? changed-sub-attr]
|
||||
:or {reg-objects? false
|
||||
save-undo? true
|
||||
stack-undo? false
|
||||
ignore-touched false
|
||||
with-objects? false}}]
|
||||
|
||||
(assert (sm/check-coll-of-uuid ids))
|
||||
(assert (fn? update-fn))
|
||||
(assert (every? uuid? ids) "expect a coll of uuid for `ids`")
|
||||
(assert (fn? update-fn) "the `update-fn` should be a valid function")
|
||||
|
||||
(ptk/reify ::update-shapes
|
||||
ptk/WatchEvent
|
||||
(watch [it state _]
|
||||
(let [page-id (or page-id (:current-page-id state))
|
||||
(let [page-id (or page-id (get state :current-page-id))
|
||||
objects (dsh/lookup-page-objects state page-id)
|
||||
ids (into [] (filter some?) ids)
|
||||
|
||||
xf-update-layout
|
||||
(comp
|
||||
(map (d/getf objects))
|
||||
(filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
|
||||
(map :id))
|
||||
|
||||
update-layout-ids
|
||||
(->> ids
|
||||
(map (d/getf objects))
|
||||
(filter #(some update-layout-attr? (pcb/changed-attrs % objects update-fn {:attrs attrs :with-objects? with-objects?})))
|
||||
(map :id))
|
||||
(->> (into [] xf-update-layout ids)
|
||||
(not-empty))
|
||||
|
||||
changes (-> (pcb/empty-changes it page-id)
|
||||
(pcb/set-save-undo? save-undo?)
|
||||
(pcb/set-stack-undo? stack-undo?)
|
||||
(cls/generate-update-shapes ids
|
||||
update-fn
|
||||
objects
|
||||
{:attrs attrs
|
||||
:changed-sub-attr changed-sub-attr
|
||||
:ignore-tree ignore-tree
|
||||
:ignore-touched ignore-touched
|
||||
:with-objects? with-objects?})
|
||||
(cond-> undo-group
|
||||
(pcb/set-undo-group undo-group)))
|
||||
changes
|
||||
(-> (pcb/empty-changes it page-id)
|
||||
(pcb/set-save-undo? save-undo?)
|
||||
(pcb/set-stack-undo? stack-undo?)
|
||||
(cls/generate-update-shapes ids
|
||||
update-fn
|
||||
objects
|
||||
{:attrs attrs
|
||||
:changed-sub-attr changed-sub-attr
|
||||
:ignore-tree ignore-tree
|
||||
:ignore-touched ignore-touched
|
||||
:with-objects? with-objects?})
|
||||
(cond-> undo-group
|
||||
(pcb/set-undo-group undo-group)))
|
||||
|
||||
changes
|
||||
(add-undo-group changes state)]
|
||||
|
||||
changes (add-undo-group changes state)]
|
||||
(rx/concat
|
||||
(if (seq (:redo-changes changes))
|
||||
(let [changes (cond-> changes reg-objects? (pcb/resize-parents ids))]
|
||||
|
|
@ -88,7 +101,7 @@
|
|||
(rx/empty))
|
||||
|
||||
;; Update layouts for properties marked
|
||||
(if (d/not-empty? update-layout-ids)
|
||||
(if update-layout-ids
|
||||
(rx/of (ptk/data-event :layout/update {:ids update-layout-ids}))
|
||||
(rx/empty))))))))
|
||||
|
||||
|
|
@ -112,11 +125,13 @@
|
|||
(pcb/with-objects objects)
|
||||
(cfsh/prepare-add-shape shape objects))
|
||||
|
||||
changes (cond-> changes
|
||||
(cfh/text-shape? shape)
|
||||
(pcb/set-undo-group (:id shape)))
|
||||
changes
|
||||
(cond-> changes
|
||||
(cfh/text-shape? shape)
|
||||
(pcb/set-undo-group (:id shape)))
|
||||
|
||||
undo-id (js/Symbol)]
|
||||
undo-id
|
||||
(js/Symbol)]
|
||||
|
||||
(rx/concat
|
||||
(rx/of (dwu/start-undo-transaction undo-id)
|
||||
|
|
|
|||
|
|
@ -110,4 +110,3 @@
|
|||
(log/inf :hint "initialized"
|
||||
:enabled (str/join "," features)
|
||||
:runtime (str/join "," (:features-runtime state)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,8 @@
|
|||
(ns app.main.ui.shapes.bool
|
||||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.types.path :as path]
|
||||
|
||||
[app.main.ui.hooks :as h]
|
||||
[app.main.ui.shapes.export :as use]
|
||||
[app.main.ui.shapes.path :refer [path-shape]]
|
||||
|
|
@ -30,7 +31,7 @@
|
|||
content
|
||||
|
||||
(some? child-objs)
|
||||
(gsh/calc-bool-content shape child-objs))))
|
||||
(path/calc-bool-content shape child-objs))))
|
||||
|
||||
shape (mf/with-memo [shape content]
|
||||
(assoc shape :content content))]
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.bounds :as gsb]
|
||||
[app.common.geom.shapes.text :as gst]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.main.ui.context :as muc]
|
||||
|
|
@ -204,7 +205,7 @@
|
|||
{::mf/wrap-props false}
|
||||
[{:keys [shape stroke render-id index]}]
|
||||
(let [open-path? (and ^boolean (cfh/path-shape? shape)
|
||||
^boolean (gsh/open-path? shape))
|
||||
^boolean (path/shape-with-open-path? shape))
|
||||
gradient (:stroke-color-gradient stroke)
|
||||
alignment (:stroke-alignment stroke :center)
|
||||
width (:stroke-width stroke 0)
|
||||
|
|
@ -397,7 +398,7 @@
|
|||
has-stroke? (and (> stroke-width 0)
|
||||
(not= stroke-style :none))
|
||||
closed? (or (not ^boolean (cfh/path-shape? shape))
|
||||
(not ^boolean (gsh/open-path? shape)))
|
||||
(not ^boolean (path/shape-with-open-path? shape)))
|
||||
inner? (= :inner stroke-position)
|
||||
outer? (= :outer stroke-position)]
|
||||
|
||||
|
|
@ -496,7 +497,7 @@
|
|||
:style style})
|
||||
|
||||
open-path? (and ^boolean (cfh/path-shape? shape)
|
||||
^boolean (gsh/open-path? shape))]
|
||||
^boolean (path/shape-with-open-path? shape))]
|
||||
(when-not ^boolean (cfh/frame-shape? shape)
|
||||
(when (and (some? shape-blur)
|
||||
(not ^boolean (:hidden shape-blur)))
|
||||
|
|
|
|||
|
|
@ -7,28 +7,35 @@
|
|||
(ns app.main.ui.shapes.path
|
||||
(:require
|
||||
[app.common.logging :as log]
|
||||
[app.common.types.path :as path]
|
||||
[app.main.ui.shapes.custom-stroke :refer [shape-custom-strokes]]
|
||||
[app.util.object :as obj]
|
||||
[app.util.path.format :as upf]
|
||||
[rumext.v2 :as mf]))
|
||||
|
||||
(defn- content->string
|
||||
[content]
|
||||
(cond
|
||||
(nil? content)
|
||||
""
|
||||
|
||||
(path/content? content)
|
||||
(.toString content)
|
||||
|
||||
:else
|
||||
(let [content (path/content content)]
|
||||
(.toString content))))
|
||||
|
||||
(mf/defc path-shape
|
||||
{::mf/wrap-props false}
|
||||
[props]
|
||||
(let [shape (unchecked-get props "shape")
|
||||
content (:content shape)
|
||||
{::mf/props :obj}
|
||||
[{:keys [shape]}]
|
||||
(let [content (get shape :content)
|
||||
pdata (mf/with-memo [content]
|
||||
(try
|
||||
(upf/format-path content)
|
||||
(catch :default e
|
||||
(content->string content)
|
||||
(catch :default cause
|
||||
(log/error :hint "unexpected error on formatting path"
|
||||
:shape-name (:name shape)
|
||||
:shape-id (:id shape)
|
||||
:cause e)
|
||||
"")))
|
||||
|
||||
props (-> #js {}
|
||||
(obj/set! "d" pdata))]
|
||||
|
||||
:cause cause)
|
||||
"")))]
|
||||
[:& shape-custom-strokes {:shape shape}
|
||||
[:> :path props]]))
|
||||
[:path {:d pdata}]]))
|
||||
|
|
|
|||
|
|
@ -10,12 +10,13 @@
|
|||
[app.common.data.macros :as dm]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.geom.shapes.text :as gst]
|
||||
[app.common.math :as mth]
|
||||
[app.common.svg.path.bool :as pb]
|
||||
[app.common.svg.path.shapes-to-path :as stp]
|
||||
[app.common.svg.path.subpath :as ups]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.bool :as path.bool]
|
||||
[app.common.types.path.helpers :as path.helpers]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.common.types.path.subpath :as path.subpath]
|
||||
[app.main.refs :as refs]
|
||||
[app.util.color :as uc]
|
||||
[app.util.debug :as dbg]
|
||||
|
|
@ -101,49 +102,49 @@
|
|||
radius (/ 3 zoom)
|
||||
|
||||
c1 (-> (get objects (first (:shapes shape)))
|
||||
(stp/convert-to-path objects))
|
||||
(path/convert-to-path objects))
|
||||
c2 (-> (get objects (second (:shapes shape)))
|
||||
(stp/convert-to-path objects))
|
||||
(path/convert-to-path objects))
|
||||
|
||||
content-a (:content c1)
|
||||
content-b (:content c2)
|
||||
|
||||
bool-type (:bool-type shape)
|
||||
should-reverse? (and (not= :union bool-type)
|
||||
(= (ups/clockwise? content-b)
|
||||
(ups/clockwise? content-a)))
|
||||
(= (path.subpath/clockwise? content-b)
|
||||
(path.subpath/clockwise? content-a)))
|
||||
|
||||
content-a (-> (:content c1)
|
||||
(pb/close-paths)
|
||||
(pb/add-previous))
|
||||
(path.bool/close-paths)
|
||||
(path.bool/add-previous))
|
||||
|
||||
content-b (-> (:content c2)
|
||||
(pb/close-paths)
|
||||
(cond-> should-reverse? (ups/reverse-content))
|
||||
(pb/add-previous))
|
||||
(path.bool/close-paths)
|
||||
(cond-> should-reverse? (path.subpath/reverse-content))
|
||||
(path.bool/add-previous))
|
||||
|
||||
|
||||
sr-a (gsp/content->selrect content-a)
|
||||
sr-b (gsp/content->selrect content-b)
|
||||
sr-a (path.segment/content->selrect content-a)
|
||||
sr-b (path.segment/content->selrect content-b)
|
||||
|
||||
[content-a-split content-b-split] (pb/content-intersect-split content-a content-b sr-a sr-b)
|
||||
[content-a-split content-b-split] (path.bool/content-intersect-split content-a content-b sr-a sr-b)
|
||||
|
||||
;;content-a-geom (gsp/content->geom-data content-a)
|
||||
;;content-b-geom (gsp/content->geom-data content-b)
|
||||
;;content-a-split (->> content-a-split #_(filter #(pb/contains-segment? % content-b sr-b content-b-geom)))
|
||||
;;content-b-split (->> content-b-split #_(filter #(pb/contains-segment? % content-a sr-a content-a-geom)))
|
||||
;;content-a-geom (path.segment/content->geom-data content-a)
|
||||
;;content-b-geom (path.segment/content->geom-data content-b)
|
||||
;;content-a-split (->> content-a-split #_(filter #(path.bool/contains-segment? % content-b sr-b content-b-geom)))
|
||||
;;content-b-split (->> content-b-split #_(filter #(path.bool/contains-segment? % content-a sr-a content-a-geom)))
|
||||
]
|
||||
[:*
|
||||
(for [[i cmd] (d/enumerate content-a-split)]
|
||||
(let [p1 (:prev cmd)
|
||||
p2 (gsp/command->point cmd)
|
||||
p2 (path.helpers/command->point cmd)
|
||||
|
||||
hp (case (:command cmd)
|
||||
:line-to (-> (gsp/command->line cmd)
|
||||
(gsp/line-values 0.5))
|
||||
:line-to (-> (path.helpers/command->line cmd)
|
||||
(path.helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier cmd)
|
||||
(gsp/curve-values 0.5))
|
||||
:curve-to (-> (path.helpers/command->bezier cmd)
|
||||
(path.helpers/curve-values 0.5))
|
||||
nil)]
|
||||
[:*
|
||||
(when p1
|
||||
|
|
@ -155,14 +156,14 @@
|
|||
|
||||
(for [[i cmd] (d/enumerate content-b-split)]
|
||||
(let [p1 (:prev cmd)
|
||||
p2 (gsp/command->point cmd)
|
||||
p2 (path.helpers/command->point cmd)
|
||||
|
||||
hp (case (:command cmd)
|
||||
:line-to (-> (gsp/command->line cmd)
|
||||
(gsp/line-values 0.5))
|
||||
:line-to (-> (path.helpers/command->line cmd)
|
||||
(path.helpers/line-values 0.5))
|
||||
|
||||
:curve-to (-> (gsp/command->bezier cmd)
|
||||
(gsp/curve-values 0.5))
|
||||
:curve-to (-> (path.helpers/command->bezier cmd)
|
||||
(path.helpers/curve-values 0.5))
|
||||
nil)]
|
||||
[:*
|
||||
(when p1
|
||||
|
|
|
|||
|
|
@ -6,8 +6,8 @@
|
|||
|
||||
(ns app.main.ui.workspace.shapes.path
|
||||
(:require
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.main.data.workspace.path.helpers :as helpers]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.types.path :as types.path]
|
||||
[app.main.refs :as refs]
|
||||
[app.main.ui.shapes.path :as path]
|
||||
[app.main.ui.shapes.shape :refer [shape-container]]
|
||||
|
|
@ -15,25 +15,31 @@
|
|||
[app.main.ui.workspace.shapes.path.common :as pc]
|
||||
[rumext.v2 :as mf]))
|
||||
|
||||
(defn apply-content-modifiers
|
||||
(defn- apply-content-modifiers
|
||||
[shape content-modifiers]
|
||||
(let [shape (update shape :content upc/apply-content-modifiers content-modifiers)
|
||||
[_ new-selrect] (helpers/content->points+selrect shape (:content shape))]
|
||||
(assoc shape :selrect new-selrect)))
|
||||
(let [shape (update shape :content types.path/apply-content-modifiers content-modifiers)]
|
||||
(types.path/update-geometry shape)))
|
||||
|
||||
(mf/defc path-wrapper
|
||||
{::mf/wrap-props false}
|
||||
[props]
|
||||
(let [shape (unchecked-get props "shape")
|
||||
content-modifiers-ref (pc/make-content-modifiers-ref (:id shape))
|
||||
content-modifiers (mf/deref content-modifiers-ref)
|
||||
editing-id (mf/deref refs/selected-edition)
|
||||
editing? (= editing-id (:id shape))
|
||||
[{:keys [shape]}]
|
||||
(let [shape-id (dm/get-prop shape :id)
|
||||
|
||||
content-modifiers-ref
|
||||
(pc/make-content-modifiers-ref shape-id)
|
||||
|
||||
content-modifiers
|
||||
(mf/deref content-modifiers-ref)
|
||||
|
||||
editing-id
|
||||
(mf/deref refs/selected-edition)
|
||||
|
||||
editing?
|
||||
(= editing-id shape-id)
|
||||
|
||||
shape
|
||||
(mf/use-memo
|
||||
(mf/deps shape content-modifiers)
|
||||
#(cond-> shape
|
||||
(mf/with-memo [shape content-modifiers]
|
||||
(cond-> shape
|
||||
(some? content-modifiers)
|
||||
(apply-content-modifiers content-modifiers)))]
|
||||
|
||||
|
|
|
|||
|
|
@ -9,9 +9,8 @@
|
|||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as gsp]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.svg.path.shapes-to-path :as ups]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.segment :as path.segment]
|
||||
[app.main.data.workspace.path :as drp]
|
||||
[app.main.snap :as snap]
|
||||
[app.main.store :as st]
|
||||
|
|
@ -196,8 +195,8 @@
|
|||
(defn matching-handler? [content node handlers]
|
||||
(when (= 2 (count handlers))
|
||||
(let [[[i1 p1] [i2 p2]] handlers
|
||||
p1 (upc/handler->point content i1 p1)
|
||||
p2 (upc/handler->point content i2 p2)
|
||||
p1 (path.segment/handler->point content i1 p1)
|
||||
p2 (path.segment/handler->point content i2 p2)
|
||||
|
||||
v1 (gpt/to-vec node p1)
|
||||
v2 (gpt/to-vec node p2)
|
||||
|
|
@ -227,34 +226,36 @@
|
|||
:as edit-path} (mf/deref edit-path-ref)
|
||||
|
||||
selected-points (or selected-points #{})
|
||||
shape (hooks/use-equal-memo shape)
|
||||
|
||||
shape (cond-> shape
|
||||
(not= :path (:type shape))
|
||||
(ups/convert-to-path {})
|
||||
base-content
|
||||
(get shape :content)
|
||||
|
||||
:always
|
||||
hooks/use-equal-memo)
|
||||
base-points
|
||||
(mf/with-memo [base-content]
|
||||
(path.segment/content->points base-content))
|
||||
|
||||
base-content (:content shape)
|
||||
base-points (mf/use-memo (mf/deps base-content) #(->> base-content gsp/content->points))
|
||||
content
|
||||
(path/apply-content-modifiers base-content content-modifiers)
|
||||
|
||||
content (upc/apply-content-modifiers base-content content-modifiers)
|
||||
content-points (mf/use-memo (mf/deps content) #(->> content gsp/content->points))
|
||||
content-points
|
||||
(mf/with-memo [content]
|
||||
(path.segment/content->points content))
|
||||
|
||||
point->base (->> (map hash-map content-points base-points) (reduce merge))
|
||||
base->point (map-invert point->base)
|
||||
|
||||
points (into #{} content-points)
|
||||
|
||||
last-p (->> content last upc/command->point)
|
||||
handlers (upc/content->handlers content)
|
||||
last-p (->> content last path.segment/get-point)
|
||||
handlers (path.segment/content->handlers content)
|
||||
|
||||
start-p? (not (some? last-point))
|
||||
|
||||
[snap-selected snap-points]
|
||||
(cond
|
||||
(some? drag-handler) [#{drag-handler} points]
|
||||
(some? preview) [#{(upc/command->point preview)} points]
|
||||
(some? preview) [#{(path.segment/get-point preview)} points]
|
||||
(some? moving-handler) [#{moving-handler} points]
|
||||
:else
|
||||
[(->> selected-points (map base->point) (into #{}))
|
||||
|
|
@ -282,7 +283,7 @@
|
|||
ms/mouse-position
|
||||
(mf/deps shape zoom)
|
||||
(fn [position]
|
||||
(when-let [point (gsp/path-closest-point shape position)]
|
||||
(when-let [point (path.segment/path-closest-point shape position)]
|
||||
(reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
|
||||
|
||||
[:g.path-editor {:ref editor-ref}
|
||||
|
|
@ -313,7 +314,7 @@
|
|||
(for [[index position] (d/enumerate points)]
|
||||
(let [show-handler?
|
||||
(fn [[index prefix]]
|
||||
(let [handler-position (upc/handler->point content index prefix)]
|
||||
(let [handler-position (path.segment/handler->point content index prefix)]
|
||||
(not= position handler-position)))
|
||||
|
||||
pos-handlers (get handlers position)
|
||||
|
|
@ -327,7 +328,7 @@
|
|||
[:g.path-node {:key (dm/str index "-" (:x position) "-" (:y position))}
|
||||
[:g.point-handlers {:pointer-events (when (= edit-mode :draw) "none")}
|
||||
(for [[hindex prefix] pos-handlers]
|
||||
(let [handler-position (upc/handler->point content hindex prefix)
|
||||
(let [handler-position (path.segment/handler->point content hindex prefix)
|
||||
handler-hover? (contains? hover-handlers [hindex prefix])
|
||||
moving-handler? (= handler-position moving-handler)
|
||||
matching-handler? (matching-handler? content position pos-handlers)]
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@
|
|||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.text :as txt]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape.attrs :refer [editable-attrs]]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.main.refs :as refs]
|
||||
|
|
@ -294,7 +295,7 @@
|
|||
file-id (unchecked-get props "file-id")
|
||||
shared-libs (unchecked-get props "libraries")
|
||||
|
||||
show-caps (some #(and (= :path (:type %)) (gsh/open-path? %)) shapes)
|
||||
show-caps (some #(and (= :path (:type %)) (path/shape-with-open-path? %)) shapes)
|
||||
|
||||
;; Selrect/points only used for measures and it's the one that changes the most. We separate it
|
||||
;; so we can memoize it
|
||||
|
|
|
|||
|
|
@ -7,16 +7,15 @@
|
|||
(ns app.main.ui.workspace.viewport.path-actions
|
||||
(:require-macros [app.main.style :as stl])
|
||||
(:require
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[app.main.data.workspace.path :as drp]
|
||||
[app.main.data.workspace.path.shortcuts :as sc]
|
||||
[app.main.store :as st]
|
||||
[app.main.ui.icons :as i]
|
||||
[app.main.ui.workspace.shapes.path.common :as pc]
|
||||
[app.util.i18n :as i18n :refer [tr]]
|
||||
[app.util.path.tools :as upt]
|
||||
[rumext.v2 :as mf]))
|
||||
|
||||
|
||||
(def ^:private pentool-icon
|
||||
(i/icon-xref :pentool (stl/css :pentool-icon :pathbar-icon)))
|
||||
|
||||
|
|
@ -49,7 +48,7 @@
|
|||
|
||||
|
||||
(defn check-enabled [content selected-points]
|
||||
(let [segments (upt/get-segments content selected-points)
|
||||
(let [segments (path.segm/get-segments content selected-points)
|
||||
num-segments (count segments)
|
||||
num-points (count selected-points)
|
||||
points-selected? (seq selected-points)
|
||||
|
|
@ -58,7 +57,7 @@
|
|||
max-segments (-> num-points
|
||||
(* (- num-points 1))
|
||||
(/ 2))
|
||||
is-curve? (some #(upt/is-curve? content %) selected-points)]
|
||||
is-curve? (some #(path.segm/is-curve? content %) selected-points)]
|
||||
|
||||
{:make-corner (and points-selected? is-curve?)
|
||||
:make-curve (and points-selected? (not is-curve?))
|
||||
|
|
|
|||
|
|
@ -15,18 +15,19 @@
|
|||
[app.common.record :as crc]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.spec :as us]
|
||||
[app.common.svg.path :as path]
|
||||
[app.common.svg.path :as svg.path]
|
||||
[app.common.text :as txt]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.container :as ctn]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.grid :as ctg]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape.blur :as ctsb]
|
||||
[app.common.types.shape.export :as ctse]
|
||||
[app.common.types.shape.interactions :as ctsi]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.types.shape.path :as ctsp]
|
||||
[app.common.types.shape.radius :as ctsr]
|
||||
[app.common.types.shape.shadow :as ctss]
|
||||
[app.common.uuid :as uuid]
|
||||
|
|
@ -1312,18 +1313,19 @@
|
|||
:get #(-> % u/proxy->shape :content upf/format-path)
|
||||
:set
|
||||
(fn [_ value]
|
||||
(let [content (->> (path/parse value))]
|
||||
(let [content (svg.path/parse value)]
|
||||
(cond
|
||||
(not (cfh/path-shape? data))
|
||||
(u/display-not-valid :content-type type)
|
||||
|
||||
(not (sm/validate ::ctsp/content content))
|
||||
;; FIXME: revisit path content validation
|
||||
(not (sm/validate ::path/content content))
|
||||
(u/display-not-valid :content value)
|
||||
|
||||
(not (r/check-permission plugin-id "content:write"))
|
||||
(u/display-not-valid :content "Plugin doesn't have 'content:write' permission")
|
||||
|
||||
:else
|
||||
(let [selrect (gsh/content->selrect content)
|
||||
(let [selrect (path.segm/content->selrect content)
|
||||
points (grc/rect->points selrect)]
|
||||
(st/emit! (dwsh/update-shapes [id] (fn [shape] (assoc shape :content content :selrect selrect :points points))))))))}))))))
|
||||
|
|
|
|||
|
|
@ -10,8 +10,8 @@
|
|||
["react-dom/server" :as rds]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.types.shape.path :as path]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.main.fonts :as fonts]
|
||||
|
|
@ -309,13 +309,14 @@
|
|||
(h/call wasm/internal-module "stringToUTF8" str offset size)
|
||||
(h/call wasm/internal-module "_set_shape_path_attrs" (count attrs))))
|
||||
|
||||
;; FIXME: revisit on heap refactor is merged to use u32 instead u8
|
||||
(defn set-shape-path-content
|
||||
[content]
|
||||
(let [pdata (path/path-data content)
|
||||
size (* (count pdata) path/SEGMENT-BYTE-SIZE)
|
||||
(let [pdata (path/content content)
|
||||
size (path/get-byte-size content)
|
||||
offset (mem/alloc-bytes size)
|
||||
heap (mem/get-heap-u8)]
|
||||
(path/-write-to pdata (.-buffer heap) offset)
|
||||
(path/write-to pdata (.-buffer heap) offset)
|
||||
(h/call wasm/internal-module "_set_shape_path_content")))
|
||||
|
||||
(defn set-shape-svg-raw-content
|
||||
|
|
|
|||
|
|
@ -5,12 +5,19 @@
|
|||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.util.path.format
|
||||
"Legacy path data formater, replaced by
|
||||
app.common.types.path.PathData type.
|
||||
|
||||
WARNING: Pending to be removed from codebase once completly unused"
|
||||
(:require
|
||||
[app.common.svg.path.command :as upc]
|
||||
[app.common.svg.path.subpath :refer [pt=]]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.types.path.segment :as path.segm]
|
||||
[app.util.array :as arr]))
|
||||
|
||||
;; TODO: move to common
|
||||
(defn pt=
|
||||
"Check if two points are close"
|
||||
[p1 p2]
|
||||
(< (gpt/distance p1 p2) 0.1))
|
||||
|
||||
(def path-precision 3)
|
||||
|
||||
|
|
@ -115,7 +122,7 @@
|
|||
(try
|
||||
(let [result (make-array (count content))]
|
||||
(reduce (fn [last-move current]
|
||||
(let [point (upc/command->point current)
|
||||
(let [point (path.segm/get-point current)
|
||||
current-move? (= :move-to (:command current))
|
||||
last-move (if current-move? point last-move)]
|
||||
|
||||
|
|
|
|||
|
|
@ -1,461 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.util.path.tools
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as upg]
|
||||
[app.common.svg.path.command :as upc]
|
||||
[clojure.set :as set]))
|
||||
|
||||
;; FIXME: move to common, there are nothing tied to frontend
|
||||
|
||||
(defn remove-line-curves
|
||||
"Remove all curves that have both handlers in the same position that the
|
||||
beginning 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 (into {} 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 line->curve
|
||||
[from-p cmd]
|
||||
|
||||
(let [to-p (upc/command->point cmd)
|
||||
|
||||
v (gpt/to-vec from-p to-p)
|
||||
d (gpt/distance from-p to-p)
|
||||
|
||||
dv1 (-> (gpt/normal-left v)
|
||||
(gpt/scale (/ d 3)))
|
||||
|
||||
h1 (gpt/add from-p dv1)
|
||||
|
||||
dv2 (-> (gpt/to-vec to-p h1)
|
||||
(gpt/unit)
|
||||
(gpt/scale (/ d 3)))
|
||||
|
||||
h2 (gpt/add to-p dv2)]
|
||||
(-> cmd
|
||||
(assoc :command :curve-to)
|
||||
(update :params (fn [params]
|
||||
;; ensure plain map
|
||||
(-> (into {} params)
|
||||
(assoc :c1x (:x h1))
|
||||
(assoc :c1y (:y h1))
|
||||
(assoc :c2x (:x h2))
|
||||
(assoc :c2y (:y h2))))))))
|
||||
|
||||
(defn is-curve?
|
||||
[content point]
|
||||
(let [handlers (-> (upc/content->handlers content)
|
||||
(get point))
|
||||
handler-points (map #(upc/handler->point content (first %) (second %)) handlers)]
|
||||
(some #(not= point %) handler-points)))
|
||||
|
||||
(def ^:private xf:mapcat-points
|
||||
(comp
|
||||
(mapcat #(vector (:next-p %) (:prev-p %)))
|
||||
(remove nil?)))
|
||||
|
||||
(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 the previous->next points but with fixed length."
|
||||
[content point]
|
||||
|
||||
(let [indices (upc/point-indices content point)
|
||||
vectors (map (fn [index]
|
||||
(let [cmd (nth content index)
|
||||
prev-i (dec index)
|
||||
prev (when (not (= :move-to (:command cmd)))
|
||||
(get content prev-i))
|
||||
next-i (inc index)
|
||||
next (get content next-i)
|
||||
|
||||
next (when (not (= :move-to (:command next)))
|
||||
next)]
|
||||
{:index index
|
||||
:prev-i (when (some? prev) prev-i)
|
||||
:prev-c prev
|
||||
:prev-p (upc/command->point prev)
|
||||
:next-i (when (some? next) next-i)
|
||||
:next-c next
|
||||
:next-p (upc/command->point next)
|
||||
:command cmd}))
|
||||
indices)
|
||||
|
||||
points (into #{} xf:mapcat-points vectors)]
|
||||
|
||||
(if (= (count points) 2)
|
||||
(let [v1 (gpt/to-vec (first points) point)
|
||||
v2 (gpt/to-vec (first points) (second points))
|
||||
vp (gpt/project v1 v2)
|
||||
vh (gpt/subtract v1 vp)
|
||||
|
||||
add-curve
|
||||
(fn [content {:keys [index prev-p next-p next-i]}]
|
||||
(let [cur-cmd (get content index)
|
||||
next-cmd (get content next-i)
|
||||
|
||||
;; New handlers for prev-point and next-point
|
||||
prev-h (when (some? prev-p) (gpt/add prev-p vh))
|
||||
next-h (when (some? next-p) (gpt/add next-p vh))
|
||||
|
||||
;; Correct 1/3 to the point improves the curve
|
||||
prev-correction (when (some? prev-h) (gpt/scale (gpt/to-vec prev-h point) (/ 1 3)))
|
||||
next-correction (when (some? next-h) (gpt/scale (gpt/to-vec next-h point) (/ 1 3)))
|
||||
|
||||
prev-h (when (some? prev-h) (gpt/add prev-h prev-correction))
|
||||
next-h (when (some? next-h) (gpt/add next-h next-correction))]
|
||||
(cond-> content
|
||||
(and (= :line-to (:command cur-cmd)) (some? prev-p))
|
||||
(update index upc/update-curve-to prev-p prev-h)
|
||||
|
||||
(and (= :line-to (:command next-cmd)) (some? next-p))
|
||||
(update next-i upc/update-curve-to next-h next-p)
|
||||
|
||||
(and (= :curve-to (:command cur-cmd)) (some? prev-p))
|
||||
(update index upc/update-handler :c2 prev-h)
|
||||
|
||||
(and (= :curve-to (:command next-cmd)) (some? next-p))
|
||||
(update next-i upc/update-handler :c1 next-h))))]
|
||||
|
||||
(reduce add-curve content vectors))
|
||||
|
||||
(let [add-curve
|
||||
(fn [content {:keys [index command prev-p next-c next-i]}]
|
||||
(cond-> content
|
||||
(= :line-to (:command command))
|
||||
(update index #(line->curve prev-p %))
|
||||
|
||||
(= :curve-to (:command command))
|
||||
(update index #(line->curve prev-p %))
|
||||
|
||||
(= :line-to (:command next-c))
|
||||
(update next-i #(line->curve point %))
|
||||
|
||||
(= :curve-to (:command next-c))
|
||||
(update next-i #(line->curve point %))))]
|
||||
(reduce add-curve content vectors)))))
|
||||
|
||||
(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
|
||||
index 0
|
||||
cur-cmd (first content)
|
||||
content (rest content)]
|
||||
|
||||
(let [command (:command cur-cmd)
|
||||
close-path? (= command :close-path)
|
||||
move-to? (= command :move-to)
|
||||
|
||||
;; Close-path makes a segment from the last point to the initial path point
|
||||
cur-point (if close-path?
|
||||
start-point
|
||||
(upc/command->point cur-cmd))
|
||||
|
||||
;; If there is a move-to we don't have a segment
|
||||
prev-point (if move-to?
|
||||
nil
|
||||
prev-point)
|
||||
|
||||
;; We update the start point
|
||||
start-point (if move-to?
|
||||
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 {:start prev-point
|
||||
:end cur-point
|
||||
:cmd cur-cmd
|
||||
:index index}))]
|
||||
|
||||
(if (some? cur-cmd)
|
||||
(recur segments
|
||||
cur-point
|
||||
start-point
|
||||
(inc index)
|
||||
(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 [{:keys [start end cmd index]}]
|
||||
(case (:command cmd)
|
||||
:line-to [index (upg/split-line-to start cmd value)]
|
||||
:curve-to [index (upg/split-curve-to start cmd value)]
|
||||
:close-path [index [(upc/make-line-to (gpt/lerp start end value)) cmd]]
|
||||
nil))
|
||||
|
||||
cmd-changes
|
||||
(->> (get-segments content points)
|
||||
(into {} (comp (map split-command)
|
||||
(filter (comp not nil?)))))
|
||||
|
||||
process-segments
|
||||
(fn [[index command]]
|
||||
(if (contains? cmd-changes index)
|
||||
(get cmd-changes index)
|
||||
[command]))]
|
||||
|
||||
(into [] (mapcat process-segments) (d/enumerate content))))
|
||||
|
||||
(defn remove-nodes
|
||||
"Removes from content the points given. Will try to reconstruct the paths
|
||||
to keep everything consistent"
|
||||
[content points]
|
||||
|
||||
(if (empty? points)
|
||||
content
|
||||
|
||||
(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? (seq 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 (juxt :start :end))
|
||||
(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 []))]
|
||||
|
||||
(into 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 :start point-b :end :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)))
|
||||
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 contiguous segments in points to a single point"
|
||||
[content points]
|
||||
(let [segments (get-segments content points)]
|
||||
(if (seq segments)
|
||||
(let [point->merge-point (-> segments
|
||||
(group-segments)
|
||||
(calculate-merge-points points))]
|
||||
(-> content
|
||||
(separate-nodes points)
|
||||
(replace-points point->merge-point)))
|
||||
content)))
|
||||
|
||||
|
|
@ -11,13 +11,13 @@
|
|||
[app.common.exceptions :as ex]
|
||||
[app.common.files.builder :as fb]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.path :as gpa]
|
||||
[app.common.json :as json]
|
||||
[app.common.logging :as log]
|
||||
[app.common.media :as cm]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.text :as ct]
|
||||
[app.common.time :as tm]
|
||||
[app.common.types.path :as path]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.main.repo :as rp]
|
||||
[app.util.http :as http]
|
||||
|
|
@ -330,7 +330,7 @@
|
|||
(d/update-when :x + (:x frame))
|
||||
(d/update-when :y + (:y frame))
|
||||
(cond-> (= :path type)
|
||||
(update :content gpa/move-content (gpt/point (:x frame) (:y frame)))))
|
||||
(update :content path/move-content (gpt/point (:x frame) (:y frame)))))
|
||||
|
||||
data)))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue