Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-02-13 02:28:18 -05:00
Code Issues Activity

Merge pull request #234 from uxbox/308/paste-and-drop-image

Browse source 
308/paste and drop image
This commit is contained in:
Andrey Antukh 2020-06-03 11:41:51 +02:00 • committed by GitHub
commit 700e99a25d
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
11 changed files with 566 additions and 513 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
common/uxbox/common/pages.cljc
View file

@ -327,6 +327,65 @@
:fill-opacity 1
:shapes []})
(def ^:private default-color "#b1b2b5") ;; $color-gray-20
(def ^:private minimal-shapes
[{:type :rect
:name "Rect"
:fill-color default-color
:stroke-alignment :center}
{:type :image}
{:type :icon}
{:type :circle
:name "Circle"
:fill-color default-color}
{:type :path
:name "Path"
:stroke-style :solid
:stroke-color "#000000"
:stroke-width 2
:stroke-alignment :center
:fill-color "#000000"
:fill-opacity 0
:segments []}
{:type :frame
:stroke-style :none
:stroke-alignment :center
:name "Artboard"}
{:type :curve
:name "Path"
:stroke-style :solid
:stroke-color "#000000"
:stroke-width 2
:stroke-alignment :center
:fill-color "#000000"
:fill-opacity 0
:segments []}
{:type :text
:name "Text"
:content nil}])
(defn make-minimal-shape
[type]
(let [shape (d/seek #(= type (:type %)) minimal-shapes)]
(assert shape "unexpected shape type")
(assoc shape
:id (uuid/next)
:x 0
:y 0
:width 1
:height 1
:selrect {:x 0
:x1 0
:x2 0
:y 0
:y1 0
:y2 0
:width 1
:height 1}
:points []
:segments [])))
;; --- Changes Processing Impl
(defmulti process-change

59
frontend/src/uxbox/main/data/workspace.cljs
View file

@ -508,6 +508,40 @@
(when (= :text (:type attrs))
(start-edition-mode id)))))))
(defn- calculate-centered-box
[state aspect-ratio]
(if (>= aspect-ratio 1)
(let [vbox (get-in state [:workspace-local :vbox])
width (/ (:width vbox) 2)
height (/ width aspect-ratio)
x (+ (:x vbox) (/ width 2))
y (+ (:y vbox) (/ (- (:height vbox) height) 2))]
[width height x y])
(let [vbox (get-in state [:workspace-local :vbox])
height (/ (:height vbox) 2)
width (* height aspect-ratio)
y (+ (:y vbox) (/ height 2))
x (+ (:x vbox) (/ (- (:width vbox) width) 2))]
[width height x y])))
(defn create-and-add-shape
[type data aspect-ratio]
(ptk/reify ::create-and-add-shape
ptk/WatchEvent
(watch [_ state stream]
(let [[width height x y] (calculate-centered-box state aspect-ratio)
shape (-> (cp/make-minimal-shape type)
(merge data)
(geom/resize width height)
(geom/absolute-move (gpt/point x y)))]
(rx/of (add-shape shape))))))
@ -1096,15 +1130,38 @@
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})
(dws/select-shapes selected))))))
(defn- image-uploaded
[{:keys [id name] :as image}]
(let [shape {:name name
:metadata {:width (:width image)
:height (:height image)
:uri (:uri image)
:thumb-width (:thumb-width image)
:thumb-height (:thumb-height image)
:thumb-uri (:thumb-uri image)}}
aspect-ratio (/ (:width image) (:height image))]
(st/emit! (create-and-add-shape :image shape aspect-ratio))))
(defn- paste-image-impl
[image]
(ptk/reify ::paste-bin-impl
ptk/WatchEvent
(watch [_ state stream]
(rx/of (dwp/upload-image image image-uploaded)))))
(def paste
(ptk/reify ::paste
ptk/WatchEvent
(watch [_ state stream]
(->> (rx/from (wapi/read-from-clipboard))
(->> (wapi/read-from-clipboard)
(rx/map t/decode)
(rx/filter #(= :copied-shapes (:type %)))
(rx/map #(select-keys % [:selected :objects]))
(rx/map paste-impl)
(rx/catch (partial instance? js/SyntaxError)
(fn [_]
(->> (wapi/read-image-from-clipboard)
(rx/map paste-image-impl))))
(rx/catch (fn [err]
(js/console.error "Clipboard error:" err)
(rx/empty)))))))

282
frontend/src/uxbox/main/data/workspace/drawing.cljs Normal file
View file

@ -0,0 +1,282 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
(ns uxbox.main.data.workspace.drawing
"Drawing interactions."
(:require
[beicon.core :as rx]
[potok.core :as ptk]
[uxbox.main.data.workspace :as dw]
[uxbox.common.geom.shapes :as geom]
[uxbox.common.geom.point :as gpt]
[uxbox.common.pages :as cp]
[uxbox.util.geom.path :as path]
[uxbox.main.snap :as snap]
[uxbox.main.streams :as ms]
[uxbox.common.uuid :as uuid]))
(declare handle-drawing)
(declare handle-drawing-generic)
(declare handle-drawing-path)
(declare handle-drawing-curve)
(declare handle-finish-drawing)
(declare conditional-align)
(defn start-drawing
[type]
{:pre [(keyword? type)]}
(let [id (gensym "drawing")]
(ptk/reify ::start-drawing
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :drawing-lock] #(if (nil? %) id %)))
ptk/WatchEvent
(watch [_ state stream]
(let [lock (get-in state [:workspace-local :drawing-lock])]
(if (= lock id)
(rx/merge
(->> (rx/filter #(= % handle-finish-drawing) stream)
(rx/take 1)
(rx/map (fn [_] #(update % :workspace-local dissoc :drawing-lock))))
(rx/of (handle-drawing type)))
(rx/empty)))))))
(defn handle-drawing
[type]
(ptk/reify ::handle-drawing
ptk/UpdateEvent
(update [_ state]
(let [data (cp/make-minimal-shape type)]
(update-in state [:workspace-local :drawing] merge data)))
ptk/WatchEvent
(watch [_ state stream]
(case type
:path (rx/of handle-drawing-path)
:curve (rx/of handle-drawing-curve)
(rx/of handle-drawing-generic)))))
(def handle-drawing-generic
(letfn [(resize-shape [{:keys [x y] :as shape} point lock? point-snap]
(let [initial (gpt/point x y)
shape' (geom/shape->rect-shape shape)
shapev (gpt/point (:width shape') (:height shape'))
deltav (gpt/to-vec initial point-snap)
scalev (gpt/divide (gpt/add shapev deltav) shapev)
scalev (if lock?
(let [v (max (:x scalev) (:y scalev))]
(gpt/point v v))
scalev)]
(-> shape
(assoc-in [:modifiers :resize-vector] scalev)
(assoc-in [:modifiers :resize-origin] (gpt/point x y))
(assoc-in [:modifiers :resize-rotation] 0))))
(update-drawing [state point lock? point-snap]
(update-in state [:workspace-local :drawing] resize-shape point lock? point-snap))]
(ptk/reify ::handle-drawing-generic
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
stoper? #(or (ms/mouse-up? %) (= % :interrupt))
stoper (rx/filter stoper? stream)
initial @ms/mouse-position
page-id (get state :current-page-id)
objects (get-in state [:workspace-data page-id :objects])
layout (get state :workspace-layout)
frames (->> objects
vals
(filter (comp #{:frame} :type))
(remove #(= (:id %) uuid/zero) ))
frame-id (or (->> frames
(filter #(geom/has-point? % initial))
first
:id)
uuid/zero)
shape (-> state
(get-in [:workspace-local :drawing])
(geom/setup {:x (:x initial) :y (:y initial) :width 1 :height 1})
(assoc :frame-id frame-id)
(assoc ::initialized? true))]
(rx/concat
(rx/of #(assoc-in state [:workspace-local :drawing] shape))
(->> (snap/closest-snap-point page-id [shape] layout initial)
(rx/map (fn [{:keys [x y]}]
#(-> %
(assoc-in [:workspace-local :drawing :x] x)
(assoc-in [:workspace-local :drawing :y] y)))))
(->> ms/mouse-position
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/switch-map (fn [[point :as current]]
(->> (snap/closest-snap-point page-id [shape] layout point)
(rx/map #(conj current %)))))
(rx/map (fn [[pt ctrl? point-snap]] #(update-drawing % pt ctrl? point-snap)))
(rx/take-until stoper))
(rx/of handle-finish-drawing)))))))
(def handle-drawing-path
(letfn [(stoper-event? [{:keys [type shift] :as event}]
(or (= event ::end-path-drawing)
(and (ms/mouse-event? event)
(or (and (= type :double-click) shift)
(= type :context-menu)))
(and (ms/keyboard-event? event)
(= type :down)
(= 13 (:key event)))))
(initialize-drawing [state point]
(-> state
(assoc-in [:workspace-local :drawing :segments] [point point])
(assoc-in [:workspace-local :drawing ::initialized?] true)))
(insert-point-segment [state point]
(-> state
(update-in [:workspace-local :drawing :segments] (fnil conj []) point)))
(update-point-segment [state index point]
(let [segments (count (get-in state [:workspace-local :drawing :segments]))
exists? (< -1 index segments)]
(cond-> state
exists? (assoc-in [:workspace-local :drawing :segments index] point))))
(finish-drawing-path [state]
(update-in
state [:workspace-local :drawing]
(fn [shape] (-> shape
(update :segments #(vec (butlast %)))
(geom/update-path-selrect)))))]
(ptk/reify ::handle-drawing-path
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
last-point (volatile! @ms/mouse-position)
stoper (->> (rx/filter stoper-event? stream)
(rx/share))
mouse (rx/sample 10 ms/mouse-position)
points (->> stream
(rx/filter ms/mouse-click?)
(rx/filter #(false? (:shift %)))
(rx/with-latest vector mouse)
(rx/map second))
counter (rx/merge (rx/scan #(inc %) 1 points) (rx/of 1))
stream' (->> mouse
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/with-latest vector counter)
(rx/map flatten))
imm-transform #(vector (- % 7) (+ % 7) %)
immanted-zones (vec (concat
(map imm-transform (range 0 181 15))
(map (comp imm-transform -) (range 0 181 15))))
align-position (fn [angle pos]
(reduce (fn [pos [a1 a2 v]]
(if (< a1 angle a2)
(reduced (gpt/update-angle pos v))
pos))
pos
immanted-zones))]
(rx/merge
(rx/of #(initialize-drawing % @last-point))
(->> points
(rx/take-until stoper)
(rx/map (fn [pt] #(insert-point-segment % pt))))
(rx/concat
(->> stream'
(rx/map (fn [[point ctrl? index :as xxx]]
(let [point (if ctrl?
(as-> point $
(gpt/subtract $ @last-point)
(align-position (gpt/angle $) $)
(gpt/add $ @last-point))
point)]
#(update-point-segment % index point))))
(rx/take-until stoper))
(rx/of finish-drawing-path
handle-finish-drawing))))))))
(def simplify-tolerance 0.3)
(def handle-drawing-curve
(letfn [(stoper-event? [{:keys [type shift] :as event}]
(ms/mouse-event? event) (= type :up))
(initialize-drawing [state]
(assoc-in state [:workspace-local :drawing ::initialized?] true))
(insert-point-segment [state point]
(update-in state [:workspace-local :drawing :segments] (fnil conj []) point))
(finish-drawing-curve [state]
(update-in
state [:workspace-local :drawing]
(fn [shape]
(-> shape
(update :segments #(path/simplify % simplify-tolerance))
(geom/update-path-selrect)))))]
(ptk/reify ::handle-drawing-curve
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
stoper (rx/filter stoper-event? stream)
mouse (rx/sample 10 ms/mouse-position)]
(rx/concat
(rx/of initialize-drawing)
(->> mouse
(rx/map (fn [pt] #(insert-point-segment % pt)))
(rx/take-until stoper))
(rx/of finish-drawing-curve
handle-finish-drawing)))))))
(def handle-finish-drawing
(ptk/reify ::handle-finish-drawing
ptk/WatchEvent
(watch [_ state stream]
(let [shape (get-in state [:workspace-local :drawing])]
(rx/concat
(rx/of dw/clear-drawing)
(when (::initialized? shape)
(let [shape-min-width (case (:type shape)
:text 20
5)
shape-min-height (case (:type shape)
:text 16
5)
shape (-> shape
geom/transform-shape
(dissoc ::initialized?)) ]
;; Add & select the created shape to the workspace
(rx/of dw/deselect-all
(dw/add-shape shape)))))))))
(def close-drawing-path
(ptk/reify ::close-drawing-path
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :drawing :close?] true))))

112
frontend/src/uxbox/main/ui/hooks.cljs
View file

@ -17,6 +17,7 @@
[rumext.alpha :as mf]
[uxbox.util.transit :as t]
[uxbox.util.dom :as dom]
[uxbox.util.dom.dnd :as dnd]
[uxbox.util.webapi :as wapi]
[uxbox.util.timers :as ts]
["mousetrap" :as mousetrap])
@ -73,18 +74,6 @@
(set! (.-src img) imd)
img))
(defn drop-side
[height ypos detect-center?]
(let [thold (/ height 2)
thold1 (* height 0.2)
thold2 (* height 0.8)]
(if detect-center?
(cond
(< ypos thold1) :top
(> ypos thold2) :bot
:else :center)
(if (> ypos thold) :bot :top))))
(defn- set-timer
[state ms func]
(assoc state :timer (ts/schedule ms func)))
@ -98,24 +87,6 @@
(dissoc state :timer))
state)))
;; The dnd interface is broken in several ways. This is the official documentation
;; https://developer.mozilla.org/en-US/docs/Web/API/HTML_Drag_and_Drop_API
;;
;; And there is some discussion of the problems and many uncomplete solutions
;; https://github.com/lolmaus/jquery.dragbetter/#what-this-is-all-about
;; https://www.w3schools.com/jsref/event_relatedtarget.asp
;; https://stackoverflow.com/questions/14194324/firefox-firing-dragleave-when-dragging-over-text?noredirect=1&lq=1
;; https://stackoverflow.com/questions/7110353/html5-dragleave-fired-when-hovering-a-child-element
;; This function is useful to debug the erratic dnd interface behaviour when something weird occurs
;; (defn- trace
;; [event data label]
;; (js/console.log
;; label
;; "[" (:name data) "]"
;; (if (.-currentTarget event) (.-textContent (.-currentTarget event)) "null")
;; (if (.-relatedTarget event) (.-textContent (.-relatedTarget event)) "null")))
(defn use-sortable
[& {:keys [data-type data on-drop on-drag on-hold detect-center?] :as opts}]
(let [ref (mf/use-ref)
@ -125,78 +96,61 @@
on-drag-start
(fn [event]
(dom/stop-propagation event)
;; (trace event data "drag-start")
(let [dtrans (unchecked-get event "dataTransfer")]
(.setDragImage dtrans (invisible-image) 0 0)
(set! (.-effectAllowed dtrans) "move")
(.setData dtrans data-type (t/encode data))
(when (fn? on-drag)
(on-drag data))))
;; (dnd/trace event data "drag-start")
(dnd/set-data! event data-type data)
(dnd/set-drag-image! event (invisible-image))
(dnd/set-allowed-effect! event "move")
(when (fn? on-drag)
(on-drag data)))
on-drag-enter
(fn [event]
(dom/prevent-default event) ;; prevent default to allow drag enter
(let [target (.-currentTarget event)
related (.-relatedTarget event)]
(when-not (.contains target related) ;; ignore events triggered by elements that are
(dom/stop-propagation event) ;; children of the drop target
;; (trace event data "drag-enter")
(when (fn? on-hold)
(swap! state (fn [state]
(-> state
(cancel-timer)
(set-timer 1000 on-hold))))))))
(when-not (dnd/from-child? event)
(dom/stop-propagation event)
;; (dnd/trace event data "drag-enter")
(when (fn? on-hold)
(swap! state (fn [state]
(-> state
(cancel-timer)
(set-timer 1000 on-hold)))))))
on-drag-over
(fn [event]
(let [dtrans (unchecked-get event "dataTransfer")
target (.-currentTarget event)
related (.-relatedTarget event)
ypos (unchecked-get event "offsetY")
height (unchecked-get target "clientHeight")
side (drop-side height ypos detect-center?)]
(when (.includes (.-types dtrans) data-type)
(dom/prevent-default event) ;; prevent default to allow drag over
(when-not (.contains target related)
(dom/stop-propagation event)
;; (trace event data "drag-over")
(when (dnd/has-type? event data-type)
(dom/prevent-default event) ;; prevent default to allow drag over
(when-not (dnd/from-child? event)
(dom/stop-propagation event)
;; (dnd/trace event data "drag-over")
(let [side (dnd/drop-side event detect-center?)]
(swap! state assoc :over side)))))
on-drag-leave
(fn [event]
(let [target (.-currentTarget event)
related (.-relatedTarget event)]
(when-not (.contains target related)
(dom/stop-propagation event)
;; (trace event data "drag-leave")
(swap! state (fn [state]
(-> state
(cancel-timer)
(dissoc :over)))))))
(when-not (dnd/from-child? event)
(dom/stop-propagation event)
;; (dnd/trace event data "drag-leave")
(swap! state (fn [state]
(-> state
(cancel-timer)
(dissoc :over))))))
on-drop'
(fn [event]
(dom/stop-propagation event)
;; (trace event data "drop")
(let [dtrans (unchecked-get event "dataTransfer")
dtdata (.getData dtrans data-type)
target (.-currentTarget event)
ypos (unchecked-get event "offsetY")
height (unchecked-get target "clientHeight")
side (drop-side height ypos detect-center?)]
;; (dnd/trace event data "drop")
(let [side (dnd/drop-side event detect-center?)
drop-data (dnd/get-data event data-type)]
(swap! state (fn [state]
(-> state
(cancel-timer)
(dissoc :over))))
(when (fn? on-drop)
(on-drop side (t/decode dtdata)))))
(on-drop side drop-data))))
on-drag-end
(fn [event]
;; (trace event data "drag-end")
;; (dnd/trace event data "drag-end")
(swap! state (fn [state]
(-> state
(cancel-timer)

378
frontend/src/uxbox/main/ui/workspace/drawarea.cljs
View file

@ -5,384 +5,15 @@
;; Copyright (c) 2015-2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.main.ui.workspace.drawarea
"Draw interaction and component."
"Drawing components."
(:require
[beicon.core :as rx]
[potok.core :as ptk]
[rumext.alpha :as mf]
[uxbox.main.constants :as c]
[uxbox.main.data.workspace :as dw]
[uxbox.main.refs :as refs]
[uxbox.main.data.workspace.drawing :as dd]
[uxbox.main.store :as st]
[uxbox.main.streams :as ms]
[uxbox.main.ui.workspace.shapes :as shapes]
[uxbox.common.math :as mth]
[uxbox.util.dom :as dom]
[uxbox.util.data :refer [seek]]
[uxbox.common.geom.shapes :as geom]
[uxbox.common.geom.matrix :as gmt]
[uxbox.common.geom.point :as gpt]
[uxbox.util.geom.path :as path]
[uxbox.util.i18n :as i18n :refer [t]]
[uxbox.main.snap :as snap]
[uxbox.common.uuid :as uuid]))
;; --- Events
(declare handle-drawing)
(declare handle-drawing-generic)
(declare handle-drawing-path)
(declare handle-drawing-curve)
(declare handle-finish-drawing)
(declare conditional-align)
(def ^:private default-color "#b1b2b5") ;; $color-gray-20
(def ^:private minimal-shapes
[{:type :rect
:name "Rect"
:fill-color default-color
:stroke-alignment :center}
{:type :image}
{:type :icon}
{:type :circle
:name "Circle"
:fill-color default-color}
{:type :path
:name "Path"
:stroke-style :solid
:stroke-color "#000000"
:stroke-width 2
:stroke-alignment :center
:fill-color "#000000"
:fill-opacity 0
:segments []}
{:type :frame
:stroke-style :none
:stroke-alignment :center
:name "Artboard"}
{:type :curve
:name "Path"
:stroke-style :solid
:stroke-color "#000000"
:stroke-width 2
:stroke-alignment :center
:fill-color "#000000"
:fill-opacity 0
:segments []}
{:type :text
:name "Text"
:content nil}])
(defn- make-minimal-shape
[type]
(let [tool (seek #(= type (:type %)) minimal-shapes)]
(assert tool "unexpected drawing tool")
(assoc tool
:id (uuid/next)
:x 0
:y 0
:width 1
:height 1
:selrect {:x 0
:x1 0
:x2 0
:y 0
:y1 0
:y2 0
:width 1
:height 1}
:points []
:segments [])))
(defn- calculate-centered-box
[state aspect-ratio]
(if (>= aspect-ratio 1)
(let [vbox (get-in state [:workspace-local :vbox])
width (/ (:width vbox) 2)
height (/ width aspect-ratio)
x (+ (:x vbox) (/ width 2))
y (+ (:y vbox) (/ (- (:height vbox) height) 2))]
[width height x y])
(let [vbox (get-in state [:workspace-local :vbox])
height (/ (:height vbox) 2)
width (* height aspect-ratio)
y (+ (:y vbox) (/ height 2))
x (+ (:x vbox) (/ (- (:width vbox) width) 2))]
[width height x y])))
(defn direct-add-shape
[type data aspect-ratio]
(ptk/reify ::direct-add-shape
ptk/WatchEvent
(watch [_ state stream]
(let [[width height x y] (calculate-centered-box state aspect-ratio)
shape (-> (make-minimal-shape type)
(merge data)
(geom/resize width height)
(geom/absolute-move (gpt/point x y)))]
(rx/of (dw/add-shape shape))))))
(defn start-drawing
[type]
{:pre [(keyword? type)]}
(let [id (gensym "drawing")]
(ptk/reify ::start-drawing
ptk/UpdateEvent
(update [_ state]
(update-in state [:workspace-local :drawing-lock] #(if (nil? %) id %)))
ptk/WatchEvent
(watch [_ state stream]
(let [lock (get-in state [:workspace-local :drawing-lock])]
(if (= lock id)
(rx/merge
(->> (rx/filter #(= % handle-finish-drawing) stream)
(rx/take 1)
(rx/map (fn [_] #(update % :workspace-local dissoc :drawing-lock))))
(rx/of (handle-drawing type)))
(rx/empty)))))))
(defn handle-drawing
[type]
(ptk/reify ::handle-drawing
ptk/UpdateEvent
(update [_ state]
(let [data (make-minimal-shape type)]
(update-in state [:workspace-local :drawing] merge data)))
ptk/WatchEvent
(watch [_ state stream]
(case type
:path (rx/of handle-drawing-path)
:curve (rx/of handle-drawing-curve)
(rx/of handle-drawing-generic)))))
(def handle-drawing-generic
(letfn [(resize-shape [{:keys [x y] :as shape} point lock? point-snap]
(let [initial (gpt/point x y)
shape' (geom/shape->rect-shape shape)
shapev (gpt/point (:width shape') (:height shape'))
deltav (gpt/to-vec initial point-snap)
scalev (gpt/divide (gpt/add shapev deltav) shapev)
scalev (if lock?
(let [v (max (:x scalev) (:y scalev))]
(gpt/point v v))
scalev)]
(-> shape
(assoc-in [:modifiers :resize-vector] scalev)
(assoc-in [:modifiers :resize-origin] (gpt/point x y))
(assoc-in [:modifiers :resize-rotation] 0))))
(update-drawing [state point lock? point-snap]
(update-in state [:workspace-local :drawing] resize-shape point lock? point-snap))]
(ptk/reify ::handle-drawing-generic
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
stoper? #(or (ms/mouse-up? %) (= % :interrupt))
stoper (rx/filter stoper? stream)
initial @ms/mouse-position
page-id (get state :current-page-id)
objects (get-in state [:workspace-data page-id :objects])
layout (get state :workspace-layout)
frames (->> objects
vals
(filter (comp #{:frame} :type))
(remove #(= (:id %) uuid/zero) ))
frame-id (or (->> frames
(filter #(geom/has-point? % initial))
first
:id)
uuid/zero)
shape (-> state
(get-in [:workspace-local :drawing])
(geom/setup {:x (:x initial) :y (:y initial) :width 1 :height 1})
(assoc :frame-id frame-id)
(assoc ::initialized? true))]
(rx/concat
(rx/of #(assoc-in state [:workspace-local :drawing] shape))
(->> (snap/closest-snap-point page-id [shape] layout initial)
(rx/map (fn [{:keys [x y]}]
#(-> %
(assoc-in [:workspace-local :drawing :x] x)
(assoc-in [:workspace-local :drawing :y] y)))))
(->> ms/mouse-position
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/switch-map (fn [[point :as current]]
(->> (snap/closest-snap-point page-id [shape] layout point)
(rx/map #(conj current %)))))
(rx/map (fn [[pt ctrl? point-snap]] #(update-drawing % pt ctrl? point-snap)))
(rx/take-until stoper))
(rx/of handle-finish-drawing)))))))
(def handle-drawing-path
(letfn [(stoper-event? [{:keys [type shift] :as event}]
(or (= event ::end-path-drawing)
(and (ms/mouse-event? event)
(or (and (= type :double-click) shift)
(= type :context-menu)))
(and (ms/keyboard-event? event)
(= type :down)
(= 13 (:key event)))))
(initialize-drawing [state point]
(-> state
(assoc-in [:workspace-local :drawing :segments] [point point])
(assoc-in [:workspace-local :drawing ::initialized?] true)))
(insert-point-segment [state point]
(-> state
(update-in [:workspace-local :drawing :segments] (fnil conj []) point)))
(update-point-segment [state index point]
(let [segments (count (get-in state [:workspace-local :drawing :segments]))
exists? (< -1 index segments)]
(cond-> state
exists? (assoc-in [:workspace-local :drawing :segments index] point))))
(finish-drawing-path [state]
(update-in
state [:workspace-local :drawing]
(fn [shape] (-> shape
(update :segments #(vec (butlast %)))
(geom/update-path-selrect)))))]
(ptk/reify ::handle-drawing-path
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
last-point (volatile! @ms/mouse-position)
stoper (->> (rx/filter stoper-event? stream)
(rx/share))
mouse (rx/sample 10 ms/mouse-position)
points (->> stream
(rx/filter ms/mouse-click?)
(rx/filter #(false? (:shift %)))
(rx/with-latest vector mouse)
(rx/map second))
counter (rx/merge (rx/scan #(inc %) 1 points) (rx/of 1))
stream' (->> mouse
(rx/with-latest vector ms/mouse-position-ctrl)
(rx/with-latest vector counter)
(rx/map flatten))
imm-transform #(vector (- % 7) (+ % 7) %)
immanted-zones (vec (concat
(map imm-transform (range 0 181 15))
(map (comp imm-transform -) (range 0 181 15))))
align-position (fn [angle pos]
(reduce (fn [pos [a1 a2 v]]
(if (< a1 angle a2)
(reduced (gpt/update-angle pos v))
pos))
pos
immanted-zones))]
(rx/merge
(rx/of #(initialize-drawing % @last-point))
(->> points
(rx/take-until stoper)
(rx/map (fn [pt] #(insert-point-segment % pt))))
(rx/concat
(->> stream'
(rx/map (fn [[point ctrl? index :as xxx]]
(let [point (if ctrl?
(as-> point $
(gpt/subtract $ @last-point)
(align-position (gpt/angle $) $)
(gpt/add $ @last-point))
point)]
#(update-point-segment % index point))))
(rx/take-until stoper))
(rx/of finish-drawing-path
handle-finish-drawing))))))))
(def simplify-tolerance 0.3)
(def handle-drawing-curve
(letfn [(stoper-event? [{:keys [type shift] :as event}]
(ms/mouse-event? event) (= type :up))
(initialize-drawing [state]
(assoc-in state [:workspace-local :drawing ::initialized?] true))
(insert-point-segment [state point]
(update-in state [:workspace-local :drawing :segments] (fnil conj []) point))
(finish-drawing-curve [state]
(update-in
state [:workspace-local :drawing]
(fn [shape]
(-> shape
(update :segments #(path/simplify % simplify-tolerance))
(geom/update-path-selrect)))))]
(ptk/reify ::handle-drawing-curve
ptk/WatchEvent
(watch [_ state stream]
(let [{:keys [flags]} (:workspace-local state)
stoper (rx/filter stoper-event? stream)
mouse (rx/sample 10 ms/mouse-position)]
(rx/concat
(rx/of initialize-drawing)
(->> mouse
(rx/map (fn [pt] #(insert-point-segment % pt)))
(rx/take-until stoper))
(rx/of finish-drawing-curve
handle-finish-drawing)))))))
(def handle-finish-drawing
(ptk/reify ::handle-finish-drawing
ptk/WatchEvent
(watch [_ state stream]
(let [shape (get-in state [:workspace-local :drawing])]
(rx/concat
(rx/of dw/clear-drawing)
(when (::initialized? shape)
(let [shape-min-width (case (:type shape)
:text 20
5)
shape-min-height (case (:type shape)
:text 16
5)
shape (-> shape
geom/transform-shape
(dissoc ::initialized?)) ]
;; Add & select the created shape to the workspace
(rx/of dw/deselect-all
(dw/add-shape shape)))))))))
(def close-drawing-path
(ptk/reify ::close-drawing-path
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :drawing :close?] true))))
;; --- Components
[uxbox.util.i18n :as i18n :refer [t]]))
(declare generic-draw-area)
(declare path-draw-area)
@ -415,7 +46,7 @@
(fn [event]
(dom/stop-propagation event)
(st/emit! (dw/assign-cursor-tooltip nil)
close-drawing-path
dd/close-drawing-path
::end-path-drawing))
on-mouse-enter
@ -426,6 +57,7 @@
on-mouse-leave
(fn [event]
(st/emit! (dw/assign-cursor-tooltip nil)))]
(when-let [{:keys [x y] :as segment} (first (:segments shape))]
[:g
[:& shapes/shape-wrapper {:shape shape}]

3
frontend/src/uxbox/main/ui/workspace/left_toolbar.cljs
View file

@ -15,7 +15,6 @@
[uxbox.main.data.workspace :as dw]
[uxbox.main.store :as st]
[uxbox.main.ui.components.file-uploader :refer [file-uploader]]
[uxbox.main.ui.workspace.drawarea :refer [direct-add-shape]]
[uxbox.util.dom :as dom]
[uxbox.util.i18n :as i18n :refer [t]]
[uxbox.main.ui.icons :as i]))
@ -42,7 +41,7 @@
:thumb-height (:thumb-height image)
:thumb-uri (:thumb-uri image)}}
aspect-ratio (/ (:width image) (:height image))]
(st/emit! (direct-add-shape :image shape aspect-ratio))))
(st/emit! (dw/create-and-add-shape :image shape aspect-ratio))))
on-file-selected
(fn [file]

4
frontend/src/uxbox/main/ui/workspace/sidebar/libraries.cljs
View file

@ -20,6 +20,7 @@
[uxbox.main.ui.keyboard :as kbd]
[uxbox.main.ui.shapes.icon :as icon]
[uxbox.util.dom :as dom]
[uxbox.util.dom.dnd :as dnd]
[uxbox.util.timers :as timers]
[uxbox.common.uuid :as uuid]
[uxbox.util.i18n :as i18n :refer [tr]]
@ -100,7 +101,8 @@
:key (str (:id item))
:on-drag-start (fn [event]
(swap! state assoc :drag-style true)
(dom/set-data-transfer event (shape-from-item section item))
(dnd/set-data! event "uxbox/shape" (shape-from-item section item))
(dnd/set-allowed-effect! event "move")
;; This state is so we can give custom css to the dragging
(timers/schedule #(swap! state assoc :drag-style false)))}
(if (= section :icons)

52
frontend/src/uxbox/main/ui/workspace/viewport.cljs
View file

@ -19,6 +19,7 @@
[uxbox.common.data :as d]
[uxbox.main.constants :as c]
[uxbox.main.data.workspace :as dw]
[uxbox.main.data.workspace.drawing :as dd]
[uxbox.main.refs :as refs]
[uxbox.main.store :as st]
[uxbox.main.streams :as ms]
@ -26,7 +27,7 @@
[uxbox.main.ui.hooks :as hooks]
[uxbox.main.ui.workspace.shapes :refer [shape-wrapper frame-wrapper]]
[uxbox.main.ui.workspace.shapes.interactions :refer [interactions]]
[uxbox.main.ui.workspace.drawarea :refer [draw-area start-drawing]]
[uxbox.main.ui.workspace.drawarea :refer [draw-area]]
[uxbox.main.ui.workspace.selection :refer [selection-handlers]]
[uxbox.main.ui.workspace.presence :as presence]
[uxbox.main.ui.workspace.snap-points :refer [snap-points]]
@ -34,6 +35,7 @@
[uxbox.main.ui.workspace.frame-grid :refer [frame-grid]]
[uxbox.common.math :as mth]
[uxbox.util.dom :as dom]
[uxbox.util.dom.dnd :as dnd]
[uxbox.util.object :as obj]
[uxbox.common.geom.point :as gpt]
[uxbox.util.perf :as perf]
@ -160,7 +162,7 @@
(cond
(and (not edition) (= 1 (.-which event)))
(if drawing-tool
(st/emit! (start-drawing drawing-tool))
(st/emit! (dd/start-drawing drawing-tool))
(st/emit! dw/handle-selection))
(and (not edition)
@ -305,21 +307,46 @@
(st/emit! (dw/update-viewport-position {:x #(+ % delta)}))
(st/emit! (dw/update-viewport-position {:y #(+ % delta)}))))))))
on-drag-enter
(fn [e]
(when (or (dnd/has-type? e "uxbox/shape")
(dnd/has-type? e "Files"))
(dom/prevent-default e)))
on-drag-over
;; Should prevent only events that we'll handle on-drop
(fn [e] (dom/prevent-default e))
(fn [e]
(when (or (dnd/has-type? e "uxbox/shape")
(dnd/has-type? e "Files"))
(dom/prevent-default e)))
on-uploaded
(fn [{:keys [id name] :as image}]
(let [shape {:name name
:metadata {:width (:width image)
:height (:height image)
:uri (:uri image)
:thumb-width (:thumb-width image)
:thumb-height (:thumb-height image)
:thumb-uri (:thumb-uri image)}}
aspect-ratio (/ (:width image) (:height image))]
(st/emit! (dw/create-and-add-shape :image shape aspect-ratio))))
on-drop
(fn [event]
(dom/prevent-default event)
(let [shape (dom/get-data-transfer event)
point (gpt/point (.-clientX event) (.-clientY event))
viewport-coord (translate-point-to-viewport point)
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :x final-x)
(assoc :y final-y))))))
(if (dnd/has-type? event "uxbox/shape")
(let [shape (dnd/get-data event "uxbox/shape")
point (gpt/point (.-clientX event) (.-clientY event))
viewport-coord (translate-point-to-viewport point)
final-x (- (:x viewport-coord) (/ (:width shape) 2))
final-y (- (:y viewport-coord) (/ (:height shape) 2))]
(st/emit! (dw/add-shape (-> shape
(assoc :x final-x)
(assoc :y final-y)))))
(let [files (dnd/get-files event)]
(run! #(st/emit! (dw/upload-image % on-uploaded)) files))))
on-resize
(fn [event]
@ -380,6 +407,7 @@
:on-mouse-up on-mouse-up
:on-pointer-down on-pointer-down
:on-pointer-up on-pointer-up
:on-drag-enter on-drag-enter
:on-drag-over on-drag-over
:on-drop on-drop}
[:g

10
frontend/src/uxbox/util/dom.cljs
View file

@ -162,16 +162,6 @@
[node]
(.focus node))
(defn set-data-transfer
[event data]
(let [data-string (ts/encode data)]
(-> event .-dataTransfer (.setData "text/plain" data-string))))
(defn get-data-transfer
[event]
(let [data-string (-> event .-dataTransfer (.getData "text/plain"))]
(ts/decode data-string)))
(defn fullscreen?
[]
(boolean (.-fullscreenElement js/document)))

103
frontend/src/uxbox/util/dom/dnd.cljs
View file

@ -7,11 +7,44 @@
(ns uxbox.util.dom.dnd
"Drag & Drop interop helpers."
(:require [uxbox.util.data :refer (read-string)]))
(:require
[uxbox.util.data :refer (read-string)]
[uxbox.util.transit :as t]))
(defn event->data-transfer
[e]
(.-dataTransfer e))
;; This is the official documentation for the dnd API:
;; https://developer.mozilla.org/en-US/docs/Web/API/HTML_Drag_and_Drop_API
;;
;; The API is broken in several ways. Here is some discussion of the problems,
;; and many uncomplete solutions:
;; https://github.com/lolmaus/jquery.dragbetter/#what-this-is-all-about
;; https://www.w3schools.com/jsref/event_relatedtarget.asp
;; https://stackoverflow.com/questions/14194324/firefox-firing-dragleave-when-dragging-over-text?noredirect=1&lq=1
;; https://stackoverflow.com/questions/7110353/html5-dragleave-fired-when-hovering-a-child-element
(defn trace
;; This function is useful to debug the erratic dnd interface behaviour when something weird occurs
[event data label]
(js/console.log
label
"[" (:name data) "]"
(if (.-currentTarget event) (.-textContent (.-currentTarget event)) "null")
(if (.-relatedTarget event) (.-textContent (.-relatedTarget event)) "null")))
(defn set-data!
([e data]
(set-data! e "uxbox/data" data))
([e data-type data]
(let [dt (.-dataTransfer e)]
(.setData dt data-type (t/encode data))
e)))
(defn set-drag-image!
([e image]
(set-drag-image! e image 0 0))
([e image offset-x offset-y]
(let [dt (.-dataTransfer e)]
(.setDragImage dt image offset-x offset-y)
e)))
(defn set-allowed-effect!
[e effect]
@ -25,40 +58,44 @@
(set! (.-dropEffect dt) effect)
e))
(defn set-data!
([e data]
(set-data! e "uxbox/data" data))
([e key data]
(let [dt (.-dataTransfer e)]
(.setData dt (str key) (pr-str data)))))
(defn has-type?
[e data-type]
(let [dt (.-dataTransfer e)]
(.includes (.-types dt) data-type)))
(defn set-image!
([e data]
(set-image! e data 0 0))
([e data x y]
(let [dt (.-dataTransfer e)
st (.-style data)]
(.setDragImage dt data x y))))
(defn from-child?
[e]
;; The relatedTarget property contains the dom element that was under
;; the mouse *before* the event. This is useful, for example, to filter
;; out enter or over events initiated by children of the drop target.
(let [target (.-currentTarget e)
related (.-relatedTarget e)]
(.contains target related)))
(defn get-data
([e]
(get-data e "uxbox/data"))
([e key]
([e data-type]
(let [dt (.-dataTransfer e)]
(read-string (.getData dt (str key))))))
(t/decode (.getData dt data-type)))))
(defn get-hover-position
[event group?]
(let [target (.-currentTarget event)
brect (.getBoundingClientRect target)
width (.-offsetHeight target)
y (- (.-clientY event) (.-top brect))
part (/ (* 30 width) 100)]
(if group?
(defn get-files
[e]
(let [dt (.-dataTransfer e)]
(.-files dt)))
(defn drop-side
[e detect-center?]
(let [ypos (.-offsetY e)
target (.-currentTarget e)
height (.-clientHeight target)
thold (/ height 2)
thold1 (* height 0.2)
thold2 (* height 0.8)]
(if detect-center?
(cond
(> part y) :top
(< (- width part) y) :bottom
:else :middle)
(if (>= y (/ width 2))
:bottom
:top))))
(< ypos thold1) :top
(> ypos thold2) :bot
:else :center)
(if (> ypos thold) :bot :top))))

17
frontend/src/uxbox/util/webapi.cljs
View file

@ -13,6 +13,7 @@
[promesa.core :as p]
[beicon.core :as rx]
[cuerdas.core :as str]
[uxbox.common.data :as d]
[uxbox.util.transit :as t]))
(defn read-file-as-text
@ -79,8 +80,20 @@
(defn- read-from-clipboard
[]
(let [cboard (unchecked-get js/navigator "clipboard")]
(-> (.readText cboard)
(p/then identity))))
(rx/from (.readText cboard))))
(defn- read-image-from-clipboard
[]
(let [cboard (unchecked-get js/navigator "clipboard")
read-item (fn [item]
(let [img-type (->> (.-types item)
(d/seek #(str/starts-with? % "image/")))]
(if img-type
(rx/from (.getType item img-type))
(rx/empty))))]
(->> (rx/from (.read cboard)) ;; Get a stream of item lists
(rx/mapcat identity) ;; Convert each item into an emission
(rx/switch-map read-item))))
(defn request-fullscreen
[el]