path: root/playlist.lisp

;;;; 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
             :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 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."
  (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)))
      (cond
        ((not (eq audio (audio np)))    ; different track
         (let ((tr
                 (track-ctl-with-audio ctl audio)))
           (stop-playback ctl)
           (setf (now-playing-track ctl) tr)
           (start-playback ctl)
           (load-now-playing-display ctl tr)))
        ((pausedp audio)
         (start-playback ctl))))))

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


;;; 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)))
           (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) "100px")
    (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 :content (track-listing-line track))))
                 (div (:bind edit-controls)
                      (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
                           :audio audio
                           :track track)))
      (setf (tracks ctl)
            (insert-nth track-ctl -1 (tracks ctl) t)) 
      (cond
        ((editorp ctl) 
         (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)
                   (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 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 ()
               (navigation-header ())
               (div (:class "row")
                    (div ()
                         (now-playing-display (ctl)))
                    (div ()
                         (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)))))
                         (track-listing (pl))))
               (div (:class "row")
                    (div ()
                         (new-track-form (pl))
                         (editor-managment (pl)))))
        (setf (pl-title ctl) title-elem
              (pl-dur ctl) dur-elem
              (display input) "none"
              (display title-elem) "inline")

        (when (editorp ctl)
          (setf (attribute title-elem "title") "Click to edit the title.")
          (set-on-blur
           input
           (thunk*
             (when (plusp (length (value input)))
               (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)))))