From 425dc38a6bb93de99bb3f743683591062ed0dac7 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Wed, 26 Oct 2022 11:33:58 -0500
Subject: Add: playlist.lisp

---
 playlist.lisp | 266 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 266 insertions(+)
 create mode 100644 playlist.lisp

(limited to 'playlist.lisp')

diff --git a/playlist.lisp b/playlist.lisp
new file mode 100644
index 0000000..62f9b9e
--- /dev/null
+++ b/playlist.lisp
@@ -0,0 +1,266 @@
+;;;; 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)))))
-- 
cgit v1.2.3