diff options
| -rw-r--r-- | keyed.lisp | 9 | ||||
| -rw-r--r-- | playlist.lisp | 266 | ||||
| -rw-r--r-- | vampire.asd | 2 | ||||
| -rw-r--r-- | vampire.lisp | 326 |
4 files changed, 312 insertions, 291 deletions
diff --git a/keyed.lisp b/keyed.lisp new file mode 100644 index 0000000..b38cfe3 --- /dev/null +++ b/keyed.lisp @@ -0,0 +1,9 @@ +;;;; keyed.lisp + +(in-package :vampire) + +(defclass/bknr keyed () + ((key + :r :std (nuid) + :index-type string-unique-index + :index-reader object-with-key))) diff --git a/playlist.lisp b/playlist.lisp new file mode 100644 index 0000000..62f9b9e --- /dev/null +++ b/playlist.lisp @@ -0,0 +1,266 @@ +;;;; playlist.lisp + +(in-package :vampire) + +;;; MODEL + +(defclass/bknr playlist (keyed) + ((title :with :std (default-name "playlist")) + (tracks editors :with :std (list)) + (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.")))) + +(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"))) + +;;; OPERATIONS + +(defun playlist-duration (pl) + (reduce #'+ + (playlist-tracks pl) + :key 'track-duration + :initial-value 0)) + +(defun add-track (tr pl &optional (n -1)) + (setf (playlist-tracks pl) + (insert-nth tr n (playlist-tracks pl)))) + +(defun remove-nth-from-playlist (pl n) + (multiple-value-bind (newlist track) + (remove-nth n (playlist-tracks pl) t) + (setf (playlist-tracks pl) newlist + (track-playlists track) (delete pl (track-playlists track) + :test #'eq :count 1)))) +;;; TRANSACTIONS + +(defun append-track (pl tr) + (with-transaction () + (add-track tr pl))) + +(defun new-track (file trackinfo) + "Trackinfo is a plist containing information about the track to create." + (with-transaction () + (let ((track (apply #'make-instance 'track trackinfo))) + (setf (track-file track) (namestring file)) + track))) + +(defun new-playlist (user &key title) + (with-transaction () + (make-instance 'playlist :title title :user user))) + +;;; CLIENT STATE + +(defclass/std playlist-ctl () + ((playlist :std nil :doc "The playlist instance.") + (tracks :std nil :doc "A list of instances of track/client") + (now-playing-track :std nil :doc "An instance of track-ctl") + (np-title np-artist np-thumb np-dur np-time np-play + :std nil :doc "Now Playing Elements") + (pl-title pl-tracks + :std nil :doc "Playlist Elements")) + (:documentation "Holds the complete state for this session's viewing of a particular playlist.")) + +(defclass/std track-ctl () + ((track audio container :std nil)) + (:documentation "The state of a particular track in this session's viewing of a playlist.")) + +(defun audio-for-track (ctl track) + "Return the audio element associated with the track" + (when-let (trctl (find track (tracks ctl) :test #'eq :key #'track)) + (audio-elem trctl))) + +(defun track-for-audio (ctl audio) + "Return the track instance associated with the AUDIO element." + (when-let (trctl (find audio (tracks ctl) :test #'eq :key #'audio-elem)) + (track trctl))) + +(defun track-ctl-with-audio (ctl audio) + (find audio (tracks ctl) :key #'audio-elem)) + +(defun find-next-track (ctl &optional track) + "Return the TRACK-CTL instance that appeqars after TRACK in the + TRACKS list, or NIL. If TRACK is NIL, return the first TRACK in the + list." + (if (null track) + (first (tracks ctl)) + (when-let (pos (position track (tracks ctl))) + (nth (1+ pos) (tracks ctl))))) + +(defun find-previous-track (ctl &optional track) + (when-let (pos (position track (tracks ctl))) + (when (plusp pos) + (nth (1- pos) (tracks ctl))))) + +;;; CLIENT SESSION + +(defun install-new-playlist-ctl (playlist body) + (setf (connection-data-item body "playlist-ctl") + (make-instance 'playlist-ctl :playlist playlist))) + +(defun get-playlist-ctl (obj) + (connection-data-item obj "playlist-ctl")) + +;;; PLAYBACK CONTROL + +(defun start-playback (ctl) + (when-let (tr (now-playing-track ctl)) + (play-media (audio tr)) + (setf (text (np-play ctl)) "||"))) + +(defun pause-playback (ctl) + (when-let (tr (now-playing-track ctl)) + (pause-media (audio tr)) + (setf (text (np-play ctl)) "|>"))) + +(defun stop-playback (ctl) + (when-let (tr (now-playing-track ctl)) + (pause-media (audio tr)) + (setf (media-position (audio tr)) 0 + (now-playing-track ctl) nil + (text (np-play ctl)) "|>"))) + + +;;; CLIENT CONTROL + +(defun load-track-display (ctl track-ctl) + (let ((tr (track track-ctl))) + (setf (text (np-title ctl)) (track-title tr) + (text (np-artist ctl)) (or (track-artist tr) "") + (url-src (np-thumb ctl)) (or (track-thumb-url tr) "") + (text (np-dur ctl)) (secs-to-hms (or (track-duration tr) 0)) + (text (np-time ctl)) (secs-to-hms 0) + (text (np-play ctl)) "|>"))) + +(defun toggle-now-playing (e) + (when-let (ctl (get-playlist-ctl e)) + (if-let (np (now-playing-track ctl)) + (if (pausedp (audio np)) + (start-playback ctl) + (pause-playback ctl)) + (advance-now-playing e)))) + +(defun advance-now-playing (e) + (when-let* ((ctl + (get-playlist-ctl e)) + (next + (find-next-track ctl (now-playing-track ctl)))) + (stop-playback ctl) + (setf (now-playing-track ctl) next) + (load-track-display ctl next) + (start-playback ctl))) + +(defun previous-now-playing (e) + (when-let* ((ctl + (get-playlist-ctl e)) + (prev + (find-previous-track ctl (now-playing-track ctl)))) + (stop-playback ctl) + (setf (now-playing-track ctl) prev) + (load-track-display ctl prev) + (start-playback ctl))) + +(defun update-now-playing-time (e) + (when-let* ((ctl (get-playlist-ctl e)) + (tr (now-playing-track ctl))) + (setf (text (np-time ctl)) + (secs-to-hms + (media-position (audio tr)))))) + + +(defun play-this-audio (audio) + (when-let (ctl (get-playlist-ctl audio)) + (let ((np (now-playing-track ctl))) + (unless (and np (eq audio (audio np))) + (let ((tr + (track-ctl-with-audio ctl audio))) + (stop-playback ctl) + (setf (now-playing-track ctl) tr) + (start-playback ctl) + (load-track-display ctl tr)))))) + + +;;; CLIENT UI + +(defun playlist-title-content (playlist) + (format nil "~a -- ~a" + (playlist-title playlist) + (secs-to-hms (playlist-duration playlist)))) + +(defun create-track-display (parent ctl) + (with-clog-create parent + (div (:class "track-display") + (section (:h3 :content "Now Playing")) + (img (:bind thumb)) + (p () + (span (:bind title)) + (span (:bind artist))) + (p () + (span (:bind time)) + (span (:content " / ")) + (span (:bind dur))) + (button (:content "<<" :bind back)) + (button (:content "|>" :bind play)) + (button (:content ">>" :bind forward))) + (setf (np-title ctl) title + (np-artist ctl) artist + (np-thumb ctl) thumb + (np-dur ctl) dur + (np-time ctl) time + (np-play ctl) play) + (set-on-click back 'previous-now-playing) + (set-on-click forward 'advance-now-playing) + (set-on-click play 'toggle-now-playing))) + +(defun create-track-list-item (list track ctl) + (with-clog-create list + (list-item (:bind container) + (p () + (span (:content (track-listing-line track))) + (span (:content " -- ")) + (span (:content (secs-to-hms (or (track-duration track) 0))))) + (audio (:source (media-url-path track) :controls nil :bind audio))) + (setf (tracks ctl) + (insert-nth (make-instance 'track-ctl + :container container + :audio audio + :track track) + -1 + (tracks ctl))) + (set-on-time-update audio 'update-now-playing-time) + (set-on-ended audio 'advance-now-playing) + (set-on-click container (alambda (play-this-audio audio))))) + +(defun create-track-listing (parent pl ctl) + (let ((ol (create-ordered-list parent))) + (setf (pl-tracks ctl) ol) + (dolist (track (playlist-tracks pl)) + (create-track-list-item ol track ctl)))) + +(defun create-new-track-form (parent pl ctl) + ) + + +(defun playlist-key-from-url (url) + (first (last (ppcre:split "/" (nth 4 (multiple-value-list (quri:parse-uri url))))))) + +(defun playlist-page (body) + (when-let* ((list-id + (playlist-key-from-url (url (location body)))) + (pl + (object-with-key list-id))) + (let ((ctl + (install-new-playlist-ctl pl body))) + (with-clog-create body + (div () + (section (:h2 :content (playlist-title-content pl) :bind title-elem)) + (track-display (ctl)) + (track-listing (pl ctl :bind tracks-elem)) + ;(new-track-form (pl ctl)) + ) + (setf (pl-title ctl) title-elem + (pl-tracks ctl) tracks-elem))))) diff --git a/vampire.asd b/vampire.asd index b68f05a..6dc0aa3 100644 --- a/vampire.asd +++ b/vampire.asd @@ -17,4 +17,6 @@ (:file "definition-macros") (:file "utilities") (:file "downloader") + (:file "keyed") + (:file "playlist") (:file "vampire"))) diff --git a/vampire.lisp b/vampire.lisp index 57e474f..8ca4b79 100644 --- a/vampire.lisp +++ b/vampire.lisp @@ -19,25 +19,6 @@ ;;; RESOURCE MODEL -(defclass/bknr keyed () - ((key - :r :std (nuid) - :index-type string-unique-index - :index-reader object-with-key))) - -(defclass/bknr playlist (keyed) - ((title :with :std (default-name "playlist")) - (tracks editors :with :std (list)) - (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.")))) - -(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 "") @@ -46,43 +27,18 @@ ;;; RESOURCE ACCESS OPERATIONS -(defun playlist-duration (pl) - (reduce #'+ - (playlist-tracks pl) - :key 'track-duration - :initial-value 0)) - -(defun add-track (tr pl &optional (n -1)) - (setf (playlist-tracks pl) - (insert-nth tr n (playlist-tracks pl)))) - -(defun remove-nth-from-playlist (pl n) - (multiple-value-bind (newlist track) - (remove-nth n (playlist-tracks pl) t) - (setf (playlist-tracks pl) newlist - (track-playlists track) (delete pl (track-playlists track) - :test #'eq :count 1)))) ;;; 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-instance 'playlist :title title :user user))) -(defun new-track (file trackinfo) - "Trackinfo is a plist containing information about the track to create." - (with-transaction () - (let ((track (apply #'make-instance 'track trackinfo))) - (setf (track-file track) (namestring file)) - track))) + + ;;; CLIENT @@ -146,251 +102,39 @@ (princ title out)))) -;;; PLAYLIST CONTROL - -(defclass/std playlist/ctl () - ((playlist track-list track-display audio->track now-playing :std nil))) - -(defmethod (setf now-playing) :before (newval ctl) - (with-slots (now-playing) ctl - (when now-playing - (remove-class (parent-element now-playing) "now-playing"))) - (when newval - (add-class (parent-element newval) "now-playing"))) - -(defclass/std track-display () - ((title-elem - thumb-elem - artist-elem - time-elem - duration-elem - play/pause-btn))) - -(defun get-audio-track (ctl audio) - (cdr (assoc audio (audio->track ctl)))) - -(defun get-next-audio-track (ctl &optional audio) - (with-slots (audio->track) ctl - (if (null audio) - (first audio->track) - (let ((pos - (position audio audio->track :key #'car))) - (assert pos () "Audio element ~a not found in this playlist control." audio) - (nth (1+ pos) audio->track))))) - -(defun stop-playback (ctl) - (with-slots (now-playing) ctl - (when now-playing - (pause-media now-playing) - (setf (media-position now-playing) 0 - now-playing nil - (text (play/pause-btn (track-display ctl))) "⏵")))) - -(defun pause-playback (ctl) - (when-let (audio (now-playing ctl)) - (pause-media audio) - (setf (text (play/pause-btn (track-display ctl))) "⏵"))) - -(defun start-playback (ctl) - (when-let (audio (now-playing ctl)) - (play-media audio) - (setf (text (play/pause-btn (track-display ctl))) - "⏸"))) - -(defun load-track-display (ctl) - (when-let (track (get-audio-track ctl (now-playing ctl))) - (with-slots - (title-elem thumb-elem artist-elem - time-elem duration-elem) - (track-display ctl) - (with-slots (title artist thumb-url duration) track - (setf (text title-elem) title - (text duration-elem) (secs-to-hms duration) - (text time-elem) (secs-to-hms 0) - (url-src thumb-elem) thumb-url))))) - -(defun initialize-playlist/ctl (body) - (let ((ctl (playlist/ctl body))) - (setf now-playing (car (first (audio->track ctl)))) - (load-track-display ctl))) - -(defun playlist/ctl (obj) - (connection-data-item obj "playlist/ctl")) - -(defun install-playlist/ctl (playlist obj) - (setf (connection-data-item obj "playlist/ctl") - (make-instance 'playlist/ctl :playlist playlist))) - -(defun install-track-list (list) - (let ((ctl (playlist/ctl list))) - (setf (track-list ctl) list))) - -(defun install-track-display (thumb title artist time dur play/pause) - (let ((ctl (playlist/ctl thumb))) - (setf (track-display ctl) - (make-instance 'track-display - :duration-elem dur - :time-elem time - :artist-elem artist - :thumb-elem thumb - :title-elem title - :play/pause-btn play/pause)))) - -(defun install-audio-track (audio track &optional (position -1)) - (when-let (ctl (playlist/ctl audio)) - (setf (audio->track ctl) - (insert-nth (cons audio track) position (audio->track ctl))))) - -(defun ctl/now-playing (elem) - (when-let (ctl (playlist/ctl elem)) - (now-playing ctl))) - -(defun ctl/pause (elem) - (when-let (ctl (playlist/ctl elem)) - (pause-playback ctl))) - -(defun ctl/stop (elem) - (when-let (ctl (playlist/ctl elem)) - (stop-playback ctl))) - -(defun ctl/play-audio (audio) - (when-let (ctl (playlist/ctl audio)) - (unless (eq audio (now-playing ctl)) - (stop-playback ctl) - (setf (now-playing ctl) audio) - (start-playback ctl) - (load-track-display ctl)))) - -(defun ctl/toggle-play (elem) - (when-let (ctl (playlist/ctl elem)) - (if (now-playing ctl) - (if (pausedp (now-playing ctl)) - (start-playback ctl) - (pause-playback ctl)) - (ctl/next-track elem)))) - -(defun ctl/next-track (elem) - (when-let (ctl (playlist/ctl elem)) - (let ((next - (get-next-audio-track ctl (now-playing ctl)))) - (stop-playback ctl) - (when next - (setf (now-playing ctl) (car next)) - (start-playback ctl) - (load-track-display ctl))))) - -(defun ctl/update-playback-time (audio) - (when-let (ctl (playlist/ctl audio)) - (setf (text (time-elem (track-display ctl))) - (secs-to-hms (media-position audio))))) - -(defun create-track-list-item (parent track) - (with-clog-create parent - (div (:bind view) - (p () - (span (:content (track-listing-line track))) - (span (:content " -- ")) - (span (:content (secs-to-hms (or (track-duration track) 0))))) - (audio (:source (media-url-path track) :controls nil :bind audio))) - (install-audio-track audio track) - (set-on-time-update - audio - 'ctl/update-playback-time) - (set-on-ended - audio - (alambda (ctl/next-track audio))) - (set-on-click - view - (alambda - (ctl/play-audio audio))))) +;; (defun create-track-form (parent playlist &rest args) +;; (declare (ignorable args)) +;; (with-clog-create parent +;; (div () +;; (section (:h3 :content "Add Track")) +;; (label (:content "Paste URL: " :bind url-label)) +;; (form-element (:text :bind url-input)) +;; (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") +;; (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) "") +;; (add-fetch-track-job +;; url +;; (lambda (track) +;; (remove-from-dom notice) +;; (append-track playlist track) +;; (add-track-to-listing parent track)) +;; (lambda (err) +;; (remove-from-dom notice) +;; (format t "Error: ~a~%" err) +;; (alert (window (connection-body parent)) +;; (format nil "Error while fetching track at: ~a~%" +;; url))))))))) + -(defun create-track-listing (parent playlist &rest args) - (declare (ignorable args)) - (let ((list (create-ordered-list parent))) - (install-track-list list) - (dolist (track (playlist-tracks playlist)) - (with-clog-create list - (list-item () - (track-list-item (track))))))) - -(defun add-track-to-listing (elem track) - (with-slots (track-list) (playlist/ctl elem) - (with-clog-create track-list - (list-item () - (track-list-item (track)))))) - -(defun create-track-form (parent playlist &rest args) - (declare (ignorable args)) - (with-clog-create parent - (div () - (section (:h3 :content "Add Track")) - (label (:content "Paste URL: " :bind url-label)) - (form-element (:text :bind url-input)) - (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") - (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) "") - (add-fetch-track-job - url - (lambda (track) - (remove-from-dom notice) - (append-track playlist track) - (add-track-to-listing parent track)) - (lambda (err) - (remove-from-dom notice) - (format t "Error: ~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))))))) - -(defun create-track-display (obj) - (with-clog-create obj - (div () - (section (:h3 :content "Now Playing")) - (img (:bind thumb-elem)) - (p (:bind title-elem)) - (p (:bind artist-elem :hidden t)) - (p () - (span (:bind time-elem)) - (span (:content "/")) - (span (:bind duration-elem))) - (button (:bind stop-button :content "⏹")) - (button (:bind next-button :content "⏭")) - (button (:bind pause/play-button :content "⏵"))) - (setf (height thumb-elem) 120) - (set-on-click stop-button 'ctl/stop) - (set-on-click next-button 'ctl/next-track) - (set-on-click - pause/play-button - #'ctl/toggle-play) - (install-track-display thumb-elem title-elem artist-elem time-elem duration-elem - pause/play-button))) - -(defun playlist-page (body) - (when-let* ((listid - (playlist-key-from-url (url (location body)))) - (playlist - (object-with-key listid))) - (install-playlist/ctl playlist body) - (with-clog-create body - (div () - (section (:h2 :content (format nil "~a -- ~a" - (playlist-title playlist) - (secs-to-hms (playlist-duration playlist))))) - (track-display ()) - (div () (track-listing (playlist))) - (track-form (playlist)))))) (defun user-page (body) (if-let (user (session-user body)) |