aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--explore.lisp32
-rw-r--r--model.lisp12
-rw-r--r--playlist.lisp126
-rw-r--r--vampire.lisp1
4 files changed, 112 insertions, 59 deletions
diff --git a/explore.lisp b/explore.lisp
new file mode 100644
index 0000000..f562448
--- /dev/null
+++ b/explore.lisp
@@ -0,0 +1,32 @@
+;;; explore.lisp
+
+(in-package :vampire)
+
+(defun create-media-search-area (parent)
+ (with-clog-create parent
+ (p (:content "media search area"))))
+
+(defun create-playlist-explore-card (parent pl)
+ (with-clog-create parent
+ (div ()
+ (img (:bind thumb))
+ (section (:h4)
+ (a (:link (url-to-playlist pl) :content (playlist-title pl)))
+ (span (:content " -- "))
+ (span (:content (secs-to-hms (playlist-duration pl))))))
+ (setf (maximum-width thumb) "120px")
+ (when-let (track (first (playlist-tracks pl)))
+ (setf (url-src thumb) (or (track-thumb-url track) "")))))
+
+(defun create-recent-playlists-area (parent)
+ (let* ((container (create-div parent)))
+ (dolist (pl (recent-playlists 10))
+ (create-playlist-explore-card container pl))))
+
+(defun explore-page (body)
+ (with-clog-create body
+ (div ()
+ (navigation-header ())
+ ;(media-search-area ())
+ (section (:h2 :content "Recent Playlists"))
+ (recent-playlists-area ()))))
diff --git a/model.lisp b/model.lisp
index fc8d93f..42142ed 100644
--- a/model.lisp
+++ b/model.lisp
@@ -36,6 +36,10 @@
;;; MODEL OPERATIONS
+(defun can-edit-p (user playlist)
+ (or (eq (playlist-user playlist) user)
+ (member user (playlist-editors playlist) :test #'eq)))
+
(defun invite-by-code (code)
"Returns NIL if CODE is an invalid invite code. Returns the INVITE
instance otherwise"
@@ -56,6 +60,14 @@
(when (equalp pwhash (hash-string password pwsalt))
user))))
+(defun last-change (obj)
+ (slot-value obj 'bknr.datastore::last-change))
+
+(defun recent-playlists (&optional (count 10))
+ (take count
+ (sort (copy-seq (store-objects-with-class 'playlist))
+ #'>
+ :key #'last-change)))
(defun playlist-duration (pl)
(reduce #'+
(playlist-tracks pl)
diff --git a/playlist.lisp b/playlist.lisp
index 8b4b4e6..938972c 100644
--- a/playlist.lisp
+++ b/playlist.lisp
@@ -218,11 +218,11 @@
(princ " - " out))
(princ title out))))
-(defun create-track-list-item (list track ctl)
+(defun create-track-list-item (list track ctl &optional editp)
(with-clog-create list
(list-item (:bind container)
- (div ()
- (button (:content "delete " :hidden t :bind delbtn))
+ (div (:bind edit-controls)
+ (button (:content "delete " :bind delbtn))
(button (:content "↓" :bind downbtn))
(button (:content "↑" :bind upbtn)))
(div (:bind item)
@@ -238,20 +238,26 @@
:track track)))
(setf (tracks ctl)
(insert-nth track-ctl -1 (tracks ctl) t))
- (setf (visiblep delbtn) 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))))
+
+ (cond
+ (editp
+ (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))
- (let ((ol (create-ordered-list parent)))
+ (let ((ol (create-ordered-list parent))
+ (editp (can-edit-p (session-user parent) pl)))
(setf (pl-tracks ctl) ol)
(dolist (track (playlist-tracks pl))
- (create-track-list-item ol track ctl)))))
+ (create-track-list-item ol track ctl editp)))))
(defun append-track-list-item (obj track)
(when-let (ctl (cur-playlist-ctl obj))
@@ -260,39 +266,40 @@
(secs-to-hms (playlist-duration (playlist 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 (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)
- (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))))))))))
+ (when (can-edit-p (session-user 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 (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)
+ (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 playlist-key-from-url (url)
(first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url)))))))
@@ -320,23 +327,24 @@
(pl-dur ctl) dur-elem
(display input) "none"
(display title-elem) "inline")
-
- (set-on-blur
- input
- (thunk*
- (when (plusp (length (value input)))
- (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)))
+
+ (when (can-edit-p (session-user body) pl)
+ (set-on-blur
+ input
+ (thunk*
+ (when (plusp (length (value input)))
+ (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)))))
diff --git a/vampire.lisp b/vampire.lisp
index dcfb2e3..b620a2b 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -101,6 +101,7 @@
(set-on-new-window 'login-page :path "/login")
(set-on-new-window (when-logged-in? 'playlist-page) :path "/playlist")
(set-on-new-window 'new-accout-page :path "/new-account")
+ (set-on-new-window (when-logged-in? 'explore-page) :path "/explore")
(open-browser))
(defun hacking-start ()