diff options
| -rw-r--r-- | explore.lisp | 32 | ||||
| -rw-r--r-- | model.lisp | 12 | ||||
| -rw-r--r-- | playlist.lisp | 126 | ||||
| -rw-r--r-- | vampire.lisp | 1 |
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 ())))) @@ -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 () |