Merge pull request #2725 from penpot/alotor-bug-fixing

Bug fixing

common/src/app/common/geom/shapes/modifiers.cljc

@@ -317,33 +317,47 @@
       modif-tree)))
 
 (defn set-objects-modifiers
-  [modif-tree objects ignore-constraints snap-pixel?]
+  ([modif-tree objects ignore-constraints snap-pixel?]
+   (set-objects-modifiers nil modif-tree objects ignore-constraints snap-pixel?))
 
-  (let [objects (apply-structure-modifiers objects modif-tree)
+  ([old-modif-tree modif-tree objects ignore-constraints snap-pixel?]
+   (let [objects (-> objects
+                     (cond-> (some? old-modif-tree)
+                       (apply-structure-modifiers old-modif-tree))
+                     (apply-structure-modifiers modif-tree))
 
-        bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
-        shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
+         bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
+         bounds (cond-> bounds
+                  (some? old-modif-tree)
+                  (transform-bounds objects old-modif-tree))
 
-        ;; Calculate the input transformation and constraints
-        modif-tree (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree)
-        bounds (transform-bounds bounds objects modif-tree shapes-tree)
+         shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
 
-        [modif-tree-layout sizing-auto-layouts]
-        (reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}] shapes-tree)
+         ;; Calculate the input transformation and constraints
+         modif-tree (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree)
+         bounds (transform-bounds bounds objects modif-tree shapes-tree)
 
-        modif-tree (merge-modif-tree modif-tree modif-tree-layout)
+         [modif-tree-layout sizing-auto-layouts]
+         (reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}] shapes-tree)
 
-        ;; Calculate hug layouts positions
-        bounds (transform-bounds bounds objects modif-tree-layout shapes-tree)
+         modif-tree (merge-modif-tree modif-tree modif-tree-layout)
 
-        modif-tree
-        (-> modif-tree
-            (sizing-auto-modifiers sizing-auto-layouts objects bounds ignore-constraints))
+         ;; Calculate hug layouts positions
+         bounds (transform-bounds bounds objects modif-tree-layout shapes-tree)
 
-        modif-tree
-        (cond-> modif-tree
-          snap-pixel? (gpp/adjust-pixel-precision objects))]
+         modif-tree
+         (-> modif-tree
+             (sizing-auto-modifiers sizing-auto-layouts objects bounds ignore-constraints))
 
-    ;;#?(:cljs
-    ;;   (.log js/console ">result" (modif->js modif-tree objects)))
-    modif-tree))
+         modif-tree
+         (if old-modif-tree
+           (merge-modif-tree old-modif-tree modif-tree)
+           modif-tree)
+
+         modif-tree
+         (cond-> modif-tree
+           snap-pixel? (gpp/adjust-pixel-precision objects))]
+
+     ;;#?(:cljs
+     ;;   (.log js/console ">result" (modif->js modif-tree objects)))
+     modif-tree)))

common/src/app/common/geom/shapes/transforms.cljc

@@ -111,10 +111,10 @@
        (cond-> (some? transform)
          (gmt/multiply transform))
 
-       (cond-> (and flip-x (not no-flip))
+       (cond-> (and flip-x no-flip)
          (gmt/scale (gpt/point -1 1)))
 
-       (cond-> (and flip-y (not no-flip))
+       (cond-> (and flip-y no-flip)
          (gmt/scale (gpt/point 1 -1)))
 
        (gmt/translate (gpt/negate shape-center)))))
@@ -126,8 +126,8 @@
   ([{:keys [transform flip-x flip-y] :as shape} {:keys [no-flip] :as params}]
    (if (and (some? shape)
             (or (some? transform)
-                (and (not no-flip) flip-x)
-                (and (not no-flip) flip-y)))
+                (and no-flip flip-x)
+                (and no-flip flip-y)))
      (dm/str (transform-matrix shape params))
      "")))
 

frontend/deps.edn

@@ -9,7 +9,7 @@
 
   funcool/beicon {:mvn/version "2021.07.05-1"}
   funcool/okulary {:mvn/version "2022.04.11-16"}
-  funcool/potok {:mvn/version "2022.04.28-67"}
+  funcool/potok {:mvn/version "2022.12.16-71"}
   funcool/tubax {:mvn/version "2021.05.20-0"}
 
   funcool/rumext

frontend/src/app/main/data/workspace/modifiers.cljs

@@ -190,26 +190,27 @@
                            [(get-in objects [k :name]) v]))
                     modif-tree)))
 
+(defn apply-text-modifier
+  [shape {:keys [width height]}]
+  (cond-> shape
+    (some? width)
+    (assoc :width width)
+
+    (some? height)
+    (assoc :height height)
+
+    (or (some? width) (some? height))
+    (cts/setup-rect-selrect)))
+
 (defn apply-text-modifiers
   [objects text-modifiers]
-  (letfn [(apply-text-modifier
-            [shape {:keys [width height]}]
-            (cond-> shape
-              (some? width)
-              (assoc :width width)
-
-              (some? height)
-              (assoc :height height)
-
-              (or (some? width) (some? height))
-              (cts/setup-rect-selrect)))]
-    (loop [modifiers (seq text-modifiers)
-           result objects]
-      (if (empty? modifiers)
-        result
-        (let [[id text-modifier] (first modifiers)]
-          (recur (rest modifiers)
-                 (update objects id apply-text-modifier text-modifier)))))))
+  (loop [modifiers (seq text-modifiers)
+         result objects]
+    (if (empty? modifiers)
+      result
+      (let [[id text-modifier] (first modifiers)]
+        (recur (rest modifiers)
+               (update objects id apply-text-modifier text-modifier))))))
 
 #_(defn apply-path-modifiers
   [objects path-modifiers]
@@ -242,6 +243,33 @@
        ;;(apply-path-modifiers $ (get-in state [:workspace-local :edit-path]))
        (gsh/set-objects-modifiers modif-tree $ ignore-constraints snap-pixel?)))))
 
+(defn- calculate-update-modifiers
+  [old-modif-tree state ignore-constraints ignore-snap-pixel modif-tree]
+  (let [objects
+        (wsh/lookup-page-objects state)
+
+        snap-pixel?
+        (and (not ignore-snap-pixel) (contains? (:workspace-layout state) :snap-pixel-grid))
+
+        objects
+        (-> objects
+            (apply-text-modifiers (get state :workspace-text-modifier)))]
+
+    (gsh/set-objects-modifiers  old-modif-tree modif-tree objects ignore-constraints snap-pixel?)))
+
+(defn update-modifiers
+  ([modif-tree]
+   (update-modifiers modif-tree false))
+
+  ([modif-tree ignore-constraints]
+   (update-modifiers modif-tree ignore-constraints false))
+
+  ([modif-tree ignore-constraints ignore-snap-pixel]
+   (ptk/reify ::update-modifiers
+     ptk/UpdateEvent
+     (update [_ state]
+       (update state :workspace-modifiers calculate-update-modifiers state ignore-constraints ignore-snap-pixel modif-tree)))))
+
 (defn set-modifiers
   ([modif-tree]
    (set-modifiers modif-tree false))

frontend/src/app/main/data/workspace/persistence.cljs

@@ -30,6 +30,7 @@
 (declare persist-changes)
 (declare persist-synchronous-changes)
 (declare shapes-changes-persisted)
+(declare shapes-changes-persisted-finished)
 (declare update-persistence-status)
 
 ;; --- Persistence
@@ -42,6 +43,7 @@
       (log/debug :hint "initialize persistence")
       (let [stoper   (rx/filter (ptk/type? ::initialize-persistence) stream)
             commits  (l/atom [])
+            saving?  (l/atom false)
 
             local-file?
             #(as-> (:file-id %) event-file-id
@@ -61,13 +63,15 @@
 
             on-saving
             (fn []
+              (reset! saving? true)
               (st/emit! (update-persistence-status {:status :saving})))
 
             on-saved
             (fn []
               ;; Disable reload stoper
               (swap! st/ongoing-tasks disj :workspace-change)
-              (st/emit! (update-persistence-status {:status :saved})))]
+              (st/emit! (update-persistence-status {:status :saved}))
+              (reset! saving? false))]
 
         (rx/merge
          (->> stream
@@ -88,12 +92,15 @@
 
          (->> (rx/from-atom commits)
               (rx/filter (complement empty?))
-              (rx/sample-when (rx/merge
-                               (rx/interval 5000)
-                               (rx/filter #(= ::force-persist %) stream)
-                               (->> (rx/from-atom commits)
-                                    (rx/filter (complement empty?))
-                                    (rx/debounce 2000))))
+              (rx/sample-when
+               (->> (rx/merge
+                     (rx/interval 5000)
+                     (rx/filter #(= ::force-persist %) stream)
+                     (->> (rx/from-atom commits)
+                          (rx/filter (complement empty?))
+                          (rx/debounce 2000)))
+                    ;; Not sample while saving so there are no race conditions
+                    (rx/filter #(not @saving?))))
               (rx/tap #(reset! commits []))
               (rx/tap on-saving)
               (rx/mapcat (fn [changes]
@@ -101,9 +108,11 @@
                            ;; next persistence before this one is
                            ;; finished.
                            (rx/merge
-                            (rx/of (persist-changes file-id changes))
+                            (->> (rx/of (persist-changes file-id changes commits))
+                                 (rx/observe-on :async))
                             (->> stream
-                                 (rx/filter (ptk/type? ::changes-persisted))
+                                 ;; We wait for every change to be persisted
+                                 (rx/filter (ptk/type? ::shapes-changes-persisted-finished))
                                  (rx/take 1)
                                  (rx/tap on-saved)
                                  (rx/ignore)))))
@@ -123,7 +132,7 @@
                              (log/debug :hint "finalize persistence: synchronous save loop")))))))))
 
 (defn persist-changes
-  [file-id changes]
+  [file-id changes pending-commits]
   (log/debug :hint "persist changes" :changes (count changes))
   (us/verify ::us/uuid file-id)
   (ptk/reify ::persist-changes
@@ -150,20 +159,29 @@
                             (log/debug :hint "changes persisted" :lagged (count lagged))
                             (let [frame-updates
                                   (-> (group-by :page-id changes)
-                                      (update-vals #(into #{} (mapcat :frames) %)))]
+                                      (update-vals #(into #{} (mapcat :frames) %)))
 
-                              (rx/merge
-                               (->> (rx/from frame-updates)
-                                    (rx/mapcat (fn [[page-id frames]]
-                                                 (->> frames (map #(vector page-id %)))))
-                                    (rx/map (fn [[page-id frame-id]] (dwt/update-thumbnail (:id file) page-id frame-id))))
-                               (->> (rx/from lagged)
-                                    (rx/merge-map (fn [{:keys [changes] :as entry}]
-                                                    (rx/merge
-                                                     (rx/from
-                                                      (for [[page-id changes] (group-by :page-id changes)]
-                                                        (dch/update-indices page-id changes)))
-                                                     (rx/of (shapes-changes-persisted file-id entry))))))))))
+                                  commits
+                                  (->> @pending-commits
+                                       (map #(assoc % :revn (:revn file))))]
+
+                              (rx/concat
+                               (rx/merge
+                                (->> (rx/from frame-updates)
+                                     (rx/mapcat (fn [[page-id frames]]
+                                                  (->> frames (map #(vector page-id %)))))
+                                     (rx/map (fn [[page-id frame-id]] (dwt/update-thumbnail (:id file) page-id frame-id))))
+
+                                (->> (rx/from (concat lagged commits))
+                                     (rx/merge-map
+                                      (fn [{:keys [changes] :as entry}]
+                                        (rx/merge
+                                         (rx/from
+                                          (for [[page-id changes] (group-by :page-id changes)]
+                                            (dch/update-indices page-id changes)))
+                                         (rx/of (shapes-changes-persisted file-id entry)))))))
+
+                               (rx/of (shapes-changes-persisted-finished))))))
                (rx/catch (fn [cause]
                            (rx/concat
                             (if (= :authentication (:type cause))
@@ -171,6 +189,11 @@
                               (rx/of (rt/assign-exception cause)))
                             (rx/throw cause))))))))))
 
+;; Event to be thrown after the changes have been persisted
+(defn shapes-changes-persisted-finished
+  []
+  (ptk/reify ::shapes-changes-persisted-finished))
+
 (defn persist-synchronous-changes
   [{:keys [file-id changes]}]
   (us/verify ::us/uuid file-id)

frontend/src/app/main/data/workspace/texts.cljs

@@ -408,8 +408,7 @@
                       (not (mth/close? (:height props) current-height))))
 
            (let [modif-tree (dwm/create-modif-tree [id] (ctm/reflow-modifiers))]
-             (->> (rx/of (dwm/set-modifiers modif-tree))
-                  (rx/observe-on :async)))
+             (rx/of (dwm/update-modifiers modif-tree)))
            (rx/empty)))))))
 
 (defn clean-text-modifier

frontend/src/app/main/store.cljs

@@ -23,8 +23,22 @@
   [type data]
   (ptk/data-event type data))
 
+;;(def debug-exclude-events
+;;  #{:app.main.data.workspace.notifications/handle-pointer-update
+;;    :app.main.data.workspace.notifications/handle-pointer-send
+;;    :app.main.data.workspace.persistence/update-persistence-status
+;;    :app.main.data.workspace.changes/update-indices
+;;    :app.main.data.websocket/send-message
+;;    :app.main.data.workspace.selection/change-hover-state})
+;; (def ^:dynamic *debug-events* false)
+
 (defonce state
   (ptk/store {:resolve ptk/resolve
+              ;;:on-event (fn [e]
+              ;;            (when (and *debug-events*
+              ;;                       (ptk/event? e)
+              ;;                       (not (debug-exclude-events (ptk/type e))))
+              ;;              (.log js/console (str "[stream]: " (ptk/repr-event e)) )))
               :on-error (fn [e] (@on-error e))}))
 
 (defonce stream

frontend/src/app/main/ui/shapes/text/svg_text.cljs

@@ -8,8 +8,6 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.geom.matrix :as gmt]
-   [app.common.geom.point :as gpt]
    [app.common.geom.shapes :as gsh]
    [app.config :as cf]
    [app.main.ui.context :as muc]
@@ -32,23 +30,6 @@
         (d/update-when :position-data #(mapv update-color %))
         (assoc :stroke-color "#FFFFFF" :stroke-opacity 1))))
 
-(defn position-data-transform
-  [shape {:keys [x y width height]}]
-  (let [rect (gsh/make-rect x (- y height) width height)
-        center (gsh/center-rect rect)]
-    (when (or (:flip-x shape) (:flip-y shape))
-      (-> (gmt/matrix)
-          (gmt/translate center)
-
-          (cond-> (:flip-x shape)
-            (gmt/scale (gpt/point -1 1))
-
-            (:flip-y shape)
-            (gmt/scale (gpt/point 1 -1)))
-
-          (gmt/translate (gpt/negate center))
-          (dm/str)))))
-
 (mf/defc text-shape
   {::mf/wrap-props false
    ::mf/wrap [mf/memo]}
@@ -60,7 +41,7 @@
 
         {:keys [x y width height position-data]} shape
 
-        transform (gsh/transform-str shape {:no-flip true})
+        transform (gsh/transform-str shape)
 
         ;; These position attributes are not really necessary but they are convenient for for the export
         group-props (-> #js {:transform transform
@@ -96,7 +77,6 @@
                              :y (- (:y data) (:height data))
                              :textLength (:width data)
                              :lengthAdjust "spacingAndGlyphs"
-                             :transform (position-data-transform shape data)
                              :alignmentBaseline alignment-bl
                              :dominantBaseline dominant-bl
                              :style (-> #js {:fontFamily (:font-family data)

frontend/src/app/main/ui/workspace/shapes/text.cljs

@@ -39,7 +39,7 @@
       [:& text/text-shape {:shape shape}]]
 
      (when (and (debug? :text-outline) (d/not-empty? (:position-data shape)))
-       [:g {:transform (gsh/transform-str shape {:no-flip true})}
+       [:g {:transform (gsh/transform-str shape)}
         (let [bounding-box (gsht/position-data-selrect shape)]
           [:rect {
                   :x (:x bounding-box)

frontend/src/app/main/ui/workspace/shapes/text/text_edition_outline.cljs

@@ -28,7 +28,7 @@
                 (some? text-modifier)
                 (dwt/apply-text-modifier text-modifier))
 
-        transform (gsh/transform-str shape {:no-flip true})
+        transform (gsh/transform-str shape)
         {:keys [x y width height]} shape]
 
     [:rect.main.viewport-selrect

frontend/src/app/main/ui/workspace/viewport/selection.cljs

@@ -272,7 +272,7 @@
         current-transform (mf/deref refs/current-transform)
 
         selrect (:selrect shape)
-        transform (gsh/transform-str shape {:no-flip true})]
+        transform (gsh/transform-str shape)]
 
     (when (not (#{:move :rotate} current-transform))
       [:g.controls {:pointer-events (if disable-handlers "none" "visible")}
@@ -297,7 +297,7 @@
         workspace-read-only? (mf/use-ctx ctx/workspace-read-only?)
 
         selrect (:selrect shape)
-        transform (gsh/transform-matrix shape {:no-flip true})
+        transform (gsh/transform-matrix shape)
 
         rotation (-> (gpt/point 1 0)
                      (gpt/transform (:transform shape))
@@ -309,7 +309,22 @@
       [:g.controls {:pointer-events (if disable-handlers "none" "visible")}
        ;; Handlers
        (for [{:keys [type position props]} (handlers-for-selection selrect shape zoom)]
-         (let [common-props {:key (dm/str (name type) "-" (name position))
+         (let [rotation
+               (cond
+                 (and (#{:top-left :bottom-right} position)
+                      (or (and (:flip-x shape) (not (:flip-y shape)))
+                          (and (:flip-y shape) (not (:flip-x shape)))))
+                 (- rotation 90)
+
+                 (and (#{:top-right :bottom-left} position)
+                      (or (and (:flip-x shape) (not (:flip-y shape)))
+                          (and (:flip-y shape) (not (:flip-x shape)))))
+                 (+ rotation 90)
+
+                 :else
+                 rotation)
+
+               common-props {:key (dm/str (name type) "-" (name position))
                              :zoom zoom
                              :position position
                              :on-rotate on-rotate