From 60fac3a2d058077aea46fb2ce2fd3e9531728124 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 25 Oct 2022 17:21:40 -0500 Subject: Add: track-display class; better track display and controls --- vampire.lisp | 118 ++++++++++++++++++++++++++++++++++++++++++----------------- 1 file 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)) -- cgit v1.2.3