diff options
| -rw-r--r-- | vampire.lisp | 64 |
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 |