aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-10-25 15:51:32 -0500
committerColin Okay <colin@cicadas.surf>2022-10-25 15:51:32 -0500
commite1010af31425cf129c43d74e7f7e2adcb21f4bf2 (patch)
tree55cc534f82addfecf1e9615dd4c571dd18f9ec34
parente75db7bd501d4a7b8c085f0a6de62666521b45f4 (diff)
Add: Playlist control
-rw-r--r--vampire.lisp114
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))