🎉 Initial work on multicanvas setup.

Preparing the workspace code to be able handle
multiple canvas in a single page.

frontend/resources/styles/main.scss

@@ -40,7 +40,7 @@
 
 @import 'main/partials/main-bar';
 @import 'main/partials/workspace-bar';
-@import 'main/partials/workspace-canvas';
+@import 'main/partials/workspace';
 @import 'main/partials/tool-bar';
 @import 'main/partials/project-bar';
 @import 'main/partials/sidebar';

frontend/resources/styles/main/partials/workspace.scss

@@ -35,7 +35,7 @@
   &.no-tool-bar-left {
     padding-left: 0;
     width: calc(100% - 230px);
-    
+
     &.no-tool-bar-right {
       width: 100%;
     }
@@ -68,7 +68,7 @@
     text-align: center;
   }
 
-  .workspace-canvas {
+  .workspace-viewport {
     height: calc(95% - 20px);
     overflow: scroll;
     transition: none;
@@ -86,19 +86,16 @@
         stroke-width: 0.1px;
       }
 
-      svg {
+      g.controls {
-        g.controls {
+        rect.main { pointer-events: none; }
-          rect.main { pointer-events: none; }
+        circle.top-left { cursor: nwse-resize; }
-          circle.top-left { cursor: nwse-resize; }
+        circle.bottom-right { cursor: nwse-resize; }
-          circle.bottom-right { cursor: nwse-resize; }
+        circle.top-right { cursor: nesw-resize; }
-          circle.top-right { cursor: nesw-resize; }
+        circle.bottom-left { cursor: nesw-resize; }
-          circle.bottom-left { cursor: nesw-resize; }
+        circle.top { cursor: ns-resize; }
-          circle.top { cursor: ns-resize; }
+        circle.bottom { cursor: ns-resize; }
-          circle.bottom { cursor: ns-resize; }
+        circle.left { cursor: ew-resize; }
-          circle.left { cursor: ew-resize; }
+        circle.right { cursor: ew-resize; }
-          circle.right { cursor: ew-resize; }
-        }
-
       }
     }
 

frontend/src/uxbox/main/constants.cljs

@@ -11,9 +11,6 @@
 
 (def canvas-start-x 1200)
 (def canvas-start-y 1200)
-(def canvas-scroll-padding 50)
-(def canvas-start-scroll-x (- canvas-start-x canvas-scroll-padding))
-(def canvas-start-scroll-y (- canvas-start-y canvas-scroll-padding))
 
 (def grid-x-axis 10)
 (def grid-y-axis 10)

frontend/src/uxbox/main/data/shapes.cljs

@@ -445,18 +445,12 @@
   {:pre [(uuid? id) (number? index) (gpt/point? delta)]}
   (UpdatePath. id index delta))
 
-(def ^:private canvas-coords
-  (gpt/point c/canvas-start-x
-             c/canvas-start-y))
-
 (deftype InitialPathPointAlign [id index]
   ptk/WatchEvent
   (watch [_ state s]
     (let [shape (get-in state [:shapes id])
-          point (get-in shape [:segments index])
+          point (get-in shape [:segments index])]
-          point (gpt/add point canvas-coords)]
       (->> (uwrk/align-point point)
-           (rx/map #(gpt/subtract % point))
            (rx/map #(update-path id index %))))))
 
 (defn initial-path-point-align

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

@@ -19,7 +19,6 @@
    [uxbox.main.data.shapes :as uds]
    [uxbox.main.data.shapes-impl :as simpl]
    [uxbox.main.data.workspace.ruler :as wruler]
-   [uxbox.main.data.workspace.scroll :as wscroll]
    [uxbox.main.geom :as geom]
    [uxbox.main.lenses :as ul]
    [uxbox.main.refs :as refs]
@@ -37,11 +36,6 @@
 
 ;; --- Expose inner functions
 
-(def start-viewport-positioning wscroll/start-viewport-positioning)
-(def stop-viewport-positioning wscroll/stop-viewport-positioning)
-;; (def start-drawing wdrawing/start-drawing)
-;; (def close-drawing-path wdrawing/close-drawing-path)
-;; (def select-for-drawing wdrawing/select-for-drawing)
 (def start-ruler wruler/start-ruler)
 (def clear-ruler wruler/clear-ruler)
 
@@ -352,7 +346,7 @@
     (rx/of (activate-flag :element-options))))
 
 (defn select-shape
-  "Mark a shape selected for drawing in the canvas."
+  "Mark a shape selected for drawing."
   [id]
   {:pre [(uuid? id)]}
   (SelectShape. id))
@@ -383,24 +377,20 @@
       (assoc-in state [:workspace pid :selected] #{sid}))))
 
 (defn select-first-shape
-  "Mark a shape selected for drawing in the canvas."
+  "Mark a shape selected for drawing."
   []
   (SelectFirstShape.))
 
 ;; --- Select Shapes (By selrect)
 
-(defrecord SelectShapesBySelrect [selrect]
+(def select-shapes-by-current-selrect
-  ptk/UpdateEvent
+  (reify
-  (update [_ state]
+    ptk/UpdateEvent
-    (let [page-id (get-in state [:workspace :current])
+    (update [_ state]
-          shapes (simpl/match-by-selrect state page-id selrect)]
+      (let [pid (get-in state [:workspace :current])
-      (assoc-in state [:workspace page-id :selected] shapes))))
+            selrect (get-in state [:workspace pid :selrect])
-
+            shapes (simpl/match-by-selrect state pid selrect)]
-(defn select-shapes-by-selrect
+        (assoc-in state [:workspace pid :selected] shapes)))))
-  "Select shapes that matches the select rect."
-  [selrect]
-  {:pre [(us/valid? ::uds/rect-like-shape selrect)]}
-  (SelectShapesBySelrect. selrect))
 
 ;; --- Update Shape Attrs
 
@@ -536,21 +526,15 @@
 
 ;; --- Shape Transformations
 
-(def ^:private canvas-coords
-  (gpt/point c/canvas-start-x
-             c/canvas-start-y))
-
 (defrecord InitialShapeAlign [id]
   ptk/WatchEvent
   (watch [_ state s]
     (let [{:keys [x1 y1] :as shape} (->> (get-in state [:shapes id])
                                          (geom/shape->rect-shape state))
-          point1 (gpt/point x1 y1)
+          point (gpt/point x1 y1)]
-          point2 (gpt/add point1 canvas-coords)]
+      (->> (uwrk/align-point point)
-      (->> (uwrk/align-point point2)
-           (rx/map #(gpt/subtract % canvas-coords))
            (rx/map (fn [{:keys [x y] :as pt}]
-                     (apply-temporal-displacement id (gpt/subtract pt point1))))))))
+                     (apply-temporal-displacement id (gpt/subtract pt point))))))))
 
 (defn initial-shape-align
   [id]
@@ -679,22 +663,10 @@
            :y2 end-y
            :type :rect)))
 
-(defn translate-to-canvas
-  "Translate the given rect to the canvas coordinates system."
-  [rect zoom]
-  (let [startx (* c/canvas-start-x zoom)
-        starty (* c/canvas-start-y zoom)]
-    (assoc rect
-           :x1 (/ (- (:x1 rect) startx) zoom)
-           :y1 (/ (- (:y1 rect) starty) zoom)
-           :x2 (/ (- (:x2 rect) startx) zoom)
-           :y2 (/ (- (:y2 rect) starty) zoom))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Server Interactions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-
 ;; --- Update Metadata
 
 ;; Is a workspace aware wrapper over uxbox.data.pages/UpdateMetadata event.

frontend/src/uxbox/main/data/workspace/scroll.cljs

@@ -1,68 +0,0 @@
-;; 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) 2015-2017 Andrey Antukh <niwi@niwi.nz>
-
-(ns uxbox.main.data.workspace.scroll
-  "Workspace scroll related events. Mostly or all events
-  are related to UI logic."
-  (:require [beicon.core :as rx]
-            [potok.core :as ptk]
-            [uxbox.main.refs :as refs]
-            [uxbox.main.streams :as streams]
-            [uxbox.util.dom :as dom]
-            [uxbox.util.geom.point :as gpt]))
-
-;; --- Start Viewport Positioning
-
-(declare stop-viewport-positioning?)
-
-(defn run-viewport-positioning
-  [stream]
-  (let [stoper (->> (rx/filter stop-viewport-positioning? stream)
-                    (rx/take 1))
-        reference @refs/viewport-mouse-position
-        dom (dom/get-element "workspace-canvas")]
-    (->> streams/viewport-mouse-position
-         (rx/take-until stoper)
-         (rx/map (fn [point]
-                   (let [{:keys [x y]} (gpt/subtract point reference)
-                         cx (.-scrollLeft dom)
-                         cy (.-scrollTop dom)]
-                     (set! (.-scrollLeft dom) (- cx x))
-                     (set! (.-scrollTop dom) (- cy y)))))
-         (rx/ignore))))
-
-(deftype StartViewportPositioning [id]
-  ptk/UpdateEvent
-  (update [_ state]
-    (update-in state [:workspace :viewport-positionig] #(if (nil? %) id %)))
-
-  ptk/WatchEvent
-  (watch [_ state stream]
-    (let [cid (get-in state [:workspace :viewport-positionig])]
-      (if (= cid id)
-        (run-viewport-positioning stream)
-        (rx/empty)))))
-
-(defn start-viewport-positioning
-  []
-  (StartViewportPositioning. (gensym "viewport-positioning")))
-
-;; --- Stop Viewport positioning
-
-(deftype StopViewportPositioning []
-  ptk/UpdateEvent
-  (update [_ state]
-    (update state :workspace dissoc :viewport-positionig)))
-
-(defn stop-viewport-positioning
-  []
-  (StopViewportPositioning.))
-
-(defn stop-viewport-positioning?
-  [v]
-  (instance? StopViewportPositioning v))
-
-

frontend/src/uxbox/main/ui/shapes/common.cljs

@@ -47,7 +47,7 @@
 
 
 (defn on-mouse-down
-  [event {:keys [id group] :as shape} selected]
+  [event {:keys [id] :as shape} selected]
   (let [selected? (contains? selected id)
         drawing? @refs/selected-drawing-tool]
     (when-not (:blocked shape)

frontend/src/uxbox/main/ui/workspace.cljs

@@ -31,7 +31,7 @@
    [uxbox.main.ui.workspace.shortcuts :as shortcuts]
    [uxbox.main.ui.workspace.sidebar :refer [left-sidebar right-sidebar]]
    [uxbox.main.ui.workspace.sidebar.history :refer [history-dialog]]
-   [uxbox.main.ui.workspace.streams :as ws]
+   [uxbox.main.ui.workspace.streams :as uws]
    [uxbox.util.data :refer [classnames]]
    [uxbox.util.dom :as dom]
    [uxbox.util.geom.point :as gpt]
@@ -41,11 +41,10 @@
 
 (defn- on-scroll
   [event]
-  ;; TODO: refactor
+  (let [target (.-target event)
-  #_(let [target (.-target event)
         top (.-scrollTop target)
         left (.-scrollLeft target)]
-    (ws/emit! (ws/scroll-event (gpt/point left top)))))
+    (st/emit! (uws/scroll-event (gpt/point left top)))))
 
 (defn- on-wheel
   [event canvas]
@@ -53,7 +52,7 @@
     (let [prev-zoom @refs/selected-zoom
           dom (mf/ref-node canvas)
           scroll-position (scroll/get-current-position-absolute dom)
-          mouse-point @refs/viewport-mouse-position]
+          mouse-point @uws/viewport-mouse-position]
       (dom/prevent-default event)
       (dom/stop-propagation event)
       (if (pos? (.-deltaY event))
@@ -89,7 +88,7 @@
                  :no-tool-bar-right (not right-sidebar?)
                  :no-tool-bar-left (not left-sidebar?)
                  :scrolling (:viewport-positionig workspace))]
-    (prn "workspace.render")
+    ;; (prn "workspace.render")
 
     (mf/use-effect {:deps (:id page)
                     :init #(subscibe canvas page)
@@ -118,8 +117,7 @@
        (when (contains? flags :rules)
          [:& vertical-rule])
 
-       ;; Canvas
+       [:section.workspace-viewport {:id "workspace-viewport" :ref canvas}
-       [:section.workspace-canvas {:id "workspace-canvas" :ref canvas}
         [:& viewport {:page page :key (:id page)}]]]
 
       ;; Aside

frontend/src/uxbox/main/ui/workspace/canvas.cljs

@@ -40,7 +40,7 @@
                        :width width
                        :height height}
      [:& background metadata]
-     [:svg.page-layout
+     #_[:svg.page-layout
       [:g.main
        (for [id (reverse (:shapes page))]
          [:& uus/shape-component {:id id :key id}])

frontend/src/uxbox/main/ui/workspace/drawarea.cljs

@@ -24,10 +24,6 @@
    [uxbox.util.geom.path :as path]
    [uxbox.util.geom.point :as gpt]))
 
-(def ^:private canvas-coords
-  (gpt/point c/canvas-start-x
-             c/canvas-start-y))
-
 ;; --- Events
 
 (declare handle-drawing)
@@ -55,17 +51,11 @@
                       (rx/of (handle-drawing object)))
             (rx/empty)))))))
 
-(defn- translate-to-canvas [point zoom]
-  (-> point
-      (gpt/subtract (gpt/multiply canvas-coords zoom))
-      (gpt/divide zoom)))
-
 (defn- conditional-align [point align?]
   (if align?
     (uwrk/align-point point)
     (rx/of point)))
 
-
 ;; TODO: maybe this should be a simple function
 (defn handle-drawing
   [shape]
@@ -126,10 +116,12 @@
 
               mouse (->> uws/viewport-mouse-position
                          (rx/mapcat #(conditional-align % align?))
-                         (rx/map #(translate-to-canvas % zoom))
                          (rx/with-latest vector uws/mouse-position-ctrl))]
           (rx/concat
-           (rx/of #(initialize-drawing % @uws/canvas-mouse-position))
+           (->> uws/viewport-mouse-position
+                (rx/take 1)
+                (rx/mapcat #(conditional-align % align?))
+                (rx/map (fn [pt] #(initialize-drawing % pt))))
            (->> mouse
                 (rx/map (fn [[pt ctrl?]] #(update-drawing % pt ctrl?)))
                 (rx/take-until stoper))
@@ -174,14 +166,13 @@
               flags (get-in state [:workspace pid :flags])
               align? (refs/alignment-activated? flags)
 
-              last-point (volatile! @uws/canvas-mouse-position)
+              last-point (volatile! @uws/viewport-mouse-position)
 
               stoper (->> (rx/filter stoper-event? stream)
                           (rx/take 1))
 
               mouse (->> (rx/sample 10 uws/viewport-mouse-position)
-                         (rx/mapcat #(conditional-align % align?))
+                         (rx/mapcat #(conditional-align % align?)))
-                         (rx/map #(translate-to-canvas % zoom)))
 
               points (->> stream
                           (rx/filter uws/mouse-click?)
@@ -259,8 +250,7 @@
                           (rx/take 1))
 
               mouse (->> (rx/sample 10 uws/viewport-mouse-position)
-                         (rx/mapcat #(conditional-align % align?))
+                         (rx/mapcat #(conditional-align % align?)))]
-                         (rx/map #(translate-to-canvas % zoom)))]
           (rx/concat
            (rx/of initialize-drawing)
            (->> mouse

frontend/src/uxbox/main/ui/workspace/grid.cljs

@@ -15,29 +15,21 @@
 
 (defn- horizontal-line
   [width acc value]
-  (let [pos (+ value c/canvas-start-y)]
+  (let [pos value]
     (conj acc (str/format "M %s %s L %s %s" 0 pos width pos))))
 
 (defn- vertical-line
   [height acc value]
-  (let [pos (+ value c/canvas-start-y)]
+  (let [pos value]
     (conj acc (str/format "M %s %s L %s %s" pos 0 pos height))))
 
 (defn- make-grid-path
   [metadata]
-  (let [width c/viewport-width
+  (let [x-ticks (range 0 c/viewport-width (:grid-x-axis metadata 10))
-        height c/viewport-height
+        y-ticks (range 0 c/viewport-height (:grid-y-axis metadata 10))]
-
-        x-ticks (range (- 0 c/canvas-start-x)
-                       (- width c/canvas-start-x)
-                       (:grid-x-axis metadata 10))
-
-        y-ticks (range (- 0 c/canvas-start-x)
-                       (- height c/canvas-start-x)
-                       (:grid-y-axis metadata 10))]
     (as-> [] $
-      (reduce (partial vertical-line height) $ x-ticks)
+      (reduce (partial vertical-line c/viewport-height) $ x-ticks)
-      (reduce (partial horizontal-line width) $ y-ticks)
+      (reduce (partial horizontal-line c/viewport-width) $ y-ticks)
       (str/join " " $))))
 
 (mf/defc grid

frontend/src/uxbox/main/ui/workspace/rules.cljs

@@ -13,21 +13,23 @@
    [uxbox.main.constants :as c]
    [uxbox.main.refs :as refs]
    [uxbox.main.store :as s]
+   [uxbox.main.ui.workspace.streams :as uws]
+   [uxbox.util.components :refer [use-rxsub]]
    [uxbox.util.dom :as dom]))
 
 ;; --- Constants & Helpers
 
+(def rule-padding 20)
 (def step-padding 20)
 (def step-size 10)
+(def scroll-padding 50)
+
+(def +ticks+ (range 0 c/viewport-width step-size))
 
 (defn big-ticks-mod [zoom] (/ 100 zoom))
 (defn mid-ticks-mod [zoom] (/ 50 zoom))
 
-(def +ticks+
-  (concat (range (- (/ c/viewport-width 1)) 0 step-size)
-          (range 0 (/ c/viewport-width 1) step-size)))
 
-(def rule-padding 20)
 
 (defn- make-vertical-tick
   [zoom acc value]
@@ -35,8 +37,7 @@
         mid-ticks-mod (mid-ticks-mod zoom)
         pos (+ (* value zoom)
                rule-padding
-               (* c/canvas-start-x zoom)
+               scroll-padding)]
-               c/canvas-scroll-padding)]
     (cond
       (< (mod value big-ticks-mod) step-size)
       (conj acc (str/format "M %s %s L %s %s" pos 5 pos step-padding))
@@ -52,8 +53,7 @@
   (let [big-ticks-mod (big-ticks-mod zoom)
         mid-ticks-mod (mid-ticks-mod zoom)
         pos (+ (* value zoom)
-               (* c/canvas-start-x zoom)
+               scroll-padding)]
-               c/canvas-scroll-padding)]
     (cond
       (< (mod value big-ticks-mod) step-size)
       (conj acc (str/format "M %s %s L %s %s" 5 pos step-padding pos))
@@ -71,8 +71,7 @@
   (let [big-ticks-mod (big-ticks-mod zoom)
         pos (+ (* value zoom)
                rule-padding
-               (* c/canvas-start-x zoom)
+               scroll-padding)]
-               c/canvas-scroll-padding)]
     (when (< (mod value big-ticks-mod) step-size)
       [:text {:x (+ pos 2)
               :y 13
@@ -87,8 +86,7 @@
   [{:keys [zoom value] :as props}]
   (let [big-ticks-mod (big-ticks-mod zoom)
         pos (+ (* value zoom)
-               (* c/canvas-start-x zoom)
+               scroll-padding)]
-               c/canvas-scroll-padding)]
     (when (< (mod value big-ticks-mod) step-size)
       [:text {:y (- pos 3)
               :x 5
@@ -103,8 +101,7 @@
 (mf/defc horizontal-rule-ticks
   {:wrap [mf/wrap-memo]}
   [{:keys [zoom]}]
-  (let [zoom (or zoom 1)
+  (let [path (reduce (partial make-vertical-tick zoom) [] +ticks+)]
-        path (reduce (partial make-vertical-tick zoom) [] +ticks+)]
     [:g
      [:path {:d (str/join " " path)}]
      (for [tick +ticks+]
@@ -115,8 +112,7 @@
 (mf/defc vertical-rule-ticks
   {:wrap [mf/wrap-memo]}
   [{:keys [zoom]}]
-  (let [zoom (or zoom 1)
+  (let [path (reduce (partial make-horizontal-tick zoom) [] +ticks+)]
-        path (reduce (partial make-horizontal-tick zoom) [] +ticks+)]
     [:g
      [:path {:d (str/join " " path)}]
      (for [tick +ticks+]
@@ -127,10 +123,9 @@
 (mf/defc horizontal-rule
   {:wrap [mf/wrap-memo]}
   [props]
-  (let [scroll (mf/deref refs/workspace-scroll)
+  (let [scroll (use-rxsub  uws/viewport-scroll)
         zoom (mf/deref refs/selected-zoom)
-        scroll-x (:x scroll)
+        translate-x (- (- scroll-padding) (:x scroll))]
-        translate-x (- (- c/canvas-scroll-padding) (:x scroll))]
     [:svg.horizontal-rule
      {:width c/viewport-width
       :height 20}
@@ -144,13 +139,15 @@
 (mf/defc vertical-rule
   {:wrap [mf/wrap-memo]}
   [props]
-  (let [scroll (mf/deref refs/workspace-scroll)
+  (let [scroll (use-rxsub uws/viewport-scroll)
-        zoom (mf/deref refs/selected-zoom)
+        zoom (or (mf/deref refs/selected-zoom) 1)
         scroll-y (:y scroll)
-        translate-y (- (- c/canvas-scroll-padding) (:y scroll))]
+        translate-y (+ (- scroll-padding)
-    [:svg.vertical-rule
+                       (- (:y scroll)))
-     {:width 20
+        ]
-      :height c/viewport-height}
+    [:svg.vertical-rule {:width 20
+                         ;; :x 0 :y 0
+                         :height c/viewport-height}
 
      [:g {:transform (str  "translate(0, " translate-y ")")}
       [:& vertical-rule-ticks {:zoom zoom}]]

frontend/src/uxbox/main/ui/workspace/selection.cljs

@@ -71,7 +71,7 @@
           stoper (->> ws/interaction-events
                       (rx/filter ws/mouse-up?)
                       (rx/take 1))
-          stream (->> ws/canvas-mouse-position
+          stream (->> ws/viewport-mouse-position
                       (rx/take-until stoper)
                       (rx/map apply-zoom)
                       (rx/mapcat apply-grid-alignment)

frontend/src/uxbox/main/ui/workspace/streams.cljs

@@ -54,21 +54,17 @@
 
 (defrecord PointerEvent [window
                          viewport
-                         canvas
                          ctrl
                          shift])
 
 (defn pointer-event
-  [window viewport canvas ctrl shift]
+  [window viewport ctrl shift]
   {:pre [(gpt/point? window)
          (gpt/point? viewport)
-         (or (gpt/point? canvas)
-             (nil? canvas))
          (boolean? ctrl)
          (boolean? shift)]}
   (PointerEvent. window
                  viewport
-                 canvas
                  ctrl
                  shift))
 
@@ -76,13 +72,24 @@
   [v]
   (instance? PointerEvent v))
 
-;; --- Derived streams
+(defrecord ScrollEvent [point])
+
+(defn scroll-event
+  [pt]
+  {:pre [(gpt/point? pt)]}
+  (ScrollEvent. pt))
+
+(defn scroll-event?
+  [v]
+  (instance? ScrollEvent v))
 
 (defn interaction-event?
   [event]
   (or (keyboard-event? event)
       (mouse-event? event)))
 
+;; --- Derived streams
+
 ;; TODO: this shoul be DEPRECATED
 (defonce interaction-events
   (rx/filter interaction-event? st/stream))
@@ -90,12 +97,6 @@
 (defonce mouse-position
   (rx/filter pointer-event? st/stream))
 
-(defonce canvas-mouse-position
-  (let [sub (rx/behavior-subject nil)]
-    (-> (rx/map :canvas mouse-position)
-        (rx/subscribe-with sub))
-    sub))
-
 (defonce viewport-mouse-position
   (let [sub (rx/behavior-subject nil)]
     (-> (rx/map :viewport mouse-position)
@@ -126,3 +127,11 @@
        (rx/map (fn [[old new]]
                  (gpt/subtract new old)))
        (rx/share)))
+
+(defonce viewport-scroll
+  (let [sub (rx/behavior-subject nil)
+        sob (->> (rx/filter scroll-event? st/stream)
+                 (rx/map :point))]
+    (rx/subscribe-with sob sub)
+    sub))
+

frontend/src/uxbox/main/ui/workspace/viewport.cljs

@@ -22,6 +22,11 @@
    [uxbox.main.ui.workspace.ruler :refer [ruler]]
    [uxbox.main.ui.workspace.streams :as uws]
    [uxbox.main.ui.workspace.drawarea :refer [start-drawing]]
+
+   [uxbox.main.ui.shapes :as uus]
+   [uxbox.main.ui.workspace.drawarea :refer [draw-area]]
+   [uxbox.main.ui.workspace.selection :refer [selection-handlers]]
+
    [uxbox.util.data :refer [parse-int]]
    [uxbox.util.dom :as dom]
    [uxbox.util.geom.point :as gpt])
@@ -69,47 +74,32 @@
 
 ;; --- Selection Rect
 
-(defn stop-selrect
+(def ^:private handle-selrect
-  []
+  (letfn [(update-state [state position]
-  (letfn [(clear-state [state]
+            (let [id (get-in state [:workspace :current])
-            (prn "clear-state")
+                  selrect (get-in state [:workspace id :selrect])]
+              (if selrect
+                (assoc-in state [:workspace id :selrect]
+                          (dw/selection->rect (assoc selrect :stop position)))
+                (assoc-in state [:workspace id :selrect]
+                          (dw/selection->rect {:start position :stop position})))))
+
+          (clear-state [state]
             (let [id (get-in state [:workspace :current])]
               (update-in state [:workspace id] dissoc :selrect)))]
     (reify
       ptk/WatchEvent
       (watch [_ state stream]
-        (let [id (get-in state [:workspace :current])
+        (let [stoper (->> (rx/merge (rx/filter #(= % :interrupt) stream)
-              zoom (get-in state [:workspace id :zoom])
+                                    (rx/filter uws/mouse-up? stream))
-              rect (some-> (get-in state [:workspace id :selrect])
+                          (rx/take 1))]
-                           (dw/translate-to-canvas zoom))]
+          (rx/concat
-          (if rect
+           (->> uws/viewport-mouse-position
-            (rx/of clear-state
+                (rx/map (fn [pos] #(update-state % pos)))
-                   (dw/deselect-all)
+                (rx/take-until stoper))
-                   (dw/select-shapes-by-selrect rect))
+           (rx/of (dw/deselect-all)
-            (rx/of (dw/deselect-all))))))))
+                  dw/select-shapes-by-current-selrect
-
+                  clear-state)))))))
-(defn start-selrect
-  []
-  (letfn [(update-state [state position]
-            (let [id (get-in state [:workspace :current])
-                  selrect (get-in state [:workspace id :selrect])]
-              (if selrect
-                (assoc-in state [:workspace id :selrect] (dw/selection->rect (assoc selrect :stop position)))
-                (assoc-in state [:workspace id :selrect] (dw/selection->rect {:start position :stop position})))))
-
-          (selection-stoper [stream]
-            (->> (rx/merge (rx/filter #(= % :interrupt) stream)
-                           (rx/filter uws/mouse-up? stream))
-                 (rx/take 1)))]
-
-    (reify
-      ptk/WatchEvent
-      (watch [_ state stream]
-        (rx/concat
-         (->> uws/viewport-mouse-position
-              (rx/take-until (selection-stoper stream))
-              (rx/map (fn [pos] #(update-state % pos))))
-         (rx/of (stop-selrect)))))))
 
 (mf/defc selrect
   {:wrap [mf/wrap-memo]}
@@ -122,6 +112,27 @@
         :width width
         :height height}])))
 
+
+;; --- Viewport Positioning
+
+(def handle-viewport-positioning
+  (reify
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (let [stoper (->> (rx/filter #(= ::finish-positioning %) stream)
+                        (rx/take 1))
+            reference @uws/viewport-mouse-position
+            dom (dom/get-element "workspace-viewport")]
+        (->> uws/viewport-mouse-position
+             (rx/map (fn [point]
+                       (let [{:keys [x y]} (gpt/subtract point reference)
+                             cx (.-scrollLeft dom)
+                             cy (.-scrollTop dom)]
+                         (set! (.-scrollLeft dom) (- cx x))
+                         (set! (.-scrollTop dom) (- cy y)))))
+             (rx/take-until stoper)
+             (rx/ignore))))))
+
 ;; --- Viewport
 
 (mf/def viewport
@@ -138,27 +149,19 @@
                                      (parse-int (.-top brect)))]
                 (gpt/subtract pt brect)))
 
-            (translate-point-to-canvas [pt]
-              (let [viewport (mf/ref-node (::viewport own))]
-                (when-let [canvas (dom/get-element-by-class "page-canvas" viewport)]
-                  (let [brect (.getBoundingClientRect canvas)
-                        bbox (.getBBox canvas)
-                        brect (gpt/point (parse-int (.-left brect))
-                                         (parse-int (.-top brect)))
-                        bbox (gpt/point (.-x bbox) (.-y bbox))]
-                    (-> (gpt/add pt bbox)
-                        (gpt/subtract brect))))))
-
             (on-key-down [event]
-              (let [key (.-keyCode event)
+              (let [bevent (.getBrowserEvent event)
+                    key (.-keyCode event)
                     ctrl? (kbd/ctrl? event)
                     shift? (kbd/shift? event)
                     opts {:key key
                           :shift? shift?
                           :ctrl? ctrl?}]
-                (st/emit! (uws/keyboard-event :down key ctrl? shift?))
+                (when-not (.-repeat bevent)
-                (when (kbd/space? event)
+                  (st/emit! (uws/keyboard-event :down key ctrl? shift?))
-                  (st/emit! (dw/start-viewport-positioning)))))
+                  (when (kbd/space? event)
+                    (st/emit! handle-viewport-positioning)
+                    #_(st/emit! (dw/start-viewport-positioning))))))
 
             (on-key-up [event]
               (let [key (.-keyCode event)
@@ -168,22 +171,20 @@
                           :shift? shift?
                           :ctrl? ctrl?}]
                 (when (kbd/space? event)
-                  (st/emit! (dw/stop-viewport-positioning)))
+                  (st/emit! ::finish-positioning #_(dw/stop-viewport-positioning)))
                 (st/emit! (uws/keyboard-event :up key ctrl? shift?))))
 
             (on-mousemove [event]
               (let [wpt (gpt/point (.-clientX event)
                                    (.-clientY event))
                     vpt (translate-point-to-viewport wpt)
-                    cpt (translate-point-to-canvas wpt)
                     ctrl? (kbd/ctrl? event)
                     shift? (kbd/shift? event)
                     event {:ctrl ctrl?
                            :shift shift?
                            :window-coords wpt
-                           :viewport-coords vpt
+                           :viewport-coords vpt}]
-                           :canvas-coords cpt}]
+                (st/emit! (uws/pointer-event wpt vpt ctrl? shift?))))]
-                (st/emit! (uws/pointer-event wpt vpt cpt ctrl? shift?))))]
 
       (let [key1 (events/listen js/document EventType.MOUSEMOVE on-mousemove)
             key2 (events/listen js/document EventType.KEYDOWN on-key-down)
@@ -217,7 +218,7 @@
                 (when (not edition)
                   (if drawing-tool
                     (st/emit! (start-drawing drawing-tool))
-                    (st/emit! :interrupt (start-selrect)))))
+                    (st/emit! :interrupt handle-selrect))))
               (on-context-menu [event]
                 (dom/prevent-default event)
                 (dom/stop-propagation event)
@@ -264,6 +265,22 @@
           [:g.zoom {:transform (str "scale(" zoom ", " zoom ")")}
            (when page
              [:& canvas {:page page :wst wst}])
+
+           (when page
+             [:*
+              (for [id (reverse (:shapes page))]
+                [:& uus/shape-component {:id id :key id}])
+
+              (when (seq (:selected wst))
+                [:& selection-handlers {:wst wst}])
+
+              (when-let [dshape (:drawing wst)]
+                [:& draw-area {:shape dshape
+                               :zoom (:zoom wst)
+                               :modifiers (:modifiers wst)}])])
+
+
+
            (if (contains? flags :grid)
              [:& grid {:page page}])]
           (when (contains? flags :ruler)

frontend/src/uxbox/util/components.cljs

@@ -38,3 +38,13 @@
                       :end #(when % (rx/cancel! %))})
       (for [item (:current @state)]
         (children item)))))
+
+(defn use-rxsub
+  [ob]
+  (let [[state reset-state!] (mf/use-state* @ob)]
+    (mf/use-effect*
+     (fn []
+       (let [sub (rx/subscribe ob #(reset-state! %))]
+         #(rx/cancel! sub)))
+     #js [ob])
+    state))