Add: track-display class; better track display and controls

1 files changed, 84 insertions, 34 deletions

diff --git a/vampire.lisp b/vampire.lisp
index cfac3b9..8669da7 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -151,6 +151,13 @@
 (defclass/std playlist/ctl ()
   ((playlist track-display audio->track now-playing :std nil)))
 
+(defclass/std track-display ()
+  ((title-elem
+    thumb-elem
+    artist-elem
+    time-elem
+    duration-elem)))
+
 (defun get-audio-track (ctl audio)
   (cdr (assoc audio (audio->track ctl))))
 
@@ -171,27 +178,27 @@
             now-playing nil))))
 
 (defun pause-playback (ctl)
-  (when-let  (track (now-playing ctl))
-    (pause-media track)))
+  (when-let  (audio (now-playing ctl))
+    (pause-media audio)))
 
 (defun start-playback (ctl)
-  (when-let (track (now-playing ctl))
-    (play-media track)))
+  (when-let (audio (now-playing ctl))
+    (play-media audio)))
 
 (defun load-track-display (ctl)
-  (with-slots (now-playing track-display) ctl
-    (when now-playing
-      (let ((track (get-audio-track ctl now-playing)))
-        (setf (inner-html track-display) "")
-        (with-clog-create track-display
-            (div ()
-                 (section (:h3 :content "Now Playing"))
-                 (img (:url-src (track-thumb-url track) :bind thumb))
-                 (section (:h4 :content (track-title track))))
-          (setf (width thumb) 100))))))
+  (when-let (track (get-audio-track ctl (now-playing ctl)))
+    (with-slots
+          (title-elem thumb-elem artist-elem
+           time-elem duration-elem)
+        (track-display ctl)
+      (with-slots (title artist thumb-url duration) track
+        (setf (text title-elem) title
+              (text duration-elem) (secs-to-hms duration)
+              (text time-elem) (secs-to-hms 0)
+              (url-src thumb-elem) thumb-url)))))
 
 (defun initialize-playlist/ctl (body)
-  (when-let (ctl (playlist/ctl body))
+  (let ((ctl (playlist/ctl body)))
     (setf now-playing (car (first (audio->track ctl))))
     (load-track-display ctl)))
 
@@ -202,32 +209,47 @@
   (setf (connection-data-item obj "playlist/ctl")
         (make-instance 'playlist/ctl :playlist playlist)))
 
-(defun install-track-display (display)
-  (let ((ctl (playlist/ctl display)))
-    (setf (track-display ctl) display)))
+(defun install-track-display (thumb title artist time dur)
+  (let ((ctl (playlist/ctl thumb)))
+    (setf (track-display ctl)
+          (make-instance 'track-display
+                         :duration-elem dur
+                         :time-elem time
+                         :artist-elem artist
+                         :thumb-elem thumb
+                         :title-elem title))))
 
 (defun install-audio-track (audio track &optional (position -1))
   (when-let (ctl (playlist/ctl audio))
     (setf (audio->track ctl)
           (insert-nth (cons audio track) position (audio->track ctl)))))
 
-(defun ctl/pause (audio)
-  (when-let (ctl (playlist/ctl audio))
+(defun ctl/now-playing (elem)
+  (when-let (ctl (playlist/ctl elem))
+    (now-playing ctl)))
+
+(defun ctl/pause (elem)
+  (when-let (ctl (playlist/ctl elem))
     (pause-playback ctl)))
 
-(defun ctl/stop (audio)
-  (when-let (ctl (playlist/ctl audio))
+(defun ctl/stop (elem)
+  (when-let (ctl (playlist/ctl elem))
     (stop-playback ctl)))
 
-(defun ctl/play (audio)
+(defun ctl/play-audio (audio)
   (when-let (ctl (playlist/ctl audio))
     (stop-playback ctl)
     (setf (now-playing ctl) audio)
     (start-playback ctl)
     (load-track-display ctl)))
 
-(defun ctl/next-track (audio)
-  (when-let (ctl (playlist/ctl audio))
+(defun ctl/toggle-play (elem)
+  (if-let (now (ctl/now-playing elem))
+    (if (pausedp now) (play-media now) (pause-media now))
+    (ctl/next-track elem)))
+
+(defun ctl/next-track (elem)
+  (when-let (ctl (playlist/ctl elem))
     (let ((next
             (get-next-audio-track ctl (now-playing ctl))))
       (stop-playback ctl)
@@ -236,23 +258,32 @@
         (start-playback ctl)
         (load-track-display ctl)))))
 
+(defun ctl/update-playback-time (audio)
+  (when-let (ctl (playlist/ctl audio))
+    (setf (text (time-elem (track-display ctl)))
+          (secs-to-hms (media-position audio)))))
+
 ;;; 
 
 (defun create-track-list-item (parent track)
   (with-clog-create parent
       (div ()
            (p ()
-              (button (:content "|>" :bind btn))
+              (button (:content "⏵" :bind btn))
               (span (:content (track-listing-line track)))
               (span (:content (secs-to-hms (or (track-duration track) 0)))))
            (audio (:source (media-url-path track) :controls nil :bind audio)))
     (install-audio-track audio track)
+    (set-on-time-update 
+     audio
+     'ctl/update-playback-time)
     (set-on-ended
      audio
      (alambda (ctl/next-track audio)))
     (set-on-click
      btn
-     (alambda (ctl/play audio)))))
+     (alambda
+         (ctl/play-audio audio)))))
 
 (defun create-track-listing (parent playlist &rest args)
   (declare (ignorable args))
@@ -296,6 +327,26 @@
 (defun playlist-key-from-url (url)
   (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url)))))))
 
+(defun create-track-display (obj)
+  (with-clog-create obj
+      (div ()
+           (section (:h3 :content "Now Playing"))
+           (img (:bind thumb-elem))
+           (p (:bind title-elem))
+           (p (:bind artist-elem :hidden t))
+           (p ()
+              (span (:bind time-elem))
+              (span (:content "/"))
+              (span (:bind duration-elem)))
+           (button (:bind stop-button :content "⏹"))
+           (button (:bind next-button :content "⏭"))
+           (button (:bind pause/play-button :content "⏯")))
+    (setf (height thumb-elem) 120)
+    (set-on-click stop-button 'ctl/stop)
+    (set-on-click next-button 'ctl/next-track)
+    (set-on-click pause/play-button 'ctl/toggle-play)
+    (install-track-display thumb-elem title-elem artist-elem time-elem duration-elem)))
+
 (defun playlist-page (body)
   (when-let* ((listid
                (playlist-key-from-url (url (location body))))
@@ -304,13 +355,12 @@
     (install-playlist/ctl playlist body)
     (with-clog-create body
         (div ()
-             (section (:h2 :content (playlist-title playlist)))
-             (div (:bind track-display))
-             (div ()
-                  (track-listing (playlist)))
-             (track-form (playlist)))
-      (install-track-display track-display)
-      (initialize-playlist/ctl body))))
+             (section (:h2 :content (format nil "~a -- ~a"
+                                            (playlist-title playlist)
+                                            (secs-to-hms (playlist-duration playlist)))))
+             (track-display ())
+             (div () (track-listing (playlist)))
+             (track-form (playlist))))))
 
 (defun user-page (body)
   (if-let (user (session-user body))