diff options
Diffstat (limited to 'playlist.lisp')
| -rw-r--r-- | playlist.lisp | 544 |
1 files changed, 0 insertions, 544 deletions
diff --git a/playlist.lisp b/playlist.lisp deleted file mode 100644 index d5c3690..0000000 --- a/playlist.lisp +++ /dev/null @@ -1,544 +0,0 @@ -;;;; playlist.lisp - -(in-package :vampire) - - -;;; CLIENT STATE - -(defclass/std playlist-ctl () - ((playlist :std nil :doc "The playlist instance.") - (editorp :std nil) - (tracks :std nil :doc "A list of instances of track-ctl") - (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 pl-dur pl-zip pl-download - :std nil :doc "Playlist Elements")) - (:documentation "Holds the complete state for this session's viewing of a particular playlist.")) - -(defclass/std track-ctl () - ((track listing-line audio container info-edit-ctl edit-save-btn editing? - artist-input album-input title-input :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 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)) - (track trctl))) - -(defun track-ctl-with-audio (ctl audio) - (find audio (tracks ctl) :key #'audio)) - -(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))))) - -;;; SESSION UTIL - -(defparameter +playlist-connection-key+ "playlist-connection-key" - "Stored in the clog connection object") - -(defun cur-playlist-ctl (obj) - (when (connection-data obj) - (connection-data-item obj +playlist-connection-key+))) - -(defun (setf cur-playlist-ctl) (newval obj) - (setf (connection-data-item obj +playlist-connection-key+) newval)) - -(defun install-new-playlist-ctl (playlist body) - (setf (cur-playlist-ctl body) - (make-instance 'playlist-ctl - :playlist playlist - :editorp (can-edit-p (session-user body) playlist)))) - -;;; SYNCHRONIZATION - -(defvar *playlist-viewers* (make-hash-table :synchronized t) - "Holds lists of active viewers of each playlist, keyed by playlist.") - -(defun playlist-viewers (ctl) - (gethash (playlist ctl) *playlist-viewers* nil)) - -(defun add-playlist-viewer (ctl) - "Add a new playlist-ctl instance for this connection and, while - doing so, remove any dead controllers" - (let ((viewers - (playlist-viewers ctl))) - (setf (gethash (playlist ctl) *playlist-viewers*) - (cons ctl (remove-if-not 'controller-alive-p viewers))))) - -(defun controller-alive-p (ctl) - "A controller is a live if the CLOG elements it manages are - associated with a live connection." - (when (pl-title ctl) (connection-data (pl-title ctl)))) - -(defmacro for-playlist-viewers (clog-elem ctlvar &body body) - `(dolist (,ctlvar (playlist-viewers (cur-playlist-ctl ,clog-elem))) - (if (controller-alive-p ctl) - (progn ,@body)))) - -;;; PLAYBACK CONTROL - -(defun start-playback (ctl) - (when-let (tr (now-playing-track ctl)) - (add-class (first-child (container tr)) "now-playing-track") - (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)) - (remove-class (first-child (container tr)) "now-playing-track") - (setf (media-position (audio tr)) 0 - (now-playing-track ctl) nil - (text (np-play ctl)) "⏵"))) - - -;;; CLIENT CONTROL - -(defun initialize-now-playing (elem) - (when-let (ctl (cur-playlist-ctl elem)) - (when (tracks ctl) - (setf (now-playing-track ctl) (first (tracks ctl))) - (load-now-playing-display ctl (now-playing-track ctl))))) - -(defun load-now-playing-display (ctl track-ctl) - (let ((tr (track track-ctl))) - (setf (text (np-title ctl)) (track-listing-line tr nil) - (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)))) - -(defun toggle-now-playing (e) - (when-let (ctl (cur-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 - (cur-playlist-ctl e))) - - (if-let (next (find-next-track ctl (now-playing-track ctl))) - (progn - (stop-playback ctl) - (setf (now-playing-track ctl) next) - (load-now-playing-display ctl next) - (start-playback ctl)) - (stop-playback ctl)))) - -(defun previous-now-playing (e) - (when-let* ((ctl - (cur-playlist-ctl e)) - (prev - (find-previous-track ctl (now-playing-track ctl)))) - (stop-playback ctl) - (setf (now-playing-track ctl) prev) - (load-now-playing-display ctl prev) - (start-playback ctl))) - -(defun update-now-playing-time (e) - (when-let* ((ctl (cur-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 (cur-playlist-ctl audio)) - (let ((np (now-playing-track ctl)) - (tr (track-ctl-with-audio ctl audio))) - (cond - ((and np (eq audio (audio np)) (pausedp audio)) - (start-playback ctl)) - - (t - (stop-playback ctl) - (setf (now-playing-track ctl) tr) - (start-playback ctl) - (load-now-playing-display ctl tr)))))) - -;;; SYNCHRONZIED CLIENT CONTROL - -(defun remove-track (track-ctl) - (when-let* ((container (container track-ctl)) - (curctl (cur-playlist-ctl container)) - (pos (position track-ctl (tracks curctl)))) - - (when (delete-track-at (playlist curctl) pos) - (delete-zipped-playlist curctl) - (for-playlist-viewers container ctl - (let ((track-ctl (nth pos (tracks ctl)))) - (destroy (container track-ctl)) - (setf (tracks ctl) (delete track-ctl (tracks ctl)) - (text (pl-dur ctl)) (secs-to-hms (playlist-duration (playlist ctl))))))))) - -(defun move-track-down (track-ctl) - (when-let* ((curctl (cur-playlist-ctl (container track-ctl))) - (pos (position track-ctl (tracks curctl)))) - (when (swap-tracks (playlist curctl) pos (1+ pos)) - (delete-zipped-playlist curctl) - (for-playlist-viewers (container track-ctl) ctl - (let* ((cur - (nth pos (tracks ctl))) - (next - (nth (1+ pos) (tracks ctl)))) - ;; swap track-ctls - (setf (tracks ctl) - (nswap (tracks ctl) pos (1+ pos))) - ;; swap list items in the dom - (place-before (container cur) (container next))))))) - -(defun move-track-up (track-ctl) - (when-let* ((curctl (cur-playlist-ctl (container track-ctl))) - (pos (position track-ctl (tracks curctl)))) - (when (swap-tracks (playlist curctl) pos (1- pos)) - (delete-zipped-playlist curctl) - (for-playlist-viewers (container track-ctl) ctl - (let* ((cur - (nth pos (tracks ctl))) - (next - (nth (1- pos) (tracks ctl)))) - ;; swap track-ctls - (setf (tracks ctl) - (nswap (tracks ctl) pos (1- pos))) - ;; swap list items in the dom - (place-after (container cur) (container next))))))) - -(defun open-track-editor (track-ctl) - (setf (display (info-edit-ctl track-ctl)) "inline" - (text (edit-save-btn track-ctl)) "save " - (editing? track-ctl) t) - (with-slots (artist-input album-input title-input) track-ctl - (with-slots (artist album title) (track track-ctl) - (setf (place-holder artist-input) (or artist "Artist") - (place-holder album-input) (or album "Album") - (place-holder title-input) (or title "Title")) - (set-on-click - (edit-save-btn track-ctl) - (thunk* (update-track-info - (track track-ctl) (value artist-input) (value album-input) (value title-input)) - (close-track-editor track-ctl)) - :one-time t)))) - -(defun close-track-editor (track-ctl) - (setf (display (info-edit-ctl track-ctl)) "none" - (text (listing-line track-ctl)) (track-listing-line (track track-ctl)) - (text (edit-save-btn track-ctl)) "edit " - (editing? track-ctl) nil) - (set-on-click - (edit-save-btn track-ctl) - (thunk* (open-track-editor track-ctl)) - :one-time t)) - -(defun add-zipped-playlist-link (pl-ctl playlist) - "Adds the link to a zipped playlist to the DOM." - (for-playlist-viewers (pl-download pl-ctl) ctl - (setf (pl-zip ctl) (make-zipped-playlist-link playlist (pl-download ctl))) - (place-inside-bottom-of (pl-download ctl) (pl-zip ctl)))) - -;;; CLIENT UI - -(defun playlist-title-content (playlist) - (format nil "~a -- ~a" - (playlist-title playlist) - (secs-to-hms (playlist-duration playlist)))) - -(defun create-now-playing-display (parent ctl) - (with-clog-create parent - (div (:class "now-playing") - (section (:h3 :content "Now Playing")) - (img (:bind thumb)) - (section (:h4) - (span (:bind title)) - (span (:bind artist))) - (p () - (span (:bind time)) - (span (:content " / ")) - (span (:bind dur))) - (div (:class "controls") - (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) - (setf (height thumb) "300px") - (set-on-click back 'previous-now-playing) - (set-on-click forward 'advance-now-playing) - (set-on-click play 'toggle-now-playing))) - -(defun media-url-path (track) - (format nil "/media/~a.~a" - (pathname-name (track-file track)) - (pathname-type (track-file track)))) - -(defun track-listing-line (track &optional (timep t)) - (with-slots (artist title duration) track - (if timep - (format nil "~50<~a~;~a~>~%~a" - (subseq* title 0 40) - (secs-to-hms (or duration 0)) - (if artist (concatenate 'string " by " - (subseq* artist 0 40)) "")) - (format nil "~a~%~a" - (subseq* title 0 40) - (if artist (concatenate 'string " by " - (subseq* artist 0 40)) ""))))) - -(defun create-track-list-item (list track ctl) - (with-clog-create list - (list-item (:bind container) - - (div (:bind item :class "track-list-item") - (section (:pre :bind listing-line))) - (div (:bind info-edit-ctl :class "track-list-edit") - (div (:class "track-edit-inputs column") - ;; (label (:content "Artist" :bind artist-label)) - (form-element (:text :bind artist-input :value (track-artist track))) - ;; (label (:content "Album" :bind album-label)) - (form-element (:text :bind album-input :value (track-album track))) - ;; (label (:content "Title" :bind title-label)) - (form-element (:text :bind title-input :value (track-title track))))) - (div (:bind edit-controls) - (button (:content "edit " :bind edit-save-btn)) - (button (:content "delete " :bind delbtn)) - (button (:content "↓" :bind downbtn)) - (button (:content "↑" :bind upbtn))) - (audio (:source (media-url-path track) :controls nil :bind audio))) - (let ((track-ctl - (make-instance 'track-ctl - :container container - :listing-line listing-line - :audio audio - :track track - :info-edit-ctl info-edit-ctl - :edit-save-btn edit-save-btn - :artist-input artist-input - :album-input album-input - :title-input title-input - :editing? nil))) - (setf (tracks ctl) - (insert-nth track-ctl -1 (tracks ctl) t) - (text listing-line) (track-listing-line track) - (display info-edit-ctl) "none") - (cond - ((editorp ctl) - (setf (attribute downbtn "title") "move track down" - (attribute upbtn "title") "move track up") - (set-on-click edit-save-btn (thunk* (open-track-editor track-ctl)) :one-time t) - (set-on-click delbtn (thunk* (remove-track track-ctl))) - (set-on-click downbtn (thunk* (move-track-down track-ctl))) - (set-on-click upbtn (thunk* (move-track-up track-ctl)))) - (t - (setf (display edit-controls) "none")))) - - (set-on-time-update audio 'update-now-playing-time) - (set-on-ended audio 'advance-now-playing) - (set-on-click item (thunk* (play-this-audio audio))))) - -(defun create-track-listing (parent pl) - (when-let (ctl (cur-playlist-ctl parent)) - (create-section parent :h3 :content "TRACKS") - (let ((ol (create-ordered-list parent :class "playlist-tracks"))) - (setf (pl-tracks ctl) ol) - (dolist (track (playlist-tracks pl)) - (create-track-list-item ol track ctl))))) - -(defun append-track-list-item (obj track) - (for-playlist-viewers obj ctl - (create-track-list-item (pl-tracks ctl) track ctl) - (setf (text (pl-dur ctl)) - (secs-to-hms (playlist-duration (playlist ctl)))))) - -(defun create-new-track-form (parent pl) - (when (editorp (cur-playlist-ctl parent)) - (with-clog-create parent - (div () - (section (:h3 :content "Add A Track")) - (label (:content "Paste a URL: " :bind url-label)) - (form-element (:text :bind url-input)) - (button (:content "Fetch Track" :bind button)) - (p (:content "Paste from youtube, bandcamp, vimeo... anything really. Chances are it'll work.")) - (div (:bind notice-area))) - (label-for url-label url-input) - (setf (size url-input) (length "https://www.youtube.com/watch?v=dQw4w9WgXcQ")) - (setf (place-holder url-input) "https://www.youtube.com/watch?v=dQw4w9WgXcQ") - (set-on-click - button - (thunk* - (let* ((url - (value url-input)) - (notice - (create-p notice-area :content (format nil "... Fetching ~a" url))) - (on-ok - (lambda (track) - (destroy notice) - (delete-zipped-playlist (cur-playlist-ctl parent)) - (append-track pl track) - (append-track-list-item parent track)))) - (setf (value url-input) "") - (if-let (track (track-with-source url)) - (funcall on-ok track) - (add-fetch-track-job - url on-ok - (lambda (err) - (destroy notice) - (format t "~a" err) - (alert (window (connection-body parent)) - (format nil "Error while fetching track at: ~a~%" - url))))))))))) - -(defun create-editor-managment (parent playlist) - (when (eq (session-user parent) (playlist-user playlist)) - (with-clog-create parent - (div () - (section (:h3 :content "Collaborators")) - (unordered-list (:bind editor-list)) - (button (:content "Add Contributor" :bind addbtn)) - (form-element (:text :bind userinput)) - (span (:bind username-status))) - (setf (place-holder userinput) "who?" - (width userinput ) 140) - (flet ((create-editor-item (editor) - (with-clog-create editor-list - (p (:content (user-name editor) :bind editor-elem) - (button (:content "remove" :bind delbtn))) - (set-on-click - delbtn - (thunk* - (remove-editor playlist editor) - (destroy editor-elem)))))) - (set-on-blur - userinput - (thunk* - (setf (text username-status) - (if (user-with-name (value userinput)) - "✔" "No user with that name")))) - (set-on-click - addbtn - (thunk* - (let ((user (user-with-name (value userinput)))) - (cond - (user - (add-editor playlist user) - (setf (value userinput) "" - (text username-status) "") - (create-editor-item user)) - (t - (setf (text username-status) - "No user with that name")))))) - (dolist (editor (playlist-editors playlist)) - (create-editor-item editor)))))) - -(defun url-to-user (user) - (format nil "/user/~a" (key user))) - -(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))) - (add-playlist-viewer ctl) - (include-style body) - (with-clog-create body - (div (:class "container") - (navigation-header ()) - (div (:class "player") - (now-playing-display (ctl)) - (div (:class "playlist-display") - (:span (:bind edit-indicator)) - (section (:h2) - (:span (:bind title-elem :content (playlist-title pl))) - (form-element (:text :bind input)) - (:span (:content " -- ")) - (:span (:bind dur-elem :content (secs-to-hms (playlist-duration pl))))) - (span (:content "by ") - (a (:link (url-to-user (playlist-user pl)) - :content (format nil "~a" (user-name (playlist-user pl)))))) - (p (:bind collaborators-elem)) - (track-listing (pl)))) - - (div (:class "row") - (div (:class "column" :bind dl-elem) - (button (:content "Create Zipped Playlist" :bind zip-download-button))) - (div () - (new-track-form (pl)) - (editor-managment (pl))))) - - (setf (pl-title ctl) title-elem - (pl-dur ctl) dur-elem - (pl-download ctl) dl-elem - (display input) "none" - (display title-elem) "inline") - - (when (zipped-playlist-exists-p pl) - (setf (pl-zip ctl) (make-zipped-playlist-link pl body)) - (place-after zip-download-button (pl-zip ctl))) - - (set-on-click zip-download-button - (thunk* - (zip-playlist pl) - (add-zipped-playlist-link ctl pl))) - - (when (playlist-editors pl) - (setf (inner-html collaborators-elem) - (with-output-to-string (out) - (princ "with help from " out) - (loop for (u . more) on (playlist-editors pl) - do (format out "<a href='/user/~a'>~a</a>" - (key u) (user-name u)) - when more do (princ ", " out))))) - - (when (editorp ctl) - (setf (attribute title-elem "title") "Click to edit the title." - (text edit-indicator) "(click the title to edit it)") - (set-on-blur - input - (thunk* - (when (plusp (length (value input))) - (delete-zipped-playlist ctl) ;; must happen first - (update-playlist-title pl (value input)) - (setf (text title-elem) (value input))) - (setf (display input) "none" - (display title-elem) "inline"))) - - (set-on-click - title-elem - (thunk* - (setf (value input) (text title-elem) - (display title-elem) "none" - (display input) "inline") - (focus input)))) - (initialize-now-playing body))))) |