diff options
Diffstat (limited to 'vampire.lisp')
| -rw-r--r-- | vampire.lisp | 119 |
1 files changed, 42 insertions, 77 deletions
diff --git a/vampire.lisp b/vampire.lisp index 03b8830..e7ce96d 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -28,13 +28,16 @@ (defclass/bknr playlist (keyed) ((title :with :std (default-name "playlist")) (tracks editors :with :std (list)) - (cover :with :std nil :doc "A url to the cover of this album.") + (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.")))) -(defclass/bknr track (bknr.datastore:blob keyed) - ((source title artist album thumb-url duration codec :with) - (playlists :std (list) :doc "A list of playlists in which this track appears"))) +(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 "") @@ -43,12 +46,6 @@ ;;; RESOURCE ACCESS OPERATIONS -(defun make-playlist (user &key (title (default-name "playlist"))) - (make-instance 'playlist :user user :title title)) - -(defun track-with-source (source &key (test 'string-equal)) - (find source (store-objects-with-class 'track) :test test :key 'track-source)) - (defun playlist-duration (pl) (reduce #'+ (playlist-tracks pl) @@ -65,48 +62,6 @@ (setf (playlist-tracks pl) newlist (track-playlists track) (delete pl (track-playlists track) :test #'eq :count 1)))) - - -(defun add-editor (playlist user) - (pushnew user (playlist-editors playlist) :test #'eq)) - -(defun remove-editor (playlist user) - (setf (playlist-editors playlist) - (delete user (playlist-editors playlist) :test #'eq))) - -(defgeneric can-edit-p (thing user)) - -(defmethod can-edit-p ((pl playlist) user) - (or - (eq user (content-user user)) - (member user (playlist-editors pl) :test #'eq))) - -(defmethod can-edit-p ((tr track) user) - (loop for pl in (track-playlists tr) - thereis (can-edit-p pl user))) - -(defun delete-track (tr) - "Deletes a track and ensures it is removed from playlists that - include it." - (loop for pl in (track-playlists tr) - do (setf (playlist-tracks pl) - (delete tr (playlist-tracks pl) :test #'eq))) - (bknr.datastore:delete-object tr)) - -(defun delete-playlist (pl) - (loop for tr in (playlist-tracks pl) - do (remove-track-from-list ) - - do (setf (track-playlists tr) (delete pl (track-playlists tr)))) - (bknr.datastore:delete-object pl)) - -(defun ownerp (user content) - (eq user (content-user content))) - -(defun set-owner (user &rest contents) - (dolist (content contents) - (setf (content-user content) user))) - ;;; TRANSACTIONS (defun append-track (pl tr) @@ -119,16 +74,14 @@ (defun new-playlist (user &key title) (with-transaction () - (push (make-playlist user :title title) - (user-playlists user)))) + (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 () - (apply #'bknr.datastore:make-blob-from-file - file - 'track - trackinfo))) + (let ((track (apply #'make-instance 'track trackinfo))) + (setf (track-file track) (namestring file)) + track))) ;;; CLIENT @@ -178,19 +131,28 @@ (setf (url (location (connection-body parent))) url))))))) +(defun media-url-path (track) + (format nil "/media/~a.~a" + (pathname-name (track-file track)) + (pathname-type (track-file track)))) + +(create-audio ) + (defun create-track-listing (parent playlist &rest args) (declare (ignorable args)) (dolist (track (playlist-tracks playlist)) (with-clog-create parent - (div () + (div (:bind view) (section (:h4 :content (track-title track))) (img (:bind thumb)) - (audio (:source :bind audio)) - (p (:content "|>"))) + (audio (:source (media-url-path track) :controls nil :bind audio))) + (set-on-click + view + (alambda + (play-media audio))) (if (track-thumb-url track) (setf (url-src thumb) (track-thumb-url track) - (height thumb) "100px") - (setf ( )))))) + (height thumb) "100px"))))) (defun create-track-form (parent playlist &rest args) (declare (ignorable args)) @@ -211,15 +173,17 @@ (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)))))) + (add-fetch-track-job + url + (lambda (track) + (append-track playlist track) + (reload (location (connection-body parent)))) + (lambda (err) + (remove-from-dom notice) + (format t "Error: ~a~%" err) + (alert (window (connection-body parent)) + (format nil "Error whiel fetching track at: ~a~%" + url))))))))) (defun playlist-page (body) (when-let* ((listid @@ -268,14 +232,15 @@ (make-instance 'bknr.datastore:mp-store :directory (datastore-directory config) - :subsystems (list (make-instance 'bknr.datastore:store-object-subsystem) - (make-instance 'bknr.datastore:blob-subsystem)))) + :subsystems (list (make-instance 'bknr.datastore:store-object-subsystem)))) (defun start (config) (setf *config* config) (initialize-database config ) - (start-downloader-service) - (initialize 'main) + (start-downloader-service config) + (initialize 'main + :extended-routing t + :static-root (static-directory config)) (set-on-new-window 'user-page :path "/user") (set-on-new-window 'login-page :path "/login") (set-on-new-window 'playlist-page :path "/playlist") @@ -284,5 +249,5 @@ (defun hacking-start () (start (make-instance 'config - :media-directory (merge-pathnames "vampire-media/" (user-homedir-pathname)) + :static-directory (merge-pathnames "vampire-static/" (user-homedir-pathname)) :datastore-directory (merge-pathnames "vampire-store/" (user-homedir-pathname))))) |