✨ Support for multi-track span in cells

common/src/app/common/geom/shapes/grid_layout/areas.cljc

@@ -0,0 +1,95 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+;; Based on the code in:
+;; https://en.wikibooks.org/wiki/Algorithm_Implementation/Geometry/Rectangle_difference
+(ns app.common.geom.shapes.grid-layout.areas
+  (:refer-clojure :exclude [contains?]))
+
+(defn area->cell-props [[column row column-span row-span]]
+  {:row row
+   :column column
+   :row-span row-span
+   :column-span column-span})
+
+(defn make-area
+  ([{:keys [column row column-span row-span]}]
+   (make-area column row column-span row-span))
+  ([x y width height]
+   [x y width height]))
+
+(defn contains?
+  [[a-x a-y a-width a-height :as a]
+   [b-x b-y b-width b-height :as b]]
+  (and (>= b-x a-x)
+       (>= b-y a-y)
+       (<= (+ b-x b-width) (+ a-x a-width))
+       (<= (+ b-y b-height) (+ a-y a-height))))
+
+(defn intersects?
+  [[a-x a-y a-width a-height ]
+   [b-x b-y b-width b-height]]
+  (not (or (<= (+ b-x b-width) a-x)
+           (<= (+ b-y b-height) a-y)
+           (>= b-x (+ a-x a-width))
+           (>= b-y (+ a-y a-height)))))
+
+(defn top-rect
+  [[a-x a-y a-width _]
+   [_ b-y _ _]]
+  (let [height (- b-y a-y)]
+    (when (> height 0)
+      (make-area a-x a-y a-width height))))
+
+(defn bottom-rect
+  [[a-x a-y a-width a-height]
+   [_ b-y _ b-height]]
+
+  (let [y (+ b-y b-height)
+        height (- a-height (- y a-y))]
+    (when (and (> height 0) (< y (+ a-y a-height)))
+      (make-area a-x y a-width height))))
+
+(defn left-rect
+  [[a-x a-y _ a-height]
+   [b-x b-y _ b-height]]
+
+  (let [rb-y (+ b-y b-height)
+        ra-y (+ a-y a-height)
+        y1 (max a-y b-y)
+        y2 (min ra-y rb-y)
+        height (- y2 y1)
+        width (- b-x a-x)]
+    (when (and (> width 0) (> height 0))
+      (make-area a-x y1 width height))))
+
+(defn right-rect
+  [[a-x a-y a-width a-height]
+   [b-x b-y b-width b-height]]
+
+  (let [rb-y (+ b-y b-height)
+        ra-y (+ a-y a-height)
+        y1 (max a-y b-y)
+        y2 (min ra-y rb-y)
+        height (- y2 y1)
+        rb-x (+ b-x b-width)
+        width (- a-width (- rb-x a-x))
+        ]
+    (when (and (> width 0) (> height 0))
+      (make-area rb-x y1 width height)))
+  )
+
+(defn difference
+  [area-a area-b]
+  (if (or (nil? area-b)
+          (not (intersects? area-a area-b))
+          (contains? area-b area-a))
+    []
+
+    (into []
+          (keep #(% area-a area-b))
+          [top-rect left-rect right-rect bottom-rect])))
+ 

common/src/app/common/geom/shapes/grid_layout/layout_data.cljc

@@ -49,8 +49,6 @@
 ;;
 ;; - Stretch auto tracks
 
-
-
 (ns app.common.geom.shapes.grid-layout.layout-data
   (:require
    [app.common.geom.point :as gpt]
@@ -62,47 +60,6 @@
   (let [[pad-top pad-right pad-bottom pad-left] (ctl/paddings parent)]
     (gpo/pad-points shape-bounds pad-top pad-right pad-bottom pad-left)))
 
-#_(defn set-sample-data
-  [parent children]
-
-  (let [parent (assoc parent
-                      :layout-grid-columns
-                      [{:type :percent :value 25}
-                       {:type :percent :value 25}
-                       {:type :fixed :value 100}
-                       ;;{:type :auto}
-                       ;;{:type :flex :value 1}
-                       ]
-
-                      :layout-grid-rows
-                      [{:type :percent :value 50}
-                       {:type :percent :value 50}
-                       ;;{:type :fixed :value 100}
-                       ;;{:type :auto}
-                       ;;{:type :flex :value 1}
-                       ])
-
-        num-rows (count (:layout-grid-rows parent))
-        num-columns (count (:layout-grid-columns parent))
-
-        layout-grid-cells
-        (into
-         {}
-         (for [[row-idx _row] (d/enumerate (:layout-grid-rows parent))
-               [col-idx _col] (d/enumerate (:layout-grid-columns parent))]
-           (let [[_bounds shape] (nth children (+ (* row-idx num-columns) col-idx) nil)
-                 cell-data {:id (uuid/next)
-                            :row (inc row-idx)
-                            :column (inc col-idx)
-                            :row-span 1
-                            :col-span 1
-                            :shapes (when shape [(:id shape)])}]
-             [(:id cell-data) cell-data])))
-
-        parent (assoc parent :layout-grid-cells layout-grid-cells)]
-
-    [parent children]))
-
 (defn calculate-initial-track-size
   [total-value {:keys [type value] :as track}]
 
@@ -119,7 +76,6 @@
           [0.01 ##Inf])]
     (assoc track :size size :max-size max-size)))
 
-
 (defn set-auto-base-size
   [track-list children shape-cells type]
 
@@ -280,7 +236,6 @@
                         (gpt/add start-p (vv (+ size row-gap)))])
                      [[] start-p])
              (first))
-
         ]
 
     {:origin start-p
@@ -288,6 +243,8 @@
      :row-tracks row-tracks
      :column-tracks column-tracks
      :shape-cells shape-cells
+     :column-gap column-gap
+     :row-gap row-gap
 
      ;; Convenient informaton for visualization
      :column-total-size column-total-size
@@ -300,7 +257,6 @@
   [{:keys [origin row-tracks column-tracks shape-cells]} _transformed-parent-bounds [_ child]]
 
   (let [grid-cell (get shape-cells (:id child))]
-
     (when (some? grid-cell)
       (let [column (nth column-tracks (dec (:column grid-cell)) nil)
             row (nth row-tracks (dec (:row grid-cell)) nil)
@@ -311,7 +267,7 @@
             start-p (gpt/add origin
                              (gpt/add
                               (gpt/to-vec origin column-start-p)
-                              (gpt/to-vec origin row-start-p)))
-            ]
+                              (gpt/to-vec origin row-start-p)))]
 
         (assoc grid-cell :start-p  start-p)))))
+

common/src/app/common/types/shape/layout.cljc

@@ -8,6 +8,7 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.geom.shapes.grid-layout.areas :as sga]
    [app.common.math :as mth]
    [app.common.schema :as sm]
    [app.common.uuid :as uuid]))
@@ -673,12 +674,6 @@
         (update :layout-grid-cells remove-cells)
         (assign-cells))))
 
-;; TODO: Mix the cells given as arguments leaving only one. It should move all the shapes in those cells in the direction for the grid
-;; and lastly use assign-cells to reassing the orphaned shapes
-(defn merge-cells
-  [parent _cells]
-  parent)
-
 (defn get-cells
   ([parent]
    (get-cells parent nil))
@@ -815,31 +810,128 @@
         [(assoc-in parent [:layout-grid-cells (get-in cells [index :id]) :shapes] [])
          (assoc-in result-cells [index :shapes] [])]))))
 
+
+(defn in-cell?
+  "Given a cell check if the row+column is inside this cell"
+  [{cell-row :row cell-column :column :keys [row-span column-span]} row column]
+  (and (>= row cell-row)
+       (>= column cell-column)
+       (<= row (+ cell-row row-span -1))
+       (<= column (+ cell-column column-span -1))))
+
+(defn cell-by-row-column
+  [parent row column]
+  (->> (:layout-grid-cells parent)
+       (vals)
+       (d/seek #(in-cell? % row column))))
+
 (defn seek-indexed-cell
   [cells row column]
   (let [cells+index (d/enumerate cells)]
-    (d/seek (fn [[_ {cell-row :row cell-column :column}]]
-              (and (= cell-row row)
-                   (= cell-column column))) cells+index)))
+    (d/seek #(in-cell? (second %) row column) cells+index)))
 
 (defn push-into-cell
   "Push the shapes into the row/column cell and moves the rest"
   [parent shape-ids row column]
 
   (let [cells (vec (get-cells parent {:sort? true}))
-        cells+index (d/enumerate cells)
+        [start-index start-cell] (seek-indexed-cell cells row column)]
 
-        [start-index _] (seek-indexed-cell cells row column)
+    (if (some? start-cell)
+      (let [ ;; start-index => to-index is the range where the shapes inserted will be added
+            to-index (min (+ start-index (count shape-ids)) (dec (count cells)))]
 
-        ;; start-index => to-index is the range where the shapes inserted will be added
-        to-index (min (+ start-index (count shape-ids)) (dec (count cells)))]
+        ;; Move shift the `shapes` attribute between cells
+        (->> (range start-index (inc to-index))
+             (map vector shape-ids)
+             (reduce (fn [[parent cells] [shape-id idx]]
+                       (let [[parent cells] (free-cell-push parent cells idx)]
+                         [(assoc-in parent [:layout-grid-cells (get-in cells [idx :id]) :shapes] [shape-id])
+                          cells]))
+                     [parent cells])
+             (first)))
+      parent)))
 
-    ;; Move shift the `shapes` attribute between cells
-    (->> (range start-index (inc to-index))
-         (map vector shape-ids)
-         (reduce (fn [[parent cells] [shape-id idx]]
-                   (let [[parent cells] (free-cell-push parent cells idx)]
-                     [(assoc-in parent [:layout-grid-cells (get-in cells [idx :id]) :shapes] [shape-id])
-                      cells]))
-                 [parent cells])
-         (first))))
+(defn resize-cell-area
+  "Increases/decreases the cell size"
+  [parent row column new-row new-column new-row-span new-column-span]
+
+  (let [cells (vec (get-cells parent {:sort? true}))
+
+        prev-cell (cell-by-row-column parent row column)
+        prev-area (sga/make-area prev-cell)
+
+        target-cell
+        (-> prev-cell
+            (assoc
+             :row new-row
+             :column new-column
+             :row-span new-row-span
+             :column-span new-column-span))
+
+        target-area (sga/make-area target-cell)]
+
+    (if (sga/contains? prev-area target-area)
+      ;; The new area is smaller than the previous. We need to create cells in the empty space
+      (let [parent
+            (-> parent
+                (assoc-in [:layout-grid-cells (:id target-cell)] target-cell))
+
+            new-cells
+            (->> (sga/difference prev-area target-area)
+                 (mapcat (fn [[column row column-span row-span]]
+                           (for [new-col (range column (+ column column-span))
+                                 new-row (range row (+ row row-span))]
+                             (merge grid-cell-defaults
+                                    {:id (uuid/next)
+                                     :row new-row
+                                     :column new-col
+                                     :row-span 1
+                                     :column-span 1})))))
+
+            parent
+            (->> new-cells
+                 (reduce #(assoc-in %1 [:layout-grid-cells (:id %2)] %2) parent))]
+
+        parent)
+
+      ;; The new area is bigger we need to remove the cells filled and split the intersections
+      (let [remove-cells (->> cells
+                              (filter #(and (not= (:id target-cell) (:id %))
+                                            (sga/contains? target-area (sga/make-area %))))
+                              (into #{}))
+
+            split-cells  (->> cells (filter #(and (not= (:id target-cell) (:id %))
+                                                  (not (contains? remove-cells %))
+                                                  (sga/intersects? target-area (sga/make-area %)))))
+
+            [parent _]
+            (->> (d/enumerate cells)
+                 (reduce (fn [[parent cells] [index cur-cell]]
+                           (if (contains? remove-cells cur-cell)
+                             (let [[parent cells] (free-cell-push parent cells index)]
+                               [parent (conj cells cur-cell)])
+                             [parent cells]))
+                         [parent cells]))
+
+            parent
+            (-> parent
+                (assoc-in [:layout-grid-cells (:id target-cell)] target-cell))
+
+            parent
+            (->> remove-cells
+                 (reduce (fn [parent cell]
+                           (update parent :layout-grid-cells dissoc (:id cell)))
+                         parent))
+
+            parent
+            (->> split-cells
+                 (reduce (fn [parent cell]
+                           (let [new-areas (sga/difference (sga/make-area cell) target-area)]
+                             (as-> parent $
+                               (update-in $ [:layout-grid-cells (:id cell)] merge (sga/area->cell-props (first new-areas)))
+                               (reduce (fn [parent area]
+                                         (let [cell (merge (assoc grid-cell-defaults :id (uuid/next)) (sga/area->cell-props area))]
+                                           (assoc-in parent [:layout-grid-cells (:id cell)] cell))) $ new-areas))))
+                         parent))]
+        parent))))