Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (declaim (optimize (debug 3)))
- (in-package :com.gigamonkeys.mp3-browser)
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; Two versions of silence
- ;; Set this variable to the filename of an MP3 of silence.
- (defparameter *silence-mp3* "/home/worklab/work/Android/Coursera_Course_Adam_Porter/coursera-android/Examples/NotificationStatusBar/res/raw/alarm_rooster.mp3")
- (defun make-silent-song (title &optional (file *silence-mp3*))
- (make-instance
- 'song
- :file file
- :title title
- :id3-size (if (id3-p file) (size (read-id3 file)) 0)))
- (defparameter *empty-playlist-song* (make-silent-song "Playlist empty."))
- (defparameter *end-of-playlist-song* (make-silent-song "At end of playlist."))
- (defclass playlist ()
- ((id :accessor id :initarg :id)
- (songs-table :accessor songs-table :initform (make-playlist-table))
- (current-song :accessor current-song :initform *empty-playlist-song*)
- (current-idx :accessor current-idx :initform 0)
- (ordering :accessor ordering :initform :album)
- (shuffle :accessor shuffle :initform :none)
- (repeat :accessor repeat :initform :none)
- (user-agent :accessor user-agent :initform "Unknown")
- (lock :reader lock :initform (sb-thread:make-mutex))))
- (defun make-playlist-table ()
- (make-instance 'table :schema *mp3-schema*))
- (defmacro with-playlist-locked ((playlist) &body body)
- `(sb-thread:with-mutex ((lock ,playlist))
- ,@body))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; find-song-source
- (defvar *playlists* (make-hash-table :test #'equal))
- (defparameter *playlists-lock* (sb-thread:make-mutex :name "playlists-lock"))
- (defmethod find-song-source ((type (eql 'playlist)) request)
- (let ((playlist (lookup-playlist (playlist-id request))))
- (with-playlist-locked (playlist)
- (let ((user-agent (header-slot-value request :user-agent)))
- (when user-agent (setf (user-agent playlist) user-agent))))
- playlist))
- (defun lookup-playlist (id)
- (sb-thread:with-mutex (*playlists-lock*)
- (or (gethash id *playlists*)
- (setf (gethash id *playlists*) (make-instance 'playlist :id id)))))
- (defun playlist-id (request)
- (ipaddr-to-dotted (remote-host (request-socket request))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; song-source implementation
- (defmethod current-song :around ((playlist playlist))
- (with-playlist-locked (playlist) (call-next-method)))
- (defmethod still-current-p (song (playlist playlist))
- (with-playlist-locked (playlist)
- (eql song (current-song playlist))))
- (defmethod maybe-move-to-next-song (song (playlist playlist))
- (with-playlist-locked (playlist)
- (when (still-current-p song playlist)
- (unless (at-end-p playlist)
- (ecase (repeat playlist)
- (:song) ; nothing changes
- (:none (incf (current-idx playlist)))
- (:all (setf (current-idx playlist)
- (mod (1+ (current-idx playlist))
- (table-size (songs-table playlist)))))))
- (update-current-if-necessary playlist))))
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; Internals
- ;;; update-current-if-necessary
- (defun update-current-if-necessary (playlist)
- (unless (equal (file (current-song playlist))
- (file-for-current-idx playlist))
- (reset-current-song playlist)))
- (defun file-for-current-idx (playlist)
- (if (at-end-p playlist)
- nil
- (column-value (nth-row (current-idx playlist) (songs-table playlist)) :file)))
- (defun at-end-p (playlist)
- (>= (current-idx playlist) (table-size (songs-table playlist))))
- (defun reset-current-song (playlist)
- (setf
- (current-song playlist)
- (cond
- ((empty-p playlist) *empty-playlist-song*)
- ((at-end-p playlist) *end-of-playlist-song*)
- (t (row->song (nth-row (current-idx playlist) (songs-table playlist)))))))
- (defun row->song (song-db-entry)
- (with-column-values (file song artist album id3-size) song-db-entry
- (make-instance
- 'song
- :file file
- :title (format nil "~a by ~a from ~a" song artist album)
- :id3-size id3-size)))
- (defun empty-p (playlist)
- (zerop (table-size (songs-table playlist))))
- ;;; Playlist manipulation functions called from mp3-browser.lisp
- (defun add-songs (playlist column-name values)
- (let ((table (make-instance
- 'table
- :schema (extract-schema (list column-name) (schema *mp3s*)))))
- (dolist (v values) (insert-row (list column-name v) table))
- (do-rows (row (select :from *mp3s* :where (in column-name table)))
- (insert-row row (songs-table playlist))))
- (update-current-if-necessary playlist))
- (defun delete-songs (playlist &rest names-and-values)
- (delete-rows
- :from (songs-table playlist)
- :where (apply #'matching (songs-table playlist) names-and-values))
- (setf (current-idx playlist) (or (position-of-current playlist) 0))
- (update-current-if-necessary playlist))
- (defun clear-playlist (playlist)
- (delete-all-rows (songs-table playlist))
- (setf (current-idx playlist) 0)
- (update-current-if-necessary playlist))
- (defun sort-playlist (playlist ordering)
- (setf (ordering playlist) ordering)
- (setf (shuffle playlist) :none)
- (order-playlist playlist)
- (setf (current-idx playlist) (position-of-current playlist)))
- (defun shuffle-playlist (playlist shuffle)
- (setf (shuffle playlist) shuffle)
- (case shuffle
- (:none (order-playlist playlist))
- (:song (shuffle-by-song playlist))
- (:album (shuffle-by-album playlist)))
- (setf (current-idx playlist) (position-of-current playlist)))
- (defmethod (setf repeat) :after (value (playlist playlist))
- (if (and (at-end-p playlist) (not (empty-p playlist)))
- (ecase value
- (:song (setf (current-idx playlist) (1- (table-size (songs-table playlist)))))
- (:none)
- (:all (setf (current-idx playlist) 0)))
- (update-current-if-necessary playlist)))
- ;;; Shuffling helpers
- (defun position-of-current (playlist)
- (let* ((table (songs-table playlist))
- (matcher (matching table :file (file (current-song playlist))))
- (pos 0))
- (do-rows (row table)
- (when (funcall matcher row)
- (return-from position-of-current pos))
- (incf pos))))
- (defun order-playlist (playlist)
- (apply #'sort-rows (songs-table playlist)
- (case (ordering playlist)
- (:genre '(:genre :album :track))
- (:artist '(:artist :album :track))
- (:album '(:album :track))
- (:song '(:song)))))
- (defun shuffle-by-song (playlist)
- (shuffle-table (songs-table playlist)))
- (defun shuffle-by-album (playlist)
- (let ((new-table (make-playlist-table)))
- (do-rows (album-row (shuffled-album-names playlist))
- (do-rows (song (songs-for-album playlist (column-value album-row :album)))
- (insert-row song new-table)))
- (setf (songs-table playlist) new-table)))
- (defun shuffled-album-names (playlist)
- (shuffle-table
- (select
- :columns :album
- :from (songs-table playlist)
- :distinct t)))
- (defun songs-for-album (playlist album)
- (select
- :from (songs-table playlist)
- :where (matching (songs-table playlist) :album album)
- :order-by :track))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement