Implement custom progress indicator and seeking

Squashed commit of the following:

commit 23b9a3deac564bf3753a00238784a6045cb50d46
Author: Arne Schlüter <arne@schlueter.is>
Date:   Sun Oct 14 10:20:08 2018 +0200

    Enable seeking in buffered part and fix drawn x value

commit 9ce4b0941f4a57286f608d2b155658672cac3817
Author: Arne Schlüter <arne@schlueter.is>
Date:   Sun Oct 14 09:40:43 2018 +0200

    Draw seek position and enable seeking played part by click

commit 58cbf2d8035c0eeacaed3da7a68f97d94db4a2b6
Author: Arne Schlüter <arne@schlueter.is>
Date:   Thu Oct 11 21:42:57 2018 +0200

    Add retina canvas

commit 6acb84a67e4bee61e5b9ae6eb15e8159e0431662
Author: Arne Schlüter <arne@schlueter.is>
Date:   Wed Oct 10 17:52:43 2018 +0200

    Implement canvas progress bar

src/cljs/airsonic_ui/audio/core.cljs

@@ -14,11 +14,13 @@
   "Takes an audio object and returns a map describing its current status"
   [elem]
   {:ended? (.-ended elem)
-   :loop? (.-loop elem)
-   :muted? (.-muted elem)
    :paused? (.-paused elem)
    :current-src (.-currentSrc elem)
-   :current-time (.-currentTime elem)})
+   :current-time (.-currentTime elem)
+   :seekable (let [seekable (.-seekable elem)]
+               (if (> (.-length seekable) 0)
+                 (.end seekable (dec (.-length seekable)))
+                 0))})
 
 ; explanation of these events: https://developer.mozilla.org/en-US/Apps/Fundamentals/Audio_and_video_delivery/Cross-browser_audio_basics
 
@@ -60,6 +62,12 @@
        (.play a)
        (.pause a)))))
 
+(re-frame/reg-fx
+ :audio/seek
+ (fn [[percentage duration]]
+   (set! (. @audio -currentTime)
+         (* percentage duration))))
+
 ;; subscriptions
 
 (defn summary

src/cljs/airsonic_ui/components/audio_player/events.cljs

@@ -61,3 +61,9 @@
     (:ended? status) (assoc :dispatch [:audio-player/next-song])))
 
 (re-frame/reg-event-fx :audio/update audio-update)
+
+(re-frame/reg-event-fx
+ :audio-player/seek
+ (fn [{:keys [db]} [_ percentage]]
+   (let [duration (:duration (playlist/peek (get-in db [:audio :playlist])))]
+     {:audio/seek [percentage duration]})))

src/cljs/airsonic_ui/components/audio_player/views.cljs

@@ -1,18 +1,80 @@
 (ns airsonic-ui.components.audio-player.views
-  (:require [re-frame.core :refer [subscribe]]
+  (:require [re-frame.core :refer [subscribe dispatch]]
             [airsonic-ui.routes :as routes]
+            [airsonic-ui.components.highres-canvas.views :refer [canvas]]
             [airsonic-ui.helpers :refer [add-classes muted-dispatch]]
             [airsonic-ui.views.cover :refer [cover]]
             [airsonic-ui.views.icon :refer [icon]]))
 
 ;; currently playing / coming next / audio controls...
+;; FIXME: Sometimes items don't have a duration
+
+(def progress-bar-color "rgb(93,93,93)")
+(def progress-bar-color-buffered "rgb(123,123,123)")
+(def progress-bar-color-active "whitesmoke")
+
+(defn draw-progress [ctx current-time seekable duration]
+  (let [width (.. ctx -canvas -clientWidth)
+        height (.. ctx -canvas -clientHeight)
+        padding 5
+        seekable-x (+ padding (* (- width (* 2 padding)) (min 1 (/ seekable duration))))
+        current-x (+ padding (* (- width (* 2 padding)) (min 1 (/ current-time duration))))]
+    ;; vertically center everything
+    (.translate ctx 0.5 (+ (Math/ceil (/ height 2)) 0.5))
+    ;; draw complete bar
+    (set! (.-strokeStyle ctx) progress-bar-color)
+    (doto ctx
+      (.beginPath)
+      (.moveTo padding 0)
+      (.lineTo (- width (* 2 padding)) 0)
+      (.stroke))
+    ;; draw the buffered part
+    (set! (.-strokeStyle ctx) progress-bar-color-buffered)
+    (doto ctx
+      (.beginPath)
+      (.moveTo padding 0)
+      (.lineTo seekable-x 0)
+      (.stroke))
+    ;; draw the part that's already played
+    (set! (.-strokeStyle ctx) progress-bar-color-active)
+    (doto ctx
+      (.beginPath)
+      (.moveTo padding 0)
+      (.lineTo current-x 0)
+      (.stroke))
+    ;; draw a dot marking the current time
+    (set! (.-fillStyle ctx) progress-bar-color-active)
+    (doto ctx
+      (.beginPath)
+      (.arc current-x 0 (/ padding 2) 0 (* Math/PI 2))
+      (.fill))))
+
+(defn current-progress [current-time seekable duration]
+  [canvas {:class-name "current-progress-canvas"
+           :draw draw-progress} current-time seekable duration])
+
+(defn seek
+  "Calculates the position of the click and sets current playback accordingly"
+  [ev]
+  (let [x (- (.. ev -nativeEvent -pageX)
+             (.. ev -target getBoundingClientRect -left))
+        width (.. ev -target -nextElementSibling -clientWidth)]
+    (dispatch [:audio-player/seek (/ x width)])))
+
+(defn buffered-part
+  [seekable duration]
+  [:div.buffered-part {:on-click seek
+                       :style {:width (str (min 100 (* (/ seekable duration) 100)) "%")}}])
 
 (defn current-song-info [song status]
-  [:article.current-song-info
-   [:span (:artist song) " - " (:title song)]
-   ;; FIXME: Sometimes items don't have a duration
-   [:progress.progress.is-tiny {:value (:current-time status)
-                                :max (:duration song)}]])
+  (let [current-time (:current-time status)
+        seekable (:seekable status)
+        duration (:duration song)]
+    [:article.current-song-info
+     [:div.current-name (:artist song) [:br] (:title song)]
+     [:div.current-progress
+      [buffered-part seekable duration]
+      [current-progress current-time seekable duration]]]))
 
 (defn song-controls [is-playing?]
   [:div.field.has-addons
@@ -25,14 +87,14 @@
                 :media-step-forward "Next"}]
      (map (fn [[icon-glyph event]]
             ^{:key icon-glyph} [:p.control>button.button.is-light
-                                {:on-click (muted-dispatch [event])
-                                 :title (title icon-glyph)}
-                                [icon icon-glyph]])
+                                      {:on-click (muted-dispatch [event])
+                                       :title (title icon-glyph)}
+                                      [icon icon-glyph]])
           buttons))])
 
 (defn- toggle-shuffle [playback-mode]
   (muted-dispatch [:audio-player/set-playback-mode (if (= playback-mode :shuffled)
-                                          :linear :shuffled)]))
+                                                     :linear :shuffled)]))
 
 (defn- toggle-repeat-mode [current-mode]
   (let [modes (cycle '(:repeat-none :repeat-all :repeat-single))

src/cljs/airsonic_ui/components/collection/views.cljs

@@ -1,20 +1,12 @@
 (ns airsonic-ui.components.collection.views
   "A collection is a list of audio files that belong together (e.g. an album or
   a podcast's overview)"
-  (:require [airsonic-ui.routes :as routes :refer [url-for]]
+  (:require [airsonic-ui.helpers :refer [format-duration]]
+            [airsonic-ui.routes :as routes :refer [url-for]]
             [airsonic-ui.views.cover :refer [cover card]]
             [airsonic-ui.views.icon :refer [icon]]
             [airsonic-ui.views.song :as song]))
 
-(defn format-duration [seconds]
-  (let [hours (quot seconds 3600)
-        minutes (quot (rem seconds 3600) 60)
-        seconds (rem seconds 60)]
-    (-> (cond-> ""
-          (> hours 0) (str hours "h ")
-          (> minutes 0) (str minutes "m "))
-        (str seconds "s"))))
-
 (defn collection-info [{:keys [songCount duration year]}]
   (vec (cond-> [:ul.is-smaller.collection-info
                 [:li [icon :audio-spectrum] (str songCount (if (= 1 songCount)
@@ -22,7 +14,6 @@
                 [:li [icon :clock] (format-duration duration)]]
          year (conj [:li [icon :calendar] (str "Released in " year)]))))
 
-
 (defn album-card [album]
   (let [{:keys [artist artistId name id]} album]
     [card album

src/cljs/airsonic_ui/components/highres_canvas/views.cljs

@@ -0,0 +1,33 @@
+(ns airsonic-ui.components.highres-canvas.views
+  "This module provides a reusable canvas component. You can provide a drawing
+  function via the `:draw` attribute which will be passed a 2d rendering
+  context. It will automatically be drawn in high resolution on retina displays."
+  (:require [reagent.core :as reagent]))
+
+(defn redraw [this]
+  (let [[_ {draw :draw} & props] (reagent/argv this)
+        canvas (reagent/dom-node this)
+        width (.-clientWidth canvas)
+        height (.-clientHeight canvas)
+        ctx (.getContext canvas "2d")
+        pixel-ratio (.-devicePixelRatio js/window)]
+    (set! (. canvas -width) width)
+    (set! (. canvas -height) height)
+    ;; retina drawing code:
+    ;; set up dimensions, reset the transform matrix to the identity
+    ;; matrix and automatically scale up
+    (when (> pixel-ratio 1)
+      (set! (. canvas -width) (* pixel-ratio width))
+      (set! (. canvas -height) (* pixel-ratio height))
+      (set! (.. canvas -style -width) (str width "px"))
+      (set! (.. canvas -style -height) (str height "px"))
+      (.setTransform ctx 1 0 0 1 0 0)
+      (.scale ctx pixel-ratio pixel-ratio))
+    (apply draw ctx props)))
+
+(defn canvas [attrs & _]
+  (reagent/create-class
+   {:component-did-update redraw
+    :component-did-mount redraw
+    :render (fn render []
+              [:canvas.highres-canvas (dissoc attrs :draw)])}))

src/cljs/airsonic_ui/helpers.cljs

@@ -31,3 +31,12 @@
       (str/replace #"([a-z])([A-Z])" (fn [[_ a b]] (str a "-" b)))
       (str/lower-case)
       (keyword)))
+
+(defn format-duration [seconds]
+  (let [hours (quot seconds 3600)
+        minutes (quot (rem seconds 3600) 60)
+        seconds (rem seconds 60)]
+    (-> (cond-> ""
+          (> hours 0) (str hours "h ")
+          (> minutes 0) (str minutes "m "))
+        (str seconds "s"))))

src/cljs/airsonic_ui/views/cover.cljs

@@ -1,55 +1,40 @@
 (ns airsonic-ui.views.cover
-  (:require [clojure.string :as str]
-            [re-frame.core :refer [subscribe]]
-            [reagent.core :as reagent]
+  (:require [re-frame.core :refer [subscribe]]
             [airsonic-ui.subs :as subs]
+            [airsonic-ui.components.highres-canvas.views :refer [canvas]]
             ["@hugojosefson/color-hash" :as ColorHash]))
 
 (def color-hash (ColorHash.))
 
+(defn hsl->css [h s l]
+  (str "hsl(" h "," (* 100 s) "%," (* 100 l) "%)"))
+
 (defn palette
   "Generate a hsl palette of two colors that's unique for a given item"
   [item]
   (let [identifier (str (:artistId item) "-" (or (:albumId item) (:id item)))
-        [h s l] (js->clj (.hsl color-hash identifier))
-        s (str (* 100 s) "%")
-        l (str (* 100 l) "%")]
-    (->>
-     [[h s l]
-      [(mod (+ h (* h 0.3) 10) 360) s l]]
-     (map #(str "hsl(" (str/join "," %) ")")))))
+        [h s l] (js->clj (.hsl color-hash identifier))]
+    [(hsl->css h s l)
+     (hsl->css (mod (+ h (* h 0.3) 10) 360) s l)]))
 
-(defn generate-cover [canvas item]
-  (let [ctx (.getContext canvas "2d")
-        size (.-clientWidth canvas)
-        [a b] (palette item)
+(defn generate-cover [ctx item]
+  (let [[a b] (palette item)
+        size (.. ctx -canvas -offsetWidth)
         pad (* 0.02 size)
         gradient (doto (.createLinearGradient ctx pad 0 (- size pad) size)
                    (.addColorStop 0 a)
                    (.addColorStop 1 b))]
+    (set! (.. ctx -canvas -height) (.. ctx -canvas -width))
+    (set! (.. ctx -canvas -style -height) (.. ctx -canvas -style -width))
+    ;; we have to re-scale everything because resizing messes with the content
+    (.scale ctx (.-devicePixelRatio js/window) (.-devicePixelRatio js/window))
     (set! (.-fillStyle ctx) gradient)
-    (.fillRect ctx 0 0 size size)))
+    (.fillRect ctx 0 0 (.. ctx -canvas -width) (.. ctx -canvas -height))))
 
 (defn missing-cover
   [item size]
-  (let [dom-node (reagent/atom nil)]
-    (reagent/create-class
-     {:component-did-update
-      (fn [this]
-        (let [canvas @dom-node]
-          (set! (.. canvas -style -width) "100%")
-          (set! (. canvas -width) (.-offsetWidth canvas))
-          (set! (. canvas -height) (.-offsetWidth canvas))
-          (generate-cover canvas item)))
-
-      :component-did-mount
-      (fn [this]
-        (reset! dom-node (reagent/dom-node this)))
-
-      :reagent-render
-      (fn []
-        @dom-node
-        [:canvas.missing-cover])})))
+  [canvas {:class-name "missing-cover"
+           :draw generate-cover} item])
 
 (defn has-cover? [item]
   (:coverArt item))

src/cljs/airsonic_ui/views/song.cljs

@@ -1,11 +1,12 @@
 (ns airsonic-ui.views.song
   (:require [re-frame.core :refer [subscribe]]
-            [airsonic-ui.helpers :refer [muted-dispatch]]
+            [airsonic-ui.helpers :refer [muted-dispatch format-duration]]
             [airsonic-ui.routes :as routes :refer [url-for]]
             [airsonic-ui.views.icon :refer [icon]]))
 
 (defn item [songs song idx]
-  (let [artist-id (:artistId song)]
+  (let [artist-id (:artistId song)
+        duration (:duration song)]
     [:div
      (if artist-id
        [:a {:href (url-for ::routes/artist.detail {:id artist-id})} (:artist song)]
@@ -13,7 +14,8 @@
      " - "
      [:a
       {:href "#" :on-click (muted-dispatch [:audio-player/play-all songs idx])}
-      (:title song)]]))
+      (:title song)]
+     [:span.duration (format-duration duration)]]))
 
 (defn listing [songs]
   (let [current-song @(subscribe [:audio/current-song])]