🎉 Allow to position interaction overlays

common/src/app/common/pages/helpers.cljc

@@ -161,6 +161,12 @@
     (when parent-id
       (lazy-seq (cons parent-id (get-parents parent-id objects))))))
 
+(defn get-frame
+  "Get the frame that contains the shape. If the shape is already a frame, get itself."
+  [shape objects]
+  (if (= (:type shape) :frame)
+    shape
+    (get objects (:frame-id shape))))
 
 (defn clean-loops
   "Clean a list of ids from circular references."

common/src/app/common/pages/spec.cljc

@@ -9,6 +9,7 @@
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
    [app.common.spec :as us]
+   [app.common.types.interactions :as cti]
    [app.common.uuid :as uuid]
    [clojure.set :as set]
    [clojure.spec.alpha :as s]))
@@ -183,25 +184,6 @@
 (s/def :internal.page/options
   (s/keys :opt-un [:internal.page.options/background]))
 
-;; Interactions
-
-(s/def :internal.shape.interaction/event-type #{:click :hover})
-(s/def :internal.shape.interaction/action-type #{:navigate :open-overlay :close-overlay})
-(s/def :internal.shape.interaction/destination (s/nilable ::uuid))
-
-(s/def :internal.shape/interaction
-  (s/keys :req-un [:internal.shape.interaction/event-type
-                   :internal.shape.interaction/action-type
-                   :internal.shape.interaction/destination]))
-
-(s/def :internal.shape/interactions
-  (s/coll-of :internal.shape/interaction :kind vector?))
-
-(def default-interaction
-  {:event-type :click
-   :action-type :navigate
-   :destination nil})
-
 ;; Size constraints
 
 (s/def :internal.shape/constraints-h #{:left :right :leftright :center :scale})
@@ -366,7 +348,7 @@
                    :internal.shape/transform-inverse
                    :internal.shape/width
                    :internal.shape/height
-                   :internal.shape/interactions
+                   ::cti/interactions
                    :internal.shape/masked-group?
                    :internal.shape/shadow
                    :internal.shape/blur]))

common/src/app/common/types/interactions.cljc

@@ -0,0 +1,187 @@
+;; 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) UXBOX Labs SL
+
+(ns app.common.types.interactions
+  (:require
+   [app.common.geom.point :as gpt]
+   [app.common.spec :as us]
+   [clojure.spec.alpha :as s]))
+
+;; TODO: Move this to other place to avoid duplication with common.pages.spec
+(s/def ::string string?)
+(s/def ::safe-integer ::us/safe-integer)
+(s/def ::uuid uuid?)
+
+(s/def ::point
+  (s/and (s/keys :req-un [::x ::y])
+         gpt/point?))
+
+;; -- Options depending on event type
+
+(s/def ::event-type #{:click
+                      :mouse-over
+                      :mouse-press
+                      :mouse-enter
+                      :mouse-leave
+                      :after-delay})
+
+(s/def ::delay ::safe-integer)
+
+(defmulti event-opts-spec :event-type)
+
+(defmethod event-opts-spec :after-delay [_]
+  (s/keys :req-un [::delay]))
+
+(defmethod event-opts-spec :default [_]
+  (s/keys :req-un []))
+
+(s/def ::event-opts
+  (s/multi-spec event-opts-spec ::event-type))
+
+;; -- Options depending on action type
+
+(s/def ::action-type #{:navigate
+                       :open-overlay
+                       :close-overlay
+                       :prev-screen
+                       :open-url})
+
+(s/def ::destination (s/nilable ::uuid))
+(s/def ::overlay-position ::point)
+(s/def ::url ::string)
+
+(defmulti action-opts-spec :action-type)
+
+(defmethod action-opts-spec :navigate [_]
+  (s/keys :req-un [::destination]))
+
+(defmethod action-opts-spec :open-overlay [_]
+  (s/keys :req-un [::destination
+                   ::overlay-position]))
+
+(defmethod action-opts-spec :close-overlay [_]
+  (s/keys :req-un [::destination]))
+
+(defmethod action-opts-spec :prev-screen [_]
+  (s/keys :req-un []))
+
+(defmethod action-opts-spec :open-url [_]
+  (s/keys :req-un [::url]))
+
+(s/def ::action-opts
+  (s/multi-spec action-opts-spec ::action-type))
+
+;; -- Interaction
+
+(s/def ::classifier
+  (s/keys :req-un [::event-type
+                   ::action-type]))
+
+(s/def ::interaction
+  (s/merge ::classifier
+           ::event-opts
+           ::action-opts))
+
+(s/def ::interactions
+  (s/coll-of ::interaction :kind vector?))
+
+(def default-interaction
+  {:event-type :click
+   :action-type :navigate
+   :destination nil})
+
+(def default-delay 100)
+
+;; -- Helpers
+
+(defn set-event-type
+  [interaction event-type]
+  (us/verify ::interaction interaction)
+  (us/verify ::event-type event-type)
+  (if (= (:event-type interaction) event-type)
+    interaction
+    (case event-type
+
+      :after-delay
+      (assoc interaction
+             :event-type event-type
+             :delay (get interaction :delay default-delay))
+
+      (assoc interaction
+             :event-type event-type))))
+
+
+(defn set-action-type
+  [interaction action-type]
+  (us/verify ::interaction interaction)
+  (us/verify ::action-type action-type)
+  (if (= (:action-type interaction) action-type)
+    interaction
+    (case action-type
+
+      :navigate
+      (assoc interaction
+             :action-type action-type
+             :destination (get interaction :destination))
+
+      :open-overlay
+      (assoc interaction
+             :action-type action-type
+             :destination (get interaction :destination)
+             :overlay-position (get interaction :overlay-position (gpt/point 0 0)))
+
+      :close-overlay
+      (assoc interaction
+             :action-type action-type
+             :destination (get interaction :destination))
+
+      :prev-screen
+      (assoc interaction
+             :action-type action-type)
+
+      :open-url
+      (assoc interaction
+             :action-type action-type
+             :url (get interaction :url "")))))
+
+
+(defn set-destination
+  [interaction destination shape objects]
+  (us/verify ::interaction interaction)
+  (us/verify ::destination destination)
+  (assert (or (nil? destination)
+              (some? (get objects destination))))
+  (assert #(:navigate :open-overlay :close-overlay) (:action-type interaction))
+  (let [calc-overlay-position
+        (fn []
+          (if (nil? destination)
+            (gpt/point 0 0)
+            (let [dest-frame   (get objects destination)
+                  overlay-size (:selrect dest-frame)
+
+                  orig-frame   (if (= (:type shape) :frame)
+                                 shape
+                                 (get objects (:frame-id shape)))
+                  frame-size   (:selrect orig-frame)
+
+                  x (/ (- (:width frame-size) (:width overlay-size)) 2)
+                  y (/ (- (:height frame-size) (:height overlay-size)) 2)]
+              (gpt/point x y))))]
+
+    (cond-> interaction
+      :always
+      (assoc :destination destination)
+
+      (= (:action-type interaction) :open-overlay)
+      (assoc :overlay-position (calc-overlay-position)))))
+
+
+(defn set-overlay-position
+  [interaction overlay-position]
+  (us/verify ::interaction interaction)
+  (us/verify ::overlay-position overlay-position)
+  (assoc interaction :overlay-position overlay-position))
+

frontend/src/app/main/data/viewer.cljs

@@ -328,8 +328,9 @@
 ;; --- Overlays
 
 (defn open-overlay
-  [frame-id]
+  [frame-id position]
   (us/verify ::us/uuid frame-id)
+  (us/verify ::us/point position)
   (ptk/reify ::open-overlay
     ptk/UpdateEvent
     (update [_ state]
@@ -340,7 +341,9 @@
             frame    (d/seek #(= (:id %) frame-id) frames)
             overlays (get-in state [:viewer-local :overlays])]
         (if-not (some #(= % frame) overlays)
-          (update-in state [:viewer-local :overlays] conj frame)
+          (update-in state [:viewer-local :overlays] conj 
+                     {:frame frame
+                      :position position})
           state)))))
 
 (defn close-overlay
@@ -350,7 +353,7 @@
     (update [_ state]
       (update-in state [:viewer-local :overlays]
                  (fn [overlays]
-                   (remove #(= (:id %) frame-id) overlays))))))
+                   (remove #(= (:id (:frame %)) frame-id) overlays))))))
 
 ;; --- Objects selection
 

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

@@ -18,6 +18,7 @@
    [app.common.pages.spec :as spec]
    [app.common.spec :as us]
    [app.common.transit :as t]
+   [app.common.types.interactions :as cti]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.main.data.events :as ev]
@@ -1826,10 +1827,93 @@
                                                frame)]
                                    ;; Update or create interaction
                                    (if index
-                                     (assoc-in interactions [index :destination] (:id frame))
+                                     (update-in interactions [index]
+                                                #(cti/set-destination % (:id frame) shape objects))
                                      (conj (or interactions [])
-                                           (assoc spec/default-interaction
-                                                  :destination (:id frame))))))))))))))))
+                                           (cti/set-destination cti/default-interaction
+                                                                (:id frame)
+                                                                shape
+                                                                objects)))))))))))))))
+
+(declare move-overlay-pos)
+(declare finish-move-overlay-pos)
+
+(defn start-move-overlay-pos
+  [index]
+  (ptk/reify ::start-move-overlay-pos
+    ptk/UpdateEvent
+    (update [_ state]
+      (-> state
+          (assoc-in [:workspace-local :move-overlay-to] nil)
+          (assoc-in [:workspace-local :move-overlay-index] index)))
+
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (let [initial-pos @ms/mouse-position
+            selected (wsh/lookup-selected state)
+            stopper (rx/filter ms/mouse-up? stream)]
+        (when (= 1 (count selected))
+          (let [page-id     (:current-page-id state)
+                objects     (wsh/lookup-page-objects state page-id)
+                shape       (->> state
+                                 wsh/lookup-selected
+                                 first
+                                 (get objects))
+                overlay-pos (-> shape
+                                (get-in [:interactions index])
+                                :overlay-position)
+                orig-frame  (cph/get-frame shape objects)
+                frame-pos   (gpt/point (:x orig-frame) (:y orig-frame))
+                offset      (-> initial-pos
+                                (gpt/subtract overlay-pos)
+                                (gpt/subtract frame-pos))]
+            (rx/concat
+              (->> ms/mouse-position
+                   (rx/take-until stopper)
+                   (rx/map #(move-overlay-pos % overlay-pos frame-pos offset)))
+              (rx/of (finish-move-overlay-pos index overlay-pos frame-pos offset)))))))))
+
+(defn move-overlay-pos
+  [pos overlay-pos frame-pos offset]
+  (ptk/reify ::move-overlay-pos
+    ptk/UpdateEvent
+    (update [_ state]
+      (let [pos (-> pos
+                    (gpt/subtract frame-pos)
+                    (gpt/subtract offset))]
+        (assoc-in state [:workspace-local :move-overlay-to] pos)))))
+
+(defn finish-move-overlay-pos
+ [index overlay-pos frame-pos offset]
+ (ptk/reify ::finish-move-overlay-pos
+    ptk/UpdateEvent
+    (update [_ state]
+      (-> state
+          (d/dissoc-in [:workspace-local :move-overlay-to])
+          (d/dissoc-in [:workspace-local :move-overlay-index])))
+
+   ptk/WatchEvent
+   (watch [_ state _]
+     (let [pos         @ms/mouse-position
+           overlay-pos (-> pos
+                           (gpt/subtract frame-pos)
+                           (gpt/subtract offset))
+
+           page-id     (:current-page-id state)
+           objects     (wsh/lookup-page-objects state page-id)
+           shape       (->> state
+                            wsh/lookup-selected
+                            first
+                            (get objects))
+
+           interactions (:interactions shape)
+
+           new-interactions
+           (update interactions index
+                   #(cti/set-overlay-position % overlay-pos))]
+
+       (rx/of (update-shape (:id shape) {:interactions new-interactions}))))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; CANVAS OPTIONS

frontend/src/app/main/ui/viewer.cljs

@@ -33,11 +33,6 @@
      :height (* height zoom)
      :vbox   (str "0 0 " width " " height)}))
 
-(defn- position-overlay
-  [size size-over]
-  {:x (/ (- (:width size) (:width size-over)) 2)
-   :y (/ (- (:height size) (:height size-over)) 2)})
-
 (mf/defc viewer
   [{:keys [params data]}]
 
@@ -125,7 +120,6 @@
              :section section
              :local local}]
 
-
            [:div.viewport-container
             {:style {:width (:width size)
                      :height (:height size)
@@ -147,16 +141,15 @@
               :local local}]
 
             (for [overlay (:overlays local)]
-              (let [size-over (calculate-size overlay zoom)
-                    pos-over  (position-overlay size size-over)]
+              (let [size-over (calculate-size (:frame overlay) zoom)]
                 [:div.viewport-container
                  {:style {:width (:width size-over)
                           :height (:height size-over)
                           :position "absolute"
-                          :left (:x pos-over)
-                          :top (:y pos-over)}}
+                          :left (:x (:position overlay))
+                          :top (:y (:position overlay))}}
                  [:& interactions/viewport
-                  {:frame overlay
+                  {:frame (:frame overlay)
                    :size size-over
                    :page page
                    :file file

frontend/src/app/main/ui/viewer/shapes.cljs

@@ -39,9 +39,10 @@
         (st/emit! (dv/go-to-frame frame-id)))
 
       :open-overlay
-      (let [frame-id (:destination interaction)]
+      (let [frame-id (:destination interaction)
+            position (:overlay-position interaction)]
         (dom/stop-propagation event)
-        (st/emit! (dv/open-overlay frame-id)))
+        (st/emit! (dv/open-overlay frame-id position)))
 
       :close-overlay
       (let [frame-id (or (:destination interaction)

frontend/src/app/main/ui/workspace/sidebar/options/menus/interactions.cljs

@@ -8,7 +8,7 @@
   (:require
    [app.common.data :as d]
    [app.common.pages :as cp]
-   [app.common.pages.spec :as spec]
+   [app.common.types.interactions :as cti]
    [app.common.uuid :as uuid]
    [app.main.data.workspace :as dw]
    [app.main.refs :as refs]
@@ -21,7 +21,7 @@
 (defn- event-type-names
   []
   {:click (tr "workspace.options.interaction-on-click")
-   :hover (tr "workspace.options.interaction-while-hovering")})
+   :mouse-over (tr "workspace.options.interaction-while-hovering")})
 
 (defn- event-type-name
   [interaction]
@@ -56,18 +56,18 @@
         change-event-type
         (fn [event]
           (let [value (-> event dom/get-target dom/get-value d/read-string)]
-            (update-interaction index #(assoc % :event-type value))))
+            (update-interaction index #(cti/set-event-type % value))))
 
         change-action-type
         (fn [event]
           (let [value (-> event dom/get-target dom/get-value d/read-string)]
-            (update-interaction index #(assoc % :action-type value))))
+            (update-interaction index #(cti/set-action-type % value))))
 
         change-destination
         (fn [event]
           (let [value (-> event dom/get-target dom/get-value)
                 value (when (not= value "") (uuid/uuid value))]
-            (update-interaction index #(assoc % :destination value))))]
+            (update-interaction index #(cti/set-destination % value shape objects))))]
 
     [:*
      [:div.element-set-options-group
@@ -84,21 +84,21 @@
          [:div.interactions-element
             [:span.element-set-subtitle.wide (tr "workspace.options.interaction-trigger")]
             [:select.input-select
-             {:default-value (str (:event-type interaction))
+             {:value (str (:event-type interaction))
               :on-change change-event-type}
              (for [[value name] (event-type-names)]
                [:option {:value (str value)} name])]]
          [:div.interactions-element
             [:span.element-set-subtitle.wide (tr "workspace.options.interaction-action")]
             [:select.input-select
-             {:default-value (str (:action-type interaction))
+             {:value (str (:action-type interaction))
               :on-change change-action-type}
              (for [[value name] (action-type-names)]
                [:option {:value (str value)} name])]]
          [:div.interactions-element
             [:span.element-set-subtitle.wide (tr "workspace.options.interaction-destination")]
             [:select.input-select
-             {:default-value (str (:destination interaction))
+             {:value (str (:destination interaction))
               :on-change change-destination}
              [:option {:value ""} (tr "workspace.options.interaction-none")]
              (for [frame frames]
@@ -112,8 +112,7 @@
 
         add-interaction
         (fn [_]
-          (let [new-interactions
-                (conj interactions (update spec/default-interaction :event-type identity))]
+          (let [new-interactions (conj interactions cti/default-interaction)]
             (st/emit! (dw/update-shape (:id shape) {:interactions new-interactions}))))
 
         remove-interaction

frontend/src/app/main/ui/workspace/viewport/interactions.cljs

@@ -8,6 +8,7 @@
   "Visually show shape interactions in workspace"
   (:require
    [app.common.data :as d]
+   [app.common.pages.helpers :as cph]
    [app.main.data.workspace :as dw]
    [app.main.refs :as refs]
    [app.main.store :as st]
@@ -86,11 +87,8 @@
                                  :right "M -5 0 l 8 0 l -4 -4 m 4 4 l -4 4"
                                  :left "M 5 0 l -8 0 l 4 -4 m -4 4 l 4 4"
                                  nil)
-                     :open-overlay (case arrow-dir
-                                     ;; TODO: have a different icon for open overlay?
-                                     :right "M -5 0 l 8 0 l -4 -4 m 4 4 l -4 4"
-                                     :left "M 5 0 l -8 0 l 4 -4 m -4 4 l 4 4"
-                                     nil)
+
+                     :open-overlay "M-4 -4 h6 v6 h-6 z M2 -2 h2.5 v6.5 h-6.5 v-2.5"
 
                      :close-overlay "M -4 -4 L 4 4 M -4 4 L 4 -4"
 
@@ -162,6 +160,11 @@
                :pointer-events "visible"
                :stroke-width (/ 2 zoom)
                :d pdata}]
+
+       (when dest-shape
+         [:& outline {:shape dest-shape
+                      :color "#31EFB8"}])
+
        [:& interaction-marker {:index index
                                :x orig-x
                                :y orig-y
@@ -173,11 +176,7 @@
                                :stroke "#31EFB8"
                                :action-type action-type
                                :arrow-dir arrow-dir
-                               :zoom zoom}]
-
-       (when dest-shape
-         [:& outline {:shape dest-shape
-                      :color "#31EFB8"}])])))
+                               :zoom zoom}]])))
 
 
 (mf/defc interaction-handle
@@ -194,6 +193,37 @@
                              :zoom zoom}]]))
 
 
+(mf/defc overlay-marker
+  [{:keys [index orig-shape dest-shape position objects zoom] :as props}]
+  (let [start-move-position
+        (fn [event]
+          (st/emit! (dw/start-move-overlay-pos index)))]
+
+    (when dest-shape
+      (let [orig-frame (cph/get-frame orig-shape objects)
+            marker-x   (+ (:x orig-frame) (:x position))
+            marker-y   (+ (:y orig-frame) (:y position))
+            width      (:width dest-shape)
+            height     (:height dest-shape)]
+        [:g {:on-mouse-down start-move-position}
+         [:path {:stroke "#31EFB8"
+                 :fill "#000000"
+                 :fill-opacity 0.3
+                 :stroke-width 1
+                 :d (str "M" marker-x " " marker-y " "
+                         "h " width " "
+                         "v " height " "
+                         "h -" width " z"
+                         "M" marker-x " " marker-y " "
+                         "l " width " " height " "
+                         "M" marker-x " " (+ marker-y height) " "
+                         "l " width " -" height " ")}]
+         [:circle {:cx (+ marker-x (/ width 2))
+                   :cy (+ marker-y (/ height 2))
+                   :r 8
+                   :fill "#31EFB8"}]
+         ]))))
+
 (mf/defc interactions
   [{:keys [selected] :as props}]
   (let [local (mf/deref refs/workspace-local)
@@ -205,6 +235,8 @@
         editing-interaction-index (:editing-interaction-index local)
         draw-interaction-to (:draw-interaction-to local)
         draw-interaction-to-frame (:draw-interaction-to-frame local)
+        move-overlay-to (:move-overlay-to local)
+        move-overlay-index (:move-overlay-index local)
         first-selected (first selected-shapes)]
 
     [:g.interactions
@@ -238,14 +270,32 @@
           (for [[index interaction] (d/enumerate (:interactions shape))]
             (when-not (= index editing-interaction-index)
               (let [dest-shape (get objects (:destination interaction))]
-                [:& interaction-path {:key (str (:id shape) "-" index)
-                                      :index index
-                                      :orig-shape shape
-                                      :dest-shape dest-shape
-                                      :selected selected
-                                      :selected? true
-                                      :action-type (:action-type interaction)
-                                      :zoom zoom}])))
+                [:*
+                  [:& interaction-path {:key (str (:id shape) "-" index)
+                                        :index index
+                                        :orig-shape shape
+                                        :dest-shape dest-shape
+                                        :selected selected
+                                        :selected? true
+                                        :action-type (:action-type interaction)
+                                        :zoom zoom}]
+                  (when (= (:action-type interaction) :open-overlay)
+                    (if (and (some? move-overlay-to)
+                             (= move-overlay-index index))
+                      [:& overlay-marker {:key (str "pos" (:id shape) "-" index)
+                                          :index index
+                                          :orig-shape shape
+                                          :dest-shape dest-shape
+                                          :position move-overlay-to
+                                          :objects objects
+                                          :zoom zoom}]
+                      [:& overlay-marker {:key (str "pos" (:id shape) "-" index)
+                                          :index index
+                                          :orig-shape shape
+                                          :dest-shape dest-shape
+                                          :position (:overlay-position interaction)
+                                          :objects objects
+                                          :zoom zoom}]))])))
           (when (not (#{:move :rotate} current-transform))
             [:& interaction-handle {:key (:id shape)
                                     :index nil