Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Browse files

Ogg/FLAC support.

  • Loading branch information...
commit 56800c7a40c6ba4cef2e2176c9292affb7b01307 1 parent 4d54791
@ahefner authored
2  TODO
@@ -7,4 +7,4 @@ Bugs:
* Docs update
-* Vorbis support?
+* Verify Ogg/FLAC support works on non-Linux platforms, conditionalize them if there are problems.
6 shuffletron.asd
@@ -1,10 +1,10 @@
-(asdf:defsystem :shuffletron
+(asdf:defsystem :shuffletron
:name "Shuffletron"
- :description "An MP3 player"
+ :description "Music player"
:version "0.0.5"
:author "Andy Hefner <>"
:license "MIT-style license"
- :depends-on (:mixalot :mixalot-mp3 :osicat)
+ :depends-on (:osicat :mixalot :mixalot-mp3 :mixalot-vorbis :mixalot-flac)
:components ((:module src
:serial t
:components ((:file "packages")
38 src/audio.lisp
@@ -2,10 +2,19 @@
(defvar *mixer* nil)
-(defclass mp3-jukebox-streamer (mp3-streamer)
+(defclass shuffletron-stream-mixin ()
((song :accessor song-of :initarg :song)
(stopped :accessor stopped :initform nil)))
+;;; Should use a proxy approach, so we don't have to define N
+;;; subclasses. Won't work without some small changes to Mixalot -
+;;; presently, a proxying stream can't tell when the proxied stream is
+;;; finished. Fix later.
+(defclass shuffletron-mp3-stream (mixalot-mp3:mp3-streamer shuffletron-stream-mixin) ())
+(defclass shuffletron-ogg-stream (mixalot-vorbis:vorbis-streamer shuffletron-stream-mixin) ())
+(defclass shuffletron-flac-stream (mixalot-flac:flac-streamer shuffletron-stream-mixin) ())
(defun audio-init ()
(setf *mixer* (create-mixer :rate 44100)))
@@ -53,6 +62,22 @@
(setf *playqueue* (append *playqueue* (list (song-of stream))))))
(end-stream stream))
+(defun make-streamer (song)
+ (ecase (music-file-type (song-full-path song))
+ (:mp3 (mixalot-mp3:make-mp3-streamer
+ (song-full-path song)
+ :class 'shuffletron-mp3-stream
+ :song song
+ :prescan (pref "prescan" t)))
+ (:ogg (mixalot-vorbis:make-vorbis-streamer
+ (song-full-path song)
+ :class 'shuffletron-ogg-stream
+ :song song))
+ (:flac (mixalot-flac:make-flac-streamer
+ (song-full-path song)
+ :class 'shuffletron-flac-stream
+ :song song))))
(defun play-song (song)
"Start a song playing, overriding the existing song. Returns the new
stream if successful, or NIL if the song could not be played."
@@ -61,10 +86,7 @@ stream if successful, or NIL if the song could not be played."
(with-stream-control ()
(when *current-stream* (finish-stream *current-stream*))
- (let ((new (make-mp3-streamer (song-full-path song)
- :prescan (pref "prescan" t)
- :class 'mp3-jukebox-streamer
- :song song))
+ (let ((new (make-streamer song))
(start-at (song-start-time song)))
(setf *current-stream* new)
(mixer-add-streamer *mixer* *current-stream*)
@@ -113,9 +135,9 @@ stream if successful, or NIL if the song could not be played."
(t (with-stream-control ()
(when *current-stream* (finish-stream *current-stream*)))))))
-(defmethod streamer-cleanup ((stream mp3-jukebox-streamer) mixer)
+(defmethod streamer-cleanup :after ((stream shuffletron-stream-mixin) mixer)
(declare (ignore mixer))
- (call-next-method)
;; The STOPPED flag distinguishes whether playback was interrupted
;; by the user, versus having reached the end of the song. If we're
;; supposed to loop, this determines who is responsible for making
@@ -126,7 +148,7 @@ stream if successful, or NIL if the song could not be played."
;; If stopped is set, someone else can be expected to start up the
;; next song. Otherwise, we have to do it ourselves.
(unless (stopped stream)
- ;; If the song completed:
+ ;; If the song completed:
(with-stream-control ()
(when (eq stream *current-stream*)
(setf *current-stream* nil)))
39 src/library.lisp
@@ -10,8 +10,13 @@
(defun init-library ()
(setf *library* (make-array 0 :fill-pointer 0 :adjustable t)))
-(defun mp3-p (filename)
- (not (mismatch filename "mp3" :test #'char-equal :start1 (- (length filename) 3))))
+(defun match-extension (filename extension)
+ (not (mismatch filename extension :test #'char-equal :start1 (- (length filename) (length extension)))))
+(defun music-file-type (filename)
+ (or (and (match-extension filename "mp3") :mp3)
+ (and (match-extension filename "ogg") :ogg)
+ (and (match-extension filename "flac") :flac)))
(defvar *library-progress* 0)
@@ -20,7 +25,7 @@
(defun carriage-return () (format t "~C" (code-char 13)))
-(defun add-mp3-file (full-filename relative-filename)
+(defun add-song-file (full-filename relative-filename)
(let ((song (make-song :full-path full-filename
:local-path relative-filename
:smashed (smash-string relative-filename)
@@ -34,18 +39,18 @@
(when (probe-file path)
(walk path
(lambda (filename)
- (when (mp3-p filename)
+ (when (music-file-type filename)
(incf *library-progress*)
(when (zerop (mod *library-progress* 10))
(format t "Scanning. ~:D files.." *library-progress*)
- (add-mp3-file filename (rel path filename)))))
+ (add-song-file filename (rel path filename)))))
(defun songs-needing-id3-scan () (count-if-not #'song-id3-p *library*))
-(defun save-id3-cache ()
+(defun save-metadata-cache ()
(setf (pref "id3-cache")
(map 'vector (lambda (song) (list (song-local-path song)
(song-id3-p song)
@@ -53,15 +58,22 @@
-(defun load-id3-cache ()
+(defun load-metadata-cache ()
(loop for (name id3-p id3) across (pref "id3-cache" #())
as song = (gethash name *local-path->song*)
when (and song id3-p)
do (setf (song-id3-p song) t
(song-id3 song) id3)))
-(defun scan-id3-tags (&key verbose adjective)
- (format t "~&Scanning ID3 tags (~D).~%" (songs-needing-id3-scan))
+(defun get-song-metadata (absolute-path)
+ (case (music-file-type absolute-path)
+ (:mp3 (mpg123:get-tags-from-file absolute-path :no-utf8 t))
+ ;; FIXME: Audit OGG/FLAC paths for unicode insanity.
+ (:ogg (vorbisfile:get-vorbis-tags-from-file absolute-path))
+ (:flac (flac:get-flac-tags-from-file absolute-path))))
+(defun scan-file-metadata (&key verbose adjective)
+ (format t "~&Scanning file metadata (~:D files).~%" (songs-needing-id3-scan))
(when verbose (fresh-line))
(loop with pending = (and verbose (songs-needing-id3-scan))
with n = 1
@@ -71,18 +83,13 @@
(format t "Reading ~Atags: ~:D of ~:D" (or adjective "") n pending)
- (setf (song-id3 song) (mpg123:get-tags-from-file (song-full-path song) :no-utf8 t)
+ (setf (song-id3 song) (get-song-metadata (song-full-path song))
(song-matchprops song) nil
(song-id3-p song) t)
(incf n)
(when (and pending (not (zerop pending))) (terpri)))
- (save-id3-cache))
-(defun build-sequence-table (seq &optional (key #'identity) (test #'equal))
- (let ((table (make-hash-table :test test)))
- (map nil (lambda (elt) (setf (gethash (funcall key elt) table) elt)) seq)
- table))
+ (save-metadata-cache))
(defun compute-filtered-library ()
(setf *filtered-library* (remove-if (lambda (song) (find "ignore" (song-tags song) :test #'string=)) *library*)))
8 src/main.lisp
@@ -26,7 +26,7 @@
(code-char 13) (length *library*))
- (load-id3-cache)
+ (load-metadata-cache)
;; Scan tags of new files automatically, unless there's a ton of them.
(let ((need (songs-needing-id3-scan)))
@@ -36,7 +36,7 @@
(format t "~:D new songs need to be scanned for ID3 tags. To do this now,
type \"scanid3\". It may take a moment.~%"
- (t (scan-id3-tags :verbose t :adjective "new ")))))
+ (t (scan-file-metadata :verbose t :adjective "new ")))))
(defun spooky-init ()
(let ((stream #+sbcl (sb-sys:make-fd-stream 1 :external-format :latin1 :output t :input nil)
@@ -332,12 +332,12 @@ type \"scanid3\". It may take a moment.~%"
;; Scan new ID3 tags
((string= line "scanid3")
- (scan-id3-tags :verbose t))
+ (scan-file-metadata :verbose t))
;; Clear and rescan ID3 tags
((string= line "rescanid3")
(loop for song across *library* do (setf (song-id3-p song) nil))
- (scan-id3-tags :verbose t))
+ (scan-file-metadata :verbose t))
;; Attempt to start swank server, for development.
((string= line "swankme")
4 src/packages.lisp
@@ -1,5 +1,5 @@
(defpackage :shuffletron
- (:use :common-lisp :mixalot :mixalot-mp3)
+ (:use :common-lisp :mixalot)
(:nicknames :shuf)
(:export #:run #:*shuffletron-version*
@@ -21,7 +21,7 @@
#:*loop-mode* #:*wakeup-time*
#:end-stream #:finish-stream
#:play-song #:play-songs #:add-songs #:play-next-song #:skip-song
- #:play-command #:stop-command
+ #:play-command #:stop-command
#:toggle-pause #:unpause
5 src/util.lisp
@@ -71,6 +71,11 @@
(defun emptyp (seq) (or (null seq) (zerop (length seq))))
+(defun build-sequence-table (seq &optional (key #'identity) (test #'equal))
+ (let ((table (make-hash-table :test test)))
+ (map nil (lambda (elt) (setf (gethash (funcall key elt) table) elt)) seq)
+ table))
;;;; S-Expression File I/O Accessor
(defun file (filename)
Please sign in to comment.
Something went wrong with that request. Please try again.