diff --git a/src/bean/frames.cljs b/src/bean/frames.cljs index 8cc8815..2f17cdf 100644 --- a/src/bean/frames.cljs +++ b/src/bean/frames.cljs @@ -159,8 +159,33 @@ (set (mapcat #(label->cells sheet frame-name %) addresses)))] (update-in sheet [:frames frame-name :skip-cells] #(apply disj % addresses*)))) -(defn resize-frame [sheet frame-name area] - (update-in sheet [:frames frame-name] merge area)) +(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) + (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]}]] @@ -168,7 +193,7 @@ (< updated-c (inc (second end))) (>= updated-c (second start))) frame-name)) (:frames sheet))] - + (let [[end-r end-c] (:end (get-frame sheet at-end-of-frame))] (resize-frame sheet at-end-of-frame {:end [(inc end-r) end-c]})) sheet)) diff --git a/src/bean/grid.cljs b/src/bean/grid.cljs index c4fcad1..8da5c10 100644 --- a/src/bean/grid.cljs +++ b/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) diff --git a/src/bean/ui/events.cljs b/src/bean/ui/events.cljs index bacb04d..6e2f534 100644 --- a/src/bean/ui/events.cljs +++ b/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]] diff --git a/src/bean/ui/util.cljs b/src/bean/ui/util.cljs index f8969b7..124e9d8 100644 --- a/src/bean/ui/util.cljs +++ b/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))) diff --git a/src/bean/ui/views/sheet.cljs b/src/bean/ui/views/sheet.cljs index 09d0686..dc49a22 100644 --- a/src/bean/ui/views/sheet.cljs +++ b/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,9 +347,6 @@ 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! @@ -349,7 +354,7 @@ #(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] @@ -487,7 +522,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) (draw-frame-resizer g frame-name x y w h grid-g row-heights col-widths) (.addChild g (draw-label-bounds textures sheet frame-name (:labels frame-data) row-heights col-widths)) diff --git a/src/bean/util.cljs b/src/bean/util.cljs index c1985a6..14d2217 100644 --- a/src/bean/util.cljs +++ b/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)])