diff options
| -rw-r--r-- | vampire.lisp | 114 |
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)) |