diff options
Diffstat (limited to 'playlist.lisp')
| -rw-r--r-- | playlist.lisp | 266 |
1 files changed, 266 insertions, 0 deletions
diff --git a/playlist.lisp b/playlist.lisp new file mode 100644 index 0000000..62f9b9e --- /dev/null +++ b/playlist.lisp @@ -0,0 +1,266 @@ +;;;; playlist.lisp + +(in-package :vampire) + +;;; MODEL + +(defclass/bknr playlist (keyed) + ((title :with :std (default-name "playlist")) + (tracks editors :with :std (list)) + (cover-image :with :std nil :doc "A url to the cover of this album.") + (user :with + :std (error "A USER is required to have created the content.")))) + +(defmethod initialize-instance :after ((pl playlist) &key) + (pushnew pl (user-playlists (playlist-user pl)) :test #'eq)) + +(defclass/bknr track (keyed) + ((source file title artist album thumb-url duration codec :with) + (playlists :with :std (list) :doc "A list of playlists in which this track appears"))) + +;;; OPERATIONS + +(defun playlist-duration (pl) + (reduce #'+ + (playlist-tracks pl) + :key 'track-duration + :initial-value 0)) + +(defun add-track (tr pl &optional (n -1)) + (setf (playlist-tracks pl) + (insert-nth tr n (playlist-tracks pl)))) + +(defun remove-nth-from-playlist (pl n) + (multiple-value-bind (newlist track) + (remove-nth n (playlist-tracks pl) t) + (setf (playlist-tracks pl) newlist + (track-playlists track) (delete pl (track-playlists track) + :test #'eq :count 1)))) +;;; TRANSACTIONS + +(defun append-track (pl tr) + (with-transaction () + (add-track tr pl))) + +(defun new-track (file trackinfo) + "Trackinfo is a plist containing information about the track to create." + (with-transaction () + (let ((track (apply #'make-instance 'track trackinfo))) + (setf (track-file track) (namestring file)) + track))) + +(defun new-playlist (user &key title) + (with-transaction () + (make-instance 'playlist :title title :user user))) + +;;; CLIENT STATE + +(defclass/std playlist-ctl () + ((playlist :std nil :doc "The playlist instance.") + (tracks :std nil :doc "A list of instances of track/client") + (now-playing-track :std nil :doc "An instance of track-ctl") + (np-title np-artist np-thumb np-dur np-time np-play + :std nil :doc "Now Playing Elements") + (pl-title pl-tracks + :std nil :doc "Playlist Elements")) + (:documentation "Holds the complete state for this session's viewing of a particular playlist.")) + +(defclass/std track-ctl () + ((track audio container :std nil)) + (:documentation "The state of a particular track in this session's viewing of a playlist.")) + +(defun audio-for-track (ctl track) + "Return the audio element associated with the track" + (when-let (trctl (find track (tracks ctl) :test #'eq :key #'track)) + (audio-elem trctl))) + +(defun track-for-audio (ctl audio) + "Return the track instance associated with the AUDIO element." + (when-let (trctl (find audio (tracks ctl) :test #'eq :key #'audio-elem)) + (track trctl))) + +(defun track-ctl-with-audio (ctl audio) + (find audio (tracks ctl) :key #'audio-elem)) + +(defun find-next-track (ctl &optional track) + "Return the TRACK-CTL instance that appeqars after TRACK in the + TRACKS list, or NIL. If TRACK is NIL, return the first TRACK in the + list." + (if (null track) + (first (tracks ctl)) + (when-let (pos (position track (tracks ctl))) + (nth (1+ pos) (tracks ctl))))) + +(defun find-previous-track (ctl &optional track) + (when-let (pos (position track (tracks ctl))) + (when (plusp pos) + (nth (1- pos) (tracks ctl))))) + +;;; CLIENT SESSION + +(defun install-new-playlist-ctl (playlist body) + (setf (connection-data-item body "playlist-ctl") + (make-instance 'playlist-ctl :playlist playlist))) + +(defun get-playlist-ctl (obj) + (connection-data-item obj "playlist-ctl")) + +;;; PLAYBACK CONTROL + +(defun start-playback (ctl) + (when-let (tr (now-playing-track ctl)) + (play-media (audio tr)) + (setf (text (np-play ctl)) "||"))) + +(defun pause-playback (ctl) + (when-let (tr (now-playing-track ctl)) + (pause-media (audio tr)) + (setf (text (np-play ctl)) "|>"))) + +(defun stop-playback (ctl) + (when-let (tr (now-playing-track ctl)) + (pause-media (audio tr)) + (setf (media-position (audio tr)) 0 + (now-playing-track ctl) nil + (text (np-play ctl)) "|>"))) + + +;;; CLIENT CONTROL + +(defun load-track-display (ctl track-ctl) + (let ((tr (track track-ctl))) + (setf (text (np-title ctl)) (track-title tr) + (text (np-artist ctl)) (or (track-artist tr) "") + (url-src (np-thumb ctl)) (or (track-thumb-url tr) "") + (text (np-dur ctl)) (secs-to-hms (or (track-duration tr) 0)) + (text (np-time ctl)) (secs-to-hms 0) + (text (np-play ctl)) "|>"))) + +(defun toggle-now-playing (e) + (when-let (ctl (get-playlist-ctl e)) + (if-let (np (now-playing-track ctl)) + (if (pausedp (audio np)) + (start-playback ctl) + (pause-playback ctl)) + (advance-now-playing e)))) + +(defun advance-now-playing (e) + (when-let* ((ctl + (get-playlist-ctl e)) + (next + (find-next-track ctl (now-playing-track ctl)))) + (stop-playback ctl) + (setf (now-playing-track ctl) next) + (load-track-display ctl next) + (start-playback ctl))) + +(defun previous-now-playing (e) + (when-let* ((ctl + (get-playlist-ctl e)) + (prev + (find-previous-track ctl (now-playing-track ctl)))) + (stop-playback ctl) + (setf (now-playing-track ctl) prev) + (load-track-display ctl prev) + (start-playback ctl))) + +(defun update-now-playing-time (e) + (when-let* ((ctl (get-playlist-ctl e)) + (tr (now-playing-track ctl))) + (setf (text (np-time ctl)) + (secs-to-hms + (media-position (audio tr)))))) + + +(defun play-this-audio (audio) + (when-let (ctl (get-playlist-ctl audio)) + (let ((np (now-playing-track ctl))) + (unless (and np (eq audio (audio np))) + (let ((tr + (track-ctl-with-audio ctl audio))) + (stop-playback ctl) + (setf (now-playing-track ctl) tr) + (start-playback ctl) + (load-track-display ctl tr)))))) + + +;;; CLIENT UI + +(defun playlist-title-content (playlist) + (format nil "~a -- ~a" + (playlist-title playlist) + (secs-to-hms (playlist-duration playlist)))) + +(defun create-track-display (parent ctl) + (with-clog-create parent + (div (:class "track-display") + (section (:h3 :content "Now Playing")) + (img (:bind thumb)) + (p () + (span (:bind title)) + (span (:bind artist))) + (p () + (span (:bind time)) + (span (:content " / ")) + (span (:bind dur))) + (button (:content "<<" :bind back)) + (button (:content "|>" :bind play)) + (button (:content ">>" :bind forward))) + (setf (np-title ctl) title + (np-artist ctl) artist + (np-thumb ctl) thumb + (np-dur ctl) dur + (np-time ctl) time + (np-play ctl) play) + (set-on-click back 'previous-now-playing) + (set-on-click forward 'advance-now-playing) + (set-on-click play 'toggle-now-playing))) + +(defun create-track-list-item (list track ctl) + (with-clog-create list + (list-item (:bind container) + (p () + (span (:content (track-listing-line track))) + (span (:content " -- ")) + (span (:content (secs-to-hms (or (track-duration track) 0))))) + (audio (:source (media-url-path track) :controls nil :bind audio))) + (setf (tracks ctl) + (insert-nth (make-instance 'track-ctl + :container container + :audio audio + :track track) + -1 + (tracks ctl))) + (set-on-time-update audio 'update-now-playing-time) + (set-on-ended audio 'advance-now-playing) + (set-on-click container (alambda (play-this-audio audio))))) + +(defun create-track-listing (parent pl ctl) + (let ((ol (create-ordered-list parent))) + (setf (pl-tracks ctl) ol) + (dolist (track (playlist-tracks pl)) + (create-track-list-item ol track ctl)))) + +(defun create-new-track-form (parent pl ctl) + ) + + +(defun playlist-key-from-url (url) + (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url))))))) + +(defun playlist-page (body) + (when-let* ((list-id + (playlist-key-from-url (url (location body)))) + (pl + (object-with-key list-id))) + (let ((ctl + (install-new-playlist-ctl pl body))) + (with-clog-create body + (div () + (section (:h2 :content (playlist-title-content pl) :bind title-elem)) + (track-display (ctl)) + (track-listing (pl ctl :bind tracks-elem)) + ;(new-track-form (pl ctl)) + ) + (setf (pl-title ctl) title-elem + (pl-tracks ctl) tracks-elem))))) |