⚡ Add thumbnail/imposter queue

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

@@ -775,7 +775,7 @@
             component       (ctkl/get-component data component-id)
             page-id         (:main-instance-page component)
             root-id         (:main-instance-id component)]
-           (rx/of (dwt/update-thumbnail file-id page-id root-id))))))
+           (rx/of (dwt/request-thumbnail file-id page-id root-id))))))
 
 (defn- find-shape-index
   [objects id shape-id]

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

@@ -17,7 +17,9 @@
    [app.main.refs :as refs]
    [app.main.render :as render]
    [app.main.repo :as rp]
+   [app.main.store :as st]
    [app.util.http :as http]
+   [app.util.queue :as q]
    [app.util.time :as tp]
    [app.util.timers :as tm]
    [app.util.webapi :as wapi]
@@ -27,11 +29,54 @@
 
 (l/set-level! :info)
 
+(declare update-thumbnail)
+
+(defn resolve-request
+  "Resolves the request to generate a thumbnail for the given ids."
+  [item]
+  (let [file-id (unchecked-get item "file-id")
+        page-id  (unchecked-get item "page-id")
+        shape-id (unchecked-get item "shape-id")]
+    (st/emit! (update-thumbnail file-id page-id shape-id))))
+
+;; Defines the thumbnail queue
+(defonce queue
+  (q/create resolve-request (/ 1000 30)))
+
+(defn create-request
+  "Creates a request to generate a thumbnail for the given ids."
+  [file-id page-id shape-id]
+  #js {:file-id file-id :page-id page-id :shape-id shape-id})
+
+(defn find-request
+  "Returns true if the given item matches the given ids."
+  [file-id page-id shape-id item]
+  (and (= file-id (unchecked-get item "file-id"))
+       (= page-id (unchecked-get item "page-id"))
+       (= shape-id (unchecked-get item "shape-id"))))
+
+(defn request-thumbnail
+  "Enqueues a request to generate a thumbnail for the given ids."
+  [file-id page-id shape-id]
+  (ptk/reify ::request-thumbnail
+    ptk/EffectEvent
+    (effect [_ _ _]
+      (l/dbg :hint "request thumbnail" :file-id file-id :page-id page-id :shape-id shape-id)
+      (q/enqueue-unique
+       queue
+       (create-request file-id page-id shape-id)
+       (partial find-request file-id page-id shape-id)))))
+
 (defn fmt-object-id
+  "Returns ids formatted as a string (object-id)"
   [file-id page-id frame-id]
   (str/ffmt "%/%/%" file-id page-id frame-id))
 
+;; This function first renders the HTML calling `render/render-frame` that
+;; returns HTML as a string, then we send that data to the iframe rasterizer
+;; that returns the image as a Blob. Finally we create a URI for that blob.
 (defn get-thumbnail
+  "Returns the thumbnail for the given ids"
   [state file-id page-id frame-id & {:keys [object-id]}]
 
   (let [object-id (or object-id (fmt-object-id file-id page-id frame-id))
@@ -236,7 +281,7 @@
             ;; BUFFER NOTIFIER (window of 5s of inactivity)
             notifier-s
             (->> changes-s
-                 (rx/debounce 5000)
+                 (rx/debounce 1000)
                  (rx/tap #(l/trc :hint "buffer initialized")))]
 
         (->> (rx/merge
@@ -253,6 +298,6 @@
                    (rx/buffer-until notifier-s)
                    (rx/mapcat #(into #{} %))
                    (rx/map (fn [frame-id]
-                             (update-thumbnail file-id page-id frame-id)))))
+                             (request-thumbnail file-id page-id frame-id)))))
 
              (rx/take-until stopper-s))))))

frontend/src/app/main/ui/workspace/shapes/frame.cljs

@@ -125,7 +125,7 @@
         (mf/with-effect []
           (when-not (some? thumbnail-uri)
             (tm/schedule-on-idle
-             #(st/emit! (dwt/update-thumbnail file-id page-id frame-id)))))
+             #(st/emit! (dwt/request-thumbnail file-id page-id frame-id)))))
 
         (fdm/use-dynamic-modifiers objects (mf/ref-val content-ref) modifiers)
 

frontend/src/app/util/queue.cljs

@@ -0,0 +1,101 @@
+;; 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.util.queue
+  (:require [app.common.logging :as l]
+            [app.common.math :as mth]
+            [app.util.time :as t]))
+
+(l/set-level! :info)
+
+(declare process)
+(declare dequeue)
+
+(defrecord Queue [f items timeout time threshold max-iterations])
+
+(defn create
+  [f threshold]
+  (Queue. f
+          #js []
+          nil
+          0
+          threshold
+          ##Inf))
+
+(defn- measure-fn
+  [f & args]
+  (let [tp       (t/tpoint-ms)
+        _        (apply f args)
+        duration (tp)]
+    (l/dbg :hint "queue::measure-fn" :duration duration)
+    duration))
+
+(defn- next-process-time
+  [queue]
+  (let [time      (unchecked-get queue "time")
+        threshold (unchecked-get queue "threshold")
+        max-time  5000
+        min-time  1000
+        calc-time (mth/min (mth/max (* (- time threshold) 10) min-time) max-time)]
+    (l/dbg :hint "queue::next-process-time" :time time :threshold threshold :calc-time calc-time :max-time max-time :min-time min-time)
+    calc-time))
+
+(defn- has-requested-process?
+  [queue]
+  (not (nil? (unchecked-get queue "timeout"))))
+
+(defn- request-process
+  [queue time]
+  (l/dbg :hint "queue::request-process" :time time)
+  (unchecked-set queue "timeout" (js/setTimeout (fn [] (process queue)) time)))
+
+;; NOTE: Right now there are no cases where we need to cancel a process
+;;       but if we do, we can use this function
+#_(defn- cancel-process
+  [queue]
+  (l/dbg :hint "queue::cancel-process")
+  (let [timeout (unchecked-get queue "timeout")]
+    (when (some? timeout)
+      (js/clearTimeout timeout))
+    (unchecked-set queue "timeout" nil)))
+
+(defn- process
+  [queue]
+  (unchecked-set queue "timeout" nil)
+  (unchecked-set queue "time" 0)
+  (let [threshold      (unchecked-get queue "threshold")
+        max-iterations (unchecked-get queue "max-iterations")
+        f              (unchecked-get queue "f")]
+    (loop [item (dequeue queue)
+           iterations 0]
+      (l/dbg :hint "queue::process" :item item)
+      (when (some? item)
+        (let [duration (measure-fn f item)
+              time     (unchecked-get queue "time")
+              time     (unchecked-set queue "time" (+ time duration))]
+          (if (or (> time threshold) (>= iterations max-iterations))
+            (request-process queue (next-process-time queue))
+            (recur (dequeue queue) (inc iterations))))))))
+
+(defn- dequeue
+  [queue]
+  (let [items (unchecked-get queue "items")]
+    (.shift items)))
+
+(defn enqueue
+  [queue item]
+  (assert (instance? Queue queue))
+  (let [items (unchecked-get queue "items")]
+    (.push items item)
+    (when-not (has-requested-process? queue)
+      (request-process queue (next-process-time queue)))))
+
+(defn enqueue-unique
+  [queue item f]
+  (assert (instance? Queue queue))
+  (let [items (unchecked-get queue "items")]
+    (when-not (.findLast items f)
+      (enqueue queue item))))