From 94c5004c332b932dc0e75df105d4488140b3f086 Mon Sep 17 00:00:00 2001
From: "alonso.torres" <alonso.torres@kaleidos.net>
Date: Tue, 23 Feb 2021 21:26:31 +0100
Subject: [PATCH] :sparkles: Improved geometry for rects

---
 common/app/common/geom/matrix.cljc            |  11 --
 common/app/common/geom/point.cljc             |   5 +
 .../app/main/data/workspace/svg_upload.cljs   |  83 ++++++------
 frontend/src/app/main/ui/shapes/attrs.cljs    |   3 +-
 frontend/src/app/main/ui/shapes/svg_defs.cljs |   5 +
 frontend/src/app/util/geom/path.cljs          | 127 ++++++++++++++----
 frontend/src/app/util/svg.cljs                |  82 ++++++++++-
 7 files changed, 228 insertions(+), 88 deletions(-)

diff --git a/common/app/common/geom/matrix.cljc b/common/app/common/geom/matrix.cljc
index 91f6ee6300..8b9c9a59dc 100644
--- a/common/app/common/geom/matrix.cljc
+++ b/common/app/common/geom/matrix.cljc
@@ -23,8 +23,6 @@
   (toString [_]
     (str "matrix(" a "," b "," c "," d "," e "," f ")")))
 
-(defonce matrix-regex #"matrix\((.*),(.*),(.*),(.*),(.*),(.*)\)")
-
 (defn matrix
   "Create a new matrix instance."
   ([]
@@ -32,13 +30,6 @@
   ([a b c d e f]
    (Matrix. a b c d e f)))
 
-(defn parse-matrix [mtx]
-  (let [[_ a b c d e f] (re-matches matrix-regex mtx)]
-    (->> [a b c d e f]
-         (map str/trim)
-         (map d/parse-double)
-         (apply matrix))))
-
 (defn multiply
   ([{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
     {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]
@@ -64,8 +55,6 @@
   [v]
   (instance? Matrix v))
 
-
-
 (def base (matrix))
 
 (defn base?
diff --git a/common/app/common/geom/point.cljc b/common/app/common/geom/point.cljc
index f55c2e37c6..11fff0f4b2 100644
--- a/common/app/common/geom/point.cljc
+++ b/common/app/common/geom/point.cljc
@@ -204,6 +204,11 @@
 (defn to-vec [p1 p2]
   (subtract p2 p1))
 
+(defn scale [v scalar]
+  (-> v
+      (update :x * scalar)
+      (update :y * scalar)))
+
 (defn dot [{x1 :x y1 :y} {x2 :x y2 :y}]
   (+ (* x1 x2) (* y1 y2)))
 
diff --git a/frontend/src/app/main/data/workspace/svg_upload.cljs b/frontend/src/app/main/data/workspace/svg_upload.cljs
index 18214357e9..bfe9cc6028 100644
--- a/frontend/src/app/main/data/workspace/svg_upload.cljs
+++ b/frontend/src/app/main/data/workspace/svg_upload.cljs
@@ -41,13 +41,6 @@
                     (nil? tag) "node"
                     :else (str tag))))
 
-(defn fix-dot-number
-  "Fixes decimal numbers starting in dot but without leading 0"
-  [num-str]
-  (if (str/starts-with? num-str ".")
-    (str "0" num-str)
-    num-str))
-
 (defn setup-fill [shape]
   (cond-> shape
     ;; Color present as attribute
@@ -97,7 +90,8 @@
           (-> (update-in [:svg-attrs :style] dissoc :stroke-width)
               (assoc :stroke-width (-> (get-in shape [:svg-attrs :style :stroke-width])
                                        (ud/parse-float)))))]
-    (if (d/any-key? shape :stroke-color :stroke-opacity :stroke-width)
+    shape
+    #_(if (d/any-key? shape :stroke-color :stroke-opacity :stroke-width)
       (merge default-stroke shape)
       shape)))
 
@@ -131,14 +125,13 @@
         (assoc :svg-attrs (-> (:attrs svg-data)
                               (dissoc :viewBox :xmlns))))))
 
-(defn apply-svg-transform [content transform-str]
-  (let [transform (gmt/parse-matrix transform-str)]
-    (gsh/transform-content content transform)))
-
 (defn create-path-shape [name frame-id svg-data {:keys [attrs] :as data}]
-  (let [content (cond-> (ugp/path->content (:d attrs))
-                  (contains? attrs :transform)
-                  (apply-svg-transform (:transform attrs)))
+  (let [svg-transform (usvg/parse-transform (:transform attrs))
+        content (cond-> (ugp/path->content (:d attrs))
+                  svg-transform
+                  (gsh/transform-content svg-transform))
+
+        attrs (d/update-when attrs :transform #(-> (usvg/parse-transform %) str))
 
         selrect (gsh/content->selrect content)
         points (gsh/rect->points selrect)]
@@ -151,7 +144,8 @@
          :points points}
         (assoc :svg-viewbox (select-keys selrect [:x :y :width :height]))
         (assoc :svg-attrs (dissoc attrs :d :transform))
-        #_(gsh/translate-to-frame svg-data))))
+        (assoc :svg-transform svg-transform)
+        (gsh/translate-to-frame svg-data))))
 
 (defn create-group [name frame-id svg-data {:keys [attrs]}]
   (let [{:keys [x y width height]} svg-data]
@@ -208,37 +202,42 @@
   (ptk/reify ::svg-uploaded
     ptk/WatchEvent
     (watch [_ state stream]
-      (let [page-id (:current-page-id state)
-            objects (dwc/lookup-page-objects state page-id)
-            frame-id (cp/frame-id-by-position objects {:x x :y y})
-            selected (get-in state [:workspace-local :selected])
+      (try
+        (let [page-id (:current-page-id state)
+              objects (dwc/lookup-page-objects state page-id)
+              frame-id (cp/frame-id-by-position objects {:x x :y y})
+              selected (get-in state [:workspace-local :selected])
 
-            [width height] (svg-dimensions svg-data)
-            x (- x (/ width 2))
-            y (- y (/ height 2))
+              [width height] (svg-dimensions svg-data)
+              x (- x (/ width 2))
+              y (- y (/ height 2))
 
-            unames (dwc/retrieve-used-names objects)
+              unames (dwc/retrieve-used-names objects)
 
-            svg-name (->> (str/replace (:name svg-data) ".svg" "")
-                          (dwc/generate-unique-name unames))
+              svg-name (->> (str/replace (:name svg-data) ".svg" "")
+                            (dwc/generate-unique-name unames))
 
-            ids-mappings (usvg/generate-id-mapping svg-data)
-            svg-data (-> svg-data
-                         (assoc :x x
-                                :y y
-                                :width width
-                                :height height
-                                :name svg-name))
+              ids-mappings (usvg/generate-id-mapping svg-data)
+              svg-data (-> svg-data
+                           (assoc :x x
+                                  :y y
+                                  :width width
+                                  :height height
+                                  :name svg-name))
 
-            [def-nodes svg-data] (usvg/extract-defs svg-data)
-            svg-data (assoc svg-data :defs def-nodes)
+              [def-nodes svg-data] (usvg/extract-defs svg-data)
+              svg-data (assoc svg-data :defs def-nodes)
 
-            root-shape (create-svg-root frame-id svg-data)
-            root-id (:id root-shape)
+              root-shape (create-svg-root frame-id svg-data)
+              root-id (:id root-shape)
 
-            changes (dwc/add-shape-changes page-id objects selected root-shape)
+              changes (dwc/add-shape-changes page-id objects selected root-shape)
 
-            reducer-fn (partial add-svg-child-changes page-id objects selected frame-id root-id svg-data ids-mappings)
-            [_ [rchanges uchanges]] (reduce reducer-fn [unames changes] (d/enumerate (:content svg-data)))]
-        (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
-               (dwc/select-shapes (d/ordered-set root-id)))))))
+              reducer-fn (partial add-svg-child-changes page-id objects selected frame-id root-id svg-data ids-mappings)
+              [_ [rchanges uchanges]] (reduce reducer-fn [unames changes] (d/enumerate (:content svg-data)))]
+          (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
+                 (dwc/select-shapes (d/ordered-set root-id))))
+
+        (catch :default e
+          (.error js/console e))
+        ))))
diff --git a/frontend/src/app/main/ui/shapes/attrs.cljs b/frontend/src/app/main/ui/shapes/attrs.cljs
index 1f4dde2ddb..36e10f2714 100644
--- a/frontend/src/app/main/ui/shapes/attrs.cljs
+++ b/frontend/src/app/main/ui/shapes/attrs.cljs
@@ -85,7 +85,8 @@
 
                      ;; If contains svg-attrs the origin is svg. If it's not svg origin
                      ;; we setup the default fill as transparent (instead of black)
-                     (not (contains? shape :svg-attrs))
+                     (and (not (contains? shape :svg-attrs))
+                          (not (= :svg-raw (:type shape))))
                      {:fill "transparent"}
 
                      :else
diff --git a/frontend/src/app/main/ui/shapes/svg_defs.cljs b/frontend/src/app/main/ui/shapes/svg_defs.cljs
index cd2ca9e6ea..e677aef9c7 100644
--- a/frontend/src/app/main/ui/shapes/svg_defs.cljs
+++ b/frontend/src/app/main/ui/shapes/svg_defs.cljs
@@ -84,12 +84,17 @@
 
 (mf/defc svg-defs [{:keys [shape render-id]}]
   (let [svg-defs (:svg-defs shape)
+        _ (when (:svg-transform shape) (.log js/console (str (:svg-transform shape))))
         transform (mf/use-memo
                    (mf/deps shape)
                    #(if (= :svg-raw (:type shape))
                       (gmt/matrix)
                       (usvg/svg-transform-matrix shape)))
 
+        ;;transform (gmt/multiply
+        ;;           transform
+        ;;           (:svg-transform shape (gmt/matrix)))
+
         prefix-id
         (fn [id]
           (cond->> id
diff --git a/frontend/src/app/util/geom/path.cljs b/frontend/src/app/util/geom/path.cljs
index 9a5440103c..b2ee450eb2 100644
--- a/frontend/src/app/util/geom/path.cljs
+++ b/frontend/src/app/util/geom/path.cljs
@@ -15,8 +15,17 @@
    [app.util.a2c :refer [a2c]]
    [app.util.data :as d]
    [app.util.geom.path-impl-simplify :as impl-simplify]
+   [app.util.svg :as usvg]
    [cuerdas.core :as str]))
 
+(defn calculate-opposite-handler
+  "Given a point and its handler, gives the symetric handler"
+  [point handler]
+  (let [handler-vector (gpt/to-vec point handler)]
+    (gpt/add point (gpt/negate handler-vector))))
+
+;;;
+
 (defn simplify
   ([points]
    (simplify points 0.1))
@@ -33,11 +42,6 @@
 
 (def flag-regex #"[01]")
 
-(defn fix-dot-number [val]
-  (if (str/starts-with? val ".")
-    (str "0" val)
-    val))
-
 (defn extract-params [cmd-str extract-commands]
   (loop [result []
          extract-idx 0
@@ -51,7 +55,7 @@
           match (re-find regex remain)]
 
       (if match
-        (let [value (-> match first fix-dot-number d/read-string)
+        (let [value (-> match first usvg/fix-dot-number d/read-string)
               remain (str/replace-first remain regex "")
               current (assoc current param value)
               extract-idx (inc extract-idx)
@@ -144,8 +148,8 @@
 
 (defmethod parse-command "S" [cmd]
   (let [relative (str/starts-with? cmd "s")
-        param-list (extract-params cmd [[:c1x :number]
-                                        [:c2y :number]
+        param-list (extract-params cmd [[:cx :number]
+                                        [:cy :number]
                                         [:x  :number]
                                         [:y  :number]])]
     (for [params param-list]
@@ -155,8 +159,8 @@
 
 (defmethod parse-command "Q" [cmd]
   (let [relative (str/starts-with? cmd "s")
-        param-list (extract-params cmd [[:c1x :number]
-                                        [:c1y :number]
+        param-list (extract-params cmd [[:cx :number]
+                                        [:cy :number]
                                         [:x   :number]
                                         [:y   :number]])]
     (for [params param-list]
@@ -203,12 +207,13 @@
         param-list (command->param-list entry)]
     (str/fmt "%s%s" command-str (str/join " " param-list))))
 
-(defn cmd-pos [{:keys [params]}]
-  (when (and (contains? params :x)
-             (contains? params :y))
-    (gpt/point params)))
+(defn cmd-pos [prev-pos {:keys [relative params]}]
+  (let [{:keys [x y] :or {x (:x prev-pos) y (:y prev-pos)}} params]
+    (if relative
+      (-> prev-pos (update :x + x) (update :y + y))
+      (gpt/point x y))))
 
-(defn arc->beziers [prev command]
+(defn arc->beziers [from-p command]
   (let [to-command
         (fn [[_ _ c1x c1y c2x c2y x y]]
           {:command :curve-to
@@ -217,7 +222,7 @@
                     :c2x c2x :c2y c2y
                     :x   x   :y   y}})
 
-        {from-x :x from-y :y} (:params prev)
+        {from-x :x from-y :y} from-p
         {:keys [rx ry x-axis-rotation large-arc-flag sweep-flag x y]} (:params command)
         result (a2c from-x from-y x y large-arc-flag sweep-flag rx ry x-axis-rotation)]
     
@@ -227,35 +232,99 @@
   "Removes some commands and convert relative to absolute coordinates"
   [commands]
 
-  (let [simplify-command
+  (let [smooth->curve (fn [{:keys [params]} pos]
+                        {:c1x (:x pos)
+                         :c1y (:y pos)
+                         :c2x (:cx params)
+                         :c2y (:cy params)})
+
+        quadratic->curve (fn [{:keys [params]} pos]
+                           (let [sp (gpt/point (:x pos) (:y pos)) ;; start point
+                                 ep (gpt/point (:x params) (:y params)) ;; end-point
+                                 cp (gpt/point (:cx params) (:cy params)) ;; control-point
+
+                                 cp1 (-> (gpt/to-vec sp cp)
+                                         (gpt/scale (/ 2 3))
+                                         (gpt/add sp))
+
+                                 cp2 (-> (gpt/to-vec ep cp)
+                                         (gpt/scale (/ 2 3))
+                                         (gpt/add ep))]
+
+                             {:c1x (:x cp1)
+                              :c1y (:y cp1)
+                              :c2x (:x cp2)
+                              :c2y (:y cp2)}))
+
+
+        smooth-quadratic->curve (fn [cmd {:keys [params]} pos]
+                                  (let [point (gpt/point (:x params) (:y params))
+                                        handler (gpt/point (:cx params) (:cy params))
+                                        oh (calculate-opposite-handler point handler)]
+                                    (quadratic->curve (update cmd :params assoc :cx (:x oh) :cy (:y oh)) pos)))
+        
+        simplify-command
         (fn [[pos result] [command prev]]
           (let [command
+                (cond-> command
+                  (:relative command)
+                  (-> (assoc :relative false)
+                      (cd/update-in-when [:params :c1x] + (:x pos))
+                      (cd/update-in-when [:params :c1y] + (:y pos))
+                      
+                      (cd/update-in-when [:params :c2x] + (:x pos))
+                      (cd/update-in-when [:params :c2y] + (:y pos))
+
+                      (cd/update-in-when [:params :cx] + (:x pos))
+                      (cd/update-in-when [:params :cy] + (:y pos))
+                      
+                      (cd/update-in-when [:params :x] + (:x pos))
+                      (cd/update-in-when [:params :y] + (:y pos))
+
+                      (cond->
+                        (= :line-to-horizontal (:command command))
+                        (cd/update-in-when [:params :value] + (:x pos))  
+                        
+                        (= :line-to-vertical (:command command))
+                        (cd/update-in-when [:params :value] + (:y pos)))))
+
+                params (:params command)
+                command
                 (cond-> command
                   (= :line-to-horizontal (:command command))
                   (-> (assoc :command :line-to)
                       (update :params dissoc :value)
-                      (assoc-in [:params :x] (get-in command [:params :value]))
-                      (assoc-in [:params :y] (if (:relative command) 0 (:y pos))))
+                      (assoc-in [:params :x] (:value params))
+                      (assoc-in [:params :y] (:y pos)))
 
                   (= :line-to-vertical (:command command))
                   (-> (assoc :command :line-to)
                       (update :params dissoc :value)
-                      (assoc-in [:params :y] (get-in command [:params :value]))
-                      (assoc-in [:params :x] (if (:relative command) 0 (:x pos))))
+                      (assoc-in [:params :y] (:value params))
+                      (assoc-in [:params :x] (:x pos)))
 
-                  (:relative command)
-                  (-> (assoc :relative false)
-                      (cd/update-in-when [:params :x] + (:x pos))
-                      (cd/update-in-when [:params :y] + (:y pos))))
+                  (= :smooth-curve-to (:command command))
+                  (-> (assoc :command :curve-to)
+                      (update :params dissoc :cx :cy)
+                      (update :params merge (smooth->curve command pos)))
+
+                  (= :quadratic-bezier-curve-to (:command command))
+                  (-> (assoc :command :curve-to)
+                      (update :params dissoc :cx :cy)
+                      (update :params merge (quadratic->curve command pos)))
+
+                  (= :smooth-quadratic-bezier-curve-to (:command command))
+                  (-> (assoc :command :curve-to)
+                      (update :params merge (smooth-quadratic->curve command prev pos))))
                 
                 result #_(conj result command)
                 (if (= :elliptical-arc (:command command))
-                         (cd/concat result (arc->beziers prev command))
-                         (conj result command))]
-            [(cmd-pos command) result]))
+                  (cd/concat result (arc->beziers pos command))
+                  (conj result command))]
+            [(cmd-pos pos command) result]))
 
         start (first commands)
-        start-pos (cmd-pos start)]
+        start-pos (gpt/point (:params start))]
 
     
     (->> (map vector (rest commands) commands)
diff --git a/frontend/src/app/util/svg.cljs b/frontend/src/app/util/svg.cljs
index 5e77c4529f..08cc1ef38f 100644
--- a/frontend/src/app/util/svg.cljs
+++ b/frontend/src/app/util/svg.cljs
@@ -10,7 +10,7 @@
 (ns app.util.svg
   (:require
    [app.common.uuid :as uuid]
-   [app.common.data :as cd]
+   [app.common.data :as d]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes :as gsh]
@@ -22,6 +22,19 @@
   (->> (re-seq replace-regex val)
        (mapv second)))
 
+(defn fix-dot-number
+  "Fixes decimal numbers starting in dot but without leading 0"
+  [num-str]
+  (cond
+    (str/starts-with? num-str ".")
+    (str "0" num-str)
+
+    (str/starts-with? num-str "-.")
+    (str "-0" (subs num-str 1))
+
+    :else
+    num-str))
+
 (defn clean-attrs
   "Transforms attributes to their react equivalent"
   [attrs]
@@ -59,7 +72,7 @@
   (letfn [(update-ids [key val]
             (cond
               (map? val)
-              (cd/mapm update-ids val)
+              (d/mapm update-ids val)
 
               (= key :id)
               (replace-fn val)
@@ -69,7 +82,7 @@
                     (fn [result it]
                       (str/replace result it (replace-fn it)))]
                 (reduce replace-id val (extract-ids val)))))]
-    (cd/mapm update-ids attrs)))
+    (d/mapm update-ids attrs)))
 
 (defn replace-attrs-ids
   "Replaces the ids inside a property"
@@ -119,7 +132,7 @@
 (defn find-node-references [node]
   (let [current (->> (find-attr-references (:attrs node)) (into #{}))
         children (->> (:content node) (map find-node-references) (flatten) (into #{}))]
-    (-> (cd/concat current children)
+    (-> (d/concat current children)
         (vec))))
 
 (defn find-def-references [defs references]
@@ -141,7 +154,7 @@
       :else
       (let [node (get defs to-check)
             new-refs (find-node-references node)]
-        (recur (cd/concat result new-refs)
+        (recur (d/concat result new-refs)
                (conj checked? to-check)
                (first pending)
                (rest pending))))))
@@ -166,3 +179,62 @@
     ;; :else
     (gmt/matrix)))
 
+;; Parse transform attributes to native matrix format so we can transform paths instead of
+;; relying in SVG transformation. This is necessary to import SVG's and not to break path tooling
+;;
+;; Transforms spec:
+;; https://www.w3.org/TR/SVG11/single-page.html#coords-TransformAttribute
+
+(def matrices-regex #"(matrix|translate|scale|rotate|skewX|skewY)\(([^\)]*)\)")
+(def params-regex #"[+-]?\d*(\.\d+)?(e[+-]?\d+)?")
+
+(defn format-translate-params [params]
+  (assert (or (= (count params) 1) (= (count params) 2)))
+  (if (= (count params) 1)
+    [(gpt/point (nth params 0))]
+    [(gpt/point (nth params 0) (nth params 1))]))
+
+(defn format-scale-params [params]
+  (assert (or (= (count params) 1) (= (count params) 2)))
+  (if (= (count params) 1)
+    [(gpt/point (nth params 0))]
+    [(gpt/point (nth params 0) (nth params 1))]))
+
+(defn format-rotate-params [params]
+  (assert (or (= (count params) 1) (= (count params) 3)) (str "??" (count params)))
+  (if (= (count params) 1)
+    [(nth params 0)]
+    [(nth params 0) (gpt/point (nth params 1) (nth params 2))]))
+
+(defn format-skew-x-params [params]
+  (assert (= (count params) 1))
+  [(nth params 0) 0])
+
+(defn format-skew-y-params [params]
+  (assert (= (count params) 1))
+  [0 (nth params 0)])
+
+(defn to-matrix [{:keys [type params]}]
+  (assert (#{"matrix" "translate" "scale" "rotate" "skewX" "skewY"} type))
+  (case type
+    "matrix"    (apply gmt/matrix params)
+    "translate" (apply gmt/translate-matrix (format-translate-params params))
+    "scale"     (apply gmt/scale-matrix (format-scale-params params))
+    "rotate"    (apply gmt/rotate-matrix (format-rotate-params params))
+    "skewX"     (apply gmt/skew-matrix (format-skew-x-params params))
+    "skewY"     (apply gmt/skew-matrix (format-skew-y-params params))))
+
+(defn parse-transform [transform-attr]
+  (when transform-attr
+    (let [process-matrix
+          (fn [[_ type params]]
+            (let [params (->> (re-seq params-regex params)
+                              (filter #(-> % first empty? not))
+                              (map (comp d/parse-double first)))]
+              {:type type :params params}))
+
+          matrices (->> (re-seq matrices-regex transform-attr)
+                        (map process-matrix)
+                        (map to-matrix))]
+      (reduce gmt/multiply (gmt/matrix) matrices))))
+