Advertisement
Guest User

Untitled

a guest
Feb 13th, 2020
208
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.37 KB | None | 0 0
  1. (declaim (optimize (debug 3)))
  2. (in-package :com.gigamonkeys.mp3-browser)
  3.  
  4. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5. ;;; Two versions of silence
  6.  
  7. ;; Set this variable to the filename of an MP3 of silence.
  8. (defparameter *silence-mp3* "/home/worklab/work/Android/Coursera_Course_Adam_Porter/coursera-android/Examples/NotificationStatusBar/res/raw/alarm_rooster.mp3")
  9.  
  10. (defun make-silent-song (title &optional (file *silence-mp3*))
  11. (make-instance
  12. 'song
  13. :file file
  14. :title title
  15. :id3-size (if (id3-p file) (size (read-id3 file)) 0)))
  16.  
  17. (defparameter *empty-playlist-song* (make-silent-song "Playlist empty."))
  18.  
  19. (defparameter *end-of-playlist-song* (make-silent-song "At end of playlist."))
  20.  
  21. (defclass playlist ()
  22. ((id :accessor id :initarg :id)
  23. (songs-table :accessor songs-table :initform (make-playlist-table))
  24. (current-song :accessor current-song :initform *empty-playlist-song*)
  25. (current-idx :accessor current-idx :initform 0)
  26. (ordering :accessor ordering :initform :album)
  27. (shuffle :accessor shuffle :initform :none)
  28. (repeat :accessor repeat :initform :none)
  29. (user-agent :accessor user-agent :initform "Unknown")
  30. (lock :reader lock :initform (sb-thread:make-mutex))))
  31. (defun make-playlist-table ()
  32. (make-instance 'table :schema *mp3-schema*))
  33.  
  34. (defmacro with-playlist-locked ((playlist) &body body)
  35. `(sb-thread:with-mutex ((lock ,playlist))
  36. ,@body))
  37.  
  38. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39. ;;; find-song-source
  40.  
  41. (defvar *playlists* (make-hash-table :test #'equal))
  42. (defparameter *playlists-lock* (sb-thread:make-mutex :name "playlists-lock"))
  43.  
  44. (defmethod find-song-source ((type (eql 'playlist)) request)
  45. (let ((playlist (lookup-playlist (playlist-id request))))
  46. (with-playlist-locked (playlist)
  47. (let ((user-agent (header-slot-value request :user-agent)))
  48. (when user-agent (setf (user-agent playlist) user-agent))))
  49. playlist))
  50.  
  51. (defun lookup-playlist (id)
  52. (sb-thread:with-mutex (*playlists-lock*)
  53. (or (gethash id *playlists*)
  54. (setf (gethash id *playlists*) (make-instance 'playlist :id id)))))
  55.  
  56. (defun playlist-id (request)
  57. (ipaddr-to-dotted (remote-host (request-socket request))))
  58.  
  59. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60. ;;; song-source implementation
  61.  
  62. (defmethod current-song :around ((playlist playlist))
  63. (with-playlist-locked (playlist) (call-next-method)))
  64.  
  65. (defmethod still-current-p (song (playlist playlist))
  66. (with-playlist-locked (playlist)
  67. (eql song (current-song playlist))))
  68.  
  69. (defmethod maybe-move-to-next-song (song (playlist playlist))
  70. (with-playlist-locked (playlist)
  71. (when (still-current-p song playlist)
  72. (unless (at-end-p playlist)
  73. (ecase (repeat playlist)
  74. (:song) ; nothing changes
  75. (:none (incf (current-idx playlist)))
  76. (:all (setf (current-idx playlist)
  77. (mod (1+ (current-idx playlist))
  78. (table-size (songs-table playlist)))))))
  79. (update-current-if-necessary playlist))))
  80.  
  81. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82. ;;; Internals
  83.  
  84. ;;; update-current-if-necessary
  85.  
  86. (defun update-current-if-necessary (playlist)
  87. (unless (equal (file (current-song playlist))
  88. (file-for-current-idx playlist))
  89. (reset-current-song playlist)))
  90.  
  91. (defun file-for-current-idx (playlist)
  92. (if (at-end-p playlist)
  93. nil
  94. (column-value (nth-row (current-idx playlist) (songs-table playlist)) :file)))
  95.  
  96. (defun at-end-p (playlist)
  97. (>= (current-idx playlist) (table-size (songs-table playlist))))
  98.  
  99. (defun reset-current-song (playlist)
  100. (setf
  101. (current-song playlist)
  102. (cond
  103. ((empty-p playlist) *empty-playlist-song*)
  104. ((at-end-p playlist) *end-of-playlist-song*)
  105. (t (row->song (nth-row (current-idx playlist) (songs-table playlist)))))))
  106.  
  107. (defun row->song (song-db-entry)
  108. (with-column-values (file song artist album id3-size) song-db-entry
  109. (make-instance
  110. 'song
  111. :file file
  112. :title (format nil "~a by ~a from ~a" song artist album)
  113. :id3-size id3-size)))
  114.  
  115. (defun empty-p (playlist)
  116. (zerop (table-size (songs-table playlist))))
  117.  
  118.  
  119. ;;; Playlist manipulation functions called from mp3-browser.lisp
  120.  
  121. (defun add-songs (playlist column-name values)
  122. (let ((table (make-instance
  123. 'table
  124. :schema (extract-schema (list column-name) (schema *mp3s*)))))
  125. (dolist (v values) (insert-row (list column-name v) table))
  126. (do-rows (row (select :from *mp3s* :where (in column-name table)))
  127. (insert-row row (songs-table playlist))))
  128. (update-current-if-necessary playlist))
  129.  
  130. (defun delete-songs (playlist &rest names-and-values)
  131. (delete-rows
  132. :from (songs-table playlist)
  133. :where (apply #'matching (songs-table playlist) names-and-values))
  134. (setf (current-idx playlist) (or (position-of-current playlist) 0))
  135. (update-current-if-necessary playlist))
  136.  
  137. (defun clear-playlist (playlist)
  138. (delete-all-rows (songs-table playlist))
  139. (setf (current-idx playlist) 0)
  140. (update-current-if-necessary playlist))
  141.  
  142. (defun sort-playlist (playlist ordering)
  143. (setf (ordering playlist) ordering)
  144. (setf (shuffle playlist) :none)
  145. (order-playlist playlist)
  146. (setf (current-idx playlist) (position-of-current playlist)))
  147.  
  148. (defun shuffle-playlist (playlist shuffle)
  149. (setf (shuffle playlist) shuffle)
  150. (case shuffle
  151. (:none (order-playlist playlist))
  152. (:song (shuffle-by-song playlist))
  153. (:album (shuffle-by-album playlist)))
  154. (setf (current-idx playlist) (position-of-current playlist)))
  155.  
  156. (defmethod (setf repeat) :after (value (playlist playlist))
  157. (if (and (at-end-p playlist) (not (empty-p playlist)))
  158. (ecase value
  159. (:song (setf (current-idx playlist) (1- (table-size (songs-table playlist)))))
  160. (:none)
  161. (:all (setf (current-idx playlist) 0)))
  162. (update-current-if-necessary playlist)))
  163.  
  164. ;;; Shuffling helpers
  165.  
  166. (defun position-of-current (playlist)
  167. (let* ((table (songs-table playlist))
  168. (matcher (matching table :file (file (current-song playlist))))
  169. (pos 0))
  170. (do-rows (row table)
  171. (when (funcall matcher row)
  172. (return-from position-of-current pos))
  173. (incf pos))))
  174.  
  175. (defun order-playlist (playlist)
  176. (apply #'sort-rows (songs-table playlist)
  177. (case (ordering playlist)
  178. (:genre '(:genre :album :track))
  179. (:artist '(:artist :album :track))
  180. (:album '(:album :track))
  181. (:song '(:song)))))
  182.  
  183. (defun shuffle-by-song (playlist)
  184. (shuffle-table (songs-table playlist)))
  185.  
  186. (defun shuffle-by-album (playlist)
  187. (let ((new-table (make-playlist-table)))
  188. (do-rows (album-row (shuffled-album-names playlist))
  189. (do-rows (song (songs-for-album playlist (column-value album-row :album)))
  190. (insert-row song new-table)))
  191. (setf (songs-table playlist) new-table)))
  192.  
  193. (defun shuffled-album-names (playlist)
  194. (shuffle-table
  195. (select
  196. :columns :album
  197. :from (songs-table playlist)
  198. :distinct t)))
  199.  
  200. (defun songs-for-album (playlist album)
  201. (select
  202. :from (songs-table playlist)
  203. :where (matching (songs-table playlist) :album album)
  204. :order-by :track))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement