aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--keyed.lisp9
-rw-r--r--playlist.lisp266
-rw-r--r--vampire.asd2
-rw-r--r--vampire.lisp326
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))