Reagent/re-frame FPS visualization component & tick handler example

fps.cljs

;; dependencies:
;; [cljsjs/react "0.12.2-5"]
;; [reagent "0.5.0"]
;; [re-frame "0.2.0"]
;; [cljs-log "0.2.1"]

(ns example.fps
  (:require-macros
   [reagent.ratom :refer [reaction]]
   [cljs-log.core :refer [info]])
  (:require
   [cljsjs.react :as react]
   [reagent.core :as reagent]
   [re-frame.core :refer [register-handler
                          register-sub
                          subscribe
                          dispatch
                          trim-v]]))

(defprotocol PTickHandler
  (init-state
    [_ db]
    "Called to during :add-tick-handlers event handling to allow
    modification of app-db. Must return updated db.")
  (tick
    [_ db]
    "Called at each tick w/ current app-db.
    Must return updated db."))

(defn- re-trigger-ticker
  "Dispatches :next-tick event at next React redraw cycle (usually
  every 16ms, but depending on CPU load)."
  [] (reagent/next-tick (fn [] (dispatch [:next-tick]))))

(def start-ticker re-trigger-ticker)

(defn init-ticker
  "MUST be called with app-db map from a pure re-frame handler (e.g.
  during initial app init event). Registers tick related events &
  handlers and adds initial ::tick state to given db map.

  Tick handlers can be added via :add-tick-handlers event. These
  handlers are NOT re-frame handlers and MUST implement the
  PTickHandler protocol instead, for example:

  (dispatch
    [:add-tick-handlers
     {:foo (reify PTickHandler
             (init-state [_ db] (assoc db :foo {:state 0}))
             (tick [_ db] (update-in db [:foo :state] inc)))}])"
  [db]

  (register-handler
   :add-tick-handlers trim-v
   (fn [db [handlers]]
     (info "adding tick handlers:" (keys handlers))
     (reduce-kv
      (fn [db id handler] (init-state handler db))
      (update-in db [::tick :handlers] merge handlers)
      handlers)))

  (register-handler
   :remove-tick-handlers trim-v
   (fn [db [ids]]
     (info "removing tick handlers:" ids)
     (update-in db [::tick :handlers] #(apply dissoc % ids))))

  (register-handler
   :next-tick trim-v
   (fn [{ticker ::tick :as db} _]
     (if-not (:paused? ticker)
       (do (re-trigger-ticker)
           (reduce-kv
            (fn [db id handler] (tick handler db))
            db (:handlers ticker)))
       db)))

  (assoc db ::tick {:handlers {} :paused? false}))

(defn register-fps-counter
  "Sets up an FPS counter tick handler & subscriptions for current &
  average framerates. Current framerate (:fps) is updated every
  second, the average (:avg-fps) every tick and is the total avg. rate
  since the beginning."
  [db-root]
  (register-sub
   :fps (fn [db _] (reaction (get-in @db [db-root :fps]))))
  (register-sub
   :avg-fps (fn [db _] (reaction (get-in @db [db-root :avg-fps]))))
  (dispatch
   [:add-tick-handlers
    {:update-fps
     (reify PTickHandler
       (init-state [_ db]
         (assoc db db-root
                {:frame 0 :total 0 :fps 0 :avg-fps 0
                 :start (.getTime (js/Date.))
                 :last  (.getTime (js/Date.))}))
       (tick [_ db]
         (let [{:keys [frame total start last]}  (db db-root)
               now   (.getTime (js/Date.))
               age   (- now start)
               frame (inc frame)
               total (inc total)
               db    (update db db-root assoc
                             :frame frame
                             :total total
                             :avg-fps (/ total (* age 1e-3)))]
           (if (> (- now last) 1000)
             (update db db-root assoc
                     :last now
                     :frame 0
                     :fps (/ frame (* (- now last) 1e-3)))
             db))))}]))

(defn- fps-graph
  "Updates canvas visualization using given component state & opts.
  Called from fps-panel render fn."
  [state fps width height col grid-col]
  (let [w' (- width 4)
        s  (/ (- height 20) 60)
        h' (- height 3)]
    (when-let [ctx (:ctx @state)]
      (swap! state update :history
             #(conj (if (< (count %) w') % (->> % (drop 1) vec)) (- h' (* s fps))))
      (let [history (:history @state)
            x    (dec (count history))
            w''  (inc w')
            g1   (- h' (* s 20))
            g2   (- h' (* s 40))
            g3   (- h' (* s 60))
            fps' (.toFixed (js/Number. fps) 2)]
        (.clearRect ctx 0 0 width height)
        (set! (.-strokeStyle ctx) grid-col)
        (set! (.-fillStyle ctx) col)
        (doto ctx
          (.beginPath)
          (.moveTo 2 h') (.lineTo w'' h')
          (.moveTo 2 g1) (.lineTo w'' g1)
          (.moveTo 2 g2) (.lineTo w'' g2)
          (.moveTo 2 g3) (.lineTo w'' g3)
          (.stroke))
        (set! (.-strokeStyle ctx) col)
        (.beginPath ctx)
        (.moveTo ctx (+ x 2) (get history x))
        (loop [x (dec x)]
          (when-not (neg? x)
            (.lineTo ctx (+ x 2) (get history x))
            (recur (dec x))))
        (.stroke ctx)
        (.fillText ctx (str "fps: " fps') 4 11)))))

(defn fps-panel
  "Framerate visualization component. Takes options map with following
  supported keys:

  :mode     - visualization mode (:fps or :avg-fps)
  :width    - canvas width (default 100)
  :height   - canvas height (default 76)
  :col      - graph color (#f0f)
  :grid-col - grid color (20/40/60 fps markers, #ccc)

  Furthermore, the map can contain :id, :class or :style keys. All
  other keys will be ignored.

  Example: [fps-panel {:mode :fps :width 200 :col \"limegreen\"}]"
  [& [opts]]
  (let [fps   (subscribe [(opts :mode :fps)])
        state (atom {})]
    (reagent/create-class
     {:display-name "fps-panel"
      :component-did-mount
      #(reset! state
               {:ctx (.getContext (reagent/dom-node %) "2d")
                :history []})
      :reagent-render
      (fn [& [{:keys [width height col grid-col]
               :or   {width 100 height 76 col "#f0f" grid-col "#ccc"}
               :as   opts}]]
        (fps-graph state @fps width height col grid-col)
        [:canvas
         (merge {:width width :height height}
                (select-keys opts [:id :class :style]))])})))