path: root/playlist.lisp

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

;;; 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-now-playing-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-now-playing-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-now-playing-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-now-playing-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-now-playing-display (parent ctl)
  (with-clog-create parent
      (div (:class "now-playing-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) 
    (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)
                 (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 append-track-list-item (obj track)
  (when-let (ctl (get-playlist-ctl obj))
    (create-track-list-item (pl-tracks ctl) track 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 (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))))
           (setf (value url-input) "")
           (add-fetch-track-job
            url
            (lambda (track)
              (destroy notice)
              (append-track pl track)
              (append-track-list-item parent track))
            (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 :content (playlist-title-content pl) :bind title-elem))
               (now-playing-display (ctl))
               (track-listing (pl ctl :bind tracks-elem))
               (new-track-form (pl)))
          (setf (pl-title ctl) title-elem
                (pl-tracks ctl) tracks-elem)))))