;;;; 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)))))