mirror of
https://github.com/penpot/penpot.git
synced 2025-04-15 16:31:25 -05:00
♻️ Refactor transforms
This commit is contained in:
alonso.torres
parent
2c50bb16dc
commit
af68c26aea
32 changed files with 1085 additions and 685 deletions
common/app/common
frontend/src/app
main
util
worker
|
|
@ -7,12 +7,14 @@
|
|||
(ns app.common.data
|
||||
"Data manipulation and query helper functions."
|
||||
(:refer-clojure :exclude [concat read-string hash-map])
|
||||
(:require [clojure.set :as set]
|
||||
[linked.set :as lks]
|
||||
#?(:cljs [cljs.reader :as r]
|
||||
:clj [clojure.edn :as r])
|
||||
#?(:cljs [cljs.core :as core]
|
||||
:clj [clojure.core :as core]))
|
||||
(:require
|
||||
[clojure.set :as set]
|
||||
[linked.set :as lks]
|
||||
[app.common.math :as mth]
|
||||
#?(:cljs [cljs.reader :as r]
|
||||
:clj [clojure.edn :as r])
|
||||
#?(:cljs [cljs.core :as core]
|
||||
:clj [clojure.core :as core]))
|
||||
#?(:clj
|
||||
(:import linked.set.LinkedSet)))
|
||||
|
||||
|
|
@ -261,3 +263,21 @@
|
|||
(defn coalesce
|
||||
[val default]
|
||||
(or val default))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Data Parsing / Conversion
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(defn nilf
|
||||
"Returns a new function that if you pass nil as any argument will
|
||||
return nil"
|
||||
[f]
|
||||
(fn [& args]
|
||||
(if (some nil? args)
|
||||
nil
|
||||
(apply f args))))
|
||||
|
||||
(defn check-num
|
||||
"Function that checks if a number is nil or nan. Will return 0 when not
|
||||
valid and the number otherwise."
|
||||
[v]
|
||||
(if (or (not v) (mth/nan? v)) 0 v))
|
||||
|
|
|
|||
|
|
@ -10,11 +10,7 @@
|
|||
(ns app.common.geom.align
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[app.common.spec :as us]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.math :as mth]
|
||||
[app.common.data :as d]))
|
||||
|
||||
;; --- Alignment
|
||||
|
|
@ -23,6 +19,20 @@
|
|||
|
||||
(declare calc-align-pos)
|
||||
|
||||
;; Duplicated from pages-helpers to remove cyclic dependencies
|
||||
(defn- get-children [id objects]
|
||||
(let [shapes (vec (get-in objects [id :shapes]))]
|
||||
(if shapes
|
||||
(d/concat shapes (mapcat #(get-children % objects) shapes))
|
||||
[])))
|
||||
|
||||
(defn- recursive-move
|
||||
"Move the shape and all its recursive children."
|
||||
[shape dpoint objects]
|
||||
(let [children-ids (get-children (:id shape) objects)
|
||||
children (map #(get objects %) children-ids)]
|
||||
(map #(gsh/move % dpoint) (cons shape children))))
|
||||
|
||||
(defn align-to-rect
|
||||
"Move the shape so that it is aligned with the given rectangle
|
||||
in the given axis. Take account the form of the shape and the
|
||||
|
|
@ -34,7 +44,7 @@
|
|||
align-pos (calc-align-pos wrapper-rect rect axis)
|
||||
delta {:x (- (:x align-pos) (:x wrapper-rect))
|
||||
:y (- (:y align-pos) (:y wrapper-rect))}]
|
||||
(gsh/recursive-move shape delta objects)))
|
||||
(recursive-move shape delta objects)))
|
||||
|
||||
(defn calc-align-pos
|
||||
[wrapper-rect rect axis]
|
||||
|
|
@ -80,7 +90,7 @@
|
|||
; The rectangle that wraps the whole selection
|
||||
wrapper-rect (gsh/selection-rect shapes)
|
||||
; Sort shapes by the center point in the given axis
|
||||
sorted-shapes (sort-by #(coord (gsh/center %)) shapes)
|
||||
sorted-shapes (sort-by #(coord (gsh/center-shape %)) shapes)
|
||||
; Each shape wrapped in its own rectangle
|
||||
wrapped-shapes (map #(gsh/selection-rect [%]) sorted-shapes)
|
||||
; The total space between shapes
|
||||
|
|
@ -106,7 +116,7 @@
|
|||
new-pos
|
||||
(conj deltas delta)))))]
|
||||
|
||||
(mapcat #(gsh/recursive-move %1 {coord %2 other-coord 0} objects)
|
||||
(mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
|
||||
sorted-shapes deltas)))))
|
||||
|
||||
;; Adjusto to viewport
|
||||
|
|
|
|||
|
|
@ -121,3 +121,13 @@
|
|||
([m angle-x angle-y p]
|
||||
(multiply m (skew-matrix angle-x angle-y p))))
|
||||
|
||||
(defn m-equal [m1 m2 threshold]
|
||||
(let [th-eq (fn [a b] (<= (mth/abs (- a b)) threshold))
|
||||
{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f} m1
|
||||
{m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f} m2]
|
||||
(and (th-eq m1a m2a)
|
||||
(th-eq m1b m2b)
|
||||
(th-eq m1c m2c)
|
||||
(th-eq m1d m2d)
|
||||
(th-eq m1e m2e)
|
||||
(th-eq m1f m2f))))
|
||||
|
|
|
|||
62
common/app/common/geom/proportions.cljc
Normal file
62
common/app/common/geom/proportions.cljc
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
;; 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/.
|
||||
;;
|
||||
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
;; defined by the Mozilla Public License, v. 2.0.
|
||||
;;
|
||||
;; Copyright (c) 2020 UXBOX Labs SL
|
||||
|
||||
(ns app.common.geom.proportions
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[app.common.spec :as us]
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes.common :as gco]
|
||||
[app.common.geom.shapes.transforms :as gtr]
|
||||
[app.common.geom.shapes.rect :as gpr]
|
||||
[app.common.math :as mth]
|
||||
[app.common.data :as d]))
|
||||
|
||||
;; --- Proportions
|
||||
|
||||
(declare assign-proportions-path)
|
||||
(declare assign-proportions-rect)
|
||||
|
||||
(defn assign-proportions
|
||||
[{:keys [type] :as shape}]
|
||||
(case type
|
||||
:path (assign-proportions-path shape)
|
||||
(assign-proportions-rect shape)))
|
||||
|
||||
(defn- assign-proportions-rect
|
||||
[{:keys [width height] :as shape}]
|
||||
(assoc shape :proportion (/ width height)))
|
||||
|
||||
|
||||
;; --- Setup Proportions
|
||||
|
||||
(declare setup-proportions-const)
|
||||
(declare setup-proportions-image)
|
||||
|
||||
(defn setup-proportions
|
||||
[shape]
|
||||
(case (:type shape)
|
||||
:icon (setup-proportions-image shape)
|
||||
:image (setup-proportions-image shape)
|
||||
:text shape
|
||||
(setup-proportions-const shape)))
|
||||
|
||||
(defn setup-proportions-image
|
||||
[{:keys [metadata] :as shape}]
|
||||
(let [{:keys [width height]} metadata]
|
||||
(assoc shape
|
||||
:proportion (/ width height)
|
||||
:proportion-lock false)))
|
||||
|
||||
(defn setup-proportions-const
|
||||
[shape]
|
||||
(assoc shape
|
||||
:proportion 1
|
||||
:proportion-lock false))
|
||||
|
|
@ -19,31 +19,19 @@
|
|||
[app.common.math :as mth]
|
||||
[app.common.data :as d]))
|
||||
|
||||
(defn- nilf
|
||||
"Returns a new function that if you pass nil as any argument will
|
||||
return nil"
|
||||
[f]
|
||||
(fn [& args]
|
||||
(if (some nil? args)
|
||||
nil
|
||||
(apply f args))))
|
||||
|
||||
;; --- Relative Movement
|
||||
|
||||
(declare move-rect)
|
||||
(declare move-path)
|
||||
|
||||
(defn -chk
|
||||
"Function that checks if a number is nil or nan. Will return 0 when not
|
||||
valid and the number otherwise."
|
||||
[v]
|
||||
(if (or (not v) (mth/nan? v)) 0 v))
|
||||
|
||||
(defn move
|
||||
"Move the shape relativelly to its current
|
||||
position applying the provided delta."
|
||||
[shape {dx :x dy :y}]
|
||||
(let [inc-x (nilf (fn [x] (+ (-chk x) (-chk dx))))
|
||||
(let [dx (d/check-num dx)
|
||||
dy (d/check-num dy)]
|
||||
(-> shape
|
||||
(assoc-in [:modifiers :displacement] (gmt/translate-matrix (gpt/point dx dy)))
|
||||
(gtr/transform-shape)))
|
||||
|
||||
#_(let [inc-x (nilf (fn [x] (+ (-chk x) (-chk dx))))
|
||||
inc-y (nilf (fn [y] (+ (-chk y) (-chk dy))))
|
||||
inc-point (nilf (fn [p] (-> p
|
||||
(update :x inc-x)
|
||||
|
|
@ -60,57 +48,20 @@
|
|||
(update :points #(mapv inc-point %))
|
||||
(update :segments #(mapv inc-point %)))))
|
||||
|
||||
;; Duplicated from pages-helpers to remove cyclic dependencies
|
||||
(defn get-children [id objects]
|
||||
(let [shapes (vec (get-in objects [id :shapes]))]
|
||||
(if shapes
|
||||
(d/concat shapes (mapcat #(get-children % objects) shapes))
|
||||
[])))
|
||||
|
||||
(defn recursive-move
|
||||
"Move the shape and all its recursive children."
|
||||
[shape dpoint objects]
|
||||
(let [children-ids (get-children (:id shape) objects)
|
||||
children (map #(get objects %) children-ids)]
|
||||
(map #(move % dpoint) (cons shape children))))
|
||||
|
||||
;; --- Absolute Movement
|
||||
|
||||
(declare absolute-move-rect)
|
||||
|
||||
(defn absolute-move
|
||||
"Move the shape to the exactly specified position."
|
||||
[shape position]
|
||||
(case (:type shape)
|
||||
(:curve :path) shape
|
||||
(absolute-move-rect shape position)))
|
||||
|
||||
(defn- absolute-move-rect
|
||||
"A specialized function for absolute moviment
|
||||
for rect-like shapes."
|
||||
[shape {:keys [x y] :as pos}]
|
||||
(let [dx (if x (- (-chk x) (-chk (:x shape))) 0)
|
||||
dy (if y (- (-chk y) (-chk (:y shape))) 0)]
|
||||
[shape {:keys [x y]}]
|
||||
(let [dx (- (d/check-num x) (-> shape :selrect :x))
|
||||
dy (- (d/check-num y) (-> shape :selrect :y))]
|
||||
(move shape (gpt/point dx dy))))
|
||||
|
||||
;; --- Proportions
|
||||
|
||||
(declare assign-proportions-path)
|
||||
(declare assign-proportions-rect)
|
||||
|
||||
(defn assign-proportions
|
||||
[{:keys [type] :as shape}]
|
||||
(case type
|
||||
:path (assign-proportions-path shape)
|
||||
(assign-proportions-rect shape)))
|
||||
|
||||
(defn- assign-proportions-rect
|
||||
[{:keys [width height] :as shape}]
|
||||
(assoc shape :proportion (/ width height)))
|
||||
|
||||
;; --- Paths
|
||||
|
||||
(defn update-path-point
|
||||
#_(defn update-path-point
|
||||
"Update a concrete point in the path.
|
||||
|
||||
The point should exists before, this function
|
||||
|
|
@ -118,34 +69,9 @@
|
|||
[shape index point]
|
||||
(assoc-in shape [:segments index] point))
|
||||
|
||||
;; --- Setup Proportions
|
||||
|
||||
(declare setup-proportions-const)
|
||||
(declare setup-proportions-image)
|
||||
|
||||
(defn setup-proportions
|
||||
[shape]
|
||||
(case (:type shape)
|
||||
:icon (setup-proportions-image shape)
|
||||
:image (setup-proportions-image shape)
|
||||
:text shape
|
||||
(setup-proportions-const shape)))
|
||||
|
||||
(defn setup-proportions-image
|
||||
[{:keys [metadata] :as shape}]
|
||||
(let [{:keys [width height]} metadata]
|
||||
(assoc shape
|
||||
:proportion (/ width height)
|
||||
:proportion-lock false)))
|
||||
|
||||
(defn setup-proportions-const
|
||||
[shape]
|
||||
(assoc shape
|
||||
:proportion 1
|
||||
:proportion-lock false))
|
||||
|
||||
;; --- Resize (Dimensions)
|
||||
|
||||
;;; TODO: CHANGE TO USE THE MODIFIERS
|
||||
(defn resize
|
||||
[shape width height]
|
||||
(us/assert map? shape)
|
||||
|
|
@ -177,28 +103,21 @@
|
|||
(resize shape (:width new-size) (:height new-size))))
|
||||
|
||||
;; --- Setup (Initialize)
|
||||
|
||||
(declare setup-rect)
|
||||
(declare setup-image)
|
||||
|
||||
(defn setup
|
||||
"A function that initializes the first coordinates for
|
||||
the shape. Used mainly for draw operations."
|
||||
[shape props]
|
||||
(case (:type shape)
|
||||
:image (setup-image shape props)
|
||||
(setup-rect shape props)))
|
||||
;; FIXME: Is this the correct place for these functions?
|
||||
|
||||
(defn- setup-rect
|
||||
"A specialized function for setup rect-like shapes."
|
||||
[shape {:keys [x y width height]}]
|
||||
(as-> shape $
|
||||
(assoc $ :x x
|
||||
:y y
|
||||
:width width
|
||||
:height height)
|
||||
(assoc $ :points (gtr/shape->points $))
|
||||
(assoc $ :selrect (gpr/points->selrect (:points $)))))
|
||||
(let [rect {:x x :y y :width width :height height}
|
||||
points (gpr/rect->points rect)
|
||||
selrect (gpr/points->selrect points)]
|
||||
(assoc shape
|
||||
:x x
|
||||
:y y
|
||||
:width width
|
||||
:height height
|
||||
:points points
|
||||
:selrect selrect)))
|
||||
|
||||
(defn- setup-image
|
||||
[{:keys [metadata] :as shape} {:keys [x y width height] :as props}]
|
||||
|
|
@ -208,26 +127,26 @@
|
|||
(:height metadata))
|
||||
:proportion-lock true)))
|
||||
|
||||
(defn setup
|
||||
"A function that initializes the first coordinates for
|
||||
the shape. Used mainly for draw operations."
|
||||
[shape props]
|
||||
(case (:type shape)
|
||||
:image (setup-image shape props)
|
||||
(setup-rect shape props)))
|
||||
|
||||
;; --- Resolve Shape
|
||||
|
||||
(declare resolve-rect-shape)
|
||||
(declare translate-from-frame)
|
||||
(declare translate-to-frame)
|
||||
|
||||
(defn resolve-shape
|
||||
[objects shape]
|
||||
(case (:type shape)
|
||||
:rect (resolve-rect-shape objects shape)
|
||||
:group (resolve-rect-shape objects shape)
|
||||
:frame (resolve-rect-shape objects shape)))
|
||||
|
||||
(defn- resolve-rect-shape
|
||||
[objects {:keys [parent] :as shape}]
|
||||
(loop [pobj (get objects parent)]
|
||||
(if (= :frame (:type pobj))
|
||||
(translate-from-frame shape pobj)
|
||||
(recur (get objects (:parent pobj))))))
|
||||
;; (declare resolve-rect-shape)
|
||||
;; (declare translate-from-frame)
|
||||
;; (declare translate-to-frame)
|
||||
;;
|
||||
;; (defn resolve-shape
|
||||
;; [objects shape]
|
||||
;; (loop [pobj (get objects parent)]
|
||||
;; (if (= :frame (:type pobj))
|
||||
;; (translate-from-frame shape pobj)
|
||||
;; (recur (get objects (:parent pobj))))))
|
||||
|
||||
|
||||
;; --- Outer Rect
|
||||
|
|
@ -236,24 +155,8 @@
|
|||
"Returns a rect that contains all the shapes and is aware of the
|
||||
rotation of each shape. Mainly used for multiple selection."
|
||||
[shapes]
|
||||
(let [shapes (map :selrect shapes)
|
||||
minx (transduce (map :x1) min ##Inf shapes)
|
||||
miny (transduce (map :y1) min ##Inf shapes)
|
||||
maxx (transduce (map :x2) max ##-Inf shapes)
|
||||
maxy (transduce (map :y2) max ##-Inf shapes)]
|
||||
{:x1 minx
|
||||
:y1 miny
|
||||
:x2 maxx
|
||||
:y2 maxy
|
||||
:x minx
|
||||
:y miny
|
||||
:width (- maxx minx)
|
||||
:height (- maxy miny)
|
||||
:points [(gpt/point minx miny)
|
||||
(gpt/point maxx miny)
|
||||
(gpt/point maxx maxy)
|
||||
(gpt/point minx maxy)]
|
||||
:type :rect}))
|
||||
(let [points (->> shapes (mapcat :points))]
|
||||
(gpr/points->selrect points)))
|
||||
|
||||
(defn translate-to-frame
|
||||
[shape {:keys [x y] :as frame}]
|
||||
|
|
@ -269,18 +172,20 @@
|
|||
"Check if a shape is contained in the
|
||||
provided selection rect."
|
||||
[shape selrect]
|
||||
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/shape->rect-shape selrect)
|
||||
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/shape->rect-shape shape)]
|
||||
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} selrect
|
||||
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (:selrect shape)]
|
||||
(and (neg? (- sy1 ry1))
|
||||
(neg? (- sx1 rx1))
|
||||
(pos? (- sy2 ry2))
|
||||
(pos? (- sx2 rx2)))))
|
||||
|
||||
;; TODO: This not will work for rotated shapes
|
||||
(defn overlaps?
|
||||
"Check if a shape overlaps with provided selection rect."
|
||||
[shape selrect]
|
||||
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/shape->rect-shape selrect)
|
||||
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/shape->rect-shape shape)]
|
||||
[shape rect]
|
||||
(let [{sx1 :x1 sx2 :x2 sy1 :y1 sy2 :y2} (gpr/rect->selrect rect)
|
||||
{rx1 :x1 rx2 :x2 ry1 :y1 ry2 :y2} (gpr/points->selrect (:points shape))]
|
||||
|
||||
(and (< rx1 sx2)
|
||||
(> rx2 sx1)
|
||||
(< ry1 sy2)
|
||||
|
|
@ -368,23 +273,29 @@
|
|||
|
||||
(defn setup-selrect [{:keys [x y width height] :as shape}]
|
||||
(-> shape
|
||||
(assoc :selrect {:x x :y y
|
||||
:width width :height height
|
||||
:x1 x :y1 y
|
||||
:x2 (+ x width) :y2 (+ y height)})))
|
||||
(assoc :selrect
|
||||
{:x x :y y
|
||||
:width width :height height
|
||||
:x1 x :y1 y
|
||||
:x2 (+ x width) :y2 (+ y height)})))
|
||||
|
||||
|
||||
;; EXPORTS
|
||||
(def center gco/center)
|
||||
(defn center-shape [shape] (gco/center-shape shape))
|
||||
(defn center-selrect [selrect] (gco/center-selrect selrect))
|
||||
(defn center-rect [rect] (gco/center-rect rect))
|
||||
|
||||
(def shape->rect-shape gpr/shape->rect-shape)
|
||||
(def fix-invalid-rect-values gtr/fix-invalid-rect-values)
|
||||
(def rect->rect-shape gpr/rect->rect-shape)
|
||||
(def points->selrect gpr/points->selrect)
|
||||
(defn rect->selrect [rect] (gpr/rect->selrect rect))
|
||||
|
||||
(def transform-shape-point gtr/transform-shape-point)
|
||||
(def update-path-selrect gtr/update-path-selrect)
|
||||
(def transform gtr/transform)
|
||||
#_(def shape->rect-shape gpr/shape->rect-shape)
|
||||
#_(def fix-invalid-rect-values gtr/fix-invalid-rect-values)
|
||||
#_(def rect->rect-shape gpr/rect->rect-shape)
|
||||
(defn points->selrect [points] (gpr/points->selrect points))
|
||||
|
||||
#_(def transform-shape-point gtr/transform-shape-point)
|
||||
#_(def update-path-selrect gtr/update-path-selrect)
|
||||
#_(def transform gtr/transform)
|
||||
(defn transform-shape [shape] (gtr/transform-shape shape))
|
||||
(def transform-matrix gtr/transform-matrix)
|
||||
|
||||
(defn transform-matrix [shape] (gtr/transform-matrix shape))
|
||||
(defn transform-point-center [point center transform] (gtr/transform-point-center point center transform))
|
||||
(defn transform-rect [rect mtx] (gtr/transform-rect rect mtx))
|
||||
|
|
|
|||
|
|
@ -17,32 +17,30 @@
|
|||
[app.common.math :as mth]
|
||||
[app.common.data :as d]))
|
||||
|
||||
;; --- Center
|
||||
(defn center-rect
|
||||
[{:keys [x y width height]}]
|
||||
(gpt/point (+ x (/ width 2))
|
||||
(+ y (/ height 2))))
|
||||
|
||||
(declare center-rect)
|
||||
(declare center-path)
|
||||
(defn center-selrect
|
||||
"Calculate the center of the shape."
|
||||
[selrect]
|
||||
(center-rect selrect))
|
||||
|
||||
(defn center
|
||||
(defn center-shape
|
||||
"Calculate the center of the shape."
|
||||
[shape]
|
||||
(case (:type shape)
|
||||
:curve (center-path shape)
|
||||
:path (center-path shape)
|
||||
(center-rect shape)))
|
||||
(center-rect (:selrect shape)))
|
||||
|
||||
(defn- center-rect
|
||||
[{:keys [x y width height] :as shape}]
|
||||
(gpt/point (+ x (/ width 2)) (+ y (/ height 2))))
|
||||
(defn center-points [points]
|
||||
(let [minx (transduce (map :x) min ##Inf points)
|
||||
miny (transduce (map :y) min ##Inf points)
|
||||
maxx (transduce (map :x) max ##-Inf points)
|
||||
maxy (transduce (map :y) max ##-Inf points)]
|
||||
(gpt/point (/ (+ minx maxx) 2)
|
||||
(/ (+ miny maxy) 2))))
|
||||
|
||||
(defn- center-path
|
||||
[{:keys [segments] :as shape}]
|
||||
(let [minx (apply min (map :x segments))
|
||||
miny (apply min (map :y segments))
|
||||
maxx (apply max (map :x segments))
|
||||
maxy (apply max (map :y segments))]
|
||||
(gpt/point (/ (+ minx maxx) 2) (/ (+ miny maxy) 2))))
|
||||
|
||||
(defn center->rect
|
||||
(defn make-centered-rect
|
||||
"Creates a rect given a center and a width and height"
|
||||
[center width height]
|
||||
{:x (- (:x center) (/ width 2))
|
||||
|
|
@ -50,3 +48,30 @@
|
|||
:width width
|
||||
:height height})
|
||||
|
||||
;; --- Center
|
||||
#_(
|
||||
(declare center-rect)
|
||||
(declare center-path)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(defn- center-path
|
||||
[{:keys [segments] :as shape}]
|
||||
(let [minx (apply min (map :x segments))
|
||||
miny (apply min (map :y segments))
|
||||
maxx (apply max (map :x segments))
|
||||
maxy (apply max (map :y segments))]
|
||||
(gpt/point (/ (+ minx maxx) 2) (/ (+ miny maxy) 2))))
|
||||
|
||||
(defn center->rect
|
||||
"Creates a rect given a center and a width and height"
|
||||
[center width height]
|
||||
{:x (- (:x center) (/ width 2))
|
||||
:y (- (:y center) (/ height 2))
|
||||
:width width
|
||||
:height height})
|
||||
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -16,6 +16,8 @@
|
|||
[app.common.math :as mth]
|
||||
[app.common.data :as d]))
|
||||
|
||||
(defn segments->points [segments]
|
||||
segments)
|
||||
|
||||
(defn content->points [content]
|
||||
(map #(gpt/point (-> % :param :x) (-> % :param :y)) content))
|
||||
|
||||
|
|
|
|||
|
|
@ -18,66 +18,97 @@
|
|||
[app.common.math :as mth]
|
||||
[app.common.data :as d]))
|
||||
|
||||
;; --- SHAPE -> RECT
|
||||
(defn rect->points [{:keys [x y width height]}]
|
||||
[(gpt/point x y)
|
||||
(gpt/point (+ x width) y)
|
||||
(gpt/point (+ x width) (+ y height))
|
||||
(gpt/point x (+ y height))])
|
||||
|
||||
(defn- rect->rect-shape
|
||||
[{:keys [x y width height] :as shape}]
|
||||
(assoc shape
|
||||
:x1 x
|
||||
:y1 y
|
||||
:x2 (+ x width)
|
||||
:y2 (+ y height)))
|
||||
|
||||
(defn- path->rect-shape
|
||||
[{:keys [segments] :as shape}]
|
||||
(merge shape
|
||||
{:type :rect}
|
||||
(:selrect shape)))
|
||||
|
||||
(defn shape->rect-shape
|
||||
"Coerce shape to rect like shape."
|
||||
|
||||
[{:keys [type] :as shape}]
|
||||
(case type
|
||||
(:curve :path) (path->rect-shape shape)
|
||||
(rect->rect-shape shape)))
|
||||
|
||||
;; Shape->PATH
|
||||
|
||||
(declare rect->path)
|
||||
|
||||
(defn shape->path
|
||||
[shape]
|
||||
(case (:type shape)
|
||||
(:curve :path) shape
|
||||
(rect->path shape)))
|
||||
|
||||
(defn rect->path
|
||||
[{:keys [x y width height] :as shape}]
|
||||
|
||||
(let [points [(gpt/point x y)
|
||||
(gpt/point (+ x width) y)
|
||||
(gpt/point (+ x width) (+ y height))
|
||||
(gpt/point x (+ y height))
|
||||
(gpt/point x y)]]
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :segments points))))
|
||||
|
||||
;; -- Points
|
||||
|
||||
(defn points->selrect [points]
|
||||
(defn points->rect [points]
|
||||
(let [minx (transduce (map :x) min ##Inf points)
|
||||
miny (transduce (map :y) min ##Inf points)
|
||||
maxx (transduce (map :x) max ##-Inf points)
|
||||
maxy (transduce (map :y) max ##-Inf points)]
|
||||
{:x1 minx
|
||||
:y1 miny
|
||||
:x2 maxx
|
||||
:y2 maxy
|
||||
:x minx
|
||||
{:x minx
|
||||
:y miny
|
||||
:width (- maxx minx)
|
||||
:height (- maxy miny)
|
||||
:type :rect}))
|
||||
:height (- maxy miny)}))
|
||||
|
||||
(defn points->selrect [points]
|
||||
(let [{:keys [x y width height] :as rect} (points->rect points)]
|
||||
(assoc rect
|
||||
:x1 x
|
||||
:x2 (+ x width)
|
||||
:y1 y
|
||||
:y2 (+ y height))))
|
||||
|
||||
(defn rect->selrect [rect]
|
||||
(-> rect rect->points points->selrect))
|
||||
|
||||
;; --- SHAPE -> RECT
|
||||
#_(
|
||||
(defn- rect->rect-shape
|
||||
[{:keys [x y width height] :as shape}]
|
||||
(assoc shape
|
||||
:x1 x
|
||||
:y1 y
|
||||
:x2 (+ x width)
|
||||
:y2 (+ y height)))
|
||||
|
||||
(defn- path->rect-shape
|
||||
[{:keys [segments] :as shape}]
|
||||
(merge shape
|
||||
{:type :rect}
|
||||
(:selrect shape)))
|
||||
|
||||
(defn shape->rect-shape
|
||||
"Coerce shape to rect like shape."
|
||||
|
||||
[{:keys [type] :as shape}]
|
||||
(case type
|
||||
(:curve :path) (path->rect-shape shape)
|
||||
(rect->rect-shape shape)))
|
||||
|
||||
;; Shape->PATH
|
||||
|
||||
(declare rect->path)
|
||||
|
||||
(defn shape->path
|
||||
[shape]
|
||||
(case (:type shape)
|
||||
(:curve :path) shape
|
||||
(rect->path shape)))
|
||||
|
||||
(defn rect->path
|
||||
[{:keys [x y width height] :as shape}]
|
||||
|
||||
(let [points [(gpt/point x y)
|
||||
(gpt/point (+ x width) y)
|
||||
(gpt/point (+ x width) (+ y height))
|
||||
(gpt/point x (+ y height))
|
||||
(gpt/point x y)]]
|
||||
(-> shape
|
||||
(assoc :type :path)
|
||||
(assoc :segments points))))
|
||||
|
||||
;; -- Points
|
||||
|
||||
(defn points->selrect [points]
|
||||
(let [minx (transduce (map :x) min ##Inf points)
|
||||
miny (transduce (map :y) min ##Inf points)
|
||||
maxx (transduce (map :x) max ##-Inf points)
|
||||
maxy (transduce (map :y) max ##-Inf points)]
|
||||
{:x1 minx
|
||||
:y1 miny
|
||||
:x2 maxx
|
||||
:y2 maxy
|
||||
:x minx
|
||||
:y miny
|
||||
:width (- maxx minx)
|
||||
:height (- maxy miny)
|
||||
:type :rect}))
|
||||
|
||||
|
||||
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -19,160 +19,82 @@
|
|||
[app.common.math :as mth]
|
||||
[app.common.data :as d]))
|
||||
|
||||
;; --- Transform Shape
|
||||
(defn transform-matrix
|
||||
"Returns a transformation matrix without changing the shape properties.
|
||||
The result should be used in a `transform` attribute in svg"
|
||||
([{:keys [x y] :as shape}]
|
||||
(let [shape-center (gco/center-shape shape)]
|
||||
(-> (gmt/matrix)
|
||||
(gmt/translate shape-center)
|
||||
(gmt/multiply (:transform shape (gmt/matrix)))
|
||||
(gmt/translate (gpt/negate shape-center))))))
|
||||
|
||||
(declare transform-rect)
|
||||
(declare transform-path)
|
||||
|
||||
(defn transform
|
||||
"Apply the matrix transformation to shape."
|
||||
[{:keys [type] :as shape} xfmt]
|
||||
(if (gmt/matrix? xfmt)
|
||||
(case type
|
||||
:path (transform-path shape xfmt)
|
||||
:curve (transform-path shape xfmt)
|
||||
(transform-rect shape xfmt))
|
||||
shape))
|
||||
|
||||
(defn center-transform [shape matrix]
|
||||
(let [shape-center (gco/center shape)]
|
||||
(-> shape
|
||||
(transform
|
||||
(-> (gmt/matrix)
|
||||
(gmt/translate shape-center)
|
||||
(gmt/multiply matrix)
|
||||
(gmt/translate (gpt/negate shape-center)))))))
|
||||
|
||||
(defn- transform-rect
|
||||
[{:keys [x y width height] :as shape} mx]
|
||||
(let [tl (gpt/transform (gpt/point x y) mx)
|
||||
tr (gpt/transform (gpt/point (+ x width) y) mx)
|
||||
bl (gpt/transform (gpt/point x (+ y height)) mx)
|
||||
br (gpt/transform (gpt/point (+ x width) (+ y height)) mx)
|
||||
;; TODO: replace apply with transduce (performance)
|
||||
minx (apply min (map :x [tl tr bl br]))
|
||||
maxx (apply max (map :x [tl tr bl br]))
|
||||
miny (apply min (map :y [tl tr bl br]))
|
||||
maxy (apply max (map :y [tl tr bl br]))]
|
||||
(assoc shape
|
||||
:x minx
|
||||
:y miny
|
||||
:width (- maxx minx)
|
||||
:height (- maxy miny))))
|
||||
|
||||
(defn- transform-path
|
||||
[{:keys [segments] :as shape} xfmt]
|
||||
(let [segments (mapv #(gpt/transform % xfmt) segments)]
|
||||
(assoc shape :segments segments)))
|
||||
|
||||
|
||||
(defn transform-shape-point
|
||||
(defn transform-point-center
|
||||
"Transform a point around the shape center"
|
||||
[point shape transform]
|
||||
(let [shape-center (gco/center shape)]
|
||||
(gpt/transform
|
||||
point
|
||||
(-> (gmt/multiply
|
||||
(gmt/translate-matrix shape-center)
|
||||
transform
|
||||
(gmt/translate-matrix (gpt/negate shape-center)))))))
|
||||
[point center matrix]
|
||||
(gpt/transform
|
||||
point
|
||||
(gmt/multiply (gmt/translate-matrix center)
|
||||
matrix
|
||||
(gmt/translate-matrix (gpt/negate center)))))
|
||||
|
||||
(defn shape->points [shape]
|
||||
(let [points (case (:type shape)
|
||||
(:curve :path) (if (:content shape)
|
||||
(gpa/content->points (:content shape))
|
||||
(:segments shape))
|
||||
(let [{:keys [x y width height]} shape]
|
||||
[(gpt/point x y)
|
||||
(gpt/point (+ x width) y)
|
||||
(gpt/point (+ x width) (+ y height))
|
||||
(gpt/point x (+ y height))]))]
|
||||
(->> points
|
||||
(map #(transform-shape-point % shape (:transform shape (gmt/matrix))))
|
||||
(map gpt/round)
|
||||
(vec))))
|
||||
(defn transform-points
|
||||
([points matrix]
|
||||
(transform-points points nil matrix))
|
||||
|
||||
(defn rect-path-dimensions [rect-path]
|
||||
(let [seg (:segments rect-path)
|
||||
[width height] (mapv (fn [[c1 c2]] (gpt/distance c1 c2)) (take 2 (d/zip seg (rest seg))))]
|
||||
{:width width
|
||||
:height height}))
|
||||
([points center matrix]
|
||||
|
||||
(defn update-path-selrect [shape]
|
||||
(as-> shape $
|
||||
(assoc $ :points (shape->points $))
|
||||
(assoc $ :selrect (gpr/points->selrect (:points $)))
|
||||
(assoc $ :x (get-in $ [:selrect :x]))
|
||||
(assoc $ :y (get-in $ [:selrect :y]))
|
||||
(assoc $ :width (get-in $ [:selrect :width]))
|
||||
(assoc $ :height (get-in $ [:selrect :height]))))
|
||||
(let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
|
||||
post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
|
||||
|
||||
(defn fix-invalid-rect-values
|
||||
[rect-shape]
|
||||
(letfn [(check [num]
|
||||
(if (or (nil? num) (mth/nan? num) (= ##Inf num) (= ##-Inf num)) 0 num))
|
||||
(to-positive [num] (if (< num 1) 1 num))]
|
||||
(-> rect-shape
|
||||
(update :x check)
|
||||
(update :y check)
|
||||
(update :width (comp to-positive check))
|
||||
(update :height (comp to-positive check)))))
|
||||
tr-point (fn [point]
|
||||
(gpt/transform point (gmt/multiply prev matrix post)))]
|
||||
(mapv tr-point points))))
|
||||
|
||||
(defn calculate-rec-path-skew-angle
|
||||
[path-shape]
|
||||
(let [p1 (get-in path-shape [:segments 2])
|
||||
p2 (get-in path-shape [:segments 3])
|
||||
p3 (get-in path-shape [:segments 4])
|
||||
v1 (gpt/to-vec p1 p2)
|
||||
v2 (gpt/to-vec p2 p3)]
|
||||
(- 90 (gpt/angle-with-other v1 v2))))
|
||||
(defn transform-rect
|
||||
"Transform a rectangles and changes its attributes"
|
||||
[{:keys [x y width height] :as rect} matrix]
|
||||
|
||||
(defn calculate-rec-path-height
|
||||
"Calculates the height of a paralelogram given by the path"
|
||||
[path-shape]
|
||||
(let [p1 (get-in path-shape [:segments 2])
|
||||
p2 (get-in path-shape [:segments 3])
|
||||
p3 (get-in path-shape [:segments 4])
|
||||
v1 (gpt/to-vec p1 p2)
|
||||
v2 (gpt/to-vec p2 p3)
|
||||
angle (gpt/angle-with-other v1 v2)]
|
||||
(* (gpt/length v2) (mth/sin (mth/radians angle)))))
|
||||
|
||||
(defn calculate-rec-path-rotation
|
||||
[path-shape1 path-shape2 resize-vector]
|
||||
|
||||
(let [idx-1 0
|
||||
idx-2 (cond (and (neg? (:x resize-vector)) (pos? (:y resize-vector))) 1
|
||||
(and (neg? (:x resize-vector)) (neg? (:y resize-vector))) 2
|
||||
(and (pos? (:x resize-vector)) (neg? (:y resize-vector))) 3
|
||||
:else 0)
|
||||
p1 (get-in path-shape1 [:segments idx-1])
|
||||
p2 (get-in path-shape2 [:segments idx-2])
|
||||
v1 (gpt/to-vec (gco/center path-shape1) p1)
|
||||
v2 (gpt/to-vec (gco/center path-shape2) p2)
|
||||
|
||||
rot-angle (gpt/angle-with-other v1 v2)
|
||||
rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)]
|
||||
(* rot-sign rot-angle)))
|
||||
(let [points (-> (gpr/rect->points rect)
|
||||
(transform-points matrix))]
|
||||
(gpr/points->rect points)))
|
||||
|
||||
|
||||
(defn transform-apply-modifiers
|
||||
[shape]
|
||||
(let [modifiers (:modifiers shape)
|
||||
ds-modifier (:displacement modifiers (gmt/matrix))
|
||||
(defn- shape->points [shape]
|
||||
(let [transform-point
|
||||
(fn [point]
|
||||
(-> point
|
||||
(transform-point-center (gco/center-shape shape)
|
||||
(:transform shape (gmt/matrix)))
|
||||
(gpt/round)))
|
||||
|
||||
points (cond
|
||||
(and (= :path (:type shape)) (:content shape))
|
||||
(gpa/content->points (:content shape))
|
||||
|
||||
(seq (:segments shape))
|
||||
(gpa/segments->points (:content shape))
|
||||
|
||||
:else
|
||||
(gpr/rect->points shape))]
|
||||
(mapv transform-point points)))
|
||||
|
||||
(defn normalize-scale
|
||||
"We normalize the scale so it's not too close to 0"
|
||||
[scale]
|
||||
(cond
|
||||
(and (< scale 0) (> scale -0.01)) -0.01
|
||||
(and (>= scale 0) (< scale 0.01)) 0.01
|
||||
:else scale))
|
||||
|
||||
|
||||
(defn modifiers->transform [current-transform center modifiers]
|
||||
(let [ds-modifier (:displacement modifiers (gmt/matrix))
|
||||
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
|
||||
|
||||
;; Normalize x/y vector coordinates because scale by 0 is infinite
|
||||
res-x (cond
|
||||
(and (< res-x 0) (> res-x -0.01)) -0.01
|
||||
(and (>= res-x 0) (< res-x 0.01)) 0.01
|
||||
:else res-x)
|
||||
|
||||
res-y (cond
|
||||
(and (< res-y 0) (> res-y -0.01)) -0.01
|
||||
(and (>= res-y 0) (< res-y 0.01)) 0.01
|
||||
:else res-y)
|
||||
|
||||
res-x (normalize-scale res-x)
|
||||
res-y (normalize-scale res-y)
|
||||
resize (gpt/point res-x res-y)
|
||||
|
||||
origin (:resize-origin modifiers (gpt/point 0 0))
|
||||
|
|
@ -181,162 +103,423 @@
|
|||
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
|
||||
rt-modif (or (:rotation modifiers) 0)
|
||||
|
||||
shape (-> shape
|
||||
(transform ds-modifier))
|
||||
transform (-> (gmt/matrix)
|
||||
|
||||
shape-center (gco/center shape)]
|
||||
;; Applies the current resize transformation
|
||||
(gmt/translate origin)
|
||||
(gmt/multiply resize-transform)
|
||||
(gmt/scale resize)
|
||||
(gmt/multiply resize-transform-inverse)
|
||||
(gmt/translate (gpt/negate origin))
|
||||
|
||||
(-> (gpr/shape->path shape)
|
||||
(transform (-> (gmt/matrix)
|
||||
;; Applies the stacked transformations
|
||||
(gmt/translate center)
|
||||
(gmt/multiply (gmt/rotate-matrix rt-modif))
|
||||
#_(gmt/multiply current-transform)
|
||||
(gmt/translate (gpt/negate center))
|
||||
|
||||
;; Applies the current resize transformation
|
||||
(gmt/translate origin)
|
||||
(gmt/multiply resize-transform)
|
||||
(gmt/scale resize)
|
||||
(gmt/multiply resize-transform-inverse)
|
||||
(gmt/translate (gpt/negate origin))
|
||||
;; Displacement
|
||||
(gmt/multiply ds-modifier))]
|
||||
transform))
|
||||
|
||||
;; Applies the stacked transformations
|
||||
(gmt/translate shape-center)
|
||||
(gmt/multiply (gmt/rotate-matrix rt-modif))
|
||||
(gmt/multiply (:transform shape (gmt/matrix)))
|
||||
(gmt/translate (gpt/negate shape-center)))))))
|
||||
(defn- calculate-skew-angle
|
||||
"Calculates the skew angle of the paralelogram given by the points"
|
||||
[[p1 p2 p3 p4]]
|
||||
(let [v1 (gpt/to-vec p3 p4)
|
||||
v2 (gpt/to-vec p4 p1)]
|
||||
(- 90 (gpt/angle-with-other v1 v2))))
|
||||
|
||||
(defn transform-path-shape
|
||||
[shape]
|
||||
(-> shape
|
||||
transform-apply-modifiers
|
||||
update-path-selrect)
|
||||
;; TODO: Addapt for paths is not working
|
||||
#_(let [shape-path (transform-apply-modifiers shape)
|
||||
shape-path-center (center shape-path)
|
||||
(defn- calculate-height
|
||||
"Calculates the height of a paralelogram given by the points"
|
||||
[[p1 p2 p3 p4]]
|
||||
(let [v1 (gpt/to-vec p3 p4)
|
||||
v2 (gpt/to-vec p4 p1)
|
||||
angle (gpt/angle-with-other v1 v2)]
|
||||
(* (gpt/length v2) (mth/sin (mth/radians angle)))))
|
||||
|
||||
shape-transform-inverse' (-> (gmt/matrix)
|
||||
(gmt/translate shape-path-center)
|
||||
(gmt/multiply (:transform-inverse shape (gmt/matrix)))
|
||||
(gmt/multiply (gmt/rotate-matrix (- (:rotation-modifier shape 0))))
|
||||
(gmt/translate (gpt/negate shape-path-center)))]
|
||||
(-> shape-path
|
||||
(transform shape-transform-inverse')
|
||||
(add-rotate-transform (:rotation-modifier shape 0)))))
|
||||
(defn- calculate-rotation
|
||||
"Calculates the rotation between two shapes given the resize vector direction"
|
||||
[points-shape1 points-shape2 flip-x flip-y]
|
||||
|
||||
(defn transform-rect-shape
|
||||
[shape]
|
||||
(let [;; Apply modifiers to the rect as a path so we have the end shape expected
|
||||
shape-path (transform-apply-modifiers shape)
|
||||
shape-center (gco/center shape-path)
|
||||
resize-vector (-> (get-in shape [:modifiers :resize-vector] (gpt/point 1 1))
|
||||
(update :x #(if (zero? %) 1 %))
|
||||
(update :y #(if (zero? %) 1 %)))
|
||||
(let [idx-1 0
|
||||
idx-2 (cond (and flip-x (not flip-y)) 1
|
||||
(and flip-x flip-y) 2
|
||||
(and (not flip-x) flip-y) 3
|
||||
:else 0)
|
||||
p1 (nth points-shape1 idx-1)
|
||||
p2 (nth points-shape2 idx-2)
|
||||
v1 (gpt/to-vec (gco/center-points points-shape1) p1)
|
||||
v2 (gpt/to-vec (gco/center-points points-shape2) p2)
|
||||
|
||||
;; Reverse the current transformation stack to get the base rectangle
|
||||
shape-path-temp (center-transform shape-path (:transform-inverse shape (gmt/matrix)))
|
||||
shape-path-temp-dim (rect-path-dimensions shape-path-temp)
|
||||
shape-path-temp-rec (gpr/shape->rect-shape shape-path-temp)
|
||||
rot-angle (gpt/angle-with-other v1 v2)
|
||||
rot-sign (if (> (* (:y v1) (:x v2)) (* (:x v1) (:y v2))) -1 1)]
|
||||
(* rot-sign rot-angle)))
|
||||
|
||||
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
|
||||
;; to have this width, height, x, y
|
||||
rec (gco/center->rect shape-center (:width shape-path-temp-dim) (:height shape-path-temp-dim))
|
||||
rec (fix-invalid-rect-values rec)
|
||||
rec-path (gpr/rect->path rec)
|
||||
(defn- calculate-dimensions
|
||||
[[p1 p2 p3 p4]]
|
||||
(let [width (gpt/distance p1 p2)
|
||||
height (gpt/distance p2 p3)]
|
||||
{:width width :height height}))
|
||||
|
||||
(defn calculate-adjust-matrix
|
||||
"Calculates a matrix that is a series of transformations we have to do to the transformed rectangle so that
|
||||
after applying them the end result is the `shape-pathn-temp`.
|
||||
This is compose of three transformations: skew, resize and rotation"
|
||||
[points-temp points-rec flip-x flip-y]
|
||||
(let [center (gco/center-points points-temp)
|
||||
|
||||
;; The next matrix is a series of transformations we have to do to the previous rec so that
|
||||
;; after applying them the end result is the `shape-path-temp`
|
||||
;; This is compose of three transformations: skew, resize and rotation
|
||||
stretch-matrix (gmt/matrix)
|
||||
|
||||
skew-angle (calculate-rec-path-skew-angle shape-path-temp)
|
||||
skew-angle (calculate-skew-angle points-temp)
|
||||
|
||||
;; When one of the axis is flipped we have to reverse the skew
|
||||
skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
|
||||
;; skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
|
||||
skew-angle (if (and (or flip-x flip-y)
|
||||
(not (and flip-x flip-y))) (- skew-angle) skew-angle )
|
||||
skew-angle (if (mth/nan? skew-angle) 0 skew-angle)
|
||||
|
||||
|
||||
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
|
||||
|
||||
h1 (calculate-rec-path-height shape-path-temp)
|
||||
h2 (calculate-rec-path-height (center-transform rec-path stretch-matrix))
|
||||
h1 (calculate-height points-temp)
|
||||
h2 (calculate-height (transform-points points-temp center stretch-matrix))
|
||||
h3 (/ h1 h2)
|
||||
h3 (if (mth/nan? h3) 1 h3)
|
||||
|
||||
stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 1 h3)))
|
||||
|
||||
rotation-angle (calculate-rec-path-rotation (center-transform rec-path stretch-matrix)
|
||||
shape-path-temp resize-vector)
|
||||
rotation-angle (calculate-rotation
|
||||
(transform-points points-rec (gco/center-points points-rec) stretch-matrix)
|
||||
points-temp
|
||||
flip-x
|
||||
flip-y)
|
||||
|
||||
stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
|
||||
|
||||
stretch-matrix (-> (gmt/matrix)
|
||||
(gmt/rotate rotation-angle)
|
||||
(gmt/skew skew-angle 0)
|
||||
(gmt/scale (gpt/point 1 h3)))
|
||||
|
||||
|
||||
;; This is the inverse to be able to remove the transformation
|
||||
stretch-matrix-inverse (-> (gmt/matrix)
|
||||
(gmt/scale (gpt/point 1 h3))
|
||||
(gmt/skew (- skew-angle) 0)
|
||||
(gmt/rotate (- rotation-angle)))
|
||||
(gmt/rotate (- rotation-angle)))]
|
||||
[stretch-matrix stretch-matrix-inverse]))
|
||||
|
||||
|
||||
(defn set-points-path
|
||||
[shape points]
|
||||
(let [shape (reduce (fn [acc [idx {:keys [x y]}]]
|
||||
(-> acc
|
||||
(assoc-in [:content idx :params :x] x)
|
||||
(assoc-in [:content idx :params :y] y))) shape (d/enumerate points))
|
||||
|
||||
shape (assoc shape
|
||||
:points points
|
||||
:selrect (gpr/points->selrect points))]
|
||||
shape))
|
||||
|
||||
(defn set-points-curve
|
||||
[shape points]
|
||||
shape)
|
||||
|
||||
(defn set-points-rect
|
||||
"Given a new set of points transformed, set up the rectangle so it keeps
|
||||
its properties. We adjust de x,y,width,height and create a custom transform"
|
||||
[shape points]
|
||||
;;
|
||||
(let [center (gco/center-points points)
|
||||
|
||||
;; Reverse the current transformation stack to get the base rectangle
|
||||
tr-inverse (:transform-inverse shape (gmt/matrix))
|
||||
modifiers (:modifiers shape)
|
||||
|
||||
points-temp (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
|
||||
;; to have this width, height, x, y
|
||||
rect-shape (gco/make-centered-rect center
|
||||
(:width points-temp-dim)
|
||||
(:height points-temp-dim))
|
||||
rect-points (gpr/rect->points rect-shape)
|
||||
|
||||
[matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape))
|
||||
;;[matrix matrix-inverse] [(gmt/matrix) (gmt/matrix)]
|
||||
|
||||
new-shape (as-> shape $
|
||||
(merge $ rec)
|
||||
(merge $ rect-shape)
|
||||
(update $ :x #(mth/precision % 0))
|
||||
(update $ :y #(mth/precision % 0))
|
||||
(update $ :width #(mth/precision % 0))
|
||||
(update $ :height #(mth/precision % 0))
|
||||
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) stretch-matrix))
|
||||
(update $ :transform-inverse #(gmt/multiply stretch-matrix-inverse (or % (gmt/matrix))))
|
||||
(assoc $ :points (shape->points $))
|
||||
(assoc $ :selrect (gpr/points->selrect (:points $)))
|
||||
(update $ :selrect fix-invalid-rect-values)
|
||||
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix))
|
||||
(update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))
|
||||
(assoc $ :points (into [] points))
|
||||
(assoc $ :selrect (gpr/rect->selrect rect-shape) #_(gpr/points->selrect points))
|
||||
(update $ :rotation #(mod (+ (or % 0)
|
||||
(or (get-in $ [:modifiers :rotation]) 0)) 360)))]
|
||||
new-shape))
|
||||
|
||||
(defn transform-shape
|
||||
"Transform the shape properties given the modifiers"
|
||||
([shape]
|
||||
|
||||
(letfn [(transform-by-type [shape]
|
||||
(case (:type shape)
|
||||
(:curve :path)
|
||||
(transform-path-shape shape)
|
||||
(defn set-points [shape points]
|
||||
(let [set-points-fn
|
||||
(case (:type shape)
|
||||
:path set-points-path
|
||||
:curve set-points-curve
|
||||
set-points-rect)]
|
||||
(set-points-fn shape points)))
|
||||
|
||||
#_:default
|
||||
(transform-rect-shape shape)))]
|
||||
|
||||
(cond-> shape
|
||||
(:modifiers shape) (transform-by-type)
|
||||
:always (dissoc :modifiers)))
|
||||
(defn set-flip [shape modifiers]
|
||||
(cond-> shape
|
||||
(< (get-in modifiers [:resize-vector :x]) 0) (update :flip-x not)
|
||||
(< (get-in modifiers [:resize-vector :y]) 0) (update :flip-y not)))
|
||||
|
||||
#_(cond-> shape
|
||||
(and (:modifiers shape) (#{:curve :path} (:type shape)))
|
||||
(transform-path-shape shape)
|
||||
|
||||
(and (:modifiers shape) (not (#{:curve :path} (:type shape))))
|
||||
(transform-rect-shape shape)
|
||||
(defn transform-shape [shape]
|
||||
(if (:modifiers shape)
|
||||
(let [points (:points shape (shape->points shape))
|
||||
center (gco/center-points points)
|
||||
transform (modifiers->transform (:transform shape (gmt/matrix)) center (:modifiers shape))
|
||||
tr-points (transform-points points transform)]
|
||||
(-> shape
|
||||
(set-flip (:modifiers shape))
|
||||
(set-points tr-points)
|
||||
(dissoc :modifiers)))
|
||||
shape))
|
||||
|
||||
true
|
||||
(dissoc :modifiers)
|
||||
))
|
||||
#_([frame shape kk]
|
||||
#_(defn transform-shape
|
||||
"Transform the shape properties given the modifiers"
|
||||
([shape]
|
||||
(letfn [(transform-by-type [shape]
|
||||
(case (:type shape)
|
||||
(:curve :path)
|
||||
(transform-path-shape shape)
|
||||
|
||||
#_:default
|
||||
(transform-rect-shape shape)))]
|
||||
|
||||
(cond-> shape
|
||||
(:modifiers shape) (transform-by-type)
|
||||
:always (dissoc :modifiers)))))
|
||||
|
||||
;; --- Transform Shape
|
||||
|
||||
#_(
|
||||
(declare transform-rect)
|
||||
(declare transform-path)
|
||||
(declare transform)
|
||||
|
||||
(defn center-transform [shape matrix]
|
||||
(let [shape-center (gco/center shape)]
|
||||
(-> shape
|
||||
(transform
|
||||
(-> (gmt/matrix)
|
||||
(gmt/translate shape-center)
|
||||
(gmt/multiply matrix)
|
||||
(gmt/translate (gpt/negate shape-center)))))))
|
||||
|
||||
(defn- transform-rect
|
||||
[{:keys [x y width height] :as shape} mx]
|
||||
(let [tl (gpt/transform (gpt/point x y) mx)
|
||||
tr (gpt/transform (gpt/point (+ x width) y) mx)
|
||||
bl (gpt/transform (gpt/point x (+ y height)) mx)
|
||||
br (gpt/transform (gpt/point (+ x width) (+ y height)) mx)
|
||||
;; TODO: replace apply with transduce (performance)
|
||||
minx (apply min (map :x [tl tr bl br]))
|
||||
maxx (apply max (map :x [tl tr bl br]))
|
||||
miny (apply min (map :y [tl tr bl br]))
|
||||
maxy (apply max (map :y [tl tr bl br]))]
|
||||
(assoc shape
|
||||
:x minx
|
||||
:y miny
|
||||
:width (- maxx minx)
|
||||
:height (- maxy miny))))
|
||||
|
||||
(defn- transform-path
|
||||
[{:keys [segments] :as shape} xfmt]
|
||||
(let [segments (mapv #(gpt/transform % xfmt) segments)]
|
||||
(assoc shape :segments segments)))
|
||||
|
||||
|
||||
|
||||
|
||||
#_(if (:modifiers shape)
|
||||
(-> (case (:type shape)
|
||||
(:curve :path) (transform-path-shape shape)
|
||||
(transform-rect-shape shape))
|
||||
(dissoc :modifiers))
|
||||
shape)
|
||||
#_(let [new-shape
|
||||
]
|
||||
|
||||
#_(cond-> new-shape
|
||||
frame (translate-to-frame frame)))))
|
||||
|
||||
(defn update-path-selrect [shape]
|
||||
(as-> shape $
|
||||
(assoc $ :points (shape->points $))
|
||||
(assoc $ :selrect (gpr/points->selrect (:points $)))
|
||||
(assoc $ :x (get-in $ [:selrect :x]))
|
||||
(assoc $ :y (get-in $ [:selrect :y]))
|
||||
(assoc $ :width (get-in $ [:selrect :width]))
|
||||
(assoc $ :height (get-in $ [:selrect :height]))))
|
||||
|
||||
(defn fix-invalid-rect-values
|
||||
[rect-shape]
|
||||
(letfn [(check [num]
|
||||
(if (or (nil? num) (mth/nan? num) (= ##Inf num) (= ##-Inf num)) 0 num))
|
||||
(to-positive [num] (if (< num 1) 1 num))]
|
||||
(-> rect-shape
|
||||
(update :x check)
|
||||
(update :y check)
|
||||
(update :width (comp to-positive check))
|
||||
(update :height (comp to-positive check)))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(declare transform-points)
|
||||
|
||||
(defn apply-modifiers
|
||||
[transform-stack modifiers points]
|
||||
(let [ds-modifier (:displacement modifiers (gmt/matrix))
|
||||
{res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
|
||||
|
||||
;; Normalize x/y vector coordinates because scale by 0 is infinite
|
||||
res-x (normalize-scale res-x)
|
||||
res-y (normalize-scale res-y)
|
||||
resize (gpt/point res-x res-y)
|
||||
|
||||
origin (:resize-origin modifiers (gpt/point 0 0))
|
||||
|
||||
resize-transform (:resize-transform modifiers (gmt/matrix))
|
||||
resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
|
||||
rt-modif (or (:rotation modifiers) 0)
|
||||
|
||||
points (transform-points ds-modifier)
|
||||
center (gco/center-points points)]
|
||||
|
||||
(-> points
|
||||
(transform-points
|
||||
(-> (gmt/matrix)
|
||||
|
||||
;; Applies the current resize transformation
|
||||
(gmt/translate origin)
|
||||
(gmt/multiply resize-transform)
|
||||
(gmt/scale resize)
|
||||
(gmt/multiply resize-transform-inverse)
|
||||
(gmt/translate (gpt/negate origin))
|
||||
|
||||
;; Applies the stacked transformations
|
||||
(gmt/translate center)
|
||||
(gmt/multiply (gmt/rotate-matrix rt-modif))
|
||||
(gmt/multiply transform-stack)
|
||||
(gmt/translate (gpt/negate center)))))))
|
||||
|
||||
(defn transform-path-shape
|
||||
[shape]
|
||||
shape
|
||||
#_(-> shape
|
||||
transform-apply-modifiers
|
||||
update-path-selrect)
|
||||
;; TODO: Addapt for paths is not working
|
||||
#_(let [shape-path (transform-apply-modifiers shape)
|
||||
shape-path-center (center shape-path)
|
||||
|
||||
shape-transform-inverse' (-> (gmt/matrix)
|
||||
(gmt/translate shape-path-center)
|
||||
(gmt/multiply (:transform-inverse shape (gmt/matrix)))
|
||||
(gmt/multiply (gmt/rotate-matrix (- (:rotation-modifier shape 0))))
|
||||
(gmt/translate (gpt/negate shape-path-center)))]
|
||||
(-> shape-path
|
||||
(transform shape-transform-inverse')
|
||||
(add-rotate-transform (:rotation-modifier shape 0)))))
|
||||
|
||||
(defn adjust-rect-transforms [shape]
|
||||
)
|
||||
|
||||
(defn transform-rect-shape
|
||||
[shape]
|
||||
(let [points (-> (:points shape (shape->points shape))
|
||||
(apply-modifiers (:transform shape) (:modifiers shape) points))
|
||||
|
||||
center (gco/center-points points)
|
||||
|
||||
resize-vector (-> (get-in shape [:modifiers :resize-vector] (gpt/point 1 1))
|
||||
(update :x #(if (zero? %) 1 %))
|
||||
(update :y #(if (zero? %) 1 %)))
|
||||
|
||||
;; Reverse the current transformation stack to get the base rectangle
|
||||
tr-inverse (:transform-inverse shape (gmt/matrix))
|
||||
points-temp (transform-poins points center tr-inverse)
|
||||
points-temp-dim (gpr/rect-points-dimensions points)
|
||||
points-temp-rec (gpr/points->selrect points)
|
||||
|
||||
;; This rectangle is the new data for the current rectangle. We want to change our rectangle
|
||||
;; to have this width, height, x, y
|
||||
rec (-> (gco/center->rect center (:width points-temp-dim) (:height points-temp-dim))
|
||||
(gpr/rect->points))
|
||||
;;rec (fix-invalid-rect-values rec)
|
||||
;;rec-path (gpr/rect->path rec)
|
||||
|
||||
;; The next matrix is a series of transformations we have to do to the previous rec so that
|
||||
;; after applying them the end result is the `shape-path-temp`
|
||||
;; This is compose of three transformations: skew, resize and rotation
|
||||
stretch-matrix (gmt/matrix)
|
||||
|
||||
skew-angle (calculate-rec-path-skew-angle shape-path-temp)
|
||||
|
||||
;; When one of the axis is flipped we have to reverse the skew
|
||||
skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
|
||||
skew-angle (if (mth/nan? skew-angle) 0 skew-angle)
|
||||
|
||||
|
||||
(defn transform-matrix
|
||||
"Returns a transformation matrix without changing the shape properties.
|
||||
The result should be used in a `transform` attribute in svg"
|
||||
([{:keys [x y] :as shape}]
|
||||
(let [shape-center (gco/center shape)]
|
||||
(-> (gmt/matrix)
|
||||
(gmt/translate shape-center)
|
||||
(gmt/multiply (:transform shape (gmt/matrix)))
|
||||
(gmt/translate (gpt/negate shape-center))))))
|
||||
stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
|
||||
|
||||
h1 (calculate-rec-path-height shape-path-temp)
|
||||
h2 (calculate-rec-path-height (center-transform rec-path stretch-matrix))
|
||||
h3 (/ h1 h2)
|
||||
h3 (if (mth/nan? h3) 1 h3)
|
||||
|
||||
stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point 1 h3)))
|
||||
|
||||
rotation-angle (calculate-rec-path-rotation (center-transform rec-path stretch-matrix)
|
||||
shape-path-temp resize-vector)
|
||||
|
||||
stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
|
||||
|
||||
;; This is the inverse to be able to remove the transformation
|
||||
stretch-matrix-inverse (-> (gmt/matrix)
|
||||
(gmt/scale (gpt/point 1 h3))
|
||||
(gmt/skew (- skew-angle) 0)
|
||||
(gmt/rotate (- rotation-angle)))
|
||||
|
||||
new-shape (as-> shape $
|
||||
(merge $ rec)
|
||||
(update $ :x #(mth/precision % 0))
|
||||
(update $ :y #(mth/precision % 0))
|
||||
(update $ :width #(mth/precision % 0))
|
||||
(update $ :height #(mth/precision % 0))
|
||||
(update $ :transform #(gmt/multiply (or % (gmt/matrix)) stretch-matrix))
|
||||
(update $ :transform-inverse #(gmt/multiply stretch-matrix-inverse (or % (gmt/matrix))))
|
||||
(assoc $ :points (shape->points $))
|
||||
(assoc $ :selrect (gpr/points->selrect (:points $)))
|
||||
(update $ :selrect fix-invalid-rect-values)
|
||||
(update $ :rotation #(mod (+ (or % 0)
|
||||
(or (get-in $ [:modifiers :rotation]) 0)) 360)))]
|
||||
new-shape))
|
||||
|
||||
(defn transform-points
|
||||
"Apply the matrix transformation to points"
|
||||
[points xfmt]
|
||||
|
||||
(cond->> points
|
||||
(gmt/matrix? xfmt) (map #(gpt/transform % xfmt))))
|
||||
|
||||
#_(defn transform
|
||||
"Apply the matrix transformation to shape"
|
||||
[{:keys [type] :as shape} xfmt]
|
||||
(if (gmt/matrix? xfmt)
|
||||
(case type
|
||||
:path (transform-path shape xfmt)
|
||||
:curve (transform-path shape xfmt)
|
||||
(transform-rect shape xfmt))
|
||||
shape))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -273,7 +273,9 @@
|
|||
(s/every uuid? :kind vector?))
|
||||
|
||||
(s/def ::shape-attrs
|
||||
(s/keys :opt-un [:internal.shape/blocked
|
||||
(s/keys :req-un [:internal.shape/selrect
|
||||
:internal.shape/points]
|
||||
:opt-un [:internal.shape/blocked
|
||||
:internal.shape/collapsed
|
||||
:internal.shape/content
|
||||
:internal.shape/fill-color
|
||||
|
|
@ -309,8 +311,6 @@
|
|||
:internal.shape/width
|
||||
:internal.shape/height
|
||||
:internal.shape/interactions
|
||||
:internal.shape/selrect
|
||||
:internal.shape/points
|
||||
:internal.shape/masked-group?
|
||||
:internal.shape/shadow
|
||||
:internal.shape/blur]))
|
||||
|
|
@ -764,7 +764,7 @@
|
|||
|
||||
(defn rotation-modifiers
|
||||
[center shape angle]
|
||||
(let [displacement (let [shape-center (geom/center shape)]
|
||||
(let [displacement (let [shape-center (geom/center-shape shape)]
|
||||
(-> (gmt/matrix)
|
||||
(gmt/rotate angle center)
|
||||
(gmt/rotate (- angle) shape-center)))]
|
||||
|
|
@ -783,7 +783,7 @@
|
|||
(distinct))
|
||||
shapes)))
|
||||
(update-group [group objects]
|
||||
(let [gcenter (geom/center group)
|
||||
(let [gcenter (geom/center-shape group)
|
||||
gxfm (comp
|
||||
(map #(get objects %))
|
||||
(map #(-> %
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@
|
|||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.proportions :as gpr]
|
||||
[app.common.geom.align :as gal]
|
||||
[app.common.math :as mth]
|
||||
[app.common.pages :as cp]
|
||||
|
|
@ -30,6 +31,7 @@
|
|||
[app.main.data.workspace.selection :as dws]
|
||||
[app.main.data.workspace.texts :as dwtxt]
|
||||
[app.main.data.workspace.transforms :as dwt]
|
||||
[app.main.data.workspace.drawing :as dwd]
|
||||
[app.main.repo :as rp]
|
||||
[app.main.store :as st]
|
||||
[app.main.streams :as ms]
|
||||
|
|
@ -472,10 +474,10 @@
|
|||
(let [vbox (update vbox :x + (:left-offset vbox))
|
||||
new-zoom (if (fn? zoom) (zoom (:zoom local)) zoom)
|
||||
old-zoom (:zoom local)
|
||||
center (if center center (gsh/center vbox))
|
||||
center (if center center (gsh/center-rect vbox))
|
||||
scale (/ old-zoom new-zoom)
|
||||
mtx (gmt/scale-matrix (gpt/point scale) center)
|
||||
vbox' (gsh/transform vbox mtx)
|
||||
vbox' (gsh/transform-rect vbox mtx)
|
||||
vbox' (update vbox' :x - (:left-offset vbox))]
|
||||
(-> local
|
||||
(assoc :zoom new-zoom)
|
||||
|
|
@ -546,50 +548,6 @@
|
|||
|
||||
;; --- Add shape to Workspace
|
||||
|
||||
(declare start-edition-mode)
|
||||
|
||||
(defn add-shape
|
||||
[attrs]
|
||||
(us/verify ::shape-attrs attrs)
|
||||
(ptk/reify ::add-shape
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [page-id (:current-page-id state)
|
||||
objects (dwc/lookup-page-objects state page-id)
|
||||
|
||||
id (uuid/next)
|
||||
shape (geom/setup-proportions attrs)
|
||||
|
||||
unames (dwc/retrieve-used-names objects)
|
||||
name (dwc/generate-unique-name unames (:name shape))
|
||||
|
||||
frame-id (or (:frame-id attrs)
|
||||
(cph/frame-id-by-position objects attrs))
|
||||
|
||||
shape (merge
|
||||
(if (= :frame (:type shape))
|
||||
cp/default-frame-attrs
|
||||
cp/default-shape-attrs)
|
||||
(assoc shape
|
||||
:id id
|
||||
:name name))
|
||||
|
||||
rchange {:type :add-obj
|
||||
:id id
|
||||
:page-id page-id
|
||||
:frame-id frame-id
|
||||
:obj shape}
|
||||
uchange {:type :del-obj
|
||||
:page-id page-id
|
||||
:id id}]
|
||||
|
||||
(rx/concat
|
||||
(rx/of (dwc/commit-changes [rchange] [uchange] {:commit-local? true})
|
||||
(dws/select-shapes (d/ordered-set id)))
|
||||
(when (= :text (:type attrs))
|
||||
(->> (rx/of (start-edition-mode id))
|
||||
(rx/observe-on :async))))))))
|
||||
|
||||
(defn- viewport-center
|
||||
[state]
|
||||
(let [{:keys [x y width height]} (get-in state [:workspace-local :vbox])]
|
||||
|
|
@ -615,8 +573,8 @@
|
|||
(merge data)
|
||||
(merge {:x x :y y})
|
||||
(assoc :frame-id frame-id)
|
||||
(rx/of (add-shape shape))))))
|
||||
(gsh/setup-selrect))]
|
||||
(rx/of (dwc/add-shape shape))))))
|
||||
|
||||
;; --- Update Shape Attrs
|
||||
|
||||
|
|
@ -954,7 +912,7 @@
|
|||
|
||||
(defn align-objects
|
||||
[axis]
|
||||
(us/verify ::geom/align-axis axis)
|
||||
(us/verify ::gal/align-axis axis)
|
||||
(ptk/reify :align-objects
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
|
|
@ -992,17 +950,17 @@
|
|||
[objects object-id axis]
|
||||
(let [object (get objects object-id)
|
||||
frame (get objects (:frame-id object))]
|
||||
(geom/align-to-rect object frame axis objects)))
|
||||
(gal/align-to-rect object frame axis objects)))
|
||||
|
||||
(defn align-objects-list
|
||||
[objects selected axis]
|
||||
(let [selected-objs (map #(get objects %) selected)
|
||||
rect (geom/selection-rect selected-objs)]
|
||||
(mapcat #(geom/align-to-rect % rect axis objects) selected-objs)))
|
||||
rect (gsh/selection-rect selected-objs)]
|
||||
(mapcat #(gal/align-to-rect % rect axis objects) selected-objs)))
|
||||
|
||||
(defn distribute-objects
|
||||
[axis]
|
||||
(us/verify ::geom/dist-axis axis)
|
||||
(us/verify ::gal/dist-axis axis)
|
||||
(ptk/reify :align-objects
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
|
|
@ -1010,7 +968,7 @@
|
|||
objects (dwc/lookup-page-objects state page-id)
|
||||
selected (get-in state [:workspace-local :selected])
|
||||
moved (-> (map #(get objects %) selected)
|
||||
(geom/distribute-space axis objects))]
|
||||
(gal/distribute-space axis objects))]
|
||||
(loop [moved (seq moved)
|
||||
rchanges []
|
||||
uchanges []]
|
||||
|
|
@ -1035,62 +993,6 @@
|
|||
:operations ops2
|
||||
:id (:id curr)})))))))))
|
||||
|
||||
;; --- Start shape "edition mode"
|
||||
|
||||
(declare clear-edition-mode)
|
||||
|
||||
(defn start-edition-mode
|
||||
[id]
|
||||
(us/assert ::us/uuid id)
|
||||
(ptk/reify ::start-edition-mode
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(assoc-in state [:workspace-local :edition] id))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(->> stream
|
||||
(rx/filter dwc/interrupt?)
|
||||
(rx/take 1)
|
||||
(rx/map (constantly clear-edition-mode))))))
|
||||
|
||||
(def clear-edition-mode
|
||||
(ptk/reify ::clear-edition-mode
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(update state :workspace-local dissoc :edition))))
|
||||
|
||||
;; --- Select for Drawing
|
||||
|
||||
(def clear-drawing
|
||||
(ptk/reify ::clear-drawing
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(update state :workspace-drawing dissoc :tool :object))))
|
||||
|
||||
(defn select-for-drawing
|
||||
([tool] (select-for-drawing tool nil))
|
||||
([tool data]
|
||||
(ptk/reify ::select-for-drawing
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(update state :workspace-drawing assoc :tool tool :object data))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [stoper (rx/filter (ptk/type? ::clear-drawing) stream)]
|
||||
(rx/merge
|
||||
(rx/of (dws/deselect-all))
|
||||
|
||||
;; NOTE: comments are a special case and they manage they
|
||||
;; own interrupt cycle.
|
||||
(when (not= tool :comments)
|
||||
(->> stream
|
||||
(rx/filter dwc/interrupt?)
|
||||
(rx/take 1)
|
||||
(rx/map (constantly clear-drawing))
|
||||
(rx/take-until stoper)))))))))
|
||||
|
||||
;; --- Update Dimensions
|
||||
|
||||
;; Event mainly used for handling user modification of the size of the
|
||||
|
|
@ -1104,7 +1006,7 @@
|
|||
(ptk/reify ::update-dimensions
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(rx/of (dwc/update-shapes ids #(geom/resize-rect % attr value))))))
|
||||
(rx/of (dwc/update-shapes ids #(gsh/resize-rect % attr value))))))
|
||||
|
||||
|
||||
;; --- Shape Proportions
|
||||
|
|
@ -1118,7 +1020,7 @@
|
|||
(if-not lock
|
||||
(assoc shape :proportion-lock false)
|
||||
(-> (assoc shape :proportion-lock true)
|
||||
(geom/assign-proportions)))))))))
|
||||
(gpr/assign-proportions)))))))))
|
||||
;; --- Update Shape Position
|
||||
|
||||
(s/def ::x number?)
|
||||
|
|
@ -1157,7 +1059,7 @@
|
|||
(let [page-id (:current-page-id state)]
|
||||
(-> state
|
||||
(update-in [:workspace-data page-id :objects id :segments index] gpt/add delta)
|
||||
(update-in [:workspace-data page-id :objects id] geom/update-path-selrect))))))
|
||||
(update-in [:workspace-data page-id :objects id] gsh/update-path-selrect))))))
|
||||
|
||||
;; --- Shape attrs (Layers Sidebar)
|
||||
|
||||
|
|
@ -1290,7 +1192,7 @@
|
|||
;; When the parent frame is not selected we change to relative
|
||||
;; coordinates
|
||||
(let [frame (get objects (:frame-id shape))]
|
||||
(geom/translate-to-frame shape frame))
|
||||
(gsh/translate-to-frame shape frame))
|
||||
shape))
|
||||
|
||||
(prepare [result objects selected id]
|
||||
|
|
@ -1329,7 +1231,7 @@
|
|||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [selected-objs (map #(get objects %) selected)
|
||||
wrapper (geom/selection-rect selected-objs)
|
||||
wrapper (gsh/selection-rect selected-objs)
|
||||
orig-pos (gpt/point (:x1 wrapper) (:y1 wrapper))
|
||||
mouse-pos @ms/mouse-position
|
||||
|
||||
|
|
@ -1359,7 +1261,7 @@
|
|||
(map #(get-in % [:obj :id]))
|
||||
(into (d/ordered-set)))]
|
||||
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
||||
(dws/select-shapes selected))))))
|
||||
(dwc/select-shapes selected))))))
|
||||
|
||||
(defn- image-uploaded
|
||||
[image]
|
||||
|
|
@ -1446,7 +1348,7 @@
|
|||
page-id (:current-page-id state)
|
||||
frame-id (-> (dwc/lookup-page-objects state page-id)
|
||||
(cph/frame-id-by-position @ms/mouse-position))
|
||||
shape (geom/setup-selrect
|
||||
shape (gsh/setup-selrect
|
||||
{:id id
|
||||
:type :text
|
||||
:name "Text"
|
||||
|
|
@ -1459,7 +1361,7 @@
|
|||
:content (as-content text)})]
|
||||
(rx/of dwc/start-undo-transaction
|
||||
(dws/deselect-all)
|
||||
(add-shape shape)
|
||||
(dwc/add-shape shape)
|
||||
dwc/commit-undo-transaction)))))
|
||||
|
||||
(defn update-shape-flags
|
||||
|
|
@ -1490,7 +1392,7 @@
|
|||
(when-not (empty? shapes)
|
||||
(let [[group rchanges uchanges] (dws/prepare-create-group page-id shapes "Group-" false)]
|
||||
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
||||
(dws/select-shapes (d/ordered-set (:id group))))))))))
|
||||
(dwc/select-shapes (d/ordered-set (:id group))))))))))
|
||||
|
||||
(def ungroup-selected
|
||||
(ptk/reify ::ungroup-selected
|
||||
|
|
@ -1568,7 +1470,7 @@
|
|||
:val (:fill-color mask)}]}))]
|
||||
|
||||
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
||||
(dws/select-shapes (d/ordered-set (:id group))))))))))
|
||||
(dwc/select-shapes (d/ordered-set (:id group))))))))))
|
||||
|
||||
(def unmask-group
|
||||
(ptk/reify ::unmask-group
|
||||
|
|
@ -1595,7 +1497,7 @@
|
|||
:val (:masked-group? group)}]}]]
|
||||
|
||||
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
||||
(dws/select-shapes (d/ordered-set (:id group))))))))))
|
||||
(dwc/select-shapes (d/ordered-set (:id group))))))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -1718,10 +1620,14 @@
|
|||
|
||||
(def select-shape dws/select-shape)
|
||||
(def deselect-all dws/deselect-all)
|
||||
(def select-shapes dws/select-shapes)
|
||||
(def select-shapes dwc/select-shapes)
|
||||
(def duplicate-selected dws/duplicate-selected)
|
||||
(def handle-selection dws/handle-selection)
|
||||
(def select-inside-group dws/select-inside-group)
|
||||
(def select-for-drawing dwd/select-for-drawing)
|
||||
(def clear-edition-mode dwc/clear-edition-mode)
|
||||
(def add-shape dwc/add-shape)
|
||||
(def start-edition-mode dwc/start-edition-mode)
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -1753,12 +1659,12 @@
|
|||
"ctrl+shift+z" #(st/emit! dwc/redo)
|
||||
"ctrl+y" #(st/emit! dwc/redo)
|
||||
"ctrl+q" #(st/emit! dwc/reinitialize-undo)
|
||||
"a" #(st/emit! (select-for-drawing :frame))
|
||||
"b" #(st/emit! (select-for-drawing :rect))
|
||||
"e" #(st/emit! (select-for-drawing :circle))
|
||||
"a" #(st/emit! (dwd/select-for-drawing :frame))
|
||||
"b" #(st/emit! (dwd/select-for-drawing :rect))
|
||||
"e" #(st/emit! (dwd/select-for-drawing :circle))
|
||||
"t" #(st/emit! dwtxt/start-edit-if-selected
|
||||
(select-for-drawing :text))
|
||||
"w" #(st/emit! (select-for-drawing :path))
|
||||
(dwd/select-for-drawing :text))
|
||||
"w" #(st/emit! (dwd/select-for-drawing :path))
|
||||
"ctrl+c" #(st/emit! copy-selected)
|
||||
"ctrl+v" #(st/emit! paste)
|
||||
"ctrl+x" #(st/emit! copy-selected delete-selected)
|
||||
|
|
@ -1778,4 +1684,3 @@
|
|||
"right" #(st/emit! (dwt/move-selected :right false))
|
||||
"left" #(st/emit! (dwt/move-selected :left false))
|
||||
"i" #(st/emit! (mdc/picker-for-selected-shape ))})
|
||||
|
||||
|
|
|
|||
|
|
@ -20,8 +20,12 @@
|
|||
[app.common.uuid :as uuid]
|
||||
[app.main.worker :as uw]
|
||||
[app.util.timers :as ts]
|
||||
[app.common.geom.shapes :as geom]))
|
||||
[app.common.geom.proportions :as gpr]
|
||||
[app.common.geom.shapes :as gsh]))
|
||||
|
||||
(s/def ::shape-attrs ::cp/shape-attrs)
|
||||
(s/def ::set-of-string (s/every string? :kind set?))
|
||||
(s/def ::ordered-set-of-uuid (s/every uuid? :kind d/ordered-set?))
|
||||
;; --- Protocols
|
||||
|
||||
(declare setup-selection-index)
|
||||
|
|
@ -158,7 +162,7 @@
|
|||
(defn get-frame-at-point
|
||||
[objects point]
|
||||
(let [frames (cph/select-frames objects)]
|
||||
(d/seek #(geom/has-point? % point) frames)))
|
||||
(d/seek #(gsh/has-point? % point) frames)))
|
||||
|
||||
|
||||
(defn- extract-numeric-suffix
|
||||
|
|
@ -171,8 +175,6 @@
|
|||
[objects]
|
||||
(into #{} (map :name) (vals objects)))
|
||||
|
||||
(s/def ::set-of-string
|
||||
(s/every string? :kind set?))
|
||||
|
||||
(defn generate-unique-name
|
||||
"A unique name generator"
|
||||
|
|
@ -434,3 +436,85 @@
|
|||
[rchanges uchanges] (impl-gen-changes objects page-id (seq ids))]
|
||||
(rx/of (commit-changes rchanges uchanges {:commit-local? true})))))))
|
||||
|
||||
|
||||
(defn select-shapes
|
||||
[ids]
|
||||
(us/verify ::ordered-set-of-uuid ids)
|
||||
(ptk/reify ::select-shapes
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(assoc-in state [:workspace-local :selected] ids))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [page-id (:current-page-id state)
|
||||
objects (lookup-page-objects state page-id)]
|
||||
(rx/of (expand-all-parents ids objects))))))
|
||||
|
||||
;; --- Start shape "edition mode"
|
||||
|
||||
(declare clear-edition-mode)
|
||||
|
||||
(defn start-edition-mode
|
||||
[id]
|
||||
(us/assert ::us/uuid id)
|
||||
(ptk/reify ::start-edition-mode
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(assoc-in state [:workspace-local :edition] id))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(->> stream
|
||||
(rx/filter interrupt?)
|
||||
(rx/take 1)
|
||||
(rx/map (constantly clear-edition-mode))))))
|
||||
|
||||
(def clear-edition-mode
|
||||
(ptk/reify ::clear-edition-mode
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(update state :workspace-local dissoc :edition))))
|
||||
|
||||
|
||||
(defn add-shape
|
||||
[attrs]
|
||||
(us/verify ::shape-attrs attrs)
|
||||
(ptk/reify ::add-shape
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [page-id (:current-page-id state)
|
||||
objects (lookup-page-objects state page-id)
|
||||
|
||||
id (uuid/next)
|
||||
shape (gpr/setup-proportions attrs)
|
||||
|
||||
unames (retrieve-used-names objects)
|
||||
name (generate-unique-name unames (:name shape))
|
||||
|
||||
frame-id (or (:frame-id attrs)
|
||||
(cph/frame-id-by-position objects attrs))
|
||||
|
||||
shape (merge
|
||||
(if (= :frame (:type shape))
|
||||
cp/default-frame-attrs
|
||||
cp/default-shape-attrs)
|
||||
(assoc shape
|
||||
:id id
|
||||
:name name))
|
||||
|
||||
rchange {:type :add-obj
|
||||
:id id
|
||||
:page-id page-id
|
||||
:frame-id frame-id
|
||||
:obj shape}
|
||||
uchange {:type :del-obj
|
||||
:page-id page-id
|
||||
:id id}]
|
||||
|
||||
(rx/concat
|
||||
(rx/of (commit-changes [rchange] [uchange] {:commit-local? true})
|
||||
(select-shapes (d/ordered-set id)))
|
||||
(when (= :text (:type attrs))
|
||||
(->> (rx/of (start-edition-mode id))
|
||||
(rx/observe-on :async))))))))
|
||||
|
|
|
|||
|
|
@ -12,15 +12,48 @@
|
|||
(:require
|
||||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]
|
||||
[app.common.spec :as us]
|
||||
[app.common.pages :as cp]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.main.data.workspace.common :as dwc]
|
||||
[app.main.data.workspace.selection :as dws]
|
||||
[app.main.data.workspace.drawing.common :as common]
|
||||
[app.main.data.workspace.drawing.path :as path]
|
||||
[app.main.data.workspace.drawing.curve :as curve]
|
||||
[app.main.data.workspace.drawing.box :as box]))
|
||||
|
||||
(declare start-drawing)
|
||||
(declare handle-drawing)
|
||||
|
||||
;; --- Select for Drawing
|
||||
|
||||
(defn select-for-drawing
|
||||
([tool] (select-for-drawing tool nil))
|
||||
([tool data]
|
||||
(ptk/reify ::select-for-drawing
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(update state :workspace-drawing assoc :tool tool :object data))
|
||||
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [stoper (rx/filter (ptk/type? ::clear-drawing) stream)]
|
||||
(rx/merge
|
||||
(rx/of (dws/deselect-all))
|
||||
|
||||
(when (= tool :path)
|
||||
(rx/of (start-drawing :path)))
|
||||
|
||||
;; NOTE: comments are a special case and they manage they
|
||||
;; own interrupt cycle.
|
||||
(when (not= tool :comments)
|
||||
(->> stream
|
||||
(rx/filter dwc/interrupt?)
|
||||
(rx/take 1)
|
||||
(rx/map (constantly common/clear-drawing))
|
||||
(rx/take-until stoper)))))))))
|
||||
|
||||
|
||||
;; NOTE/TODO: when an exception is raised in some point of drawing the
|
||||
;; draw lock is not released so the user need to refresh in order to
|
||||
;; be able draw again. THIS NEED TO BE REVISITED
|
||||
|
|
@ -68,3 +101,4 @@
|
|||
;; Export
|
||||
(def close-drawing-path path/close-drawing-path)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -74,7 +74,8 @@
|
|||
;; Initial SNAP
|
||||
(->> (snap/closest-snap-point page-id [shape] layout initial)
|
||||
(rx/map (fn [{:keys [x y]}]
|
||||
#(update-in % [:workspace-drawing :object] assoc :x x :y y))))
|
||||
#(update-in % [:workspace-drawing :object] gsh/absolute-move (gpt/point x y))
|
||||
)))
|
||||
|
||||
(->> ms/mouse-position
|
||||
(rx/filter #(> (gpt/distance % initial) 2))
|
||||
|
|
|
|||
|
|
@ -13,17 +13,23 @@
|
|||
[potok.core :as ptk]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.main.data.workspace :as dw]
|
||||
[app.main.data.workspace.common :as dwc]
|
||||
[app.main.data.workspace.selection :as dws]
|
||||
[app.main.streams :as ms]))
|
||||
|
||||
(def clear-drawing
|
||||
(ptk/reify ::clear-drawing
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(update state :workspace-drawing dissoc :tool :object))))
|
||||
|
||||
(def handle-finish-drawing
|
||||
(ptk/reify ::handle-finish-drawing
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
(let [shape (get-in state [:workspace-drawing :object])]
|
||||
(rx/concat
|
||||
(rx/of dw/clear-drawing)
|
||||
(rx/of clear-drawing)
|
||||
(when (:initialized? shape)
|
||||
(let [shape-click-width (case (:type shape)
|
||||
:text 3
|
||||
|
|
@ -52,5 +58,5 @@
|
|||
(rx/of dwc/start-undo-transaction)
|
||||
(rx/empty))
|
||||
|
||||
(rx/of (dw/deselect-all)
|
||||
(dw/add-shape shape))))))))))
|
||||
(rx/of (dws/deselect-all)
|
||||
(dwc/add-shape shape))))))))))
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
(:require
|
||||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.main.streams :as ms]
|
||||
[app.util.geom.path :as path]
|
||||
|
|
@ -27,13 +28,18 @@
|
|||
(defn insert-point-segment [state point]
|
||||
(update-in state [:workspace-drawing :object :segments] (fnil conj []) point))
|
||||
|
||||
(defn update-selrect [{:keys [segments] :as shape}]
|
||||
(let [points (->> segments
|
||||
(map #(apply gpt/point %)))]
|
||||
(assoc shape :selrect (gsh/points->selrect points))))
|
||||
|
||||
(defn finish-drawing-curve [state]
|
||||
(update-in
|
||||
state [:workspace-drawing :object]
|
||||
(fn [shape]
|
||||
(-> shape
|
||||
(update :segments #(path/simplify % simplify-tolerance))
|
||||
(gsh/update-path-selrect)))))
|
||||
(update-selrect)))))
|
||||
|
||||
(defn handle-drawing-curve []
|
||||
(ptk/reify ::handle-drawing-curve
|
||||
|
|
|
|||
|
|
@ -17,23 +17,23 @@
|
|||
[app.util.geom.path :as path]
|
||||
[app.main.data.workspace.drawing.common :as common]))
|
||||
|
||||
(defn stoper-event? [{:keys [type shift] :as event}]
|
||||
(defn finish-event? [{:keys [type shift] :as event}]
|
||||
(or (= event ::end-path-drawing)
|
||||
(= event :interrupt)
|
||||
(and (ms/mouse-event? event)
|
||||
#_(and (ms/mouse-event? event)
|
||||
(or (= type :double-click)
|
||||
(= type :context-menu)))
|
||||
(and (ms/keyboard-event? event)
|
||||
(= type :down)
|
||||
(= 13 (:key event)))))
|
||||
|
||||
(defn init-path []
|
||||
#_(defn init-path []
|
||||
(fn [state]
|
||||
(update-in state [:workspace-drawing :object]
|
||||
assoc :content []
|
||||
:initialized? true)))
|
||||
|
||||
(defn add-path-command [command]
|
||||
#_(defn add-path-command [command]
|
||||
(fn [state]
|
||||
(update-in state [:workspace-drawing :object :content] conj command)))
|
||||
|
||||
|
|
@ -43,7 +43,7 @@
|
|||
(cond-> state
|
||||
exists? (assoc-in [:workspace-drawing :object :segments index] point))))
|
||||
|
||||
(defn finish-drawing-path []
|
||||
#_(defn finish-drawing-path []
|
||||
(fn [state]
|
||||
(update-in
|
||||
state [:workspace-drawing :object]
|
||||
|
|
@ -52,17 +52,109 @@
|
|||
(gsh/update-path-selrect))))))
|
||||
|
||||
|
||||
(defn handle-drawing-path []
|
||||
(defn calculate-selrect [shape]
|
||||
(let [points (->> shape
|
||||
:content
|
||||
(mapv #(gpt/point
|
||||
(-> % :params :x)
|
||||
(-> % :params :y))))]
|
||||
(assoc shape
|
||||
:points points
|
||||
:selrect (gsh/points->selrect points))))
|
||||
|
||||
(defn init-path []
|
||||
(ptk/reify ::init-path
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(-> state
|
||||
(assoc-in [:workspace-drawing :object :initialized?] true)
|
||||
(assoc-in [:workspace-drawing :object :last-point] nil)))))
|
||||
|
||||
(defn finish-path []
|
||||
(ptk/reify ::finish-path
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(-> state
|
||||
(assoc-in [:workspace-drawing :object :last-point] nil)
|
||||
(update-in [:workspace-drawing :object] calculate-selrect)))))
|
||||
|
||||
(defn add-node [{:keys [x y]}]
|
||||
(ptk/reify ::add-node
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(let [point {:x x :y y}
|
||||
last-point (get-in state [:workspace-drawing :object :last-point])
|
||||
command (if last-point
|
||||
{:command :line-to
|
||||
:params point}
|
||||
{:command :move-to
|
||||
:params point})]
|
||||
(-> state
|
||||
(assoc-in [:workspace-drawing :object :last-point] point)
|
||||
(update-in [:workspace-drawing :object :content] (fnil conj []) command))))))
|
||||
|
||||
(defn drag-handler [{:keys [x y]}]
|
||||
(ptk/reify ::drag-handler
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(-> state))))
|
||||
|
||||
(defn make-click-stream
|
||||
[stream down-event]
|
||||
(->> stream
|
||||
(rx/filter ms/mouse-click?)
|
||||
(rx/debounce 200)
|
||||
(rx/first)
|
||||
(rx/map #(add-node down-event))))
|
||||
|
||||
(defn make-drag-stream
|
||||
[stream down-event]
|
||||
(let [mouse-up (->> stream (rx/filter ms/mouse-up?))
|
||||
drag-events (->> ms/mouse-position
|
||||
(rx/take-until mouse-up)
|
||||
(rx/map #(drag-handler %)))]
|
||||
(->> (rx/timer 400)
|
||||
(rx/merge-map #(rx/concat
|
||||
(add-node down-event)
|
||||
drag-events)))))
|
||||
|
||||
(defn make-dbl-click-stream
|
||||
[stream down-event]
|
||||
(->> stream
|
||||
(rx/filter ms/mouse-double-click?)
|
||||
(rx/first)
|
||||
(rx/merge-map
|
||||
#(rx/of (add-node down-event)
|
||||
::end-path-drawing))))
|
||||
|
||||
(defn handle-drawing-path []
|
||||
(ptk/reify ::handle-drawing-path
|
||||
ptk/WatchEvent
|
||||
(watch [_ state stream]
|
||||
|
||||
;; clicks stream<[MouseEvent, Position]>
|
||||
clicks (->> stream
|
||||
(rx/filter ms/mouse-click?)
|
||||
(rx/with-latest vector ms/mouse-position))
|
||||
(let [
|
||||
|
||||
mouse-down (->> stream (rx/filter ms/mouse-down?))
|
||||
finish-events (->> stream (rx/filter finish-event?))
|
||||
|
||||
events (->> mouse-down
|
||||
(rx/take-until finish-events)
|
||||
(rx/throttle 100)
|
||||
(rx/with-latest merge ms/mouse-position)
|
||||
|
||||
;; We change to the stream that emits the first event
|
||||
(rx/switch-map
|
||||
#(rx/race (make-click-stream stream %)
|
||||
(make-drag-stream stream %)
|
||||
(make-dbl-click-stream stream %))))]
|
||||
|
||||
|
||||
(rx/concat
|
||||
(rx/of (init-path))
|
||||
events
|
||||
(rx/of (finish-path))
|
||||
(rx/of common/handle-finish-drawing)))
|
||||
|
||||
|
||||
)))
|
||||
|
|
|
|||
|
|
@ -251,7 +251,7 @@
|
|||
|
||||
|
||||
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
||||
(dws/select-shapes (d/ordered-set (:id group))))))))))
|
||||
(dwc/select-shapes (d/ordered-set (:id group))))))))))
|
||||
|
||||
(defn rename-component
|
||||
[id new-name]
|
||||
|
|
@ -407,7 +407,7 @@
|
|||
new-shapes)]
|
||||
|
||||
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
|
||||
(dws/select-shapes (d/ordered-set (:id new-shape))))))))
|
||||
(dwc/select-shapes (d/ordered-set (:id new-shape))))))))
|
||||
|
||||
(defn detach-component
|
||||
"Remove all references to components in the shape with the given id,
|
||||
|
|
|
|||
|
|
@ -80,7 +80,8 @@
|
|||
(defn start-resize
|
||||
[handler initial ids shape]
|
||||
(letfn [(resize [shape initial resizing-shapes [point lock? point-snap]]
|
||||
(let [{:keys [width height rotation]} shape
|
||||
(let [{:keys [width height]} (:selrect shape)
|
||||
{:keys [rotation]} shape
|
||||
shapev (-> (gpt/point width height))
|
||||
|
||||
rotation (if (#{:curve :path} (:type shape)) 0 rotation)
|
||||
|
|
@ -101,9 +102,11 @@
|
|||
shape-transform (:transform shape (gmt/matrix))
|
||||
shape-transform-inverse (:transform-inverse shape (gmt/matrix))
|
||||
|
||||
shape-center (gsh/center-shape shape)
|
||||
|
||||
;; Resize origin point given the selected handler
|
||||
origin (-> (handler-resize-origin shape handler)
|
||||
(gsh/transform-shape-point shape shape-transform))]
|
||||
origin (-> (handler-resize-origin (:selrect shape) handler)
|
||||
(gsh/transform-point-center shape-center shape-transform))]
|
||||
|
||||
(rx/of (set-modifiers ids
|
||||
{:resize-vector scalev
|
||||
|
|
@ -170,7 +173,7 @@
|
|||
(watch [_ state stream]
|
||||
(let [stoper (rx/filter ms/mouse-up? stream)
|
||||
group (gsh/selection-rect shapes)
|
||||
group-center (gsh/center group)
|
||||
group-center (gsh/center-selrect group)
|
||||
initial-angle (gpt/angle @ms/mouse-position group-center)
|
||||
calculate-angle (fn [pos ctrl?]
|
||||
(let [angle (- (gpt/angle pos group-center) initial-angle)
|
||||
|
|
@ -403,7 +406,7 @@
|
|||
#(reduce update-shape % ids-with-children)))))))
|
||||
|
||||
(defn rotation-modifiers [center shape angle]
|
||||
(let [displacement (let [shape-center (gsh/center shape)]
|
||||
(let [displacement (let [shape-center (gsh/center-shape shape)]
|
||||
(-> (gmt/matrix)
|
||||
(gmt/rotate angle center)
|
||||
(gmt/rotate (- angle) shape-center)))]
|
||||
|
|
@ -416,7 +419,7 @@
|
|||
|
||||
(defn set-rotation
|
||||
([delta-rotation shapes]
|
||||
(set-rotation delta-rotation shapes (-> shapes gsh/selection-rect gsh/center)))
|
||||
(set-rotation delta-rotation shapes (-> shapes gsh/selection-rect gsh/center-selrect)))
|
||||
|
||||
([delta-rotation shapes center]
|
||||
(letfn [(rotate-shape [objects angle shape center]
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@
|
|||
(let [shapes (cph/select-toplevel-shapes objects {:include-frames? true})]
|
||||
(->> (gsh/selection-rect shapes)
|
||||
(gal/adjust-to-viewport vport)
|
||||
(gsh/fix-invalid-rect-values))))
|
||||
#_(gsh/fix-invalid-rect-values))))
|
||||
|
||||
(declare shape-wrapper-factory)
|
||||
|
||||
|
|
|
|||
|
|
@ -166,7 +166,7 @@
|
|||
(rx/merge-map
|
||||
(fn [[frame selrect]]
|
||||
(let [areas (->> (gsh/selrect->areas (or (:selrect frame)
|
||||
(gsh/rect->rect-shape @refs/vbox)) selrect)
|
||||
(gsh/rect->selrect @refs/vbox)) selrect)
|
||||
(d/mapm #(select-shapes-area page-id shapes objects %2)))
|
||||
snap-x (search-snap-distance selrect :x (:left areas) (:right areas))
|
||||
snap-y (search-snap-distance selrect :y (:top areas) (:bottom areas))]
|
||||
|
|
|
|||
|
|
@ -41,11 +41,10 @@
|
|||
|
||||
(when *assert*
|
||||
(defonce debug-subscription
|
||||
(as-> stream $
|
||||
#_(rx/filter ptk/event? $)
|
||||
(rx/filter (fn [s] (debug? :events)) $)
|
||||
(rx/subscribe $ (fn [event]
|
||||
(println "[stream]: " (repr-event event)))))))
|
||||
(->> stream
|
||||
(rx/filter ptk/event?)
|
||||
(rx/filter (fn [s] (debug? :events)))
|
||||
(rx/subs #(println "[stream]: " (repr-event %))))))
|
||||
(defn emit!
|
||||
([] nil)
|
||||
([event]
|
||||
|
|
@ -73,6 +72,11 @@
|
|||
(defn ^:export dump-state []
|
||||
(logjs "state" @state))
|
||||
|
||||
(defn ^:export get-state [str-path]
|
||||
(let [path (->> (str/split str-path " ")
|
||||
(map d/read-string))]
|
||||
(clj->js (get-in @state path))))
|
||||
|
||||
(defn ^:export dump-objects []
|
||||
(let [page-id (get @state :current-page-id)]
|
||||
(logjs "state" (get-in @state [:workspace-data :pages-index page-id :objects]))))
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@
|
|||
(let [shape (unchecked-get props "shape")
|
||||
base-props (unchecked-get props "base-props")
|
||||
elem-name (unchecked-get props "elem-name")
|
||||
{:keys [x y width height]} (geom/shape->rect-shape shape)
|
||||
;; {:keys [x y width height]} (geom/shape->rect-shape shape)
|
||||
{:keys [x y width height]} (:selrect shape)
|
||||
mask-id (mf/use-ctx mask-id-ctx)
|
||||
stroke-id (mf/use-var (uuid/next))
|
||||
stroke-style (:stroke-style shape :none)
|
||||
|
|
|
|||
|
|
@ -15,10 +15,12 @@
|
|||
[app.main.ui.shapes.custom-stroke :refer [shape-custom-stroke]]
|
||||
[app.main.ui.shapes.group :refer [mask-id-ctx]]
|
||||
[app.common.geom.shapes :as geom]
|
||||
[app.util.object :as obj]))
|
||||
[app.util.object :as obj]
|
||||
[app.util.geom.path :as ugp]))
|
||||
|
||||
;; --- Path Shape
|
||||
|
||||
;; LEGACY FORMAT
|
||||
(defn- render-path
|
||||
[{:keys [segments close?] :as shape}]
|
||||
(let [numsegs (count segments)]
|
||||
|
|
@ -45,10 +47,14 @@
|
|||
[props]
|
||||
(let [shape (unchecked-get props "shape")
|
||||
background? (unchecked-get props "background?")
|
||||
{:keys [id x y width height]} (geom/shape->rect-shape shape)
|
||||
;; {:keys [id x y width height]} (geom/shape->rect-shape shape)
|
||||
{:keys [id x y width height]} (:selrect shape)
|
||||
mask-id (mf/use-ctx mask-id-ctx)
|
||||
transform (geom/transform-matrix shape)
|
||||
pdata (render-path shape)
|
||||
pdata (if (:content shape)
|
||||
(ugp/content->path (:content shape))
|
||||
(render-path shape))
|
||||
|
||||
props (-> (attrs/extract-style-attrs shape)
|
||||
(obj/merge!
|
||||
#js {:transform transform
|
||||
|
|
|
|||
|
|
@ -181,7 +181,7 @@
|
|||
on-rotate (obj/get props "on-rotate")
|
||||
current-transform (mf/deref refs/current-transform)
|
||||
|
||||
selrect (geom/shape->rect-shape shape)
|
||||
selrect (:selrect shape)
|
||||
transform (geom/transform-matrix shape)
|
||||
|
||||
tr-shape (geom/transform-shape shape)]
|
||||
|
|
@ -269,8 +269,8 @@
|
|||
|
||||
(mf/defc multiple-selection-handlers
|
||||
[{:keys [shapes selected zoom color show-distances] :as props}]
|
||||
(let [shape (geom/selection-rect shapes)
|
||||
shape-center (geom/center shape)
|
||||
(let [shape (geom/setup {:type :rect} (geom/selection-rect shapes))
|
||||
shape-center (geom/center-shape shape)
|
||||
|
||||
hover-id (-> (mf/deref refs/current-hover) first)
|
||||
hover-id (when-not (d/seek #(= hover-id (:id %)) shapes) hover-id)
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@
|
|||
(let [shape (unchecked-get props "shape")
|
||||
frame (unchecked-get props "frame")
|
||||
selrect (-> shape :selrect)
|
||||
shape-center (geom/center shape)
|
||||
shape-center (geom/center-shape shape)
|
||||
line-color (rdcolor #js {:seed (str (:id shape))})
|
||||
zoom (mf/deref refs/selected-zoom)]
|
||||
[:g.bounding-box
|
||||
|
|
|
|||
|
|
@ -141,8 +141,9 @@
|
|||
(fn [[selrect selected frame]]
|
||||
(let [lt-side (if (= coord :x) :left :top)
|
||||
gt-side (if (= coord :x) :right :bottom)
|
||||
areas (gsh/selrect->areas (or (:selrect frame)
|
||||
(gsh/rect->rect-shape @refs/vbox)) selrect)
|
||||
container-selrec (or (:selrect frame)
|
||||
(gsh/rect->selrect @refs/vbox))
|
||||
areas (gsh/selrect->areas container-selrec selrect)
|
||||
query-side (fn [side]
|
||||
(->> (uw/ask! {:cmd :selection/query
|
||||
:page-id page-id
|
||||
|
|
|
|||
|
|
@ -232,8 +232,9 @@
|
|||
(st/emit! (ms/->MouseEvent :down ctrl? shift? alt?))
|
||||
(cond
|
||||
(and (= 1 (.-which event)))
|
||||
|
||||
(if drawing-tool
|
||||
(when (not= drawing-tool :comments)
|
||||
(when (not (#{:comments :path} drawing-tool))
|
||||
(st/emit! (dd/start-drawing drawing-tool)))
|
||||
(st/emit! dw/handle-selection))
|
||||
|
||||
|
|
|
|||
|
|
@ -15,8 +15,8 @@
|
|||
[app.util.worker :as uw]))
|
||||
|
||||
(defn on-error
|
||||
[instance error]
|
||||
(js/console.error "Error on worker" (.-data error)))
|
||||
[error]
|
||||
(js/console.error "Error on worker" error))
|
||||
|
||||
(defonce instance
|
||||
(when (not= *target* "nodejs")
|
||||
|
|
|
|||
|
|
@ -27,9 +27,9 @@
|
|||
(defn shape-snap-points
|
||||
[shape]
|
||||
(let [shape (gsh/transform-shape shape)
|
||||
shape-center (gsh/center shape)]
|
||||
shape-center (gsh/center-shape shape)]
|
||||
(if (= :frame (:type shape))
|
||||
(-> shape
|
||||
(gsh/shape->rect-shape)
|
||||
:selrect
|
||||
(frame-snap-points))
|
||||
(into #{shape-center} (:points shape)))))
|
||||
|
|
|
|||
|
|
@ -38,10 +38,12 @@
|
|||
(fn [event]
|
||||
(let [data (.-data event)
|
||||
data (t/decode data)]
|
||||
(rx/push! bus data))))
|
||||
(if (:error data)
|
||||
(on-error (:error data))
|
||||
(rx/push! bus data)))))
|
||||
(.addEventListener ins "error"
|
||||
(fn [error]
|
||||
(on-error wrk error)))
|
||||
(on-error wrk (.-data error))))
|
||||
|
||||
wrk))
|
||||
|
||||
|
|
|
|||
|
|
@ -65,8 +65,7 @@
|
|||
|
||||
(defn- create-index
|
||||
[objects]
|
||||
(let [shapes (->> (cph/select-toplevel-shapes objects {:include-frames? true})
|
||||
(map #(merge % (select-keys % [:x :y :width :height]))))
|
||||
(let [shapes (cph/select-toplevel-shapes objects {:include-frames? true})
|
||||
bounds (geom/selection-rect shapes)
|
||||
bounds #js {:x (:x bounds)
|
||||
:y (:y bounds)
|
||||
|
|
@ -77,7 +76,8 @@
|
|||
shapes)))
|
||||
|
||||
(defn- index-object
|
||||
[index {:keys [id x y width height] :as obj}]
|
||||
(let [rect #js {:x x :y y :width width :height height}]
|
||||
[index obj]
|
||||
(let [{:keys [id x y width height]} (:selrect obj)
|
||||
rect #js {:x x :y y :width width :height height}]
|
||||
(qdt/insert index rect obj)))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue