Initial cut of FLAC support --- no audio info yet, though for FLAC

abstract-tag.lisp

@@ -468,3 +468,42 @@
         (when track (format t "~4ttrack: ~a~%" track))
         (when writer (format t "~4twriter: ~a~%" writer))
         (when year (format t "~4tyear: ~a~%" year)))))
+
+;;;;;;;;;;;;;;;;;;;; FLAC ;;;;;;;;;;;;;;;;;;;;
+;;; Abstract TAG interface
+(defmacro get-flac-tag-info (stream name)
+  `(flac-frame:flac-get-tag (flac-tags ,stream) ,name))
+
+(defmethod album ((me flac-file-stream))         (get-flac-tag-info me "album"))
+(defmethod artist ((me flac-file-stream))        (get-flac-tag-info me "artist"))
+(defmethod album-artist ((me flac-file-stream))  (get-flac-tag-info me "performer"))
+(defmethod copyright ((me flac-file-stream))     (get-flac-tag-info me "copyright"))
+(defmethod year ((me flac-file-stream))          (get-flac-tag-info me "date"))
+(defmethod title ((me flac-file-stream))         (get-flac-tag-info me "title"))
+(defmethod genre ((me flac-file-stream))         (get-flac-tag-info me "genre"))
+(defmethod track ((me flac-file-stream))         (get-flac-tag-info me "tracknumber"))
+
+(defmethod show-tags ((me flac-file-stream) &key (raw nil))
+  "Show the tags for a FLAC-FILE. If RAW is non-nil ... XXX"
+  (format t "~a~%" (stream-filename me))
+  (if raw
+      (format t "not yet~%")
+      (let ((album (album me))
+            (album-artist (album-artist me))
+            (artist (artist me))
+            (copyright (copyright me))
+            (genre (genre me))
+            (title (title me))
+            (track (track me))
+            (year (year me)))
+
+        ;;(if (audio-info me)
+        ;;(mp4-atom:vpprint (audio-info me) t))
+        (when album (format t "~&~4talbum: ~a~%" album))
+        (when album-artist (format t "~4talbum-artist: ~a~%" album-artist))
+        (when artist (format t "~4tartist: ~a~%" artist))
+        (when copyright (format t "~4tcopyright: ~a~%" copyright))
+        (when genre (format t "~4tgenre: ~a~%" genre))
+        (when title (format t "~4ttitle: ~a~%" title))
+        (when track (format t "~4ttrack: ~a~%" track))
+        (when year (format t "~4tyear: ~a~%" year)))))

audio-streams.lisp

@@ -127,6 +127,12 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
    (audio-info :accessor audio-info :initform nil :documentation "holds the bit-rate, etc info"))
   (:documentation "Stream for parsing MP4 audio files"))
 
+(defclass flac-file-stream (mem-stream)
+  ((flac-headers :accessor flac-headers :initform nil :documentation "holds all the flac headers in file")
+   (audio-info   :accessor audio-info   :initform nil :documentation "parsed audio info")
+   (flac-tags    :accessor flac-tags    :initform nil :documentation "parsed comment tags."))
+  (:documentation "Stream for parsing flac files"))
+
 (defun make-file-stream (filename)
   "Convenience function for creating a file stream. Detects file type and returns proper type stream."
   (let* ((new-stream (make-mmap-stream filename))
@@ -135,6 +141,8 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
     ;; detect file type and make RET-STREAM.  if we don't recognize stream, RET-STREAM will be NULL
     (cond ((mp4-atom:is-valid-m4-file new-stream)
            (setf ret-stream (make-instance 'mp4-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
+          ((flac-frame:is-valid-flac-file new-stream)
+           (setf ret-stream (make-instance 'flac-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
           ((id3-frame:is-valid-mp3-file new-stream)
            (setf ret-stream (make-instance 'mp3-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream)))))
     (stream-close new-stream)
@@ -289,6 +297,14 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
     (mp4-atom:mp4-atom-condition (c)
       (utils:warn-user "make-mp4-stream got condition: ~a" c))))
 
+(defmethod parse-audio-file ((stream flac-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
+  "Parse a flac file by reading it's headers and decoding them."
+  (declare (ignore get-audio-info)) ; audio info comes for "free" by parsing headers
+  (handler-case
+      (flac-frame:find-flac-frames stream)
+    (flac-frame:flac-frame-condition (c)
+      (utils:warn-user "make-flac-stream got condition: ~a" c))))
+
 (defmethod parse-audio-file ((stream mp3-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
   "Parse an MP3 file by reading it's FRAMES and decoding them."
   (handler-case

id3-frame.lisp

@@ -34,7 +34,7 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
 
   (log5:with-context "is-valid-mp3-file"
     (let ((id3)
-          (valid)
+          (valid nil)
           (version)
           (tag))
       (unwind-protect
@@ -52,7 +52,8 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
                                       (or (= 2 version) (= 3 version) (= 4 version)))
                                  (string= tag "TAG"))))
              (condition (c)
-               (declare (ignore c))))
+               (declare (ignore c))
+               (setf valid nil)))
         (stream-seek mp3-file 0 :start))
         valid)))
 
@@ -969,7 +970,6 @@ NB: 2.3 and 2.4 extended flags are different..."
                  (values t (nreverse frames)))))) ; reverse this so we have frames in "file order"
 
     (log5:with-context "find-id3-frames"
-
       (log-id3-frame "~a is a valid mp3 file" (stream-filename mp3-file))
 
       (setf (id3-header mp3-file) (make-instance 'id3-header :instream mp3-file))

logging.lisp

@@ -16,6 +16,7 @@
 (defparameter *logging-categories* '(mp4-atom::cat-log-mp4-atom
                                      audio-streams::cat-log-stream
                                      mpeg::cat-log-mpeg-frame
+                                     flac-frame::cat-log-flac-frame
                                      id3-frame::cat-log-id3-frame))
 
 (defmacro with-logging ((&optional file &key (categories *logging-categories*)) &body body)

packages.lisp

@@ -13,9 +13,9 @@
 
 (defpackage #:audio-streams
   (:export #:octets #:make-octets *get-audio-info* #:audio-stream-condition
-           #:mp3-file-stream #:mp4-file-stream #:base-mem-stream
-           #:id3-header #:audio-info #:mp4-atoms
-           #:parse-mp3-file #:parse-mp4-file #:parse-audio-file
+           #:mp3-file-stream #:mp4-file-stream #:base-mem-stream #:flac-file-stream #:flac-tags
+           #:id3-header #:audio-info #:mp4-atoms #:flac-headers
+           #:parse-mp3-file #:parse-mp4-file #:parse-audio-file #:parse-flac-file #:flac-tags
            #:make-mem-stream #:make-file-stream #:stream-filename
            #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32 #:stream-read-u64 #:stream-read-octets
            #:stream-decode-iso-string #:stream-deocode-ucs-string #:stream-decode-ucs-be-string
@@ -28,6 +28,11 @@
            #:stream-seek #:stream-close)
   (:use #:common-lisp #:utils))
 
+(defpackage #:flac-frame
+  (:export #:flac-frame-condition #:flac-header #:vpprint #:is-valid-flac-file #:find-flac-frames
+           #:get-flac-audio-info #:flac-get-tag)
+  (:use #:common-lisp #:utils #:audio-streams))
+
 (defpackage #:mp4-atom
   (:export #:mp4-atom #:map-mp4-atom #:find-mp4-atoms #:traverse #:mp4-atom-condition
            #:atom-file-position #:atom-children #:atom-size #:atom-of-interest #:atom-decoded

taglib-tests.lisp

@@ -29,8 +29,8 @@
              (progn
                (setf foo (make-file-stream file))
                (when foo
-                 (parse-audio-file foo))    ; only call parse-audio if we got back a MP3/M4A
-               (funcall func foo))          ; call func even is foo is null so it can account for non MP3/M4A files
+                 (parse-audio-file foo))    ; only call parse-audio if we got back a known file type
+               (funcall func foo))          ; call func even is foo is null so it can account for unkown file types
            (condition (c)
              (utils:warn-user "File: ~a~%Got condition: <~a>" file c)))
       (when foo
@@ -43,6 +43,7 @@
   "Walk :DIR and FUNCALL specified function for each file (MP4/MP3) found."
   (set-pathname-encoding file-system-encoding)
   (let ((mp3-count 0)
+        (flac-count 0)
         (mp4-count 0)
         (other-count 0))
 
@@ -50,16 +51,17 @@
                                  (do-audio-file f :func (lambda (s)
                                                           (cond ((typep s 'mp3-file-stream)
                                                                  (incf mp3-count)
-                                                                 (when func
-                                                                   (funcall func s)))
+                                                                 (when func (funcall func s)))
+                                                                ((typep s 'flac-file-stream)
+                                                                 (incf flac-count)
+                                                                 (when func (funcall func s)))
                                                                 ((typep s 'mp4-file-stream)
                                                                  (incf mp4-count)
-                                                                 (when func
-                                                                   (funcall func s)))
+                                                                 (when func (funcall func s)))
                                                                 ((null s) (incf other-count)))))))
 
-    (format t "~&~:d MP3s, ~:d MP4s, ~:d Others, for a total of ~:d~%"
-            mp3-count mp4-count other-count (+ mp3-count mp4-count other-count))))
+    (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACs ~:d Others, for a total of ~:d~%"
+            mp3-count mp4-count flac-count other-count (+ mp3-count mp4-count flac-count other-count))))
 
 (defun time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))
   "Time parsing of DIR."
@@ -74,6 +76,7 @@
 (defstruct chanl-results
   name
   mp3-count
+  flac-count
   mp4-count
   other-count)
 
@@ -84,14 +87,15 @@
   (let ((channel (make-instance 'chanl:unbounded-channel))
         (dead-channel (make-instance 'chanl:unbounded-channel))
         (mp3-count 0)
+        (flac-count 0)
         (mp4-count 0)
         (other-count 0))
     (labels ((thread-reader ()
                (declare (special *me*))
                (let ((f)
-                     (results (make-chanl-results :name *me* :mp3-count 0 :mp4-count 0 :other-count 0)))
+                     (results (make-chanl-results :name *me* :mp3-count 0 :flac-count 0 :mp4-count 0 :other-count 0)))
                  (loop
-                   (with-slots (name mp3-count mp4-count other-count) results
+                   (with-slots (name mp3-count mp4-count flac-count other-count) results
                      (setf f (chanl:recv channel))
                      (when (and (typep f 'integer)
                                 (= f *END-THREAD*))
@@ -102,6 +106,9 @@
                                               (cond ((typep s 'mp3-file-stream)
                                                      (incf mp3-count)
                                                      (when func (funcall func s)))
+                                                    ((typep s 'flac-file-stream)
+                                                     (incf flac-count)
+                                                     (when func (funcall func s)))
                                                     ((typep s 'mp4-file-stream)
                                                      (incf mp4-count)
                                                      (when func (funcall func s)))
@@ -123,23 +130,25 @@
           (loop
             (force-output *standard-output*)
             (setf results (chanl:recv dead-channel))
-            (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d Others~%"
+            (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d FLACs~:d Others~%"
                     (chanl-results-name results)
                     (chanl-results-mp3-count results)
                     (chanl-results-mp4-count results)
+                    (chanl-results-flac-count results)
                     (chanl-results-other-count results))
             (force-output *standard-output*)
 
             (incf mp3-count (chanl-results-mp3-count results))
             (incf mp4-count (chanl-results-mp4-count results))
+            (incf flac-count (chanl-results-flac-count results))
             (incf other-count (chanl-results-other-count results))
             (incf i)
             (when (= i *MAX-THREADS*)
               (return-from thread-reap *MAX-THREADS*)))))
 
       (format t "All threads done~%")
-      (format t "~&~:d MP3s, ~:d MP4s, ~:d Others, for a total of ~:d~%"
-              mp3-count mp4-count other-count (+ mp3-count mp4-count other-count)))))
+      (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACS, ~:d Others, for a total of ~:d~%"
+              mp3-count mp4-count flac-count other-count (+ mp3-count mp4-count flac-count other-count)))))
 
 (defun mp-time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))
   "Time parsing of DIR."

taglib.asd

@@ -13,6 +13,7 @@
                (:file "mpeg"          :depends-on ("packages" "audio-streams" "utils"))
                (:file "iso-639-2"     :depends-on ("packages" "utils"))
                (:file "id3-frame"     :depends-on ("packages" "utils"))
+			   (:file "flac-frame"    :depends-on ("packages" "utils"))
                (:file "abstract-tag"  :depends-on ("packages" "id3-frame" "audio-streams" "mp4-atom" "utils"))
 			   ;;(:file "mp3-tag"       :depends-on ("packages" "id3-frame" "audio-streams" "utils"))
                ;;(:file "mp4-tag"       :depends-on ("packages" "utils")))