1 files changed, 98 insertions, 16 deletions
diff --git a/vampire.lisp b/vampire.lisp
index 0d16bba..b988e27 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -137,23 +137,104 @@
           (pathname-name (track-file track))
           (pathname-type (track-file track))))
 
+(defun track-listing-line (track)
+  (with-slots (artist title) track
+    (with-output-to-string (out)
+      (when artist
+        (princ artist out)
+        (princ " - " out))
+      (princ title out))))
+
+
+;;; PLAYLIST CONTROL
+
+(defclass/std playlist/ctl ()
+  ((playlist track-display audio->track now-playing :std nil)))
+
+(defun get-audio-track (ctl audio)
+  (cdr (assoc audio (audio->track ctl))))
+
+(defun get-next-audio-track (ctl &optional audio)
+  (with-slots (audio->track) ctl
+   (if (null audio)
+       (first audio->track)
+       (let ((pos
+               (position audio audio->track :key #'car)))
+         (assert pos () "Audio element ~a not found in this playlist control." audio)
+         (nth (1+ pos) audio->track)))))
+
+(defun stop-playback (ctl)
+  (with-slots (now-playing) ctl
+    (when now-playing
+      (pause-media now-playing)
+      (setf (media-position now-playing) 0
+            now-playing nil))))
+
+(defun pause-playback (ctl)
+  (when-let  (track (now-playing ctl))
+    (pause-media track)))
+
+(defun start-playback (ctl)
+  (when-let (track (now-playing ctl))
+    (play-media track)))
+
+(defun playlist/ctl (obj)
+  (connection-data-item obj "playlist/ctl"))
+
+(defun install-playlist/ctl (playlist display)
+  (setf (connection-data-item display "playlist/ctl")
+        (make-instance 'playlist/ctl :playlist playlist :track-display display)))
+
+(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))
+    (pause-playback ctl)))
+
+(defun ctl/stop (audio)
+  (when-let (ctl (playlist/ctl audio))
+    (stop-playback ctl)))
+
+(defun ctl/play (audio)
+  (when-let (ctl (playlist/ctl audio))
+    (stop-playback ctl)
+    (setf (now-playing ctl) audio)
+    (start-playback ctl)))
+
+(defun ctl/next-track (audio)
+  (when-let (ctl (playlist/ctl audio))
+    (let ((next
+            (get-next-audio-track ctl (now-playing ctl))))
+      (stop-playback ctl)
+      (when next
+        (setf (now-playing ctl) (car next))
+        (start-playback ctl)))))
+
+;;; 
+
+(defun create-track-list-item (parent track)
+  (with-clog-create parent
+      (div ()
+           (p ()
+              (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-click
+     btn
+     (alambda (ctl/play audio)))))
+
 (defun create-track-listing (parent playlist &rest args)
   (declare (ignorable args))
-  (dolist (track (playlist-tracks playlist))
-    (with-clog-create parent
-        (div (:bind view)
-             (section (:h4 :content (track-title track)))
-             (img (:bind thumb))
-             (p (:content (track-artist track)))
-             (p (:content (secs-to-hms (or (track-duration track) 0))))
-             (audio (:source (media-url-path track) :controls nil :bind audio)))
-      (set-on-click
-       view
-       (alambda
-           (play-media audio)))
-      (if (track-thumb-url track)
-        (setf (url-src thumb) (track-thumb-url track)
-              (height thumb) "100px")))))
+  (let ((list (create-ordered-list parent))) 
+    (dolist (track (playlist-tracks playlist))
+      (with-clog-create list
+          (list-item () 
+                     (track-list-item (track)))))))
 
 (defun create-track-form (parent playlist &rest args)
   (declare (ignorable args))
@@ -199,7 +280,8 @@
              (section (:h2 :content (playlist-title playlist)))
              (div ()
                   (track-listing (playlist)))
-             (track-form (playlist))))))
+             (track-form (playlist)))
+      (install-playlist/ctl playlist body))))
 
 (defun user-page (body)
   (if-let (user (session-user body))