Remove: Purged CLOG

1 files changed, 0 insertions, 544 deletions

diff --git a/playlist.lisp b/playlist.lisp
deleted file mode 100644
index d5c3690..0000000
--- a/playlist.lisp
+++ /dev/null
@@ -1,544 +0,0 @@
-;;;; 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 pl-zip pl-download
-             :std nil :doc "Playlist Elements"))
-  (:documentation "Holds the complete state for this session's viewing of a particular playlist."))
-
-(defclass/std track-ctl ()
-  ((track listing-line audio container info-edit-ctl edit-save-btn editing?
-    artist-input album-input title-input :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."
-  (when (pl-title ctl) (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))
-          (tr (track-ctl-with-audio ctl audio)))
-      (cond
-        ((and np (eq audio (audio np)) (pausedp audio))
-         (start-playback ctl))
-
-        (t
-         (stop-playback ctl)
-         (setf (now-playing-track ctl) tr)
-         (start-playback ctl)
-         (load-now-playing-display ctl tr))))))
-
-;;; 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)
-      (delete-zipped-playlist curctl)
-      (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))
-      (delete-zipped-playlist curctl)
-      (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))
-      (delete-zipped-playlist curctl)
-      (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)))))))
-
-(defun open-track-editor (track-ctl)
-  (setf (display (info-edit-ctl track-ctl)) "inline"
-	(text (edit-save-btn track-ctl))  "save "
-	(editing? track-ctl) t)
-  (with-slots (artist-input album-input title-input) track-ctl
-    (with-slots (artist album title) (track track-ctl)
-      (setf (place-holder artist-input) (or artist "Artist")
-	    (place-holder album-input) (or album "Album")
-	    (place-holder title-input) (or title "Title"))
-      (set-on-click
-       (edit-save-btn track-ctl)
-       (thunk* (update-track-info
-		(track track-ctl) (value artist-input) (value album-input) (value title-input))
-	       (close-track-editor track-ctl))
-       :one-time t))))
-
-(defun close-track-editor (track-ctl)
-  (setf (display (info-edit-ctl track-ctl)) "none"
-	(text (listing-line track-ctl)) (track-listing-line (track track-ctl))
-	(text (edit-save-btn track-ctl)) "edit "
-  	(editing? track-ctl) nil)
-  (set-on-click
-       (edit-save-btn track-ctl)
-       (thunk* (open-track-editor track-ctl))
-       :one-time t))
-
-(defun add-zipped-playlist-link (pl-ctl playlist)
-  "Adds the link to a zipped playlist to the DOM."
-  (for-playlist-viewers (pl-download pl-ctl) ctl
-    (setf (pl-zip ctl) (make-zipped-playlist-link playlist (pl-download ctl)))
-    (place-inside-bottom-of (pl-download ctl) (pl-zip ctl))))
-
-;;; 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)))
-           (div (:class "controls")
-		(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) "300px")
-    (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 :bind listing-line)))
-		 (div (:bind info-edit-ctl :class "track-list-edit")
-		      (div (:class "track-edit-inputs column")
-			   ;; (label (:content "Artist" :bind artist-label))
-			   (form-element (:text :bind artist-input :value (track-artist track)))
-			   ;; (label (:content "Album" :bind album-label))
-			   (form-element (:text :bind album-input :value (track-album track)))
-			   ;; (label (:content "Title" :bind title-label))
-			   (form-element (:text :bind title-input :value (track-title track)))))
-                 (div (:bind edit-controls)
-		      (button (:content "edit " :bind edit-save-btn))
-                      (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
-			   :listing-line listing-line
-                           :audio audio
-                           :track track
-			   :info-edit-ctl info-edit-ctl
-			   :edit-save-btn edit-save-btn
-			   :artist-input artist-input
-			   :album-input album-input
-			   :title-input title-input
-			   :editing? nil)))
-      (setf (tracks ctl)
-            (insert-nth track-ctl -1 (tracks ctl) t)
-	    (text listing-line) (track-listing-line track)
-	    (display info-edit-ctl) "none")
-      (cond
-        ((editorp ctl)
-         (setf (attribute downbtn "title") "move track down"
-               (attribute upbtn "title") "move track up")
-	 (set-on-click edit-save-btn (thunk* (open-track-editor track-ctl)) :one-time t)
-         (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)
-                   (delete-zipped-playlist (cur-playlist-ctl parent))
-                   (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 url-to-user (user)
-  (format nil "/user/~a" (key user)))
-
-(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 (:class "container")
-               (navigation-header ())
-               (div (:class "player")
-		    (now-playing-display (ctl))
-		    (div (:class "playlist-display")
-			 (:span (:bind edit-indicator))
-			 (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)))))
-			 (span (:content "by ")
-			       (a (:link (url-to-user (playlist-user pl))
-				   :content (format nil "~a" (user-name (playlist-user pl))))))
-			 (p (:bind collaborators-elem))
-			 (track-listing (pl))))
-
-	       (div (:class "row")
-                    (div (:class "column" :bind dl-elem)
-                         (button (:content "Create Zipped Playlist" :bind zip-download-button)))
-                    (div ()
-                         (new-track-form (pl))
-                         (editor-managment (pl)))))
-
-        (setf (pl-title ctl) title-elem
-              (pl-dur ctl) dur-elem
-              (pl-download ctl) dl-elem
-              (display input) "none"
-              (display title-elem) "inline")
-
-        (when (zipped-playlist-exists-p pl)
-          (setf (pl-zip ctl) (make-zipped-playlist-link pl body))
-          (place-after zip-download-button (pl-zip ctl)))
-
-        (set-on-click zip-download-button
-                      (thunk*
-                        (zip-playlist pl)
-                        (add-zipped-playlist-link ctl pl)))
-
-        (when (playlist-editors pl)
-          (setf (inner-html collaborators-elem)
-                (with-output-to-string (out)
-                  (princ "with help from " out)
-                  (loop for (u . more) on (playlist-editors pl)
-                        do  (format out "<a href='/user/~a'>~a</a>"
-                                    (key u) (user-name u))
-                        when more do (princ ", " out)))))
-
-        (when (editorp ctl)
-          (setf (attribute title-elem "title") "Click to edit the title."
-                (text edit-indicator) "(click the title to edit it)")
-          (set-on-blur
-           input
-           (thunk*
-             (when (plusp (length (value input)))
-               (delete-zipped-playlist ctl) ;; must happen first
-               (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)))))