penpot/frontend/src/app/main/data/workspace/guides.cljs

;; 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 Sucursal en España SL

(ns app.main.data.workspace.guides
  (:require
   [app.common.data :as d]
   [app.common.data.macros :as dm]
   [app.common.files.changes-builder :as pcb]
   [app.common.geom.point :as gpt]
   [app.common.geom.shapes :as gsh]
   [app.common.types.page :as ctp]
   [app.main.data.changes :as dwc]
   [app.main.data.event :as ev]
   [app.main.data.helpers :as dsh]
   [beicon.v2.core :as rx]
   [potok.v2.core :as ptk]))

(defn update-guides
  [{:keys [id] :as guide}]

  (dm/assert!
   "expected valid guide"
   (ctp/valid-guide? guide))

  (ptk/reify ::update-guides
    ev/Event
    (-data [_]
      (assoc guide ::ev/name "update-guide"))

    ptk/WatchEvent
    (watch [it state _]
      (let [page (dsh/lookup-page state)
            changes
            (-> (pcb/empty-changes it)
                (pcb/with-page page)
                (pcb/set-guide id guide))]
        (rx/of (dwc/commit-changes changes))))))

(defn remove-guide
  [{:keys [id] :as guide}]

  (dm/assert!
   "expected valid guide"
   (ctp/valid-guide? guide))

  (ptk/reify ::remove-guide
    ev/Event
    (-data [_] guide)

    ptk/UpdateEvent
    (update [_ state]
      (let [sdisj (fnil disj #{})]
        (update-in state [:workspace-guides :hover] sdisj id)))

    ptk/WatchEvent
    (watch [it state _]
      (let [page (dsh/lookup-page state)
            changes
            (-> (pcb/empty-changes it)
                (pcb/with-page page)
                (pcb/set-guide id nil))]
        (rx/of (dwc/commit-changes changes))))))

(defn remove-guides
  [ids]

  (dm/assert!
   "expected a set of ids"
   (every? uuid? ids))

  (ptk/reify ::remove-guides
    ptk/WatchEvent
    (watch [_ state _]
      (let [{:keys [guides] :as page} (dsh/lookup-page state)
            guides (-> (select-keys guides ids) (vals))]
        (rx/from (mapv remove-guide guides))))))

(defn remove-frame-guides
  [frame-ids]

  (assert (every? uuid? frame-ids) "expected a coll of uuids")

  (ptk/reify ::remove-frame-guides
    ptk/UpdateEvent
    (update [_ state]
      (let [{:keys [guides]} (dsh/lookup-page state)
            frame-ids-set    (set frame-ids)
            guide-ids        (into #{}
                                   (comp (filter #(contains? frame-ids-set (:frame-id %)))
                                         d/xf:map-id)
                                   (vals guides))]
        (update-in state [:workspace-guides :hover]
                   (fn [hover] (reduce disj (or hover #{}) guide-ids)))))

    ptk/WatchEvent
    (watch [it state _]
      (let [{:keys [guides] :as page} (dsh/lookup-page state)
            frame-ids-set    (set frame-ids)
            to-remove        (filter #(contains? frame-ids-set (:frame-id %)) (vals guides))
            changes          (reduce
                              (fn [acc {:keys [id]}]
                                (pcb/set-guide acc id nil))
                              (-> (pcb/empty-changes it)
                                  (pcb/with-page page))
                              to-remove)]
        (rx/of (dwc/commit-changes changes))))))

(defmethod ptk/resolve ::move-frame-guides
  [_ args]
  (dm/assert!
   "expected a coll of uuids"
   (every? uuid? (:ids args)))
  (ptk/reify ::move-frame-guides
    ptk/WatchEvent
    (watch [_ state _]
      (let [ids (:ids args)
            object-modifiers (:modifiers args)
            object-transforms (:transforms args)
            objects (dsh/lookup-page-objects state)

            is-frame? (fn [id] (= :frame (get-in objects [id :type])))
            frame-ids? (into #{} (filter is-frame?) ids)

            build-move-event
            (fn [guide]
              (let [frame-id (:frame-id guide)
                    frame (get objects frame-id)
                    modifier (get-in object-modifiers [frame-id :modifiers])
                    transform (get object-transforms frame-id)

                    frame'
                    (cond-> frame
                      (some? modifier)
                      (gsh/transform-shape modifier)

                      (some? transform)
                      (gsh/apply-transform transform))

                    moved (gpt/to-vec (gpt/point (:x frame) (:y frame))
                                      (gpt/point (:x frame') (:y frame')))

                    guide (update guide :position + (get moved (:axis guide)))]
                (update-guides guide)))

            guides (-> state dsh/lookup-page :guides vals)]

        (->> guides
             (filter (comp frame-ids? :frame-id))
             (map build-move-event)
             (rx/from))))))

(defn update-guide-color
  [guide-id color]
  (ptk/reify ::update-guide-color
    ptk/WatchEvent
    (watch [it state _]
      (let [{:keys [guides] :as page} (dsh/lookup-page state)
            guide (get guides guide-id)]
        (when (some? guide)
          (let [updated-guide (if (some? color)
                                (assoc guide :color color)
                                (dissoc guide :color))
                changes
                (-> (pcb/empty-changes it)
                    (pcb/with-page page)
                    (pcb/set-guide guide-id updated-guide))]
            (rx/of (dwc/commit-changes changes))))))))

(defn set-hover-guide
  [id hover?]
  (ptk/reify ::set-hover-guide
    ptk/UpdateEvent
    (update [_ state]
      (let [sconj (fnil conj #{})
            sdisj (fnil disj #{})]
        (if hover?
          (update-in state [:workspace-guides :hover] sconj id)
          (update-in state [:workspace-guides :hover] sdisj id))))))