aboutsummaryrefslogtreecommitdiffhomepage
path: root/vampire.lisp
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-10-24 17:28:08 -0500
committerColin Okay <colin@cicadas.surf>2022-10-24 17:28:08 -0500
commit20c8eba7256d78dc36d215b7ddc798c24e42131e (patch)
tree043c3e1e00a01884ad5e9dd306237665f25341fe /vampire.lisp
parentc4c0a40788948667e10f850cbd2c47dd25f61367 (diff)
Add: adding tracks to playlists
Diffstat (limited to 'vampire.lisp')
-rw-r--r--vampire.lisp64
1 files changed, 49 insertions, 15 deletions
diff --git a/vampire.lisp b/vampire.lisp
index c83f129..4f92b41 100644
--- a/vampire.lisp
+++ b/vampire.lisp
@@ -23,7 +23,7 @@
:index-reader object-with-key)))
(defclass/bknr playlist (keyed)
- ((title :std (default-name "playlist"))
+ ((title :with :std (default-name "playlist"))
(tracks editors :with :std (list))
(cover :with :std nil :doc "A url to the cover of this album.")
(user :with
@@ -106,21 +106,26 @@
;;; 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-playlist user :title title)))
+ (push (make-playlist user :title title)
+ (user-playlists user))))
-(defun new-track (trackinfo)
+(defun new-track (file trackinfo)
"Trackinfo is a plist containing information about the track to create."
(with-transaction ()
(apply #'bknr.datastore:make-blob-from-file
- (first trackinfo)
- :class 'track
- (cdr trackinfo))))
+ file
+ 'track
+ trackinfo)))
;;; CLIENT
@@ -163,7 +168,7 @@
(with-clog-create parent
(div ()
(section (:h4)
- (a (:link url :content (content-title pl) :bind pl-link))))
+ (a (:link url :content (playlist-title pl) :bind pl-link))))
(set-on-click
pl-link
(alambda
@@ -172,8 +177,17 @@
(defun create-track-listing (parent playlist &rest args)
(declare (ignorable args))
- (with-clog-create parent
- (p (:content "a track list coming soon... "))))
+ (dolist (track (playlist-tracks playlist))
+ (with-clog-create parent
+ (div ()
+ (section (:h4 :content (track-title track)))
+ (img (:bind thumb))
+ (audio (:source :bind audio))
+ (p (:content "|>")))
+ (if (track-thumb-url track)
+ (setf (url-src thumb) (track-thumb-url track)
+ (height thumb) "100px")
+ (setf ( ))))))
(defun create-track-form (parent playlist &rest args)
(declare (ignorable args))
@@ -182,9 +196,27 @@
(section (:h3 :content "Add Track"))
(label (:content "Paste URL: " :bind url-label))
(form-element (:text :bind url-input))
- (label (:content "Track Title:")))
+ (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")))
+ (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) "")
+ (if-let (track (download-media url))
+ (progn
+ (append-track playlist track)
+ (reload (location (connection-body parent))))
+ (progn
+ (alert (window (connection-body parent))
+ (format nil "Error while fetching track at: ~%~a"
+ url))))
+ (remove-from-dom notice))))))
(defun playlist-page (body)
(when-let* ((listid
@@ -193,17 +225,19 @@
(object-with-key listid)))
(with-clog-create body
(div ()
- (section (:h2 :content (content-title playlist)))
- (track-listing (playlist))
+ (section (:h2 :content (playlist-title playlist)))
+ (div ()
+ (track-listing (playlist)))
(track-form (playlist))))))
(defun user-page (body)
- (let ((user (session-user body)))
+ (if-let (user (session-user body))
(with-clog-create body
(div ()
(p (:content (format nil "Welcome ~a" (user-name user))))
(new-playlist-form ())
- (playlist-listing ())))))
+ (playlist-listing ())))
+ (setf (url (location body)) "/")))
(defun login-page (body)
(with-clog-create body