Add: playlist.lisp

1 files changed, 35 insertions, 291 deletions

diff --git a/vampire.lisp b/vampire.lisp
index 57e474f..8ca4b79 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -19,25 +19,6 @@
 
 ;;; RESOURCE MODEL
 
-(defclass/bknr keyed ()
-  ((key
-    :r :std (nuid)
-    :index-type string-unique-index
-    :index-reader object-with-key)))
-
-(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")))
 
 (defclass/bknr user (keyed)
   ((name :with :std "")
@@ -46,43 +27,18 @@
 
 ;;; RESOURCE ACCESS 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-user (&key name)
   (with-transaction ()
     (make-instance 'user :name name)))
 
-(defun new-playlist (user &key title)
-  (with-transaction ()
-    (make-instance 'playlist :title title :user user)))
 
-(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)))
+
+
 
 ;;; CLIENT
 
@@ -146,251 +102,39 @@
       (princ title out))))
 
 
-;;; PLAYLIST CONTROL
-
-(defclass/std playlist/ctl ()
-  ((playlist track-list track-display audio->track now-playing :std nil)))
-
-(defmethod (setf now-playing) :before (newval ctl)
-  (with-slots (now-playing) ctl
-    (when now-playing
-      (remove-class (parent-element now-playing) "now-playing")))
-  (when newval
-    (add-class (parent-element newval) "now-playing")))
-
-(defclass/std track-display ()
-  ((title-elem
-    thumb-elem
-    artist-elem
-    time-elem
-    duration-elem
-    play/pause-btn)))
-
-(defun get-audio-track (ctl audio)
-  (cdr (assoc audio (audio->track ctl))))
-
-(defun get-next-audio-track (ctl &optional audio)
-  (with-slots (audio->track) ctl
-   (if (null audio)
-       (first audio->track)
-       (let ((pos
-               (position audio audio->track :key #'car)))
-         (assert pos () "Audio element ~a not found in this playlist control." audio)
-         (nth (1+ pos) audio->track)))))
-
-(defun stop-playback (ctl)
-  (with-slots (now-playing) ctl
-    (when now-playing
-      (pause-media now-playing)
-      (setf (media-position now-playing) 0
-            now-playing nil
-            (text (play/pause-btn (track-display ctl))) "⏵"))))
-
-(defun pause-playback (ctl)
-  (when-let  (audio (now-playing ctl))
-    (pause-media audio)
-    (setf (text (play/pause-btn (track-display ctl))) "⏵")))
-
-(defun start-playback (ctl)
-  (when-let (audio (now-playing ctl))
-    (play-media audio)
-    (setf (text (play/pause-btn (track-display ctl)))
-          "⏸")))
-
-(defun load-track-display (ctl)
-  (when-let (track (get-audio-track ctl (now-playing ctl)))
-    (with-slots
-          (title-elem thumb-elem artist-elem
-           time-elem duration-elem)
-        (track-display ctl)
-      (with-slots (title artist thumb-url duration) track
-        (setf (text title-elem) title
-              (text duration-elem) (secs-to-hms duration)
-              (text time-elem) (secs-to-hms 0)
-              (url-src thumb-elem) thumb-url)))))
-
-(defun initialize-playlist/ctl (body)
-  (let ((ctl (playlist/ctl body)))
-    (setf now-playing (car (first (audio->track ctl))))
-    (load-track-display ctl)))
-
-(defun playlist/ctl (obj)
-  (connection-data-item obj "playlist/ctl"))
-
-(defun install-playlist/ctl (playlist obj)
-  (setf (connection-data-item obj "playlist/ctl")
-        (make-instance 'playlist/ctl :playlist playlist)))
-
-(defun install-track-list (list)
-  (let ((ctl (playlist/ctl list)))
-    (setf (track-list ctl) list)))
-
-(defun install-track-display (thumb title artist time dur play/pause)
-  (let ((ctl (playlist/ctl thumb)))
-    (setf (track-display ctl)
-          (make-instance 'track-display
-                         :duration-elem dur
-                         :time-elem time
-                         :artist-elem artist
-                         :thumb-elem thumb
-                         :title-elem title
-                         :play/pause-btn play/pause))))
-
-(defun install-audio-track (audio track &optional (position -1))
-  (when-let (ctl (playlist/ctl audio))
-    (setf (audio->track ctl)
-          (insert-nth (cons audio track) position (audio->track ctl)))))
-
-(defun ctl/now-playing (elem)
-  (when-let (ctl (playlist/ctl elem))
-    (now-playing ctl)))
-
-(defun ctl/pause (elem)
-  (when-let (ctl (playlist/ctl elem))
-    (pause-playback ctl)))
-
-(defun ctl/stop (elem)
-  (when-let (ctl (playlist/ctl elem))
-    (stop-playback ctl)))
-
-(defun ctl/play-audio (audio)
-  (when-let (ctl (playlist/ctl audio))
-    (unless (eq audio (now-playing ctl))
-      (stop-playback ctl)
-      (setf (now-playing ctl) audio)
-      (start-playback ctl)
-      (load-track-display ctl))))
-
-(defun ctl/toggle-play (elem)
-  (when-let (ctl (playlist/ctl elem))
-    (if (now-playing ctl)
-        (if (pausedp (now-playing ctl))
-            (start-playback ctl)
-            (pause-playback ctl))
-        (ctl/next-track elem))))
-
-(defun ctl/next-track (elem)
-  (when-let (ctl (playlist/ctl elem))
-    (let ((next
-            (get-next-audio-track ctl (now-playing ctl))))
-      (stop-playback ctl)
-      (when next
-        (setf (now-playing ctl) (car next))
-        (start-playback ctl)
-        (load-track-display ctl)))))
-
-(defun ctl/update-playback-time (audio)
-  (when-let (ctl (playlist/ctl audio))
-    (setf (text (time-elem (track-display ctl)))
-          (secs-to-hms (media-position audio)))))
-
-(defun create-track-list-item (parent track)
-  (with-clog-create parent
-      (div (:bind view)
-           (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)))
-    (install-audio-track audio track)
-    (set-on-time-update 
-     audio
-     'ctl/update-playback-time)
-    (set-on-ended
-     audio
-     (alambda (ctl/next-track audio)))
-    (set-on-click
-     view
-     (alambda
-         (ctl/play-audio audio)))))
+;; (defun create-track-form (parent playlist &rest args)
+;;   (declare (ignorable args))
+;;   (with-clog-create parent
+;;       (div ()
+;;            (section (:h3 :content "Add Track"))
+;;            (label (:content "Paste URL: " :bind url-label))
+;;            (form-element (:text :bind url-input))
+;;            (button (:content "Fetch Track" :bind submit-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
+;;      submit-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)
+;;               (remove-from-dom notice)
+;;               (append-track playlist track)
+;;               (add-track-to-listing parent track))
+;;             (lambda (err)
+;;               (remove-from-dom notice)
+;;               (format t "Error: ~a~%" err)
+;;               (alert (window (connection-body parent))
+;;                      (format nil "Error while fetching track at: ~a~%"
+;;                              url)))))))))
+
 
-(defun create-track-listing (parent playlist &rest args)
-  (declare (ignorable args))
-  (let ((list (create-ordered-list parent))) 
-    (install-track-list list)
-    (dolist (track (playlist-tracks playlist))
-      (with-clog-create list
-          (list-item () 
-                     (track-list-item (track)))))))
-
-(defun add-track-to-listing (elem track)
-  (with-slots (track-list) (playlist/ctl elem)
-    (with-clog-create track-list
-        (list-item ()
-                   (track-list-item (track))))))
-
-(defun create-track-form (parent playlist &rest args)
-  (declare (ignorable args))
-  (with-clog-create parent
-      (div ()
-           (section (:h3 :content "Add Track"))
-           (label (:content "Paste URL: " :bind url-label))
-           (form-element (:text :bind url-input))
-           (button (:content "Fetch Track" :bind submit-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
-     submit-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)
-              (remove-from-dom notice)
-              (append-track playlist track)
-              (add-track-to-listing parent track))
-            (lambda (err)
-              (remove-from-dom notice)
-              (format t "Error: ~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 create-track-display (obj)
-  (with-clog-create obj
-      (div ()
-           (section (:h3 :content "Now Playing"))
-           (img (:bind thumb-elem))
-           (p (:bind title-elem))
-           (p (:bind artist-elem :hidden t))
-           (p ()
-              (span (:bind time-elem))
-              (span (:content "/"))
-              (span (:bind duration-elem)))
-           (button (:bind stop-button :content "⏹"))
-           (button (:bind next-button :content "⏭"))
-           (button (:bind pause/play-button :content "⏵")))
-    (setf (height thumb-elem) 120)
-    (set-on-click stop-button 'ctl/stop)
-    (set-on-click next-button 'ctl/next-track)
-    (set-on-click
-     pause/play-button
-     #'ctl/toggle-play)
-    (install-track-display thumb-elem title-elem artist-elem time-elem duration-elem
-                           pause/play-button)))
-
-(defun playlist-page (body)
-  (when-let* ((listid
-               (playlist-key-from-url (url (location body))))
-              (playlist
-               (object-with-key listid)))
-    (install-playlist/ctl playlist body)
-    (with-clog-create body
-        (div ()
-             (section (:h2 :content (format nil "~a -- ~a"
-                                            (playlist-title playlist)
-                                            (secs-to-hms (playlist-duration playlist)))))
-             (track-display ())
-             (div () (track-listing (playlist)))
-             (track-form (playlist))))))
 
 (defun user-page (body)
   (if-let (user (session-user body))