Add: syncrhonize playlist remove and ordering between clients

2 files changed, 79 insertions, 34 deletions

diff --git a/playlist.lisp b/playlist.lisp
index dbe982f..6943c18 100644
--- a/playlist.lisp
+++ b/playlist.lisp
@@ -2,12 +2,13 @@
 
 (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")
+   (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")
@@ -19,6 +20,7 @@
   ((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))
@@ -48,10 +50,42 @@
 
 ;;; SESSION UTIL 
 
+(defparameter +playlist-connection-key+ "playlist-connection-key"
+  "Stored in the clog connection object")
+
+(defun cur-playlist-ctl (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)))
 
+;;; 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)
+  (let ((viewers
+          (playlist-viewers ctl)))
+    (setf (gethash (playlist ctl) *playlist-viewers*)
+          (pushnew ctl viewers))))
+
+(defun remove-playlist-viewer (ctl)
+  (let ((viewers
+          (playlist-viewers ctl)))
+    (setf (gethash (playlist ctl) *playlist-viewers*)
+          (delete ctl viewers))))
+
+(defmacro for-playlist-viewers (clog-elem ctlvar &body body)
+  `(dolist (,ctlvar (playlist-viewers (cur-playlist-ctl ,clog-elem)))
+     ,@body))
 
 ;;; PLAYBACK CONTROL
 
@@ -138,37 +172,51 @@
           (start-playback ctl)
           (load-now-playing-display ctl tr))))))
 
+;;; SYNCHRONZIED CLIENT CONTROL
 
 (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)))))))
+  (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* ((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))))))
+  (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* ((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))))))
+  (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
 
@@ -348,6 +396,7 @@
                (object-with-key list-id)))
     (let ((ctl
             (install-new-playlist-ctl pl body)))
+      (add-playlist-viewer ctl)
       (with-clog-create body
           (div ()
                (navigation-header ())
@@ -384,6 +433,9 @@
                    (display input) "inline")
              (focus input))))
         
-        (initialize-now-playing body)))))
+        (initialize-now-playing body))
+
+      (run body)
+      (remove-playlist-viewer ctl))))
 
 
diff --git a/session.lisp b/session.lisp
index 6d36bec..d7bd937 100644
--- a/session.lisp
+++ b/session.lisp
@@ -16,8 +16,6 @@
 (defparameter +session-key+ "vampire-session-key"
   "Stored in the browser's local storage")
 
-(defparameter +playlist-connection-key+ "playlist-connection-key"
-  "Stored in the clog connection object")
 
 ;;; SESSION ACCESSORS
 
@@ -32,9 +30,4 @@
     (when (typep obj 'session)
       (user obj))))
 
-(defun cur-playlist-ctl (obj)
-  (connection-data-item obj +playlist-connection-key+))
-
-(defun (setf cur-playlist-ctl) (newval obj)
-  (setf (connection-data-item obj +playlist-connection-key+) newval))