path: root/playlist.lisp

;;;; playlist.lisp

(in-package :vampire)

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

(defun install-new-playlist-ctl (playlist body)
  (setf (cur-playlist-ctl body)
        (make-instance 'playlist-ctl :playlist playlist)))


;;; 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 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-title tr)
          (text (np-artist ctl)) (if (track-artist tr)
                                     (format nil "~a |" (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))))

(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))
              (next
               (find-next-track ctl (now-playing-track ctl))))
    (stop-playback ctl)
    (setf (now-playing-track ctl) next)
    (load-now-playing-display ctl next)
    (start-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)))
      (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-now-playing-display ctl tr))))))


(defun remove-track (track-ctl)
  (when-let ((ctl (cur-playlist-ctl (container track-ctl))))
    (when (delete-track-at (playlist ctl) (position track-ctl (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* ((ctl (cur-playlist-ctl (container track-ctl)))
              (pos (position track-ctl (tracks ctl))))
    (when (swap-tracks (playlist ctl) pos (1+ pos))
      (let* ((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 track-ctl) (container next))))))

(defun move-track-up (track-ctl)
  (when-let* ((ctl (cur-playlist-ctl (container track-ctl)))
              (pos (position track-ctl (tracks ctl))))
    (when (swap-tracks (playlist ctl) pos (1- pos))
      (let* ((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 track-ctl) (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-display")
           (section (:h3 :content "Now Playing"))
           (img (:bind thumb))
           (section (:h4)
              (span (:content " | "))
              (span (:bind title))
              (span (:content " | "))              
              (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)
  (with-slots (artist title) track
    (with-output-to-string (out)
      (when artist
        (princ artist out)
        (princ " - " out))
      (princ title out))))

(defun create-track-list-item (list track ctl)
  (with-clog-create list
      (list-item (:bind container)
                 (div ()
                      (button (:content "delete " :hidden t :bind delbtn))
                      (button (:content "↓" :bind downbtn))
                      (button (:content "↑" :bind upbtn)))
                 (div (:bind item)
                      (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)))
    (let ((track-ctl
            (make-instance 'track-ctl
                           :container container
                           :audio audio
                           :track track)))
      (setf (tracks ctl)
            (insert-nth track-ctl -1 (tracks ctl) t)) 
      (setf (visiblep delbtn) t)
      (set-on-click delbtn (alambda (remove-track track-ctl)))
      (set-on-click downbtn (alambda (move-track-down track-ctl)))
      (set-on-click upbtn (alambda (move-track-up track-ctl))))
    (set-on-time-update audio 'update-now-playing-time)
    (set-on-ended audio 'advance-now-playing)
    (set-on-click item (alambda (play-this-audio audio)))))

(defun create-track-listing (parent pl)
  (when-let (ctl (cur-playlist-ctl parent))
    (let ((ol (create-ordered-list parent)))
      (setf (pl-tracks ctl) ol)
      (dolist (track (playlist-tracks pl))
        (create-track-list-item ol track ctl)))))

(defun append-track-list-item (obj track)
  (when-let (ctl (cur-playlist-ctl obj))
    (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)
  (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))
           (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
     (alambda
         (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 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)
                        (: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)))))
               
               (now-playing-display (ctl))
               (track-listing (pl))
               (new-track-form (pl)))
        (setf (pl-title ctl) title-elem
              (pl-dur ctl) dur-elem
              (display input) "none"
              (display title-elem) "inline")

        (set-on-blur
         input
         (alambda
             (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
         (alambda
             (setf (value input) (text title-elem)
                   (display title-elem) "none"
                   (display input) "inline")
           (focus input)))

        (initialize-now-playing body)))))