penpot/frontend/src/app/main/data/workspace/comments.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

(ns app.main.data.workspace.comments
  (:require
   [app.common.geom.point :as gpt]
   [app.common.geom.shapes :as gsh]
   [app.common.pages.changes-builder :as pcb]
   [app.common.spec :as us]
   [app.common.types.shape-tree :as ctst]
   [app.main.data.comments :as dcm]
   [app.main.data.workspace.changes :as dwc]
   [app.main.data.workspace.common :as dwco]
   [app.main.data.workspace.drawing :as dwd]
   [app.main.data.workspace.state-helpers :as wsh]
   [app.main.data.workspace.viewport :as dwv]
   [app.main.repo :as rp]
   [app.main.streams :as ms]
   [app.util.router :as rt]
   [beicon.core :as rx]
   [potok.core :as ptk]))

(declare handle-interrupt)
(declare handle-comment-layer-click)

(defn initialize-comments
  [file-id]
  (us/assert ::us/uuid file-id)
  (ptk/reify ::initialize-comments
    ptk/WatchEvent
    (watch [_ _ stream]
      (let [stoper (rx/filter #(= ::finalize %) stream)]
        (rx/merge
         (rx/of (dcm/retrieve-comment-threads file-id))
         (->> stream
              (rx/filter ms/mouse-click?)
              (rx/switch-map #(rx/take 1 ms/mouse-position))
              (rx/with-latest-from ms/keyboard-space)
              (rx/tap prn)
              (rx/filter (fn [[_ space]] (not space)) )
              (rx/map first)
              (rx/map handle-comment-layer-click)
              (rx/take-until stoper))
         (->> stream
              (rx/filter dwco/interrupt?)
              (rx/map handle-interrupt)
              (rx/take-until stoper)))))))

(defn- handle-interrupt
  []
  (ptk/reify ::handle-interrupt
    ptk/WatchEvent
    (watch [_ state _]
      (let [local (:comments-local state)]
        (cond
          (:draft local) (rx/of (dcm/close-thread))
          (:open local)  (rx/of (dcm/close-thread))
          :else          (rx/of #(dissoc % :workspace-drawing)))))))

;; Event responsible of the what should be executed when user clicked
;; on the comments layer. An option can be create a new draft thread,
;; an other option is close previously open thread or cancel the
;; latest opened thread draft.
(defn- handle-comment-layer-click
  [position]
  (ptk/reify ::handle-comment-layer-click
    ptk/WatchEvent
    (watch [_ state _]
      (let [local (:comments-local state)]
        (if (some? (:open local))
          (rx/of (dcm/close-thread))
          (let [page-id (:current-page-id state)
                file-id (:current-file-id state)
                params  {:position position
                         :page-id page-id
                         :file-id file-id}]
            (rx/of (dcm/create-draft params))))))))

(defn center-to-comment-thread
  [{:keys [position] :as thread}]
  (us/assert ::dcm/comment-thread thread)
  (ptk/reify ::center-to-comment-thread
    ptk/UpdateEvent
    (update [_ state]
      (update state :workspace-local
              (fn [{:keys [vbox zoom] :as local}]
                (let [pw (/ 160 zoom)
                      ph (/ 160 zoom)
                      nw (- (/ (:width vbox) 2) pw)
                      nh (- (/ (:height vbox) 2) ph)
                      nx (- (:x position) nw)
                      ny (- (:y position) nh)]
                  (update local :vbox assoc :x nx :y ny)))))))

(defn navigate
  [thread]
  (us/assert ::dcm/comment-thread thread)
  (ptk/reify ::open-comment-thread
    ptk/WatchEvent
    (watch [_ _ stream]
      (let [pparams {:project-id (:project-id thread)
                     :file-id (:file-id thread)}
            qparams {:page-id (:page-id thread)}]
        (rx/merge
         (rx/of (rt/nav :workspace pparams qparams))
         (->> stream
              (rx/filter (ptk/type? ::dwv/initialize-viewport))
              (rx/take 1)
              (rx/mapcat #(rx/of (center-to-comment-thread thread)
                                 (dwd/select-for-drawing :comments)
                                 (dcm/open-thread thread)))))))))

(defn update-comment-thread-position
  ([thread  [new-x new-y]]
   (update-comment-thread-position thread  [new-x new-y] nil))

  ([thread  [new-x new-y] frame-id]
  (us/assert ::dcm/comment-thread thread)
  (ptk/reify ::update-comment-thread-position
    ptk/WatchEvent
    (watch [it state _]
      (let [thread-id (:id thread)
            page (wsh/lookup-page state)
            page-id (:id page)
            objects (wsh/lookup-page-objects state page-id)
            new-frame-id (if (nil? frame-id)
                           (ctst/frame-id-by-position objects (gpt/point new-x new-y))
                           (:frame-id thread))
            thread (assoc thread
                          :position (gpt/point new-x new-y)
                          :frame-id new-frame-id)

            changes
            (-> (pcb/empty-changes it)
                (pcb/with-page page)
                (pcb/update-page-option :comment-threads-position assoc thread-id (select-keys thread [:position :frame-id])))]

        (rx/merge
         (rx/of (dwc/commit-changes changes))
         (->> (rp/cmd! :update-comment-thread-position thread)
              (rx/catch #(rx/throw {:type :update-comment-thread-position}))
              (rx/ignore))))))))

;; Move comment threads that are inside a frame when that frame is moved"
(defmethod ptk/resolve ::move-frame-comment-threads
  [_ ids]
  (us/assert! ::us/coll-of-uuid ids)
  (ptk/reify ::move-frame-comment-threads
    ptk/WatchEvent
    (watch [_ state _]
      (let [objects (wsh/lookup-page-objects state)

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

            object-modifiers  (:workspace-modifiers state)

            threads-position-map (:comment-threads-position (wsh/lookup-page-options state))

            build-move-event
            (fn [comment-thread]
              (let [frame (get objects (:frame-id comment-thread))
                    modifiers (get object-modifiers (:frame-id comment-thread))
                    frame' (gsh/transform-shape frame modifiers)
                    moved (gpt/to-vec (gpt/point (:x frame) (:y frame))
                                      (gpt/point (:x frame') (:y frame')))
                    position (get-in threads-position-map [(:id comment-thread) :position])
                    new-x (+ (:x position) (:x moved))
                    new-y (+ (:y position) (:y moved))]
                (update-comment-thread-position comment-thread [new-x new-y] (:id frame))))]

        (->> (:comment-threads state)
             (vals)
             (map #(assoc % :position (get-in threads-position-map [(:id %) :position])))
             (map #(assoc % :frame-id (get-in threads-position-map [(:id %) :frame-id])))
             (filter (comp frame-ids? :frame-id))
             (map build-move-event)
             (rx/from))))))