3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-10 21:46:38 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #1247 from penpot/feat/bool-shapes

Browse source 
Bool shapes
This commit is contained in:
Andrey Antukh 2021-09-28 11:45:49 +02:00 • committed by GitHub
commit 9ad43e13da
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
69 changed files with 2308 additions and 348 deletions
Download patch file Download diff file Expand all files Collapse all files

5
common/src/app/common/data.cljc
View file

@ -69,6 +69,11 @@
(next colls))
(persistent! result))))
(defn preconj
[coll elem]
(assert (vector? coll))
(concat [elem] coll))
(defn enumerate
([items] (enumerate items 0))
([items start]

42
common/src/app/common/file_builder.cljc
View file

@ -278,6 +278,48 @@
(-> file
(update :parent-stack pop))))
(defn add-bool [file data]
(let [frame-id (:current-frame-id file)
name (:name data)
obj (-> {:id (uuid/next)
:type :bool
:name name
:shapes []
:frame-id frame-id}
(merge data)
(check-name file :bool)
(d/without-nils))]
(-> file
(commit-shape obj)
(assoc :last-id (:id obj))
(add-name (:name obj))
(update :parent-stack conjv (:id obj)))))
(defn close-bool [file]
(let [bool-id (-> file :parent-stack peek)
bool (lookup-shape file bool-id)
children (->> bool :shapes (mapv #(lookup-shape file %)))
file
(let [objects (lookup-objects file)
bool' (gsh/update-bool-selrect bool children objects)]
(commit-change
file
{:type :mod-obj
:id bool-id
:operations
[{:type :set :attr :selrect :val (:selrect bool')}
{:type :set :attr :points :val (:points bool')}
{:type :set :attr :x :val (-> bool' :selrect :x)}
{:type :set :attr :y :val (-> bool' :selrect :y)}
{:type :set :attr :width :val (-> bool' :selrect :width)}
{:type :set :attr :height :val (-> bool' :selrect :height)}]}
{:add-container? true}))]
(-> file
(update :parent-stack pop))))
(defn create-shape [file type data]
(let [frame-id (:current-frame-id file)
frame (when-not (= frame-id root-frame)

18
common/src/app/common/geom/point.cljc
View file

@ -22,7 +22,8 @@
(defn ^boolean point?
"Return true if `v` is Point instance."
[v]
(instance? Point v))
(or (instance? Point v)
(and (map? v) (contains? v :x) (contains? v :y))))
(defn ^boolean point-like?
[{:keys [x y] :as v}]
@ -257,15 +258,12 @@
(and (mth/almost-zero? x)
(mth/almost-zero? y)))
(defn line-val
"Given a line with two points p1-p2 and a 'percent'. Returns the point in the vector
generated by these two points. For example: for p1=(0,0) p2=(1,1) and v=0.25 will return
the point (0.25, 0.25)"
[p1 p2 v]
(let [v (-> (to-vec p1 p2)
(scale v))]
(add p1 v)))
(defn lerp
"Calculates a linear interpolation between two points given a tvalue"
[p1 p2 t]
(let [x (mth/lerp (:x p1) (:x p2) t)
y (mth/lerp (:y p1) (:y p2) t)]
(point x y)))
(defn rotate
"Rotates the point around center with an angle"

7
common/src/app/common/geom/shapes.cljc
View file

@ -8,6 +8,7 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.bool :as gsb]
[app.common.geom.shapes.common :as gco]
[app.common.geom.shapes.intersect :as gin]
[app.common.geom.shapes.path :as gsp]
@ -133,6 +134,7 @@
(d/export gco/center-rect)
(d/export gco/center-points)
(d/export gco/make-centered-rect)
(d/export gco/transform-points)
(d/export gpr/rect->selrect)
(d/export gpr/rect->points)
@ -145,7 +147,6 @@
(d/export gtr/transform-matrix)
(d/export gtr/inverse-transform-matrix)
(d/export gtr/transform-point-center)
(d/export gtr/transform-points)
(d/export gtr/transform-rect)
(d/export gtr/calculate-adjust-matrix)
(d/export gtr/update-group-selrect)
@ -156,7 +157,6 @@
(d/export gtr/calc-child-modifiers)
;; PATHS
(d/export gsp/content->points)
(d/export gsp/content->selrect)
(d/export gsp/transform-content)
@ -165,3 +165,6 @@
(d/export gin/has-point?)
(d/export gin/has-point-rect?)
(d/export gin/rect-contains-shape?)
;; Bool
(d/export gsb/update-bool-selrect)

25
common/src/app/common/geom/shapes/bool.cljc Normal file
View file

@ -0,0 +1,25 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.common.geom.shapes.bool
(:require
[app.common.geom.shapes.path :as gsp]
[app.common.path.bool :as pb]
[app.common.path.shapes-to-path :as stp]))
(defn update-bool-selrect
"Calculates the selrect+points for the boolean shape"
[shape children objects]
(let [content (->> children
(map #(stp/convert-to-path % objects))
(mapv :content)
(pb/content-bool (:bool-type shape)))
[points selrect] (gsp/content->points+selrect shape content)]
(-> shape
(assoc :selrect selrect)
(assoc :points points))))

12
common/src/app/common/geom/shapes/common.cljc
View file

@ -6,6 +6,7 @@
(ns app.common.geom.shapes.common
(:require
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.math :as mth]))
@ -48,3 +49,14 @@
:y (- (:y center) (/ height 2.0))
:width width
:height height})
(defn transform-points
([points matrix]
(transform-points points nil matrix))
([points center matrix]
(let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
tr-point (fn [point]
(gpt/transform point (gmt/multiply prev matrix post)))]
(mapv tr-point points))))

1
common/src/app/common/geom/shapes/intersect.cljc
View file

@ -308,3 +308,4 @@
(->> shape
:points
(every? (partial has-point-rect? rect))))

655
common/src/app/common/geom/shapes/path.cljc
View file

@ -7,24 +7,79 @@
(ns app.common.geom.shapes.path
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gsc]
[app.common.geom.shapes.rect :as gpr]
[app.common.math :as mth]))
[app.common.math :as mth]
[app.common.path.commands :as upc]))
(defn content->points [content]
(def ^:const curve-curve-precision 0.1)
(def ^:const curve-range-precision 2)
(defn s= [a b]
(mth/almost-zero? (- (mth/abs a) b)))
(defn calculate-opposite-handler
"Given a point and its handler, gives the symetric handler"
[point handler]
(let [handler-vector (gpt/to-vec point handler)]
(gpt/add point (gpt/negate handler-vector))))
(defn opposite-handler
"Calculates the coordinates of the opposite handler"
[point handler]
(let [phv (gpt/to-vec point handler)]
(gpt/add point (gpt/negate phv))))
(defn opposite-handler-keep-distance
"Calculates the coordinates of the opposite handler but keeping the old distance"
[point handler old-opposite]
(let [old-distance (gpt/distance point old-opposite)
phv (gpt/to-vec point handler)
phv2 (gpt/multiply
(gpt/unit (gpt/negate phv))
(gpt/point old-distance))]
(gpt/add point phv2)))
(defn content->points
"Returns the points in the given content"
[content]
(->> content
(map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
(map #(when (-> % :params :x)
(gpt/point (-> % :params :x) (-> % :params :y))))
(remove nil?)
(into [])))
(defn line-values
[[from-p to-p] t]
(let [move-v (-> (gpt/to-vec from-p to-p)
(gpt/scale t))]
(gpt/add from-p move-v)))
(defn line-windup
[[from-p to-p :as l] t]
(let [p (line-values l t)
cy (:y p)
ay (:y to-p)
by (:y from-p)]
(cond
(and (> (- cy ay) 0) (not (s= cy ay))) 1
(and (< (- cy ay) 0) (not (s= cy ay))) -1
(< (- cy by) 0) 1
(> (- cy by) 0) -1
:else 0)))
;; https://medium.com/@Acegikmo/the-ever-so-lovely-b%C3%A9zier-curve-eb27514da3bf
;; https://en.wikipedia.org/wiki/Bernstein_polynomial
(defn curve-values
"Parametric equation for cubic beziers. Given a start and end and
two intermediate points returns points for values of t.
If you draw t on a plane you got the bezier cube"
[start end h1 h2 t]
([[start end h1 h2] t]
(curve-values start end h1 h2 t))
([start end h1 h2 t]
(let [t2 (* t t) ;; t square
t3 (* t2 t) ;; t cube
@ -39,65 +94,188 @@
(* (coord h2) h2-v)
(* (coord end) end-v)))]
(gpt/point (coord-v :x) (coord-v :y))))
(gpt/point (coord-v :x) (coord-v :y)))))
(defn curve-tangent
"Retrieve the tangent vector to the curve in the point `t`"
[[start end h1 h2] t]
(let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
[(:y start) (:y h1) (:y h2) (:y end)]]
solve-derivative
(fn [[c0 c1 c2 c3]]
;; Solve B'(t) given t to retrieve the value for the
;; first derivative
(let [t2 (* t t)]
(+ (* c0 (+ (* -3 t2) (* 6 t) -3))
(* c1 (+ (* 9 t2) (* -12 t) 3))
(* c2 (+ (* -9 t2) (* 6 t)))
(* c3 (* 3 t2)))))
[x y] (->> coords (mapv solve-derivative))
;; normalize value
d (mth/sqrt (+ (* x x) (* y y)))]
(gpt/point (/ x d) (/ y d))))
(defn curve-windup
[curve t]
(let [tangent (curve-tangent curve t)]
(cond
(> (:y tangent) 0) 1
(< (:y tangent) 0) -1
:else 0)))
(defn curve-split
"Splits a curve into two at the given parametric value `t`.
Calculates the Casteljau's algorithm intermediate points"
[start end h1 h2 t]
([[start end h1 h2] t]
(curve-split start end h1 h2 t))
(let [p1 (gpt/line-val start h1 t)
p2 (gpt/line-val h1 h2 t)
p3 (gpt/line-val h2 end t)
p4 (gpt/line-val p1 p2 t)
p5 (gpt/line-val p2 p3 t)
sp (gpt/line-val p4 p5 t)]
([start end h1 h2 t]
(let [p1 (gpt/lerp start h1 t)
p2 (gpt/lerp h1 h2 t)
p3 (gpt/lerp h2 end t)
p4 (gpt/lerp p1 p2 t)
p5 (gpt/lerp p2 p3 t)
sp (gpt/lerp p4 p5 t)]
[[start sp p1 p4]
[sp end p5 p3]]))
[sp end p5 p3]])))
(defn subcurve-range
"Given a curve returns a new curve between the values t1-t2"
([[start end h1 h2] [t1 t2]]
(subcurve-range start end h1 h2 t1 t2))
([[start end h1 h2] t1 t2]
(subcurve-range start end h1 h2 t1 t2))
([start end h1 h2 t1 t2]
;; Make sure that t2 is greater than t1
(let [[t1 t2] (if (< t1 t2) [t1 t2] [t2 t1])
t2' (/ (- t2 t1) (- 1 t1))
[_ curve'] (curve-split start end h1 h2 t1)]
(first (curve-split curve' t2')))))
;; https://trans4mind.com/personal_development/mathematics/polynomials/cubicAlgebra.htm
(defn- solve-roots
"Solvers a quadratic or cubic equation given by the parameters a b c d"
([a b c]
(solve-roots a b c 0))
([a b c d]
(let [sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))]
(cond
;; No solutions
(and (mth/almost-zero? d) (mth/almost-zero? a) (mth/almost-zero? b))
[]
;; Linear solution
(and (mth/almost-zero? d) (mth/almost-zero? a))
[(/ (- c) b)]
;; Cuadratic
(mth/almost-zero? d)
[(/ (+ (- b) sqrt-b2-4ac)
(* 2 a))
(/ (- (- b) sqrt-b2-4ac)
(* 2 a))]
;; Cubic
:else
(let [a (/ a d)
b (/ b d)
c (/ c d)
p (/ (- (* 3 b) (* a a)) 3)
q (/ (+ (* 2 a a a) (* -9 a b) (* 27 c)) 27)
p3 (/ p 3)
q2 (/ q 2)
discriminant (+ (* q2 q2) (* p3 p3 p3))]
(cond
(< discriminant 0)
(let [mp3 (/ (- p) 3)
mp33 (* mp3 mp3 mp3)
r (mth/sqrt mp33)
t (/ (- q) (* 2 r))
cosphi (cond (< t -1) -1
(> t 1) 1
:else t)
phi (mth/acos cosphi)
crtr (mth/cubicroot r)
t1 (* 2 crtr)
root1 (- (* t1 (mth/cos (/ phi 3))) (/ a 3))
root2 (- (* t1 (mth/cos (/ (+ phi (* 2 mth/PI)) 3))) (/ a 3))
root3 (- (* t1 (mth/cos (/ (+ phi (* 4 mth/PI)) 3))) (/ a 3))]
[root1 root2 root3])
(mth/almost-zero? discriminant)
(let [u1 (if (< q2 0) (mth/cubicroot (- q2)) (- (mth/cubicroot q2)))
root1 (- (* 2 u1) (/ a 3))
root2 (- (- u1) (/ a 3))]
[root1 root2])
:else
(let [sd (mth/sqrt discriminant)
u1 (mth/cubicroot (- sd q2))
v1 (mth/cubicroot (+ sd q2))
root (- u1 v1 (/ a 3))]
[root])))))))
;; https://pomax.github.io/bezierinfo/#extremities
(defn curve-extremities
"Given a cubic bezier cube finds its roots in t. This are the extremities
if we calculate its values for x, y we can find a bounding box for the curve."
[start end h1 h2]
"Calculates the extremities by solving the first derivative for a cubic
bezier and then solving the quadratic formula"
([[start end h1 h2]]
(curve-extremities start end h1 h2))
([start end h1 h2]
(let [coords [[(:x start) (:x h1) (:x h2) (:x end)]
[(:y start) (:y h1) (:y h2) (:y end)]]
coord->tvalue
(fn [[c0 c1 c2 c3]]
(let [a (+ (* -3 c0) (* 9 c1) (* -9 c2) (* 3 c3))
b (+ (* 6 c0) (* -12 c1) (* 6 c2))
c (+ (* 3 c1) (* -3 c0))
c (+ (* 3 c1) (* -3 c0))]
sqrt-b2-4ac (mth/sqrt (- (* b b) (* 4 a c)))]
(cond
(and (mth/almost-zero? a)
(not (mth/almost-zero? b)))
;; When the term a is close to zero we have a linear equation
[(/ (- c) b)]
;; If a is not close to zero return the two roots for a cuadratic
(not (mth/almost-zero? a))
[(/ (+ (- b) sqrt-b2-4ac)
(* 2 a))
(/ (- (- b) sqrt-b2-4ac)
(* 2 a))]
;; If a and b close to zero we can't find a root for a constant term
:else
[])))]
(solve-roots a b c)))]
(->> coords
(mapcat coord->tvalue)
;; Only values in the range [0, 1] are valid
(filter #(and (>= % 0) (<= % 1)))
(filterv #(and (> % 0.01) (< % 0.99)))))))
;; Pass t-values to actual points
(map #(curve-values start end h1 h2 %)))
))
(defn curve-roots
"Uses cardano algorithm to find the roots for a cubic bezier"
([[start end h1 h2] coord]
(curve-roots start end h1 h2 coord))
([start end h1 h2 coord]
(let [coords [[(get start coord) (get h1 coord) (get h2 coord) (get end coord)]]
coord->tvalue
(fn [[pa pb pc pd]]
(let [a (+ (* 3 pa) (* -6 pb) (* 3 pc))
b (+ (* -3 pa) (* 3 pb))
c pa
d (+ (- pa) (* 3 pb) (* -3 pc) pd)]
(solve-roots a b c d)))]
(->> coords
(mapcat coord->tvalue)
;; Only values in the range [0, 1] are valid
(filterv #(and (>= % 0) (<= % 1)))))))
(defn command->point
([command] (command->point command nil))
@ -109,6 +287,48 @@
y (get params ykey)]
(gpt/point x y))))
(defn command->line
([cmd]
(command->line cmd (:prev cmd)))
([cmd prev]
[prev (command->point cmd)]))
(defn command->bezier
([cmd]
(command->bezier cmd (:prev cmd)))
([cmd prev]
[prev
(command->point cmd)
(gpt/point (-> cmd :params :c1x) (-> cmd :params :c1y))
(gpt/point (-> cmd :params :c2x) (-> cmd :params :c2y))]))
(defn command->selrect
([command]
(command->selrect command (:prev command)))
([command prev-point]
(let [points (case (:command command)
:move-to [(command->point command)]
;; If it's a line we add the beginning point and endpoint
:line-to [prev-point (command->point command)]
;; We return the bezier extremities
:curve-to (d/concat
[prev-point
(command->point command)]
(let [curve [prev-point
(command->point command)
(command->point command :c1)
(command->point command :c2)]]
(->> (curve-extremities curve)
(mapv #(curve-values curve %)))))
[])
selrect (gpr/points->selrect points)]
(-> selrect
(update :width #(if (mth/almost-zero? %) 1 %))
(update :height #(if (mth/almost-zero? %) 1 %))))))
(defn content->selrect [content]
(let [calc-extremities
(fn [command prev]
@ -123,10 +343,12 @@
:curve-to (d/concat
[(command->point prev)
(command->point command)]
(curve-extremities (command->point prev)
(let [curve [(command->point prev)
(command->point command)
(command->point command :c1)
(command->point command :c2)))
(command->point command :c2)]]
(->> (curve-extremities curve)
(mapv #(curve-values curve %)))))
[]))
extremities (mapcat calc-extremities
@ -302,7 +524,8 @@
"Given a path and a position"
[shape position]
(let [point+distance (fn [[cur-cmd prev-cmd]]
(let [point+distance
(fn [[cur-cmd prev-cmd]]
(let [from-p (command->point prev-cmd)
to-p (command->point cur-cmd)
h1 (gpt/point (get-in cur-cmd [:params :c1x])
@ -331,3 +554,349 @@
(map point+distance)
(reduce find-min-point)
(first))))
(defn- get-line-tval
[[{x1 :x y1 :y} {x2 :x y2 :y}] {:keys [x y]}]
(cond
(and (s= x1 x2) (s= y1 y2))
##Inf
(s= x1 x2)
(/ (- y y1) (- y2 y1))
:else
(/ (- x x1) (- x2 x1))))
(defn- curve-range->rect
[curve from-t to-t]
(let [[from-p to-p :as curve] (subcurve-range curve from-t to-t)
extremes (->> (curve-extremities curve)
(mapv #(curve-values curve %)))]
(gpr/points->rect (into [from-p to-p] extremes))))
(defn line-has-point?
"Using the line equation we put the x value and check if matches with
the given Y. If it does the point is inside the line"
[point [from-p to-p :as line]]
(let [{x1 :x y1 :y} from-p
{x2 :x y2 :y} to-p
{px :x py :y} point
m (when-not (s= x1 x2) (/ (- y2 y1) (- x2 x1)))
vy (when (some? m) (+ (* m px) (* (- m) x1) y1))
t (get-line-tval line point)]
;; If x1 = x2 there is no slope, to see if the point is in the line
;; only needs to check the x is the same
(and (or (and (s= x1 x2) (s= px x1))
(and (some? vy) (s= py vy)))
;; This will check if is between both segments
(or (> t 0) (s= t 0))
(or (< t 1) (s= t 1)))))
(defn curve-has-point?
[_point _curve]
;; TODO
#_(or (< (gpt/distance point from-p) 0.01)
(< (gpt/distance point to-p) 0.01))
false
)
(defn line-line-crossing
[[from-p1 to-p1 :as l1] [from-p2 to-p2 :as l2]]
(let [{x1 :x y1 :y} from-p1
{x2 :x y2 :y} to-p1
{x3 :x y3 :y} from-p2
{x4 :x y4 :y} to-p2
nx (- (* (- x3 x4) (- (* x1 y2) (* y1 x2)))
(* (- x1 x2) (- (* x3 y4) (* y3 x4))))
ny (- (* (- y3 y4) (- (* x1 y2) (* y1 x2)))
(* (- y1 y2) (- (* x3 y4) (* y3 x4))))
d (- (* (- x1 x2) (- y3 y4))
(* (- y1 y2) (- x3 x4)))]
(when-not (mth/almost-zero? d)
;; Coordinates in the line. We calculate the tvalue that will
;; return 0-1 as a percentage in the segment
(let [cross-p (gpt/point (/ nx d) (/ ny d))
t1 (get-line-tval l1 cross-p)
t2 (get-line-tval l2 cross-p)]
[t1 t2]))))
(defn line-curve-crossing
[[from-p1 to-p1]
[from-p2 to-p2 h1-p2 h2-p2]]
(let [theta (-> (mth/atan2 (- (:y to-p1) (:y from-p1))
(- (:x to-p1) (:x from-p1)))
(mth/degrees))
transform (-> (gmt/matrix)
(gmt/rotate (- theta))
(gmt/translate (gpt/negate from-p1)))
c2' [(gpt/transform from-p2 transform)
(gpt/transform to-p2 transform)
(gpt/transform h1-p2 transform)
(gpt/transform h2-p2 transform)]]
(curve-roots c2' :y)))
(defn ray-line-intersect
[point line]
;; If the ray is paralell to the line there will be no crossings
(let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
[ray-t line-t] (line-line-crossing ray-line line)]
(when (and (some? line-t)
(> ray-t 0)
(or (> line-t 0) (s= line-t 0))
(or (< line-t 1) (s= line-t 1)))
[[(line-values line line-t)
(line-windup line line-t)]])))
(defn line-line-intersect
[l1 l2]
(let [[l1-t l2-t] (line-line-crossing l1 l2)]
(when (and (some? l1-t) (some? l2-t)
(or (> l1-t 0) (s= l1-t 0))
(or (< l1-t 1) (s= l1-t 1))
(or (> l2-t 0) (s= l2-t 0))
(or (< l2-t 1) (s= l2-t 1)))
[[l1-t] [l2-t]])))
(defn ray-curve-intersect
[ray-line c2]
(let [;; ray-line [point (gpt/point (inc (:x point)) (:y point))]
curve-ts (->> (line-curve-crossing ray-line c2)
(filterv #(let [curve-v (curve-values c2 %)
curve-tg (curve-tangent c2 %)
curve-tg-angle (gpt/angle curve-tg)
ray-t (get-line-tval ray-line curve-v)]
(and (> ray-t 0)
(> (mth/abs (- curve-tg-angle 180)) 0.01)
(> (mth/abs (- curve-tg-angle 0)) 0.01)) )))]
(->> curve-ts
(mapv #(vector (curve-values c2 %)
(curve-windup c2 %))))))
(defn line-curve-intersect
[l1 c2]
(let [curve-ts (->> (line-curve-crossing l1 c2)
(filterv
(fn [curve-t]
(let [curve-t (if (mth/almost-zero? curve-t) 0 curve-t)
curve-v (curve-values c2 curve-t)
line-t (get-line-tval l1 curve-v)]
(and (>= curve-t 0) (<= curve-t 1)
(>= line-t 0) (<= line-t 1))))))
;; Intersection line-curve points
intersect-ps (->> curve-ts
(mapv #(curve-values c2 %)))
line-ts (->> intersect-ps
(mapv #(get-line-tval l1 %)))]
[line-ts curve-ts]))
(defn curve-curve-intersect
[c1 c2]
(letfn [(check-range [c1-from c1-to c2-from c2-to]
(let [r1 (curve-range->rect c1 c1-from c1-to)
r2 (curve-range->rect c2 c2-from c2-to)]
(when (gpr/overlaps-rects? r1 r2)
(let [p1 (curve-values c1 c1-from)
p2 (curve-values c2 c2-from)]
(if (< (gpt/distance p1 p2) curve-curve-precision)
[{:p1 p1
:p2 p2
:d (gpt/distance p1 p2)
:t1 (mth/precision c1-from 4)
:t2 (mth/precision c2-from 4)}]
(let [c1-half (+ c1-from (/ (- c1-to c1-from) 2))
c2-half (+ c2-from (/ (- c2-to c2-from) 2))
ts-1 (check-range c1-from c1-half c2-from c2-half)
ts-2 (check-range c1-from c1-half c2-half c2-to)
ts-3 (check-range c1-half c1-to c2-from c2-half)
ts-4 (check-range c1-half c1-to c2-half c2-to)]
(d/concat [] ts-1 ts-2 ts-3 ts-4)))))))
(remove-close-ts [{cp1 :p1 cp2 :p2}]
(fn [{:keys [p1 p2]}]
(and (>= (gpt/distance p1 cp1) curve-range-precision)
(>= (gpt/distance p2 cp2) curve-range-precision))))
(process-ts [ts]
(loop [current (first ts)
pending (rest ts)
c1-ts []
c2-ts []]
(if (nil? current)
[c1-ts c2-ts]
(let [pending (->> pending (filter (remove-close-ts current)))
c1-ts (conj c1-ts (:t1 current))
c2-ts (conj c2-ts (:t2 current))]
(recur (first pending)
(rest pending)
c1-ts
c2-ts)))))]
(->> (check-range 0 1 0 1)
(sort-by :d)
(process-ts))))
(defn curve->rect
[[from-p to-p :as curve]]
(let [extremes (->> (curve-extremities curve)
(mapv #(curve-values curve %)))]
(gpr/points->rect (into [from-p to-p] extremes))))
(defn is-point-in-content?
[point content]
(letfn [(cast-ray [[cmd prev]]
(let [ray-line [point (gpt/point (inc (:x point)) (:y point))]]
(case (:command cmd)
:line-to (ray-line-intersect point (command->line cmd (command->point prev)))
:curve-to (ray-curve-intersect ray-line (command->bezier cmd (command->point prev)))
#_:else [])))
(inside-border? [[cmd prev]]
(case (:command cmd)
:line-to (line-has-point? point (command->line cmd (command->point prev)))
:curve-to (curve-has-point? point (command->bezier cmd (command->point prev)))
#_:else false)
)]
(let [content-with-prev (d/with-prev content)]
(or (->> content-with-prev
(some inside-border?))
(->> content-with-prev
(mapcat cast-ray)
(map second)
(reduce +)
(not= 0))))))
(defn split-line-to
"Given a point and a line-to command will create a two new line-to commands
that will split the original line into two given a value between 0-1"
[from-p cmd t-val]
(let [to-p (upc/command->point cmd)
sp (gpt/lerp from-p to-p t-val)]
[(upc/make-line-to sp) cmd]))
(defn split-curve-to
"Given the point and a curve-to command will split the curve into two new
curve-to commands given a value between 0-1"
[from-p cmd t-val]
(let [params (:params cmd)
end (gpt/point (:x params) (:y params))
h1 (gpt/point (:c1x params) (:c1y params))
h2 (gpt/point (:c2x params) (:c2y params))
[[_ to1 h11 h21]
[_ to2 h12 h22]] (curve-split from-p end h1 h2 t-val)]
[(upc/make-curve-to to1 h11 h21)
(upc/make-curve-to to2 h12 h22)]))
(defn split-line-to-ranges
"Splits a line into several lines given the points in `values`
for example (split-line-to-ranges p c [0 0.25 0.5 0.75 1] will split
the line into 4 lines"
[from-p cmd values]
(let [values (->> values (filter #(and (> % 0) (< % 1))))]
(if (empty? values)
[cmd]
(let [to-p (upc/command->point cmd)
values-set (->> (conj values 1) (into (sorted-set)))]
(->> values-set
(mapv (fn [val]
(-> (gpt/lerp from-p to-p val)
#_(gpt/round 2)
(upc/make-line-to)))))))))
(defn split-curve-to-ranges
"Splits a curve into several curves given the points in `values`
for example (split-curve-to-ranges p c [0 0.25 0.5 0.75 1] will split
the curve into 4 curves that draw the same curve"
[from-p cmd values]
(let [values (->> values (filter #(and (> % 0) (< % 1))))]
(if (empty? values)
[cmd]
(let [to-p (upc/command->point cmd)
params (:params cmd)
h1 (gpt/point (:c1x params) (:c1y params))
h2 (gpt/point (:c2x params) (:c2y params))
values-set (->> (conj values 0 1) (into (sorted-set)))]
(->> (d/with-prev values-set)
(rest)
(mapv
(fn [[t1 t0]]
(let [[_ to-p h1' h2'] (subcurve-range from-p to-p h1 h2 t0 t1)]
(upc/make-curve-to (-> to-p #_(gpt/round 2)) h1' h2')))))))))
(defn content-center
[content]
(-> content
content->selrect
gsc/center-selrect))
(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 (gsc/center-shape shape)
(content-center content))
base-content (transform-content
content
(gmt/transform-in center transform-inverse))
;; Calculates the new selrect with points given the old center
points (-> (content->selrect base-content)
(gpr/rect->points)
(gsc/transform-points center transform))
points-center (gsc/center-points points)
;; Points is now the selrect but the center is different so we can create the selrect
;; through points
selrect (-> points
(gsc/transform-points points-center transform-inverse)
(gpr/points->selrect))]
[points selrect]))

27
common/src/app/common/geom/shapes/rect.cljc
View file

@ -7,7 +7,8 @@
(ns app.common.geom.shapes.rect
(:require
[app.common.geom.point :as gpt]
[app.common.geom.shapes.common :as gco]))
[app.common.geom.shapes.common :as gco]
[app.common.math :as mth]))
(defn rect->points [{:keys [x y width height]}]
;; (assert (number? x))
@ -70,3 +71,27 @@
:y (- (:y center) (/ height 2))
:width width
:height height})
(defn s=
[a b]
(mth/almost-zero? (- a b)))
(defn overlaps-rects?
"Check for two rects to overlap. Rects won't overlap only if
one of them is fully to the left or the top"
[rect-a rect-b]
(let [x1a (:x rect-a)
y1a (:y rect-a)
x2a (+ (:x rect-a) (:width rect-a))
y2a (+ (:y rect-a) (:height rect-a))
x1b (:x rect-b)
y1b (:y rect-b)
x2b (+ (:x rect-b) (:width rect-b))
y2b (+ (:y rect-b) (:height rect-b))]
(and (or (> x2a x1b) (s= x2a x1b))
(or (>= x2b x1a) (s= x2b x1a))
(or (<= y1b y2a) (s= y1b y2a))
(or (<= y1a y2b) (s= y1a y2b)))))

33
common/src/app/common/geom/shapes/transforms.cljc
View file

@ -161,23 +161,12 @@
matrix
(gmt/translate-matrix (gpt/negate center)))))
(defn transform-points
([points matrix]
(transform-points points nil matrix))
([points center matrix]
(let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
tr-point (fn [point]
(gpt/transform point (gmt/multiply prev matrix post)))]
(mapv tr-point points))))
(defn transform-rect
"Transform a rectangles and changes its attributes"
[rect matrix]
(let [points (-> (gpr/rect->points rect)
(transform-points matrix))]
(gco/transform-points matrix))]
(gpr/points->rect points)))
(defn calculate-adjust-matrix
@ -201,12 +190,12 @@
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
h1 (max 1 (calculate-height points-temp))
h2 (max 1 (calculate-height (transform-points points-rec center stretch-matrix)))
h2 (max 1 (calculate-height (gco/transform-points points-rec center stretch-matrix)))
h3 (if-not (mth/almost-zero? h2) (/ h1 h2) 1)
h3 (if (mth/nan? h3) 1 h3)
w1 (max 1 (calculate-width points-temp))
w2 (max 1 (calculate-width (transform-points points-rec center stretch-matrix)))
w2 (max 1 (calculate-width (gco/transform-points points-rec center stretch-matrix)))
w3 (if-not (mth/almost-zero? w2) (/ w1 w2) 1)
w3 (if (mth/nan? w3) 1 w3)
@ -214,7 +203,7 @@
rotation-angle (calculate-rotation
center
(transform-points points-rec (gco/center-points points-rec) stretch-matrix)
(gco/transform-points points-rec (gco/center-points points-rec) stretch-matrix)
points-temp
flip-x
flip-y)
@ -233,13 +222,13 @@
its properties. We adjust de x,y,width,height and create a custom transform"
[shape transform round-coords?]
;;
(let [points (-> shape :points (transform-points transform))
(let [points (-> shape :points (gco/transform-points transform))
center (gco/center-points points)
;; Reverse the current transformation stack to get the base rectangle
tr-inverse (:transform-inverse shape (gmt/matrix))
points-temp (transform-points points center tr-inverse)
points-temp (gco/transform-points points center tr-inverse)
points-temp-dim (calculate-dimensions points-temp)
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
@ -305,12 +294,12 @@
points (->> children (mapcat :points))
;; Invert to get the points minus the transforms applied to the group
base-points (transform-points points shape-center (:transform-inverse group (gmt/matrix)))
base-points (gco/transform-points points shape-center (:transform-inverse group (gmt/matrix)))
;; Defines the new selection rect with its transformations
new-points (-> (gpr/points->selrect base-points)
(gpr/rect->points)
(transform-points shape-center (:transform group (gmt/matrix))))
(gco/transform-points shape-center (:transform group (gmt/matrix))))
;; Calculte the new selrect
new-selrect (gpr/points->selrect base-points)]
@ -544,9 +533,9 @@
transformed-parent-rect (-> parent-rect
(gpr/rect->points)
(transform-points parent-displacement)
(transform-points parent-origin (gmt/scale-matrix parent-vector))
(transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2))
(gco/transform-points parent-displacement)
(gco/transform-points parent-origin (gmt/scale-matrix parent-vector))
(gco/transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2))
(gpr/points->selrect))
;; Calculate the modifiers in the horizontal and vertical directions

25
common/src/app/common/math.cljc
View file

@ -72,17 +72,24 @@
[v]
(* v v))
(defn pow
"Returns the base to the exponent power."
[b e]
#?(:cljs (js/Math.pow b e)
:clj (Math/pow b e)))
(defn sqrt
"Returns the square root of a number."
[v]
#?(:cljs (js/Math.sqrt v)
:clj (Math/sqrt v)))
(defn pow
"Returns the base to the exponent power."
[b e]
#?(:cljs (js/Math.pow b e)
:clj (Math/pow b e)))
(defn cubicroot
"Returns the cubic root of a number"
[v]
(if (pos? v)
(pow v (/ 1 3))
(- (pow (- v) (/ 1 3)))))
(defn floor
"Returns the largest integer less than or
@ -143,7 +150,7 @@
(if (> num to) to num)))
(defn almost-zero? [num]
(< (abs num) 1e-8))
(< (abs num) 1e-5))
(defonce float-equal-precision 0.001)
@ -151,3 +158,9 @@
"Equality for float numbers. Check if the difference is within a range"
[num1 num2]
(<= (abs (- num1 num2)) float-equal-precision))
(defn lerp
"Calculates a the linear interpolation between two values and a given percent"
[v0 v1 t]
(+ (* (- 1 t) v0)
(* t v1)))

3
common/src/app/common/pages.cljc
View file

@ -40,6 +40,7 @@
(d/export helpers/get-children)
(d/export helpers/get-children-objects)
(d/export helpers/get-object-with-children)
(d/export helpers/select-children)
(d/export helpers/is-shape-grouped)
(d/export helpers/get-parent)
(d/export helpers/get-parents)
@ -72,7 +73,7 @@
(d/export indices/update-z-index)
(d/export indices/generate-child-all-parents-index)
(d/export indices/generate-child-parent-index)
(d/export indices/create-mask-index)
(d/export indices/create-clip-index)
;; Process changes
(d/export changes/process-changes)

6
common/src/app/common/pages/changes.cljc
View file

@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.bool :as gshb]
[app.common.pages.common :refer [component-sync-attrs]]
[app.common.pages.helpers :as cph]
[app.common.pages.init :as init]
@ -156,7 +157,7 @@
(sequence (comp
(mapcat #(cons % (cph/get-parents % objects)))
(map #(get objects %))
(filter #(= (:type %) :group))
(filter #(contains? #{:group :bool} (:type %)))
(map :id)
(distinct))
shapes)))
@ -177,6 +178,9 @@
(empty? children)
group
(= :bool (:type group))
(gshb/update-bool-selrect group children objects)
(:masked-group? group)
(set-mask-selrect group children)

155
common/src/app/common/pages/changes_builder.cljc Normal file
View file

@ -0,0 +1,155 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.common.pages.changes-builder
(:require
[app.common.data :as d]
[app.common.pages :as cp]
[app.common.pages.helpers :as h]))
;; Auxiliary functions to help create a set of changes (undo + redo)
(defn empty-changes [origin page-id]
(let [changes {:redo-changes []
:undo-changes []
:origin origin}]
(with-meta changes
{::page-id page-id})))
(defn with-objects [changes objects]
(vary-meta changes assoc ::objects objects))
(defn add-obj
([changes obj index]
(add-obj changes (assoc obj ::index index)))
([changes obj]
(let [add-change
{:type :add-obj
:id (:id obj)
:page-id (::page-id (meta changes))
:parent-id (:parent-id obj)
:frame-id (:frame-id obj)
:index (::index obj)
:obj (dissoc obj ::index :parent-id)}
del-change
{:type :del-obj
:id (:id obj)
:page-id (::page-id (meta changes))}]
(-> changes
(update :redo-changes conj add-change)
(update :undo-changes d/preconj del-change)))))
(defn change-parent
[changes parent-id shapes]
(assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
(let [objects (::objects (meta changes))
set-parent-change
{:type :mov-objects
:parent-id parent-id
:page-id (::page-id (meta changes))
:shapes (->> shapes (mapv :id))}
mk-undo-change
(fn [change-set shape]
(d/preconj
change-set
{:type :mov-objects
:page-id (::page-id (meta changes))
:parent-id (:parent-id shape)
:shapes [(:id shape)]
:index (cp/position-on-parent (:id shape) objects)}))]
(-> changes
(update :redo-changes conj set-parent-change)
(update :undo-changes #(reduce mk-undo-change % shapes)))))
(defn- generate-operation
"Given an object old and new versions and an attribute will append into changes
the set and undo operations"
[changes attr old new ignore-geometry?]
(let [old-val (get old attr)
new-val (get new attr)]
(if (= old-val new-val)
changes
(-> changes
(update :rops conj {:type :set :attr attr :val new-val :ignore-geometry ignore-geometry?})
(update :uops conj {:type :set :attr attr :val old-val :ignore-touched true})))))
(defn update-shapes
"Calculate the changes and undos to be done when a function is applied to a
single object"
([changes ids update-fn]
(update-shapes changes ids update-fn nil))
([changes ids update-fn {:keys [attrs ignore-geometry?] :or {attrs nil ignore-geometry? false}}]
(assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
(let [objects (::objects (meta changes))
update-shape
(fn [changes id]
(let [old-obj (get objects id)
new-obj (update-fn old-obj)
attrs (or attrs (d/concat #{} (keys old-obj) (keys new-obj)))
{rops :rops uops :uops}
(reduce #(generate-operation %1 %2 old-obj new-obj ignore-geometry?)
{:rops [] :uops []}
attrs)
uops (cond-> uops
(seq uops)
(conj {:type :set-touched :touched (:touched old-obj)}))
change {:type :mod-obj
:page-id (::page-id (meta changes))
:id id}]
(cond-> changes
(seq rops)
(update :redo-changes conj (assoc change :operations rops))
(seq uops)
(update :undo-changes d/preconj (assoc change :operations uops)))))]
(reduce update-shape changes ids))))
(defn remove-objects
[changes ids]
(assert (contains? (meta changes) ::objects) "Call (with-objects) first to use this function")
(let [page-id (::page-id (meta changes))
objects (::objects (meta changes))
add-redo-change
(fn [change-set id]
(conj change-set
{:type :del-obj
:page-id page-id
:id id}))
add-undo-change
(fn [change-set id]
(let [shape (get objects id)]
(d/preconj
change-set
{:type :add-obj
:page-id page-id
:parent-id (:parent-id shape)
:frame-id (:frame-id shape)
:id id
:obj (cond-> shape
(contains? shape :shapes)
(assoc :shapes []))
:index (h/position-on-parent id objects)})))]
(-> changes
(update :redo-changes #(reduce add-redo-change % ids))
(update :undo-changes #(reduce add-undo-change % ids)))))

4
common/src/app/common/pages/helpers.cljc
View file

@ -138,6 +138,10 @@
[id objects]
(mapv #(get objects %) (cons id (get-children id objects))))
(defn select-children [id objects]
(->> (get-children id objects)
(select-keys objects)))
(defn is-shape-grouped
"Checks if a shape is inside a group"
[shape-id objects]

26
common/src/app/common/pages/indices.cljc
View file

@ -95,16 +95,24 @@
(map #(vector (:id %) (shape->parents %)))
(into {})))))
(defn create-mask-index
(defn create-clip-index
"Retrieves the mask information for an object"
[objects parents-index]
(let [retrieve-masks
(let [retrieve-clips
(fn [_ parents]
;; TODO: use transducers?
(->> parents
(map #(get objects %))
(filter #(:masked-group? %))
;; Retrieve the masking element
(mapv #(get objects (->> % :shapes first)))))]
(let [lookup-object (fn [id] (get objects id))
get-clip-parents
(fn [shape]
(cond-> []
(:masked-group? shape)
(conj (get objects (->> shape :shapes first)))
(= :bool (:type shape))
(conj shape)))]
(into []
(comp (map lookup-object)
(mapcat get-clip-parents))
parents)))]
(->> parents-index
(d/mapm retrieve-masks))))
(d/mapm retrieve-clips))))

264
common/src/app/common/path/bool.cljc Normal file
View file

@ -0,0 +1,264 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.common.path.bool
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gsp]
[app.common.geom.shapes.rect :as gpr]
[app.common.path.commands :as upc]
[app.common.path.subpaths :as ups]))
(defn- reverse-command
"Reverses a single command"
[command]
(let [{old-x :x old-y :y} (:params command)
{:keys [x y]} (:prev command)
{:keys [c1x c1y c2x c2y]} (:params command)]
(-> command
(assoc :prev (gpt/point old-x old-y))
(update :params assoc :x x :y y)
(cond-> (= :curve-to (:command command))
(update :params assoc
:c1x c2x :c1y c2y
:c2x c1x :c2y c1y)))))
(defn add-previous
([content]
(add-previous content nil))
([content first]
(->> (d/with-prev content)
(mapv (fn [[cmd prev]]
(cond-> cmd
(and (nil? prev) (some? first))
(assoc :prev first)
(some? prev)
(assoc :prev (gsp/command->point prev))))))))
(defn- 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)
[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))
(and (= :line-to (:command seg-1))
(= :curve-to (:command seg-2)))
(gsp/line-curve-intersect (gsp/command->line seg-1) (gsp/command->bezier seg-2))
(and (= :curve-to (:command seg-1))
(= :line-to (:command seg-2)))
(let [[seg-2' seg-1']
(gsp/line-curve-intersect (gsp/command->line seg-2) (gsp/command->bezier seg-1))]
;; Need to reverse because we send the arguments reversed
[seg-1' seg-2'])
(and (= :curve-to (:command seg-1))
(= :curve-to (:command seg-2)))
(gsp/curve-curve-intersect (gsp/command->bezier seg-1) (gsp/command->bezier seg-2))
:else
[[] []]))
(defn split
[seg-1 seg-2]
(let [r1 (gsp/command->selrect seg-1)
r2 (gsp/command->selrect seg-2)]
(if (not (gpr/overlaps-rects? r1 r2))
[[seg-1] [seg-2]]
(let [[ts-seg-1 ts-seg-2] (split-ts seg-1 seg-2)]
[(-> (split-command seg-1 ts-seg-1) (add-previous (:prev seg-1)))
(-> (split-command seg-2 ts-seg-2) (add-previous (:prev seg-2)))]))))
(defn content-intersect-split
[content-a content-b]
(let [cache (atom {})]
(letfn [(split-cache [seg-1 seg-2]
(cond
(contains? @cache [seg-1 seg-2])
(first (get @cache [seg-1 seg-2]))
(contains? @cache [seg-2 seg-1])
(second (get @cache [seg-2 seg-1]))
:else
(let [value (split seg-1 seg-2)]
(swap! cache assoc [seg-1 seg-2] value)
(first value))))
(split-segment-on-content
[segment content]
(loop [current (first content)
content (rest content)
result [segment]]
(if (nil? current)
result
(let [result (->> result (into [] (mapcat #(split-cache % current))))]
(recur (first content)
(rest content)
result)))))
(split-content
[content-a content-b]
(into []
(mapcat #(split-segment-on-content % content-b))
content-a))]
[(split-content content-a content-b)
(split-content content-b content-a)])))
(defn is-segment?
[cmd]
(and (contains? cmd :prev)
(contains? #{:line-to :curve-to} (:command cmd))))
(defn contains-segment?
[segment content]
(let [point (case (:command segment)
:line-to (-> (gsp/command->line segment)
(gsp/line-values 0.5))
:curve-to (-> (gsp/command->bezier segment)
(gsp/curve-values 0.5)))]
(gsp/is-point-in-content? point content)))
(defn overlap-segment?
"Finds if the current segment is overlapping against other
segment meaning they have the same coordinates"
[segment content]
(letfn [(overlap-single?
[other]
(when (and (= (:command segment) (:command other))
(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)]
(or (and (< (gpt/distance p1 p2) 0.1)
(< (gpt/distance q1 q2) 0.1))
(and (< (gpt/distance p1 q2) 0.1)
(< (gpt/distance q1 p2) 0.1))))
:curve-to (let [[p1 q1 h11 h21] (gsp/command->bezier segment)
[p2 q2 h12 h22] (gsp/command->bezier other)]
(or (and (< (gpt/distance p1 p2) 0.1)
(< (gpt/distance q1 q2) 0.1)
(< (gpt/distance h11 h12) 0.1)
(< (gpt/distance h21 h22) 0.1))
(and (< (gpt/distance p1 q2) 0.1)
(< (gpt/distance q1 p2) 0.1)
(< (gpt/distance h11 h22) 0.1)
(< (gpt/distance h21 h12) 0.1)))))))]
(some? (d/seek overlap-single? content))))
(defn create-union [content-a content-a-split content-b content-b-split]
;; Pick all segments in content-a that are not inside content-b
;; Pick all segments in content-b that are not inside content-a
(d/concat
[]
(->> content-a-split (filter #(not (contains-segment? % content-b))))
(->> content-b-split (filter #(or (not (contains-segment? % content-a))
(overlap-segment? % content-a-split))))))
(defn create-difference [content-a content-a-split content-b content-b-split]
;; Pick all segments in content-a that are not inside content-b
;; Pick all segments in content b that are inside content-a
;; removing overlapping
(d/concat
[]
(->> content-a-split (filter #(not (contains-segment? % content-b))))
;; Reverse second content so we can have holes inside other shapes
(->> content-b-split
(reverse)
(mapv reverse-command)
(filter #(and (contains-segment? % content-a)
(not (overlap-segment? % content-a-split)))))))
(defn create-intersection [content-a content-a-split content-b content-b-split]
;; Pick all segments in content-a that are inside content-b
;; Pick all segments in content-b that are inside content-a
(d/concat
[]
(->> content-a-split (filter #(contains-segment? % content-b)))
(->> content-b-split (filter #(contains-segment? % content-a)))))
(defn create-exclusion [content-a content-b]
;; Pick all segments but reverse content-b (so it makes an exclusion)
(let [content-b' (->> (reverse content-b)
(mapv reverse-command))]
(d/concat [] content-a content-b')))
(defn fix-move-to
[content]
;; Remove the field `:prev` and makes the necesaries `move-to`
;; then clean the subpaths
(loop [current (first content)
content (rest content)
prev nil
result []]
(if (nil? current)
result
(let [result (if (not= (:prev current) prev)
(conj result (upc/make-move-to (:prev current)))
result)]
(recur (first content)
(rest content)
(gsp/command->point current)
(conj result (dissoc current :prev)))))))
(defn content-bool-pair
[bool-type content-a content-b]
(let [content-a (add-previous content-a)
content-b (add-previous content-b)
;; Split content in new segments in the intersection with the other path
[content-a-split content-b-split] (content-intersect-split content-a content-b)
content-a-split (->> content-a-split add-previous (filter is-segment?))
content-b-split (->> content-b-split add-previous (filter is-segment?))
bool-content
(case bool-type
:union (create-union content-a content-a-split content-b content-b-split)
:difference (create-difference content-a content-a-split content-b content-b-split)
:intersection (create-intersection content-a content-a-split content-b content-b-split)
:exclude (create-exclusion content-a-split content-b-split))]
(->> (fix-move-to bool-content)
(ups/close-subpaths))))
(defn content-bool
[bool-type contents]
;; We apply the boolean operation in to each pair and the result to the next
;; element
(->> contents
(reduce (partial content-bool-pair bool-type))
(into [])))

3
frontend/src/app/util/path/commands.cljs → common/src/app/common/path/commands.cljc
View file

@ -4,7 +4,7 @@
;;
;; Copyright (c) UXBOX Labs SL
(ns app.util.path.commands
(ns app.common.path.commands
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]))
@ -199,3 +199,4 @@
(if (= prefix :c1)
(command->point (get content (dec index)))
(command->point (get content index))))

120
frontend/src/app/util/path/shapes_to_path.cljs → common/src/app/common/path/shapes_to_path.cljc
View file

@ -4,22 +4,52 @@
;;
;; Copyright (c) UXBOX Labs SL
(ns app.util.path.shapes-to-path
(ns app.common.path.shapes-to-path
(:require
[app.common.data :as d]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.common :as gsc]
[app.common.geom.shapes.path :as gsp]
[app.util.path.commands :as pc]))
[app.common.path.bool :as pb]
[app.common.path.commands :as pc]))
(def bezier-circle-c 0.551915024494)
(def dissoc-attrs [:x :y :width :height
(def ^:const bezier-circle-c 0.551915024494)
(def dissoc-attrs
[:x :y :width :height
:rx :ry :r1 :r2 :r3 :r4
:medata])
(def allowed-transform-types #{:rect
:metadata :shapes])
(def allowed-transform-types
#{:rect
:circle
:image})
:image
:group
:bool})
(def style-group-properties
[:shadow
:blur])
(def style-properties
(d/concat
style-group-properties
[:fill-color
:fill-opacity
:fill-color-gradient
:fill-color-ref-file
:fill-color-ref-id
:fill-image
:stroke-color
:stroke-color-ref-file
:stroke-color-ref-id
:stroke-opacity
:stroke-style
:stroke-width
:stroke-alignment
:stroke-cap-start
:stroke-cap-end]))
(defn make-corner-arc
"Creates a curvle corner for border radius"
@ -86,8 +116,9 @@
(defn rect->path
"Creates a bezier curve that approximates a rounded corner rectangle"
[x y width height r1 r2 r3 r4]
(let [p1 (gpt/point x (+ y r1))
[x y width height r1 r2 r3 r4 rx]
(let [[r1 r2 r3 r4] (->> [r1 r2 r3 r4] (mapv #(or % rx 0)))
p1 (gpt/point x (+ y r1))
p2 (gpt/point (+ x r1) y)
p3 (gpt/point (+ width x (- r2)) y)
@ -113,34 +144,71 @@
(conj (make-corner-arc p7 p8 :bottom-left r4)))
(conj (pc/make-line-to p1)))))
(declare convert-to-path)
(defn group-to-path
[group objects]
(let [xform (comp (map #(get objects %))
(map #(-> (convert-to-path % objects))))
child-as-paths (into [] xform (:shapes group))
head (first child-as-paths)
head-data (select-keys head style-properties)
content (into [] (mapcat :content) child-as-paths)]
(-> group
(assoc :type :path)
(assoc :content content)
(merge head-data)
(d/without-keys dissoc-attrs))))
(defn bool-to-path
[shape objects]
(let [children (->> (:shapes shape)
(map #(get objects %))
(map #(convert-to-path % objects)))
head (first children)
head-data (select-keys head style-properties)
content (pb/content-bool (:bool-type shape) (mapv :content children))]
(-> shape
(assoc :type :path)
(assoc :content content)
(merge head-data)
(d/without-keys dissoc-attrs))))
(defn convert-to-path
"Transforms the given shape to a path"
[{:keys [type x y width height r1 r2 r3 r4 rx metadata] :as shape}]
([shape]
(convert-to-path shape {}))
([{:keys [type x y width height r1 r2 r3 r4 rx metadata] :as shape} objects]
(assert (map? objects))
(cond
(= (:type shape) :group)
(group-to-path shape objects)
(if (contains? allowed-transform-types type)
(let [r1 (or r1 rx 0)
r2 (or r2 rx 0)
r3 (or r3 rx 0)
r4 (or r4 rx 0)
(= (:type shape) :bool)
(bool-to-path shape objects)
new-content
(contains? allowed-transform-types type)
(let [new-content
(case type
:circle
(circle->path x y width height)
(rect->path x y width height r1 r2 r3 r4))
:circle (circle->path x y width height)
#_:else (rect->path x y width height r1 r2 r3 r4 rx))
;; Apply the transforms that had the shape
transform (:transform shape)
new-content (cond-> new-content
(some? transform)
(gsp/transform-content (gmt/transform-in (gsh/center-shape shape) transform)))]
(gsp/transform-content (gmt/transform-in (gsc/center-shape shape) transform)))]
(-> shape
(d/without-keys dissoc-attrs)
(assoc :type :path)
(assoc :content new-content)
(cond-> (= :image type) (-> (assoc :fill-image metadata)
(dissoc :metadata)))))
(cond-> (= :image type)
(assoc :fill-image metadata))
(d/without-keys dissoc-attrs)))
:else
;; Do nothing if the shape is not of a correct type
shape))
shape)))

38
frontend/src/app/util/path/subpaths.cljs → common/src/app/common/path/subpaths.cljc
View file

@ -4,10 +4,16 @@
;;
;; Copyright (c) UXBOX Labs SL
(ns app.util.path.subpaths
(ns app.common.path.subpaths
(:require
[app.common.data :as d]
[app.util.path.commands :as upc]))
[app.common.geom.point :as gpt]
[app.common.path.commands :as upc]))
(defn pt=
"Check if two points are close"
[p1 p2]
(< (gpt/distance p1 p2) 0.1))
(defn make-subpath
"Creates a subpath either from a single command or with all the data"
@ -76,7 +82,7 @@
(defn subpaths-join
"Join two subpaths together when the first finish where the second starts"
[subpath other]
(assert (= (:to subpath) (:from other)))
(assert (pt= (:to subpath) (:from other)))
(-> subpath
(update :data d/concat (rest (:data other)))
(assoc :to (:to other))))
@ -88,15 +94,22 @@
(let [merge-with-candidate
(fn [[candidate result] current]
(cond
(= (:to current) (:from current))
(pt= (:to current) (:from current))
;; Subpath is already a closed path
[candidate (conj result current)]
(= (:to candidate) (:from current))
(pt= (:to candidate) (:from current))
[(subpaths-join candidate current) result]
(= (:to candidate) (:to current))
(pt= (:from candidate) (:to current))
[(subpaths-join current candidate) result]
(pt= (:to candidate) (:to current))
[(subpaths-join candidate (reverse-subpath current)) result]
(pt= (:from candidate) (:from current))
[(subpaths-join (reverse-subpath current) candidate) result]
:else
[candidate (conj result current)]))]
@ -114,7 +127,7 @@
(if (some? current)
(let [[new-current new-subpaths]
(if (= (:from current) (:to current))
(if (pt= (:from current) (:to current))
[current subpaths]
(merge-paths current subpaths))]
@ -134,3 +147,14 @@
(->> closed-subpaths
(mapcat :data)
(into []))))
(defn reverse-content
"Given a content reverse the order of the commands"
[content]
(->> content
(get-subpaths)
(mapv reverse-subpath)
(reverse)
(mapcat :data)
(into [])))

3
frontend/resources/images/icons/boolean-difference.svg Normal file
View file

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 500 500">
<path d="M0 0v337.797h162.201V500H500V162.203H337.797V0Zm34.031 34.033h269.735v269.733H34.03Z"/>
</svg>
Side by side

After

Width:  |  Height:  |  Size: 169 B

3
frontend/resources/images/icons/boolean-exclude.svg Normal file
View file

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 500 500">
<path d="M0 0v337.797h162.203V500H500V162.203H337.799V0Zm196.234 196.234h107.532v107.532H196.234Z"/>
</svg>
Side by side

After

Width:  |  Height:  |  Size: 173 B

3
frontend/resources/images/icons/boolean-flatten.svg Normal file
View file

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 500 500">
<path d="M0 0v337.059h141.904C150.271 428.269 227.21 500 320.557 500 419.47 500 500 419.47 500 320.557c0-93.18-71.47-170.015-162.445-178.614V0H0zm32 32h273.555v109.791c-43.314 3.609-82.301 22.678-111.43 51.65L32 32.8V32zm273.555 141.867V303.85l-88.866-88.051c23.298-23.102 54.286-38.46 88.866-41.932zm32 .246C411.119 182.51 468 244.691 468 320.557c0 40.092-15.942 76.315-41.777 102.855l-88.668-87.855V174.113z"/>
</svg>
Side by side

After

Width:  |  Height:  |  Size: 485 B

3
frontend/resources/images/icons/boolean-intersection.svg Normal file
View file

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 500 500">
<path d="M0 0v337.797h162.201V500H500V162.203H337.797V0Zm34.031 34.033h269.735v128.17H162.2v141.563H34.031Zm303.766 162.201h128.17v269.733H196.234v-128.17h141.563z"/>
</svg>
Side by side

After

Width:  |  Height:  |  Size: 239 B

3
frontend/resources/images/icons/boolean-union.svg Normal file
View file

@ -0,0 +1,3 @@
<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 500 500">
<path d="M0 0v337.797h162.203V500H500V162.203H337.797V0H0z"/>
</svg>
Side by side

After

Width:  |  Height:  |  Size: 134 B

19
frontend/resources/styles/main/partials/sidebar-align-options.scss
View file

@ -9,12 +9,12 @@
display: flex;
border-bottom: solid 1px $color-gray-60;
height: 40px;
padding: 0 $x-small;
.align-group {
padding: 0 $x-small;
display: flex;
justify-content: space-evenly;
width: 100%;
justify-content: flex-start;
width: 50%;
&:not(:last-child) {
border-right: solid 1px $color-gray-60;
@ -25,7 +25,12 @@
align-items: center;
cursor: pointer;
display: flex;
height: 30px;
justify-content: center;
margin: 5px 0;
padding: $small $x-small;
width: 25%;
svg {
height: 16px;
width: 16px;
@ -46,5 +51,13 @@
fill: $color-gray-40;
}
}
&.selected svg {
fill: $color-primary;
}
&.selected:hover svg {
fill: $color-white;
}
}
}

11
frontend/resources/styles/main/partials/workspace.scss
View file

@ -47,6 +47,17 @@
&:hover {
background-color: $color-primary-lighter;
}
.submenu-icon {
position: absolute;
right: 1rem;
svg {
width: 10px;
height: 10px;
}
}
}
}

13
frontend/src/app/main/data/workspace.cljs
View file

@ -23,6 +23,7 @@
[app.config :as cfg]
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.workspace.booleans :as dwb]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.drawing :as dwd]
@ -30,6 +31,7 @@
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.notifications :as dwn]
[app.main.data.workspace.path :as dwdp]
[app.main.data.workspace.path.shapes-to-path :as dwps]
[app.main.data.workspace.persistence :as dwp]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.state-helpers :as wsh]
@ -1097,7 +1099,7 @@
:text
(rx/of (dwc/start-edition-mode id))
:group
(:group :bool)
(rx/of (dwc/select-shapes (into (d/ordered-set) [(last shapes)])))
:svg-raw
@ -1987,3 +1989,12 @@
(d/export dwg/unmask-group)
(d/export dwg/group-selected)
(d/export dwg/ungroup-selected)
;; Boolean
(d/export dwb/create-bool)
(d/export dwb/group-to-bool)
(d/export dwb/bool-to-group)
(d/export dwb/change-bool-type)
;; Shapes to path
(d/export dwps/convert-selected-to-path)

124
frontend/src/app/main/data/workspace/booleans.cljs Normal file
View file

@ -0,0 +1,124 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.data.workspace.booleans
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as cb]
[app.common.path.shapes-to-path :as stp]
[app.common.uuid :as uuid]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
[cuerdas.core :as str]
[potok.core :as ptk]))
(defn selected-shapes
[state]
(let [objects (wsh/lookup-page-objects state)]
(->> (wsh/lookup-selected state)
(cp/clean-loops objects)
(map #(get objects %))
(filter #(not= :frame (:type %)))
(map #(assoc % ::index (cp/position-on-parent (:id %) objects)))
(sort-by ::index))))
(defn create-bool-data
[bool-type name shapes objects]
(let [shapes (mapv #(stp/convert-to-path % objects) shapes)
head (if (= bool-type :difference) (first shapes) (last shapes))
head-data (select-keys head stp/style-properties)]
[(-> {:id (uuid/next)
:type :bool
:bool-type bool-type
:frame-id (:frame-id head)
:parent-id (:parent-id head)
:name name
:shapes []}
(merge head-data)
(gsh/update-bool-selrect shapes objects))
(cp/position-on-parent (:id head) objects)]))
(defn group->bool
[group bool-type objects]
(let [shapes (->> (:shapes group)
(map #(get objects %))
(mapv #(stp/convert-to-path % objects)))
head (first shapes)
head-data (select-keys head stp/style-properties)]
(-> group
(assoc :type :bool)
(assoc :bool-type bool-type)
(merge head-data)
(gsh/update-bool-selrect shapes objects))))
(defn bool->group
[shape objects]
(let [children (->> (:shapes shape)
(mapv #(get objects %)))]
(-> shape
(assoc :type :group)
(dissoc :bool-type)
(d/without-keys stp/style-group-properties)
(gsh/update-group-selrect children))))
(defn create-bool
[bool-type]
(ptk/reify ::create-bool-union
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state)
base-name (-> bool-type d/name str/capital (str "-1"))
name (-> (dwc/retrieve-used-names objects)
(dwc/generate-unique-name base-name))
shapes (selected-shapes state)]
(when-not (empty? shapes)
(let [[boolean-data index] (create-bool-data bool-type name shapes objects)
shape-id (:id boolean-data)
changes (-> (cb/empty-changes it page-id)
(cb/with-objects objects)
(cb/add-obj boolean-data index)
(cb/change-parent shape-id shapes))]
(rx/of (dch/commit-changes changes)
(dwc/select-shapes (d/ordered-set shape-id)))))))))
(defn group-to-bool
[shape-id bool-type]
(ptk/reify ::group-to-bool
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
change-to-bool
(fn [shape] (group->bool shape bool-type objects))]
(rx/of (dch/update-shapes [shape-id] change-to-bool {:reg-objects? true}))))))
(defn bool-to-group
[shape-id]
(ptk/reify ::bool-to-group
ptk/WatchEvent
(watch [_ state _]
(let [objects (wsh/lookup-page-objects state)
change-to-group
(fn [shape] (bool->group shape objects))]
(rx/of (dch/update-shapes [shape-id] change-to-group {:reg-objects? true}))))))
(defn change-bool-type
[shape-id bool-type]
(ptk/reify ::change-bool-type
ptk/WatchEvent
(watch [_ _ _]
(let [change-type
(fn [shape] (assoc shape :bool-type bool-type))]
(rx/of (dch/update-shapes [shape-id] change-type {:reg-objects? true}))))))

2
frontend/src/app/main/data/workspace/groups.cljs
View file

@ -198,7 +198,7 @@
group-id (first selected)
group (get objects group-id)]
(when (and (= 1 (count selected))
(= (:type group) :group))
(contains? #{:group :bool} (:type group)))
(let [[rchanges uchanges]
(prepare-remove-group page-id group objects)]
(rx/of (dch/commit-changes {:redo-changes rchanges

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

@ -7,7 +7,10 @@
(ns app.main.data.workspace.path.drawing
(:require
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.pages :as cp]
[app.common.path.commands :as upc]
[app.common.path.shapes-to-path :as upsp]
[app.common.spec :as us]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
@ -21,9 +24,6 @@
[app.main.data.workspace.path.undo :as undo]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.streams :as ms]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[app.util.path.shapes-to-path :as upsp]
[beicon.core :as rx]
[potok.core :as ptk]))

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

@ -8,6 +8,10 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.path.commands :as upc]
[app.common.path.shapes-to-path :as upsp]
[app.common.path.subpaths :as ups]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.changes :as changes]
@ -19,10 +23,6 @@
[app.main.data.workspace.path.undo :as undo]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.streams :as ms]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[app.util.path.shapes-to-path :as upsp]
[app.util.path.subpaths :as ups]
[app.util.path.tools :as upt]
[beicon.core :as rx]
[potok.core :as ptk]))

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

@ -10,10 +10,10 @@
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.path.commands :as upc]
[app.common.path.subpaths :as ups]
[app.main.data.workspace.path.common :as common]
[app.main.streams :as ms]
[app.util.path.commands :as upc]
[app.util.path.subpaths :as ups]
[potok.core :as ptk]))
(defn end-path-event? [event]

36
frontend/src/app/main/data/workspace/path/shapes_to_path.cljs Normal file
View file

@ -0,0 +1,36 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.data.workspace.path.shapes-to-path
(:require
[app.common.pages :as cp]
[app.common.pages.changes-builder :as cb]
[app.common.path.shapes-to-path :as upsp]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
[potok.core :as ptk]))
(defn convert-selected-to-path []
(ptk/reify ::convert-selected-to-path
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
objects (wsh/lookup-page-objects state)
selected (wsh/lookup-selected state)
children-ids
(into #{}
(mapcat #(cp/get-children % objects))
selected)
changes
(-> (cb/empty-changes it page-id)
(cb/with-objects objects)
(cb/remove-objects children-ids)
(cb/update-shapes selected #(upsp/convert-to-path % objects)))]
(rx/of (dch/commit-changes changes))))))

5
frontend/src/app/main/data/workspace/path/state.cljs
View file

@ -7,7 +7,7 @@
(ns app.main.data.workspace.path.state
(:require
[app.common.data :as d]
[app.util.path.shapes-to-path :as upsp]))
[app.common.path.shapes-to-path :as upsp]))
(defn get-path-id
"Retrieves the currently editing path id"
@ -31,7 +31,8 @@
[state & ks]
(let [path-loc (get-path-location state)
shape (-> (get-in state path-loc)
(upsp/convert-to-path))]
;; Empty map because we know the current shape will not have children
(upsp/convert-to-path {}))]
(if (empty? ks)
shape

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

@ -7,12 +7,12 @@
(ns app.main.data.workspace.path.streams
(:require
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.math :as mth]
[app.main.data.workspace.path.state :as state]
[app.main.snap :as snap]
[app.main.store :as st]
[app.main.streams :as ms]
[app.util.path.geom :as upg]
[beicon.core :as rx]
[okulary.core :as l]
[potok.core :as ptk]))

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

@ -6,13 +6,13 @@
(ns app.main.data.workspace.path.tools
(:require
[app.common.path.shapes-to-path :as upsp]
[app.common.path.subpaths :as ups]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.common :as dwc]
[app.main.data.workspace.path.changes :as changes]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.state-helpers :as wsh]
[app.util.path.shapes-to-path :as upsp]
[app.util.path.subpaths :as ups]
[app.util.path.tools :as upt]
[beicon.core :as rx]
[potok.core :as ptk]))

17
frontend/src/app/main/data/workspace/shortcuts.cljs
View file

@ -260,6 +260,23 @@
:command ["alt" "."]
:type "keyup"
:fn #(st/emit! (dw/toggle-distances-display false))}
:boolean-union {:tooltip (ds/alt "U")
:command "alt+u"
:fn #(st/emit! (dw/create-bool :union))}
:boolean-difference {:tooltip (ds/alt "D")
:command "alt+d"
:fn #(st/emit! (dw/create-bool :difference))}
:boolean-intersection {:tooltip (ds/alt "I")
:command "alt+i"
:fn #(st/emit! (dw/create-bool :intersection))}
:boolean-exclude {:tooltip (ds/alt "E")
:command "alt+e"
:fn #(st/emit! (dw/create-bool :exclude))}
})
(defn get-tooltip [shortcut]

15
frontend/src/app/main/exports.cljs
View file

@ -14,6 +14,7 @@
[app.common.math :as mth]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.main.ui.shapes.bool :as bool]
[app.main.ui.shapes.circle :as circle]
[app.main.ui.shapes.embed :as embed]
[app.main.ui.shapes.export :as use]
@ -81,6 +82,18 @@
:is-child-selected? true
:childs childs}]))))
(defn bool-wrapper-factory
[objects]
(let [shape-wrapper (shape-wrapper-factory objects)
bool-shape (bool/bool-shape shape-wrapper)]
(mf/fnc bool-wrapper
[{:keys [shape frame] :as props}]
(let [childs (->> (cp/get-children (:id shape) objects)
(select-keys objects))]
[:& bool-shape {:frame frame
:shape shape
:childs childs}]))))
(defn svg-raw-wrapper-factory
[objects]
(let [shape-wrapper (shape-wrapper-factory objects)
@ -106,6 +119,7 @@
[{:keys [frame shape] :as props}]
(let [group-wrapper (mf/use-memo (mf/deps objects) #(group-wrapper-factory objects))
svg-raw-wrapper (mf/use-memo (mf/deps objects) #(svg-raw-wrapper-factory objects))
bool-wrapper (mf/use-memo (mf/deps objects) #(bool-wrapper-factory objects))
frame-wrapper (mf/use-memo (mf/deps objects) #(frame-wrapper-factory objects))]
(when (and shape (not (:hidden shape)))
(let [shape (-> (gsh/transform-shape shape)
@ -122,6 +136,7 @@
:circle [:> circle/circle-shape opts]
:frame [:> frame-wrapper {:shape shape}]
:group [:> group-wrapper {:shape shape :frame frame}]
:bool [:> bool-wrapper {:shape shape :frame frame}]
nil)]
;; Don't wrap svg elements inside a <g> otherwise some can break

30
frontend/src/app/main/refs.cljs
View file

@ -122,6 +122,10 @@
:show-distances?])
workspace-local =))
(def local-displacement
(l/derived #(select-keys % [:modifiers :selected])
workspace-local =))
(def selected-zoom
(l/derived :zoom workspace-local))
@ -239,7 +243,8 @@
([ids {:keys [with-modifiers?]
:or { with-modifiers? false }}]
(l/derived (fn [state]
(let [selector
(fn [state]
(let [objects (wsh/lookup-page-objects state)
modifiers (:workspace-modifiers state)
objects (cond-> objects
@ -247,8 +252,27 @@
(gsh/merge-modifiers modifiers))
xform (comp (map #(get objects %))
(remove nil?))]
(into [] xform ids)))
st/state =)))
(into [] xform ids)))]
(l/derived selector st/state =))))
(defn select-children [id]
(let [selector
(fn [state]
(let [objects (wsh/lookup-page-objects state)
children (cp/select-children id objects)
modifiers (-> (:workspace-modifiers state))
{selected :selected disp-modifiers :modifiers}
(-> (:workspace-local state)
(select-keys [:modifiers :selected]))
modifiers
(d/deep-merge
modifiers
(into {} (map #(vector % {:modifiers disp-modifiers})) selected))]
(gsh/merge-modifiers children modifiers)))]
(l/derived selector st/state =)))
(def selected-data
(l/derived #(let [selected (wsh/lookup-selected %)

8
frontend/src/app/main/ui/icons.cljs
View file

@ -9,6 +9,8 @@
(:require-macros [app.main.ui.icons :refer [icon-xref]])
(:require [rumext.alpha :as mf]))
;; Keep the list of icons sorted
(def action (icon-xref :action))
(def actions (icon-xref :actions))
(def align-bottom (icon-xref :align-bottom))
@ -23,6 +25,11 @@
(def auto-fix (icon-xref :auto-fix))
(def auto-height (icon-xref :auto-height))
(def auto-width (icon-xref :auto-width))
(def boolean-difference (icon-xref :boolean-difference))
(def boolean-exclude (icon-xref :boolean-exclude))
(def boolean-flatten (icon-xref :boolean-flatten))
(def boolean-intersection (icon-xref :boolean-intersection))
(def boolean-union (icon-xref :boolean-union))
(def box (icon-xref :box))
(def chain (icon-xref :chain))
(def chat (icon-xref :chat))
@ -152,6 +159,7 @@
(def uppercase (icon-xref :uppercase))
(def user (icon-xref :user))
(def loader-pencil
(mf/html
[:svg

113
frontend/src/app/main/ui/shapes/bool.cljs Normal file
View file

@ -0,0 +1,113 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.ui.shapes.bool
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.common.geom.shapes.path :as gsp]
[app.common.path.bool :as pb]
[app.common.path.shapes-to-path :as stp]
[app.main.ui.hooks :refer [use-equal-memo]]
[app.main.ui.shapes.export :as use]
[app.main.ui.shapes.path :refer [path-shape]]
[app.util.object :as obj]
[rumext.alpha :as mf]))
(mf/defc debug-bool
{::mf/wrap-props false}
[props]
(let [frame (obj/get props "frame")
shape (obj/get props "shape")
childs (obj/get props "childs")
[content-a content-b]
(mf/use-memo
(mf/deps shape childs)
(fn []
(let [childs (d/mapm #(-> %2 (gsh/translate-to-frame frame) gsh/transform-shape) childs)
[content-a content-b]
(->> (:shapes shape)
(map #(get childs %))
(filter #(not (:hidden %)))
(map #(stp/convert-to-path % childs))
(mapv :content)
(mapv pb/add-previous))]
(pb/content-intersect-split content-a content-b))))]
[:g.debug-bool
[:g.shape-a
[:& path-shape {:shape (-> shape
(assoc :type :path)
(assoc :stroke-color "blue")
(assoc :stroke-opacity 1)
(assoc :stroke-width 1)
(assoc :stroke-style :solid)
(dissoc :fill-color :fill-opacity)
(assoc :content content-b))
:frame frame}]
(for [{:keys [x y]} (gsp/content->points content-b)]
[:circle {:cx x
:cy y
:r 2.5
:style {:fill "blue"}}])]
[:g.shape-b
[:& path-shape {:shape (-> shape
(assoc :type :path)
(assoc :stroke-color "red")
(assoc :stroke-opacity 1)
(assoc :stroke-width 0.5)
(assoc :stroke-style :solid)
(dissoc :fill-color :fill-opacity)
(assoc :content content-a))
:frame frame}]
(for [{:keys [x y]} (gsp/content->points content-a)]
[:circle {:cx x
:cy y
:r 1.25
:style {:fill "red"}}])]])
)
(defn bool-shape
[shape-wrapper]
(mf/fnc bool-shape
{::mf/wrap-props false}
[props]
(let [frame (obj/get props "frame")
shape (obj/get props "shape")
childs (obj/get props "childs")
childs (use-equal-memo childs)
include-metadata? (mf/use-ctx use/include-metadata-ctx)
bool-content
(mf/use-memo
(mf/deps shape childs)
(fn []
(let [childs (d/mapm #(-> %2 (gsh/translate-to-frame frame) gsh/transform-shape) childs)]
(->> (:shapes shape)
(map #(get childs %))
(filter #(not (:hidden %)))
(map #(stp/convert-to-path % childs))
(mapv :content)
(pb/content-bool (:bool-type shape))))))]
[:*
[:& path-shape {:shape (assoc shape :content bool-content)}]
(when include-metadata?
[:> "penpot:bool" {}
(for [item (->> (:shapes shape) (mapv #(get childs %)))]
[:& shape-wrapper {:frame frame
:shape item
:key (:id item)}])])
#_[:& debug-bool {:frame frame
:shape shape
:childs childs}]])))

6
frontend/src/app/main/ui/shapes/export.cljs
View file

@ -64,6 +64,7 @@
text? (= :text (:type shape))
path? (= :path (:type shape))
mask? (and group? (:masked-group? shape))
bool? (= :bool (:type shape))
center (gsh/center-shape shape)]
(-> props
(add! :name)
@ -102,7 +103,10 @@
(add! :content (comp json/encode uuid->string))))
(cond-> mask?
(obj/set! "penpot:masked-group" "true")))))
(obj/set! "penpot:masked-group" "true"))
(cond-> bool?
(add! :bool-type)))))
(defn add-library-refs [props shape]

1
frontend/src/app/main/ui/shapes/shape.cljs
View file

@ -72,6 +72,7 @@
[:> wrapper-tag wrapper-props
(when include-metadata?
[:& ed/export-data {:shape shape}])
[:defs
[:& defs/svg-defs {:shape shape :render-id render-id}]
[:& filters/filters {:shape shape :filter-id filter-id}]

33
frontend/src/app/main/ui/viewer/handoff/render.cljs
View file

@ -8,8 +8,10 @@
"The main container for a frame in handoff mode"
(:require
[app.common.geom.shapes :as geom]
[app.common.pages :as cp]
[app.main.data.viewer :as dv]
[app.main.store :as st]
[app.main.ui.shapes.bool :as bool]
[app.main.ui.shapes.circle :as circle]
[app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.group :as group]
@ -106,6 +108,22 @@
(obj/merge! #js {:childs childs}))]
[:> group-wrapper props]))))
(defn bool-container-factory
[objects]
(let [shape-container (shape-container-factory objects)
bool-shape (bool/bool-shape shape-container)
bool-wrapper (shape-wrapper-factory bool-shape)]
(mf/fnc bool-container
{::mf/wrap-props false}
[props]
(let [shape (unchecked-get props "shape")
children-ids (cp/get-children (:id shape) objects)
childs (select-keys objects children-ids)
props (-> (obj/new)
(obj/merge! props)
(obj/merge! #js {:childs childs}))]
[:> bool-wrapper props]))))
(defn svg-raw-container-factory
[objects]
(let [shape-container (shape-container-factory objects)
@ -133,11 +151,17 @@
[props]
(let [shape (unchecked-get props "shape")
frame (unchecked-get props "frame")
group-container (mf/use-memo
(mf/deps objects)
group-container
(mf/use-memo (mf/deps objects)
#(group-container-factory objects))
svg-raw-container (mf/use-memo
(mf/deps objects)
bool-container
(mf/use-memo (mf/deps objects)
#(bool-container-factory objects))
svg-raw-container
(mf/use-memo (mf/deps objects)
#(svg-raw-container-factory objects))]
(when (and shape (not (:hidden shape)))
(let [shape (-> (geom/transform-shape shape)
@ -151,6 +175,7 @@
:image [:> image-wrapper opts]
:circle [:> circle-wrapper opts]
:group [:> group-container opts]
:bool [:> bool-container opts]
:svg-raw [:> svg-raw-container opts])))))))
(mf/defc render-frame-svg

34
frontend/src/app/main/ui/viewer/shapes.cljs
View file

@ -15,6 +15,7 @@
[app.common.types.interactions :as cti]
[app.main.data.viewer :as dv]
[app.main.store :as st]
[app.main.ui.shapes.bool :as bool]
[app.main.ui.shapes.circle :as circle]
[app.main.ui.shapes.frame :as frame]
[app.main.ui.shapes.group :as group]
@ -229,6 +230,10 @@
[shape-container show-interactions?]
(generic-wrapper-factory (group/group-shape shape-container) show-interactions?))
(defn bool-wrapper
[shape-container show-interactions?]
(generic-wrapper-factory (bool/bool-shape shape-container) show-interactions?))
(defn svg-raw-wrapper
[shape-container show-interactions?]
(generic-wrapper-factory (svg-raw/svg-raw-shape shape-container) show-interactions?))
@ -287,6 +292,21 @@
:show-interactions? show-interactions?})]
[:> group-wrapper props]))))
(defn bool-container-factory
[objects show-interactions?]
(let [shape-container (shape-container-factory objects show-interactions?)
bool-wrapper (bool-wrapper shape-container show-interactions?)]
(mf/fnc bool-container
{::mf/wrap-props false}
[props]
(let [shape (unchecked-get props "shape")
childs (select-keys objects (cp/get-children (:id shape) objects))
props (obj/merge! #js {} props
#js {:childs childs
:objects objects
:show-interactions? show-interactions?})]
[:> bool-wrapper props]))))
(defn svg-raw-container-factory
[objects show-interactions?]
(let [shape-container (shape-container-factory objects show-interactions?)
@ -312,11 +332,16 @@
(mf/fnc shape-container
{::mf/wrap-props false}
[props]
(let [group-container (mf/use-memo
(mf/deps objects)
(let [group-container
(mf/use-memo (mf/deps objects)
#(group-container-factory objects show-interactions?))
svg-raw-container (mf/use-memo
(mf/deps objects)
bool-container
(mf/use-memo (mf/deps objects)
#(bool-container-factory objects show-interactions?))
svg-raw-container
(mf/use-memo (mf/deps objects)
#(svg-raw-container-factory objects show-interactions?))
shape (unchecked-get props "shape")
frame (unchecked-get props "frame")]
@ -333,6 +358,7 @@
:image [:> image-wrapper opts]
:circle [:> circle-wrapper opts]
:group [:> group-container {:shape shape :frame frame :objects objects}]
:bool [:> bool-container {:shape shape :frame frame :objects objects}]
:svg-raw [:> svg-raw-container {:shape shape :frame frame :objects objects}])))))))
(mf/defc frame-svg

8
frontend/src/app/main/ui/workspace/colorpicker.cljs
View file

@ -202,10 +202,10 @@
h
(str (* s 100) "%")
(str (* l 100) "%")))]
(dom/set-css-property node "--color" (str/join ", " rgb))
(dom/set-css-property node "--hue-rgb" (str/join ", " hue-rgb))
(dom/set-css-property node "--saturation-grad-from" (format-hsl hsl-from))
(dom/set-css-property node "--saturation-grad-to" (format-hsl hsl-to)))))
(dom/set-css-property! node "--color" (str/join ", " rgb))
(dom/set-css-property! node "--hue-rgb" (str/join ", " hue-rgb))
(dom/set-css-property! node "--saturation-grad-from" (format-hsl hsl-from))
(dom/set-css-property! node "--saturation-grad-to" (format-hsl hsl-to)))))
;; When closing the modal we update the recent-color list
(mf/use-effect

97
frontend/src/app/main/ui/workspace/context_menu.cljs
View file

@ -16,6 +16,7 @@
[app.main.store :as st]
[app.main.ui.components.dropdown :refer [dropdown]]
[app.main.ui.context :as ctx]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :refer [tr] :as i18n]
[app.util.timers :as timers]
@ -31,10 +32,52 @@
(dom/stop-propagation event))
(mf/defc menu-entry
[{:keys [title shortcut on-click] :as props}]
[:li {:on-click on-click}
[{:keys [title shortcut on-click children] :as props}]
(let [submenu-ref (mf/use-ref nil)
hovering? (mf/use-ref false)
on-pointer-enter
(mf/use-callback
(fn []
(mf/set-ref-val! hovering? true)
(let [submenu-node (mf/ref-val submenu-ref)]
(when (some? submenu-node)
(dom/set-css-property! submenu-node "display" "block")))))
on-pointer-leave
(mf/use-callback
(fn []
(mf/set-ref-val! hovering? false)
(let [submenu-node (mf/ref-val submenu-ref)]
(when (some? submenu-node)
(timers/schedule
200
#(when-not (mf/ref-val hovering?)
(dom/set-css-property! submenu-node "display" "none")))))))
set-dom-node
(mf/use-callback
(fn [dom]
(let [submenu-node (mf/ref-val submenu-ref)]
(when (and (some? dom) (some? submenu-node))
(dom/set-css-property! submenu-node "top" (str (.-offsetTop dom) "px"))))))]
[:li {:ref set-dom-node
:on-click on-click
:on-pointer-enter on-pointer-enter
:on-pointer-leave on-pointer-leave}
[:span.title title]
[:span.shortcut (or shortcut "")]])
[:span.shortcut (or shortcut "")]
(when (> (count children) 1)
[:span.submenu-icon i/arrow-slide])
(when (> (count children) 1)
[:ul.workspace-context-menu
{:ref submenu-ref
:style {:display "none" :left 250}
:on-context-menu prevent-default}
children])]))
(mf/defc menu-separator
[]
@ -49,6 +92,21 @@
multiple? (> (count selected) 1)
editable-shape? (#{:group :text :path} (:type shape))
is-group? (and (some? shape) (= :group (:type shape)))
is-bool? (and (some? shape) (= :bool (:type shape)))
set-bool
(fn [bool-type]
#(cond
(> (count selected) 1)
(st/emit! (dw/create-bool bool-type))
(and (= (count selected) 1) is-group?)
(st/emit! (dw/group-to-bool (:id shape) bool-type))
(and (= (count selected) 1) is-bool?)
(st/emit! (dw/change-bool-type (:id shape) bool-type))))
current-file-id (mf/use-ctx ctx/current-file-id)
do-duplicate (st/emitf dw/duplicate-selected)
@ -98,7 +156,10 @@
:on-accept confirm-update-remote-component}))
do-show-component (st/emitf (dw/go-to-layout :assets))
do-navigate-component-file (st/emitf (dwl/nav-to-component-file
(:component-file shape)))]
(:component-file shape)))
do-transform-to-path (st/emitf (dw/convert-selected-to-path))
do-flatten (st/emitf (dw/convert-selected-to-path))]
[:*
[:& menu-entry {:title (tr "workspace.shape.menu.copy")
:shortcut (sc/get-tooltip :copy)
@ -147,7 +208,7 @@
:on-click do-flip-horizontal}]
[:& menu-separator]])
(when (and single? (= (:type shape) :group))
(when (and single? (or is-bool? is-group?))
[:*
[:& menu-entry {:title (tr "workspace.shape.menu.ungroup")
:shortcut (sc/get-tooltip :ungroup)
@ -165,6 +226,30 @@
:shortcut (sc/get-tooltip :start-editing)
:on-click do-start-editing}])
[:& menu-entry {:title (tr "workspace.shape.menu.transform-to-path")
:on-click do-transform-to-path}]
(when (or multiple? (and single? (or is-group? is-bool?)))
[:& menu-entry {:title (tr "workspace.shape.menu.path")}
[:& menu-entry {:title (tr "workspace.shape.menu.union")
:shortcut (sc/get-tooltip :boolean-union)
:on-click (set-bool :union)}]
[:& menu-entry {:title (tr "workspace.shape.menu.difference")
:shortcut (sc/get-tooltip :boolean-difference)
:on-click (set-bool :difference)}]
[:& menu-entry {:title (tr "workspace.shape.menu.intersection")
:shortcut (sc/get-tooltip :boolean-intersection)
:on-click (set-bool :intersection)}]
[:& menu-entry {:title (tr "workspace.shape.menu.exclude")
:shortcut (sc/get-tooltip :boolean-exclude)
:on-click (set-bool :exclude)}]
(when (and single? is-bool?)
[:*
[:& menu-separator]
[:& menu-entry {:title (tr "workspace.shape.menu.flatten")
:on-click do-flatten}]])])
(if (:hidden shape)
[:& menu-entry {:title (tr "workspace.shape.menu.show")
:on-click do-show-shape}]
@ -240,7 +325,7 @@
(when dropdown
(let [bounding-rect (dom/get-bounding-rect dropdown)
window-size (dom/get-window-size)
delta-x (max (- (:right bounding-rect) (:width window-size)) 0)
delta-x (max (- (+ (:right bounding-rect) 250) (:width window-size)) 0)
delta-y (max (- (:bottom bounding-rect) (:height window-size)) 0)
new-style (str "top: " (- top delta-y) "px; "
"left: " (- left delta-x) "px;")]

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

@ -20,6 +20,7 @@
[app.main.ui.shapes.image :as image]
[app.main.ui.shapes.rect :as rect]
[app.main.ui.shapes.text.fontfaces :as ff]
[app.main.ui.workspace.shapes.bool :as bool]
[app.main.ui.workspace.shapes.bounding-box :refer [bounding-box]]
[app.main.ui.workspace.shapes.common :as common]
[app.main.ui.workspace.shapes.frame :as frame]
@ -35,6 +36,7 @@
(declare shape-wrapper)
(declare group-wrapper)
(declare svg-raw-wrapper)
(declare bool-wrapper)
(declare frame-wrapper)
(def circle-wrapper (common/generic-wrapper-factory circle/circle-shape))
@ -99,6 +101,7 @@
:image [:> image-wrapper opts]
:circle [:> circle-wrapper opts]
:svg-raw [:> svg-raw-wrapper opts]
:bool [:> bool-wrapper opts]
;; Only used when drawing a new frame.
:frame [:> frame-wrapper {:shape shape}]
@ -113,5 +116,6 @@
(def group-wrapper (group/group-wrapper-factory shape-wrapper))
(def svg-raw-wrapper (svg-raw/svg-raw-wrapper-factory shape-wrapper))
(def bool-wrapper (bool/bool-wrapper-factory shape-wrapper))
(def frame-wrapper (frame/frame-wrapper-factory shape-wrapper))

47
frontend/src/app/main/ui/workspace/shapes/bool.cljs Normal file
View file

@ -0,0 +1,47 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.ui.workspace.shapes.bool
(:require
[app.main.data.workspace :as dw]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.streams :as ms]
[app.main.ui.shapes.bool :as bool]
[app.main.ui.shapes.shape :refer [shape-container]]
[app.util.dom :as dom]
[rumext.alpha :as mf]))
(defn use-double-click [{:keys [id]}]
(mf/use-callback
(mf/deps id)
(fn [event]
(dom/stop-propagation event)
(dom/prevent-default event)
(st/emit! (dw/select-inside-group id @ms/mouse-position)))))
(defn bool-wrapper-factory
[shape-wrapper]
(let [shape-component (bool/bool-shape shape-wrapper)]
(mf/fnc bool-wrapper
{::mf/wrap [#(mf/memo' % (mf/check-props ["shape" "frame"]))]
::mf/wrap-props false}
[props]
(let [shape (unchecked-get props "shape")
frame (unchecked-get props "frame")
childs-ref (mf/use-memo
(mf/deps (:id shape))
#(refs/select-children (:id shape)))
childs (mf/deref childs-ref)]
[:> shape-container {:shape shape}
[:& shape-component
{:frame frame
:shape shape
:childs childs}]]))))

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

@ -6,11 +6,11 @@
(ns app.main.ui.workspace.shapes.path
(:require
[app.common.path.commands :as upc]
[app.main.refs :as refs]
[app.main.ui.shapes.path :as path]
[app.main.ui.shapes.shape :refer [shape-container]]
[app.main.ui.workspace.shapes.path.common :as pc]
[app.util.path.commands :as upc]
[rumext.alpha :as mf]))
(mf/defc path-wrapper

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

@ -8,7 +8,9 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.common.geom.shapes.path :as gsp]
[app.common.path.commands :as upc]
[app.common.path.shapes-to-path :as ups]
[app.main.data.workspace.path :as drp]
[app.main.snap :as snap]
[app.main.store :as st]
@ -18,10 +20,7 @@
[app.main.ui.workspace.shapes.path.common :as pc]
[app.util.dom :as dom]
[app.util.keyboard :as kbd]
[app.util.path.commands :as upc]
[app.util.path.format :as upf]
[app.util.path.geom :as upg]
[app.util.path.shapes-to-path :as ups]
[clojure.set :refer [map-invert]]
[goog.events :as events]
[rumext.alpha :as mf])
@ -217,16 +216,16 @@
shape (cond-> shape
(not= :path (:type shape))
ups/convert-to-path
(ups/convert-to-path {})
:always
hooks/use-equal-memo)
base-content (:content shape)
base-points (mf/use-memo (mf/deps base-content) #(->> base-content upg/content->points))
base-points (mf/use-memo (mf/deps base-content) #(->> base-content gsp/content->points))
content (upc/apply-content-modifiers base-content content-modifiers)
content-points (mf/use-memo (mf/deps content) #(->> content upg/content->points))
content-points (mf/use-memo (mf/deps content) #(->> content gsp/content->points))
point->base (->> (map hash-map content-points base-points) (reduce merge))
base->point (map-invert point->base)
@ -269,7 +268,7 @@
ms/mouse-position
(mf/deps shape zoom)
(fn [position]
(when-let [point (gshp/path-closest-point shape position)]
(when-let [point (gsp/path-closest-point shape position)]
(reset! hover-point (when (< (gpt/distance position point) (/ 10 zoom)) point)))))
[:g.path-editor {:ref editor-ref}

8
frontend/src/app/main/ui/workspace/sidebar/layers.cljs
View file

@ -39,6 +39,11 @@
(if (:masked-group? shape)
i/mask
i/folder))
:bool (case (:bool-type shape)
:difference i/boolean-difference
:exclude i/boolean-exclude
:intersection i/boolean-intersection
#_:default i/boolean-union)
:svg-raw i/file-svg
nil))
@ -292,7 +297,8 @@
:shape-ref
:touched
:metadata
:masked-group?]))
:masked-group?
:bool-type]))
(defn- strip-objects
[objects]

6
frontend/src/app/main/ui/workspace/sidebar/options.cljs
View file

@ -11,10 +11,12 @@
[app.main.store :as st]
[app.main.ui.components.tab-container :refer [tab-container tab-element]]
[app.main.ui.context :as ctx]
[app.main.ui.workspace.sidebar.align :refer [align-options]]
[app.main.ui.workspace.sidebar.options.menus.align :refer [align-options]]
[app.main.ui.workspace.sidebar.options.menus.booleans :refer [booleans-options]]
[app.main.ui.workspace.sidebar.options.menus.exports :refer [exports-menu]]
[app.main.ui.workspace.sidebar.options.menus.interactions :refer [interactions-menu]]
[app.main.ui.workspace.sidebar.options.page :as page]
[app.main.ui.workspace.sidebar.options.shapes.bool :as bool]
[app.main.ui.workspace.sidebar.options.shapes.circle :as circle]
[app.main.ui.workspace.sidebar.options.shapes.frame :as frame]
[app.main.ui.workspace.sidebar.options.shapes.group :as group]
@ -43,6 +45,7 @@
:path [:& path/options {:shape shape}]
:image [:& image/options {:shape shape}]
:svg-raw [:& svg-raw/options {:shape shape}]
:bool [:& bool/options {:shape shape}]
nil)
[:& exports-menu
{:shape shape
@ -60,6 +63,7 @@
:title (tr "workspace.options.design")}
[:div.element-options
[:& align-options]
[:& booleans-options]
(case (count selected)
0 [:& page/options]
1 [:& shape-options {:shape (first shapes)

2
frontend/src/app/main/ui/workspace/sidebar/align.cljs → frontend/src/app/main/ui/workspace/sidebar/options/menus/align.cljs
View file

@ -4,7 +4,7 @@
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.ui.workspace.sidebar.align
(ns app.main.ui.workspace.sidebar.options.menus.align
(:require
[app.common.uuid :as uuid]
[app.main.data.workspace :as dw]

84
frontend/src/app/main/ui/workspace/sidebar/options/menus/booleans.cljs Normal file
View file

@ -0,0 +1,84 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.ui.workspace.sidebar.options.menus.booleans
(:require
[app.main.data.workspace :as dw]
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[rumext.alpha :as mf]))
(mf/defc booleans-options
[]
(let [selected (mf/deref refs/selected-objects)
disabled-bool-btns
(or (empty? selected)
(and (<= (count selected) 1)
(not (contains? #{:group :bool} (:type (first selected))))))
disabled-flatten
(empty? selected)
head (first selected)
is-group? (and (some? head) (= :group (:type head)))
is-bool? (and (some? head) (= :bool (:type head)))
head-bool-type (and (some? head) (:bool-type head))
set-bool
(fn [bool-type]
#(cond
(> (count selected) 1)
(st/emit! (dw/create-bool bool-type))
(and (= (count selected) 1) is-group?)
(st/emit! (dw/group-to-bool (:id head) bool-type))
(and (= (count selected) 1) is-bool?)
(if (= head-bool-type bool-type)
(st/emit! (dw/bool-to-group (:id head)))
(st/emit! (dw/change-bool-type (:id head) bool-type)))))]
[:div.align-options
[:div.align-group
[:div.align-button.tooltip.tooltip-bottom
{:alt (tr "workspace.shape.menu.union")
:class (dom/classnames :disabled disabled-bool-btns
:selected (= head-bool-type :union))
:on-click (set-bool :union)}
i/boolean-union]
[:div.align-button.tooltip.tooltip-bottom
{:alt (tr "workspace.shape.menu.difference")
:class (dom/classnames :disabled disabled-bool-btns
:selected (= head-bool-type :difference))
:on-click (set-bool :difference)}
i/boolean-difference]
[:div.align-button.tooltip.tooltip-bottom
{:alt (tr "workspace.shape.menu.intersection")
:class (dom/classnames :disabled disabled-bool-btns
:selected (= head-bool-type :intersection))
:on-click (set-bool :intersection)}
i/boolean-intersection]
[:div.align-button.tooltip.tooltip-bottom
{:alt (tr "workspace.shape.menu.exclude")
:class (dom/classnames :disabled disabled-bool-btns
:selected (= head-bool-type :exclude))
:on-click (set-bool :exclude)}
i/boolean-exclude]]
[:div.align-group
[:div.align-button.tooltip.tooltip-bottom
{:alt (tr "workspace.shape.menu.flatten")
:class (dom/classnames :disabled disabled-flatten)
:on-click (st/emitf (dw/convert-selected-to-path))}
i/boolean-flatten]]]))

45
frontend/src/app/main/ui/workspace/sidebar/options/shapes/bool.cljs Normal file
View file

@ -0,0 +1,45 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.main.ui.workspace.sidebar.options.shapes.bool
(:require
[app.main.ui.workspace.sidebar.options.menus.blur :refer [blur-menu]]
[app.main.ui.workspace.sidebar.options.menus.constraints :refer [constraint-attrs constraints-menu]]
[app.main.ui.workspace.sidebar.options.menus.fill :refer [fill-attrs fill-menu]]
[app.main.ui.workspace.sidebar.options.menus.layer :refer [layer-attrs layer-menu]]
[app.main.ui.workspace.sidebar.options.menus.measures :refer [measure-attrs measures-menu]]
[app.main.ui.workspace.sidebar.options.menus.shadow :refer [shadow-menu]]
[app.main.ui.workspace.sidebar.options.menus.stroke :refer [stroke-attrs stroke-menu]]
[rumext.alpha :as mf]))
(mf/defc options
[{:keys [shape] :as props}]
(let [ids [(:id shape)]
type (:type shape)
measure-values (select-keys shape measure-attrs)
stroke-values (select-keys shape stroke-attrs)
layer-values (select-keys shape layer-attrs)
constraint-values (select-keys shape constraint-attrs)]
[:*
[:& measures-menu {:ids ids
:type type
:values measure-values}]
[:& constraints-menu {:ids ids
:values constraint-values}]
[:& layer-menu {:ids ids
:type type
:values layer-values}]
[:& fill-menu {:ids ids
:type type
:values (select-keys shape fill-attrs)}]
[:& stroke-menu {:ids ids
:type type
:show-caps true
:values stroke-values}]
[:& shadow-menu {:ids ids
:values (select-keys shape [:shadow])}]
[:& blur-menu {:ids ids
:values (select-keys shape [:blur])}]]))

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

@ -159,8 +159,13 @@
(hooks/setup-shortcuts node-editing? drawing-path?)
(hooks/setup-active-frames objects vbox hover active-frames)
[:div.viewport
[:div.viewport-overlays
[:& wtr/frame-renderer {:objects objects
:background background}]
@ -196,11 +201,12 @@
[:& use/export-page {:options options}]
[:& (mf/provider use/include-metadata-ctx) {:value true}
[:& (mf/provider embed/context) {:value true}
;; Render root shape
[:& shapes/root-shape {:key page-id
:objects objects
:active-frames @active-frames}]]]
:active-frames @active-frames}]]]]
[:svg.viewport-controls
{:xmlns "http://www.w3.org/2000/svg"
@ -229,7 +235,6 @@
:on-pointer-up on-pointer-up}
[:g {:style {:pointer-events (if disable-events? "none" "auto")}}
(when show-outlines?
[:& outline/shape-outlines
{:objects objects

20
frontend/src/app/main/ui/workspace/viewport/hooks.cljs
View file

@ -92,6 +92,7 @@
(defn setup-hover-shapes [page-id move-stream objects transform selected ctrl? hover hover-ids hover-disabled? zoom]
(let [;; We use ref so we don't recreate the stream on a change
zoom-ref (mf/use-ref zoom)
ctrl-ref (mf/use-ref @ctrl?)
transform-ref (mf/use-ref nil)
selected-ref (mf/use-ref selected)
hover-disabled-ref (mf/use-ref hover-disabled?)
@ -101,6 +102,7 @@
(mf/deps page-id)
(fn [point]
(let [zoom (mf/ref-val zoom-ref)
ctrl? (mf/ref-val ctrl-ref)
rect (gsh/center->rect point (/ 5 zoom) (/ 5 zoom))]
(if (mf/ref-val hover-disabled-ref)
(rx/of nil)
@ -109,6 +111,7 @@
:page-id page-id
:rect rect
:include-frames? true
:clip-children? (not ctrl?)
:reverse? true}))))) ;; we want the topmost shape to be selected first
over-shapes-stream
@ -120,7 +123,6 @@
(rx/switch-map query-point))))]
;; Refresh the refs on a value change
(mf/use-effect
(mf/deps transform)
#(mf/set-ref-val! transform-ref transform))
@ -129,6 +131,10 @@
(mf/deps zoom)
#(mf/set-ref-val! zoom-ref zoom))
(mf/use-effect
(mf/deps @ctrl?)
#(mf/set-ref-val! ctrl-ref @ctrl?))
(mf/use-effect
(mf/deps selected)
#(mf/set-ref-val! selected-ref selected))
@ -143,10 +149,14 @@
(fn [ids]
(let [selected (mf/ref-val selected-ref)
remove-id? (into #{} (mapcat #(cp/get-parents % objects)) selected)
remove-id? (if @ctrl?
(d/concat remove-id?
(->> ids
(filterv #(= :group (get-in objects [% :type])))))
is-group?
(fn [id]
(contains? #{:group :bool} (get-in objects [id :type])))
remove-id?
(if @ctrl?
(d/concat remove-id? (filterv is-group? ids))
remove-id?)
ids (->> ids (filterv (comp not remove-id?)))]
(reset! hover (get objects (first ids)))

2
frontend/src/app/util/dom.cljs
View file

@ -281,7 +281,7 @@
(defn set-text! [node text]
(set! (.-textContent node) text))
(defn set-css-property [node property value]
(defn set-css-property! [node property value]
(.setProperty (.-style ^js node) property value))
(defn capture-pointer [event]

17
frontend/src/app/util/import/parser.cljs
View file

@ -209,6 +209,13 @@
(->> node :content last))]
(merge (add-attrs {} (:attrs svg-node)) node-attrs))
(= type :bool)
(->> node
(:content)
(filter #(= :path (:tag %)))
(map #(:attrs %))
(reduce add-attrs node-attrs))
:else
node-attrs)))
@ -443,6 +450,11 @@
mask?
(assoc :masked-group? true))))
(defn add-bool-data
[props node]
(-> props
(assoc :bool-type (get-meta node :bool-type keyword))))
(defn parse-shadow [node]
{:id (uuid/next)
:style (get-meta node :shadow-type keyword)
@ -706,7 +718,10 @@
(add-image-data type node))
(cond-> (= :text type)
(add-text-data node))))))
(add-text-data node))
(cond-> (= :bool type)
(add-bool-data node))))))
(defn parse-page-data
[node]

16
frontend/src/app/util/path/format.cljs
View file

@ -6,7 +6,8 @@
(ns app.util.path.format
(:require
[app.util.path.commands :as upc]
[app.common.path.commands :as upc]
[app.common.path.subpaths :refer [pt=]]
[cuerdas.core :as str]))
(defn command->param-list [command]
@ -62,6 +63,12 @@
(str command-str param-list)))
(defn set-point
[command point]
(-> command
(assoc-in [:params :x] (:x point))
(assoc-in [:params :y] (:y point))))
(defn format-path [content]
(with-out-str
(loop [last-move nil
@ -72,9 +79,12 @@
(let [point (upc/command->point current)
current-move? (= :move-to (:command current))
last-move (if current-move? point last-move)]
(print (command->string current))
(when (and (not current-move?) (= last-move point))
(if (and (not current-move?) (pt= last-move point))
(print (command->string (set-point current last-move)))
(print (command->string current)))
(when (and (not current-move?) (pt= last-move point))
(print "Z"))
(recur last-move

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

@ -1,55 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) UXBOX Labs SL
(ns app.util.path.geom
(:require
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gshp]
[app.util.path.commands :as upc]))
(defn calculate-opposite-handler
"Given a point and its handler, gives the symetric handler"
[point handler]
(let [handler-vector (gpt/to-vec point handler)]
(gpt/add point (gpt/negate handler-vector))))
(defn split-line-to [from-p cmd val]
(let [to-p (upc/command->point cmd)
sp (gpt/line-val from-p to-p val)]
[(upc/make-line-to sp) cmd]))
(defn split-curve-to [from-p cmd val]
(let [params (:params cmd)
end (gpt/point (:x params) (:y params))
h1 (gpt/point (:c1x params) (:c1y params))
h2 (gpt/point (:c2x params) (:c2y params))
[[_ to1 h11 h21]
[_ to2 h12 h22]] (gshp/curve-split from-p end h1 h2 val)]
[(upc/make-curve-to to1 h11 h21)
(upc/make-curve-to to2 h12 h22)]))
(defn opposite-handler
"Calculates the coordinates of the opposite handler"
[point handler]
(let [phv (gpt/to-vec point handler)]
(gpt/add point (gpt/negate phv))))
(defn opposite-handler-keep-distance
"Calculates the coordinates of the opposite handler but keeping the old distance"
[point handler old-opposite]
(let [old-distance (gpt/distance point old-opposite)
phv (gpt/to-vec point handler)
phv2 (gpt/multiply
(gpt/unit (gpt/negate phv))
(gpt/point old-distance))]
(gpt/add point phv2)))
(defn content->points [content]
(->> content
(map #(when (-> % :params :x) (gpt/point (-> % :params :x) (-> % :params :y))))
(remove nil?)
(into [])))

4
frontend/src/app/util/path/parser.cljs
View file

@ -8,9 +8,9 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.path.commands :as upc]
[app.util.path.arc-to-curve :refer [a2c]]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[app.util.svg :as usvg]
[cuerdas.core :as str]))

6
frontend/src/app/util/path/tools.cljs
View file

@ -8,9 +8,9 @@
(:require
[app.common.data :as d]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as upg]
[app.common.math :as mth]
[app.util.path.commands :as upc]
[app.util.path.geom :as upg]
[app.common.path.commands :as upc]
[clojure.set :as set]))
(defn remove-line-curves
@ -210,7 +210,7 @@
(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/line-val start end value)) cmd]]
:close-path [index [(upc/make-line-to (gpt/lerp start end value)) cmd]]
nil))
cmd-changes

2
frontend/src/app/worker/import.cljs
View file

@ -202,6 +202,7 @@
(case type
:frame (fb/close-artboard file)
:group (fb/close-group file)
:bool (fb/close-bool file)
:svg-raw (fb/close-svg-raw file)
#_default file)
@ -218,6 +219,7 @@
file (case type
:frame (fb/add-artboard file data)
:group (fb/add-group file data)
:bool (fb/add-bool file data)
:rect (fb/create-rect file data)
:circle (fb/create-circle file data)
:path (fb/create-path file data)

38
frontend/src/app/worker/selection.cljs
View file

@ -18,13 +18,13 @@
(defonce state (l/atom {}))
(defn index-shape
[objects parents-index masks-index]
[objects parents-index clip-parents-index]
(fn [index shape]
(let [{:keys [x y width height]} (gsh/points->selrect (:points shape))
shape-bound #js {:x x :y y :width width :height height}
parents (get parents-index (:id shape))
masks (get masks-index (:id shape))
clip-parents (get clip-parents-index (:id shape))
frame (when (and (not= :frame (:type shape))
(not= (:frame-id shape) uuid/zero))
@ -32,19 +32,22 @@
(qdt/insert index
(:id shape)
shape-bound
(assoc shape :frame frame :masks masks :parents parents)))))
(assoc shape
:frame frame
:clip-parents clip-parents
:parents parents)))))
(defn- create-index
[objects]
(let [shapes (-> objects (dissoc uuid/zero) (vals))
parents-index (cp/generate-child-all-parents-index objects)
masks-index (cp/create-mask-index objects parents-index)
clip-parents-index (cp/create-clip-index objects parents-index)
bounds #js {:x (int -0.5e7)
:y (int -0.5e7)
:width (int 1e7)
:height (int 1e7)}
index (reduce (index-shape objects parents-index masks-index)
index (reduce (index-shape objects parents-index clip-parents-index)
(qdt/create bounds)
shapes)
@ -68,11 +71,11 @@
shapes (->> changed-ids (mapv #(get new-objects %)) (filterv (comp not nil?)))
parents-index (cp/generate-child-all-parents-index new-objects shapes)
masks-index (cp/create-mask-index new-objects parents-index)
clip-parents-index (cp/create-clip-index new-objects parents-index)
new-index (qdt/remove-all index changed-ids)
index (reduce (index-shape new-objects parents-index masks-index)
index (reduce (index-shape new-objects parents-index clip-parents-index)
new-index
shapes)
@ -84,7 +87,7 @@
(create-index new-objects)))
(defn- query-index
[{index :index z-index :z-index} rect frame-id include-frames? full-frame? include-groups? reverse?]
[{index :index z-index :z-index} rect frame-id full-frame? include-frames? clip-children? reverse?]
(let [result (-> (qdt/search index (clj->js rect))
(es6-iterator-seq))
@ -96,7 +99,6 @@
(or (not frame-id) (= frame-id (:frame-id shape)))
(case (:type shape)
:frame include-frames?
:group include-groups?
true)
(or (not full-frame?)
@ -107,11 +109,9 @@
(fn [shape]
(gsh/overlaps? shape rect))
overlaps-masks?
(fn [masks]
(->> masks
(some (comp not overlaps?))
not))
overlaps-parent?
(fn [clip-parents]
(->> clip-parents (some (comp not overlaps?)) not))
add-z-index
(fn [{:keys [id frame-id] :as shape}]
@ -125,7 +125,9 @@
(filter match-criteria?)
(filter overlaps?)
(filter (comp overlaps? :frame))
(filter (comp overlaps-masks? :masks))
(filter (if clip-children?
(comp overlaps-parent? :clip-parents)
(constantly true)))
(map add-z-index))
result)
@ -155,10 +157,10 @@
nil)
(defmethod impl/handler :selection/query
[{:keys [page-id rect frame-id include-frames? full-frame? include-groups? reverse?]
:or {include-groups? true reverse? false include-frames? false full-frame? false} :as message}]
[{:keys [page-id rect frame-id reverse? full-frame? include-frames? clip-children?]
:or {reverse? false full-frame? false include-frames? false clip-children? true} :as message}]
(when-let [index (get @state page-id)]
(query-index index rect frame-id include-frames? full-frame? include-groups? reverse?)))
(query-index index rect frame-id full-frame? include-frames? clip-children? reverse?)))
(defmethod impl/handler :selection/query-z-index
[{:keys [page-id objects ids]}]

23
frontend/translations/en.po
View file

@ -3114,4 +3114,25 @@ msgid "viewer.breaking-change.message"
msgstr "Sorry!"
msgid "viewer.breaking-change.description"
msgstr "This shareable link is no longer valid. Create a new one or ask the owner for a new one.
msgstr "This shareable link is no longer valid. Create a new one or ask the owner for a new one."
msgid "workspace.shape.menu.path"
msgstr "Path"
msgid "workspace.shape.menu.union"
msgstr "Union"
msgid "workspace.shape.menu.difference"
msgstr "Difference"
msgid "workspace.shape.menu.intersection"
msgstr "Intersection"
msgid "workspace.shape.menu.exclude"
msgstr "Exclude"
msgid "workspace.shape.menu.flatten"
msgstr "Flatten"
msgid "workspace.shape.menu.transform-to-path"
msgstr "Transform to path"

21
frontend/translations/es.po
View file

@ -3000,3 +3000,24 @@ msgstr "¡Lo sentimos!"
msgid "viewer.breaking-change.description"
msgstr "Este link compartido ya no funciona. Crea uno nuevo o pídelo a la persona que lo creó."
msgid "workspace.shape.menu.path"
msgstr "Path"
msgid "workspace.shape.menu.union"
msgstr "Unión"
msgid "workspace.shape.menu.difference"
msgstr "Diferencia"
msgid "workspace.shape.menu.intersection"
msgstr "Intersección"
msgid "workspace.shape.menu.exclude"
msgstr "Exclusión"
msgid "workspace.shape.menu.flatten"
msgstr "Aplanar"
msgid "workspace.shape.menu.transform-to-path"
msgstr "Convertir en vector"