|
|
@@ -9,21 +9,30 @@
|
|
|
(deftype octet () '(unsigned-byte 8))
|
|
|
(defmacro make-octets (len) `(make-array ,len :element-type 'octet))
|
|
|
|
|
|
+;;;
|
|
|
+;;; A simple stream interface for parsing audio files. Currently, we have two basic stream types:
|
|
|
+;;; file-based and in-memory based, both of which implement the stream protocol of read, seek, etc.
|
|
|
+;;;
|
|
|
(defclass base-stream ()
|
|
|
- ((stream :accessor stream)))
|
|
|
+ ((stream :accessor stream))
|
|
|
+ (:documentation "Base class for audio-stream implementation"))
|
|
|
|
|
|
(defclass base-file-stream (base-stream)
|
|
|
- ((stream-filename :accessor stream-filename)))
|
|
|
+ ((stream-filename :accessor stream-filename))
|
|
|
+ (:documentation "File-based audio stream"))
|
|
|
|
|
|
(defclass mp3-file-stream (base-file-stream)
|
|
|
- ((id3-header :accessor id3-header)
|
|
|
- (audio-info :accessor audio-info :initform nil)))
|
|
|
+ ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")
|
|
|
+ (audio-info :accessor audio-info :initform nil :documentation "holds the bit-rate, etc info"))
|
|
|
+ (:documentation "Stream for parsing MP3 files"))
|
|
|
|
|
|
(defclass mp4-file-stream (base-file-stream)
|
|
|
- ((mp4-atoms :accessor mp4-atoms :initform nil)
|
|
|
- (audio-info :accessor audio-info :initform nil)))
|
|
|
+ ((mp4-atoms :accessor mp4-atoms :initform nil :documentation "holds tree of parsed MP4 atoms/boxes")
|
|
|
+ (audio-info :accessor audio-info :initform nil :documentation "holds the bit-rate, etc info"))
|
|
|
+ (:documentation "Stream for parsing MP4A files"))
|
|
|
|
|
|
(defun make-file-stream (class-name filename &key (read-only t))
|
|
|
+ "Convenience function for creating a file stream."
|
|
|
(let ((new-stream (make-instance (find-class class-name))))
|
|
|
(setf (stream new-stream) (if read-only
|
|
|
(open filename :direction :input :element-type 'octet)
|
|
|
@@ -31,27 +40,34 @@
|
|
|
(setf (stream-filename new-stream) filename)
|
|
|
new-stream))
|
|
|
|
|
|
+;;; (:documentation "In-memory stream")))
|
|
|
(defclass base-mem-stream (base-stream) ())
|
|
|
|
|
|
(defun make-mem-stream (vector)
|
|
|
+ "Convenience function to turn a vector into a stream."
|
|
|
(let ((new-stream (make-instance 'base-mem-stream)))
|
|
|
(setf (stream new-stream) (ccl:make-vector-input-stream vector))
|
|
|
new-stream))
|
|
|
|
|
|
(defmethod stream-close ((in-stream base-file-stream))
|
|
|
+ "Close the underlying file."
|
|
|
(with-slots (stream) in-stream
|
|
|
(when stream
|
|
|
(close stream)
|
|
|
(setf stream nil))))
|
|
|
|
|
|
(defmethod stream-close ((in-stream base-mem-stream))
|
|
|
+ "'Close' a memory stream by setting it to nil"
|
|
|
(with-slots (stream) in-stream
|
|
|
(setf stream nil)))
|
|
|
|
|
|
(defmethod stream-size ((in-stream base-stream))
|
|
|
+ "Returns the length of the underlying stream"
|
|
|
(ccl::stream-length (stream in-stream)))
|
|
|
|
|
|
+
|
|
|
(defmethod stream-seek ((in-stream base-stream) offset from)
|
|
|
+ "C-like stream positioner. Takes an offset and a location (one of :start, :end, :current)."
|
|
|
(with-slots (stream) in-stream
|
|
|
(ecase from
|
|
|
(:start (ccl::stream-position stream offset))
|
|
|
@@ -60,65 +76,51 @@
|
|
|
(ccl::stream-position stream (+ (ccl::stream-position stream) offset))))
|
|
|
(:end (ccl::stream-position stream (- (ccl::stream-length stream) offset))))))
|
|
|
|
|
|
+(defmethod stream-pos ((in-stream base-stream))
|
|
|
+ "Short hand for getting current stream read position"
|
|
|
+ (stream-seek in-stream 0 :current))
|
|
|
+
|
|
|
(defun stream-read-octets (instream bytes &key (bits-per-byte 8))
|
|
|
+ "Used to slurp in octets for the stream-read-* methods"
|
|
|
(loop with value = 0
|
|
|
for low-bit downfrom (* bits-per-byte (1- bytes)) to 0 by bits-per-byte do
|
|
|
(setf (ldb (byte bits-per-byte low-bit) value) (read-byte instream))
|
|
|
finally (return value)))
|
|
|
|
|
|
(defmethod stream-read-u8 ((in-stream base-stream) &key (bits-per-byte 8))
|
|
|
- "read 1 byte from file"
|
|
|
+ "Read 1 byte from file"
|
|
|
(with-slots (stream) in-stream
|
|
|
(stream-read-octets stream 1 :bits-per-byte bits-per-byte)))
|
|
|
|
|
|
(defmethod stream-read-u16 ((in-stream base-stream) &key (bits-per-byte 8))
|
|
|
- "read 2 bytes from file"
|
|
|
+ "Read 2 bytes from file"
|
|
|
(with-slots (stream) in-stream
|
|
|
(stream-read-octets stream 2 :bits-per-byte bits-per-byte)))
|
|
|
|
|
|
(defmethod stream-read-u24 ((in-stream base-stream) &key (bits-per-byte 8))
|
|
|
- "read 3 bytes from file"
|
|
|
+ "Read 3 bytes from file"
|
|
|
(with-slots (stream) in-stream
|
|
|
(stream-read-octets stream 3 :bits-per-byte bits-per-byte)))
|
|
|
|
|
|
(defmethod stream-read-u32 ((in-stream base-stream) &key (bits-per-byte 8))
|
|
|
- "read 4 bytes from file"
|
|
|
+ "Read 4 bytes from file"
|
|
|
(with-slots (stream) in-stream
|
|
|
(stream-read-octets stream 4 :bits-per-byte bits-per-byte)))
|
|
|
|
|
|
(defmethod stream-read-u64 ((in-stream base-stream) &key (bits-per-byte 8))
|
|
|
- "read 8 bytes from file"
|
|
|
+ "Read 8 bytes from file"
|
|
|
(with-slots (stream) in-stream
|
|
|
(stream-read-octets stream 8 :bits-per-byte bits-per-byte)))
|
|
|
|
|
|
-;; (defmethod stream-read-string ((stream base-stream) &key size (terminators nil))
|
|
|
-;; "Read normal string from stream. If size is provided, read exactly that many octets.
|
|
|
-;; If terminators is supplied, it is a list of characters that can terminate a string (and hence stop read)"
|
|
|
-;; (with-output-to-string (s)
|
|
|
-;; (with-slots (stream) stream
|
|
|
-;; (let ((terminated nil)
|
|
|
-;; (count 0)
|
|
|
-;; (byte))
|
|
|
-;; (loop
|
|
|
-;; (when (if size (= count size) terminated) (return))
|
|
|
-;; (setf byte (read-byte stream))
|
|
|
-;; (incf count)
|
|
|
-;; (when (member byte terminators :test #'=)
|
|
|
-;; (setf terminated t))
|
|
|
-;; (when (not terminated)
|
|
|
-;; (write-char (code-char byte) s)))))))
|
|
|
-
|
|
|
(defmethod stream-read-sequence ((stream base-stream) size &key (bits-per-byte 8))
|
|
|
"Read SIZE octets from input-file in BIT-PER-BYTE sizes"
|
|
|
(log5:with-context "stream-read-sequence"
|
|
|
(ecase bits-per-byte
|
|
|
(8
|
|
|
- ;(log-stream "reading ~:d bytes as 8-bit sequence" size)
|
|
|
(let ((octets (make-octets size)))
|
|
|
(read-sequence octets (slot-value stream 'stream))
|
|
|
octets))
|
|
|
(7
|
|
|
- ;(log-stream "reading ~:d bytes as 7-bit sequence" size)
|
|
|
(let* ((last-byte-was-FF nil)
|
|
|
(byte nil)
|
|
|
(octets (ccl:with-output-to-vector (out)
|
|
|
@@ -129,23 +131,21 @@
|
|
|
(write-byte byte out))
|
|
|
(write-byte byte out))
|
|
|
(setf last-byte-was-FF (= byte #xFF))))))
|
|
|
- ;(log-stream "file pos is now: ~:d" (stream-seek stream 0 :current))
|
|
|
- ;(log-stream "~a" (utils:printable-array octets))
|
|
|
octets)))))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; STRINGS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
-;;
|
|
|
-;; decode octets as an iso-8859-1 string (encoding == 0)
|
|
|
+;;;
|
|
|
+;;; Decode octets as an iso-8859-1 string (encoding == 0)
|
|
|
(defun stream-decode-iso-string (octets &key (start 0) (end nil))
|
|
|
(ccl:decode-string-from-octets octets :start start :end end :external-format :iso-8859-1))
|
|
|
|
|
|
-;;
|
|
|
-;; decode octets as a ucs string (encoding == 1)
|
|
|
-;; XXX: Coded this way because I can't seem to get a simple :external-format :ucs-2 to work correctly
|
|
|
-;; AND some taggers encode a UCS-2 empty string w/o a byte-order mark (i.e. null strings are
|
|
|
-;; sometimes encoded as #(00 00))
|
|
|
+;;;
|
|
|
+;;; XXX: Coded this way because I can't seem to get a simple :external-format :ucs-2 to work correctly
|
|
|
+;;; AND some taggers encode a UCS-2 empty string w/o a byte-order mark (i.e. null strings are
|
|
|
+;;; sometimes encoded as #(00 00))
|
|
|
(defun stream-decode-ucs-string (octets &key (start 0) (end nil))
|
|
|
+ "Decode octets as a UCS string with a BOM (encoding == 1)"
|
|
|
(labels ((get-byte-order-mark (octets)
|
|
|
(let ((retval 0))
|
|
|
(setf (ldb (byte 8 0) retval) (aref octets 1))
|
|
|
@@ -166,62 +166,52 @@
|
|
|
(#xfeff (ccl:decode-string-from-octets octets :start (+ 2 start) :end end :external-format :ucs-2be))
|
|
|
(0 (make-string 0))))))))
|
|
|
|
|
|
-;;
|
|
|
-;; decode octets as a ucs-be string (encoding == 2)
|
|
|
(defun stream-decode-ucs-be-string (octets &key (start 0) (end nil))
|
|
|
+ "Decode octets as a UCS-BE string (encoding == 2)"
|
|
|
(ccl:decode-string-from-octets octets :start start :end end :external-format :ucs-2be))
|
|
|
|
|
|
-;;
|
|
|
-;; decode octets as a utf-8 string
|
|
|
(defun stream-decode-utf-8-string (octets &key (start 0) (end nil))
|
|
|
+ "Decode octets as a utf-8 string"
|
|
|
(ccl:decode-string-from-octets octets :start start :end end :external-format :utf-8))
|
|
|
|
|
|
-;;
|
|
|
-;; decode octets depending on encoding
|
|
|
(defun stream-decode-string (octets &key (start 0) (end nil) (encoding 0))
|
|
|
+ "Decode octets depending on encoding"
|
|
|
(ecase encoding
|
|
|
- (0 (stream-decode-iso-string octets :start start :end end))
|
|
|
- (1 (stream-decode-ucs-string octets :start start :end end))
|
|
|
+ (0 (stream-decode-iso-string octets :start start :end end))
|
|
|
+ (1 (stream-decode-ucs-string octets :start start :end end))
|
|
|
(2 (stream-decode-ucs-be-string octets :start start :end end))
|
|
|
- (3 (stream-decode-utf-8-string octets :start start :end end))))
|
|
|
+ (3 (stream-decode-utf-8-string octets :start start :end end))))
|
|
|
|
|
|
-;;
|
|
|
-;; read an iso-8859-1 string of length 'len' (encoding = 0)
|
|
|
(defmethod stream-read-iso-string-with-len ((instream base-stream) len)
|
|
|
+ "Read an iso-8859-1 string of length 'len' (encoding = 0)"
|
|
|
(let ((octets (stream-read-sequence instream len)))
|
|
|
(stream-decode-iso-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; read an ucs-2 string of length 'len' (encoding = 1)
|
|
|
(defmethod stream-read-ucs-string-with-len ((instream base-stream) len)
|
|
|
+ "Read an ucs-2 string of length 'len' (encoding = 1)"
|
|
|
(let ((octets (stream-read-sequence instream len)))
|
|
|
(stream-decode-ucs-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; read an ucs-2-be string of length 'len' (encoding = 2)
|
|
|
(defmethod stream-read-ucs-be-string-with-len ((instream base-stream) len)
|
|
|
+ "Read an ucs-2-be string of length 'len' (encoding = 2)"
|
|
|
(let ((octets (stream-read-sequence instream len)))
|
|
|
(stream-decode-ucs-be-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; read an utf-8 string of length 'len' (encoding = 3)
|
|
|
(defmethod stream-read-utf-8-string-with-len ((instream base-stream) len)
|
|
|
+ "Read an utf-8 string of length 'len' (encoding = 3)"
|
|
|
(let ((octets (stream-read-sequence instream len)))
|
|
|
(stream-decode-utf-8-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; Read in a string of a given encoding of length 'len'
|
|
|
(defmethod stream-read-string-with-len ((instream base-stream) len &key (encoding 0))
|
|
|
- ;(format t "s-wth-len: ~a, ~d, ~d~%" instream len encoding)
|
|
|
+ "Read in a string of a given encoding of length 'len'"
|
|
|
(ecase encoding
|
|
|
(0 (stream-read-iso-string-with-len instream len))
|
|
|
(1 (stream-read-ucs-string-with-len instream len))
|
|
|
(2 (stream-read-ucs-be-string-with-len instream len))
|
|
|
(3 (stream-read-utf-8-string-with-len instream len))))
|
|
|
|
|
|
-;;
|
|
|
-;; Read in a null terminated iso-8859-1 string
|
|
|
(defmethod stream-read-iso-string ((instream base-stream))
|
|
|
+ "Read in a null terminated iso-8859-1 string"
|
|
|
(let ((octets (ccl:with-output-to-vector (out)
|
|
|
(do ((b (stream-read-u8 instream) (stream-read-u8 instream)))
|
|
|
(nil)
|
|
|
@@ -230,9 +220,8 @@
|
|
|
(write-byte b out)))))
|
|
|
(stream-decode-iso-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; Read in a null terminated ucs string
|
|
|
(defmethod stream-read-ucs-string ((instream base-stream))
|
|
|
+ "Read in a null terminated UCS string."
|
|
|
(let ((octets (ccl:with-output-to-vector (out)
|
|
|
(do* ((b0 (stream-read-u8 instream)
|
|
|
(stream-read-u8 instream))
|
|
|
@@ -245,9 +234,8 @@
|
|
|
(write-byte b1 out)))))
|
|
|
(stream-decode-ucs-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; Read in a null terminated ucs-be string
|
|
|
(defmethod stream-read-ucs-be-string ((instream base-stream))
|
|
|
+ "Read in a null terminated UCS-BE string."
|
|
|
(let ((octets (ccl:with-output-to-vector (out)
|
|
|
(do* ((b0 (stream-read-u8 instream)
|
|
|
(stream-read-u8 instream))
|
|
|
@@ -260,9 +248,8 @@
|
|
|
(write-byte b1 out)))))
|
|
|
(stream-decode-ucs-be-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; Read in a null terminated utf-8 string (encoding == 3)
|
|
|
(defmethod stream-read-utf-8-string ((instream base-stream))
|
|
|
+ "Read in a null terminated utf-8 string (encoding == 3)"
|
|
|
(let ((octets (ccl:with-output-to-vector (out)
|
|
|
(do ((b (stream-read-u8 instream)
|
|
|
(stream-read-u8 instream)))
|
|
|
@@ -272,17 +259,19 @@
|
|
|
(write-byte b out)))))
|
|
|
(stream-decode-utf-8-string octets)))
|
|
|
|
|
|
-;;
|
|
|
-;; Read in a null terminated string of a given encoding
|
|
|
(defmethod stream-read-string ((instream base-stream) &key (encoding 0))
|
|
|
+ "Read in a null terminated string of a given encoding."
|
|
|
(ecase encoding
|
|
|
- (0 (stream-read-iso-string instream))
|
|
|
- (1 (stream-read-ucs-string instream))
|
|
|
+ (0 (stream-read-iso-string instream))
|
|
|
+ (1 (stream-read-ucs-string instream))
|
|
|
(2 (stream-read-ucs-be-string instream))
|
|
|
- (3 (stream-read-utf-8-string instream))))
|
|
|
+ (3 (stream-read-utf-8-string instream))))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; FILES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
+(defvar *get-audio-info* t "controls whether the parsing functions also parse audio info like bit-rate, etc")
|
|
|
+
|
|
|
(defun parse-mp4-file (filename &key (get-audio-info *get-audio-info*))
|
|
|
+ "Parse an MP4A file by reading it's ATOMS and decoding them."
|
|
|
(let (stream)
|
|
|
(handler-case
|
|
|
(progn
|
|
|
@@ -296,9 +285,8 @@
|
|
|
(setf stream nil)))
|
|
|
stream))
|
|
|
|
|
|
-(defvar *get-audio-info* nil)
|
|
|
-
|
|
|
(defun parse-mp3-file (filename &key (get-audio-info *get-audio-info*))
|
|
|
+ "Parse an MP3 file by reading it's FRAMES and decoding them."
|
|
|
(let (stream)
|
|
|
(handler-case
|
|
|
(progn
|