WIP Move frames around

src/bean/frames.cljs

@@ -193,8 +193,33 @@
          (set (mapcat #(label->cells sheet frame-name %) addresses)))]
     (update-in sheet [:frames frame-name :skip-cells] #(apply disj % addresses*))))
 
+(defn- remove-outside-labels [sheet frame-name]
+  (let [labels (get-in sheet [:frames frame-name :labels])
+        {:keys [start end]} (get-in sheet [:frames frame-name])]
+    (reduce
+     #(if-not (area/overlap?
+               {:start start :end end}
+               {:start %2 :end %2})
+        (update-in %1 [:frames frame-name :labels] dissoc %2)
+        %1) sheet
+     (keys labels))))
+
 (defn resize-frame [sheet frame-name area]
-  (update-in sheet [:frames frame-name] merge area))
+  (-> (update-in sheet [:frames frame-name] merge area)
+      (remove-outside-labels frame-name)))
+
+(defn- move-labels [sheet frame-name move-from move-to]
+  (assoc-in
+   sheet [:frames frame-name :labels]
+   (update-keys
+    (get-in sheet [:frames frame-name :labels])
+    #(util/offset move-to (util/distance move-from %)))))
+
+(defn move-frame [sheet frame-name area]
+  (let [start (get-in sheet [:frames frame-name :start])]
+    (-> (update-in sheet [:frames frame-name] merge area)
+        (move-labels frame-name start (:start area))
+        (remove-outside-labels frame-name))))
 
 (defn expand-frames [sheet [updated-r updated-c]]
   (if-let [at-end-of-frame (some (fn [[frame-name {:keys [start end]}]]

src/bean/grid.cljs

@@ -35,9 +35,6 @@
    "error" {:scalar functions/bean-error
             :representation "f"}})
 
-(defn- offset [[start-r start-c] [offset-rows offset-cols]]
-  [(+ start-r offset-rows) (+ start-c offset-cols)])
-
 (defn- set-error [grid address error]
   (update-in grid
              address
@@ -97,7 +94,7 @@
       spill into the (previously common) cell successfully"
       (reduce
        #(let [{:keys [spilled-from relative-address]} %2
-              [r c] (offset spilled-from relative-address)
+              [r c] (util/offset spilled-from relative-address)
               existing-spillers (get-in %1 [r c :interested-spillers] #{})
               spillers* (conj existing-spillers spilled-from)]
           (assoc-in %1 [r c :interested-spillers] spillers*))
@@ -110,7 +107,7 @@
        if the spillage conflicts with existing content (or spillage)."
       (reduce
        #(let [{:keys [relative-address]} %2
-              address* (offset spiller relative-address)
+              address* (util/offset spiller relative-address)
               cell (util/get-cell %1 address*)
               blank? (empty? (:content cell))
               spilled-by-other? (:spilled-from cell)
@@ -125,7 +122,7 @@
 
     (spilled-addrs
       [spillage]
-      (->> spillage (map #(offset spiller (:relative-address %))) set))
+      (->> spillage (map #(util/offset spiller (:relative-address %))) set))
 
     (spill
       [grid spillage]
@@ -299,7 +296,7 @@
 ;; many cells and handling merged cells etc.
 (defn update-cells-bulk [sheet {:keys [start]} addressed-attrs]
   (->> addressed-attrs
-       (map #(do [(offset (first %) start) (second %)]))
+       (map #(do [(util/offset (first %) start) (second %)]))
        (reduce
         (fn [sheet* [address attrs]]
           (let [existing-cell (util/get-cell (:grid sheet*) address)
@@ -310,11 +307,26 @@
             (if (:merge-until attrs)
               (merge-cells new-sheet
                            {:start address
-                            :end (offset (:merge-until attrs) start)})
+                            :end (util/offset (:merge-until attrs) start)})
               new-sheet)))
-        (unmerge-cells sheet (map #(offset % start) (keys addressed-attrs))))
+        (unmerge-cells sheet (map #(util/offset % start) (keys addressed-attrs))))
        eval-sheet-a-few-times))
 
+(defn move-cells [sheet {:keys [start end]} move-to]
+  ;; horrible code, please rewrite
+  ;; merged with needs to be changed
+  ;; what is the move boundary splits across a merged cell
+  (reduce
+   #(-> %1
+        (assoc-in
+         (flatten [:grid (util/offset move-to (util/distance start %2))])
+         (get-in sheet (flatten [:grid %2])))
+        (assoc-in
+         (flatten [:grid %2])
+         {:content "" :ast [] :representation ""}))
+   sheet
+   (area/area->addresses {:start start :end end})))
+
 (defn add-frame-labels [sheet frame-name addresses dirn]
   (-> (reduce #(set-cell-style %1 %2 :bold true) sheet addresses)
       (frames/add-labels frame-name addresses dirn)
@@ -327,13 +339,21 @@
 
 (defn pasted-area [pasted-at addresses]
   (let [{:keys [start end]} (area/addresses->area addresses)]
-    {:start (offset start pasted-at)
-     :end (offset end pasted-at)}))
+    {:start (util/offset start pasted-at)
+     :end (util/offset end pasted-at)}))
 
 (defn resize-frame [sheet frame-name area]
   (-> (frames/resize-frame sheet frame-name area)
       eval-sheet-a-few-times))
 
+(defn move-frame [sheet frame-name move-to]
+  (let [{:keys [start end]} (get-in sheet [:frames frame-name])
+        new-area {:start move-to :end (util/offset move-to (util/distance start end))}]
+    ;; check for overlaps first
+    (-> (move-cells sheet {:start start :end end} move-to)
+        (frames/move-frame frame-name new-area)
+        eval-sheet-a-few-times)))
+
 (defn clear-area [sheet {:keys [start end]}]
   (->> (util/addresses-matrix start end)
        (mapcat identity)

src/bean/ui/events.cljs

@@ -188,9 +188,13 @@
 (rf/reg-event-db
  ::set-selection
  (fn [db [_ selection]]
-   (if (util/area-inside? (:sheet db) selection)
-     (assoc-in db [:ui :grid :selection] selection)
-     db)))
+   (when (util/area-inside? (:sheet db) selection)
+     (assoc-in db [:ui :grid :selection] selection))))
+
+(rf/reg-event-db
+ ::clear-selection
+ (fn [db [_]]
+   (assoc-in db [:ui :grid :selection] nil)))
 
 (rf/reg-event-fx
  ::select-frame
@@ -248,6 +252,12 @@
        (update-in db [:sheet]
                   #(grid/resize-frame % frame-name {:start start :end end}))))))
 
+(rf/reg-event-db
+ ::move-frame
+ (undoable)
+ (fn move-frame [db [_ frame-name move-to]]
+   (update-in db [:sheet] #(grid/move-frame % frame-name move-to))))
+
 (rf/reg-event-db
  ::display-help
  (fn display-help [db [_ flag]]

src/bean/ui/util.cljs

@@ -26,6 +26,8 @@
 (def map-on-matrix util/map-on-matrix)
 (def addresses-matrix util/addresses-matrix)
 (def map-on-matrix-addressed util/map-on-matrix-addressed)
+(def offset util/offset)
+(def distance util/distance)
 
 (defn color-int->hex [color]
   (str "#" (.toString color 16)))

src/bean/ui/views/sheet.cljs

@@ -96,6 +96,14 @@
       (.lineStyle g (:selection-border styles/sizes) color 1 1)
       (.drawRect g x y w h))))
 
+(defn- frame-rect [^js g area row-heights col-widths]
+  (when (:start area)
+    (let [[x y w h] (area->xywh area row-heights col-widths)
+          color (:frame-border styles/colors)]
+      (.beginFill g color 0.05)
+      (.lineStyle g (:frame-border styles/sizes) color 0.15 1)
+      (.drawRect g x y w h))))
+
 (defn- edit-cell [rc sheet]
   (rf/dispatch-sync [::events/select-frame (frames/cell-frame rc sheet)])
   (rf/dispatch [::events/edit-cell rc]))
@@ -339,17 +347,14 @@
     grid)
    g))
 
-(defn- frame-resize-end []
-  (remove-listener! :frame-resize-move))
-
 (defn- frame-resize-start [e frame-name grid-g row-heights col-widths]
   (.stopPropagation e)
   (reset-listener!
    :frame-resize-move grid-g "globalpointermove"
    #(rf/dispatch-sync [::events/resize-frame frame-name (i->rc e grid-g row-heights col-widths)]))
   (reset-listener!
    :frame-resize-end grid-g "pointerup"
-   frame-resize-end))
+   #(remove-listener! :frame-resize-move)))
 
 (defn- draw-frame-resizer [^js g frame-name x y w h grid-g row-heights col-widths]
   (let [width 10
@@ -362,7 +367,34 @@
     (.drawRect resizer (- (+ x w) width) (- (+ y h) width) width width)
     (.addChild g resizer)))
 
-(defn- draw-frame-name [^js g frame-name x y]
+(defn- frame-move-end [g frame-name area]
+  (remove-listener! :frame-move-move)
+  (remove-listener! :frame-move-end)
+  (rf/dispatch-sync [::events/move-frame frame-name (:start area)])
+  (.destroy g))
+
+(defn frame-move-move [g area row-heights col-widths]
+  (.clear g)
+  (frame-rect g area row-heights col-widths))
+
+(defn- frame-move-start [e ^js grid-g frame-name {:keys [start end]} row-heights col-widths]
+  (.stopPropagation e)
+  (rf/dispatch [::events/clear-edit-cell])
+  (rf/dispatch [::events/clear-selection])
+  (let [g (new pixi/Graphics)
+        moved-to #(let [[r c] (i->rc % grid-g row-heights col-widths)]
+                    {:start [(inc r) c]
+                     :end (util/offset [(inc r) c] (util/distance start end))})]
+    (.addChild grid-g g)
+    (set! (.-eventMode g) "none")
+    (reset-listener!
+     :frame-move-move grid-g "globalpointermove"
+     #(frame-move-move g (moved-to %) row-heights col-widths))
+    (reset-listener!
+     :frame-move-end grid-g "pointerup"
+     #(frame-move-end g frame-name (moved-to %)))))
+
+(defn- draw-frame-name [^js g frame-name frame-data x y grid-g row-heights col-widths]
   (let [font-size (:frame-name-font styles/sizes)
         text-bitmap (new pixi/BitmapText frame-name
                          #js {:fontName "SpaceGrotesk"
@@ -378,6 +410,9 @@
     (set! (.-x text-bitmap) (+ x padding))
     (set! (.-y text-bitmap) (- y (padded font-size)))
     (.addChild g text-bitmap)
+    (set! (.-eventMode text-bitmap) "static")
+    (set! (.-cursor text-bitmap) "move")
+    (.on text-bitmap "pointerdown" #(frame-move-start % grid-g frame-name frame-data row-heights col-widths))
     g))
 
 (defn- button! [sprite ^js g x y w on-click]
@@ -502,7 +537,7 @@
                                      w (+ h extra-hitarea-y)))
        (.lineStyle border (:frame-border styles/sizes) (:frame-border styles/colors) 0.5 0.5)
        (.drawRect border x y w h)
-       (draw-frame-name highlight frame-name x y)
+       (draw-frame-name highlight frame-name frame-data x y grid-g row-heights col-widths)
        (.addChild g (draw-label-bounds textures sheet frame-name (:labels frame-data) row-heights col-widths))
 
        (let [label-controls (draw-label-controls textures frame-name selection)]

src/bean/util.cljs

@@ -61,3 +61,9 @@
 
 (defn merged-or-self [[r c] sheet]
   (or (get-in sheet [:grid r c :style :merged-with]) [r c]))
+
+(defn offset [[start-r start-c] [offset-rows offset-cols]]
+  [(+ start-r offset-rows) (+ start-c offset-cols)])
+
+(defn distance [[r1 c1] [r2 c2]]
+  [(- r2 r1) (- c2 c1)])