checkpoint

mp3-frame.lisp

@@ -162,7 +162,8 @@
 		(setf revision (stream-read-u8 instream))
 		(setf flags (stream-read-u8 instream))
 		(setf size (stream-read-sync-safe-u32 instream))
-		(when (header-unsynchronized-p flags) (log-mp3-frame "unsync"))
+		(when (header-unsynchronized-p flags)
+		  (log-mp3-frame "unsync"))
 		(assert (not (header-footer-p flags)) () "Can't decode ID3 footer's yet")
 		(when (header-extended-p flags)
 		  (setf ext-header (make-instance 'mp3-extended-header :instream instream))))
@@ -175,7 +176,7 @@
    (id      :accessor id      :initarg :id)
    (len     :accessor len     :initarg :len)
    (flags   :accessor flags   :initarg :flags :initform nil))
-  (:documentation   "Base class for an ID3 frame"))
+  (:documentation "Base class for an ID3 frame"))
 
 (defmacro frame-23-altertag-p  (frame-flags) `(logbitp 15 ,frame-flags))
 (defmacro frame-23-alterfile-p (frame-flags) `(logbitp 14 ,frame-flags))
@@ -246,7 +247,7 @@
 
 
 (defun find-mp3-frames (mp3-file)
-  "With an open mp3-file, make sure it is in fact an MP3 file, then read it's header and frames, returning both"
+  "With an open mp3-file, make sure it is in fact an MP3 file, then read it's header and frames"
   (log5:with-context "find-mp3-frames"
 	(when (not (is-valid-mp3-file mp3-file))
 	  (log-mp3-frame "~a is not an mp3 file" (filename mp3-file))
@@ -254,25 +255,13 @@
 
 	(log-mp3-frame "~a is a valid mp3 file" (filename mp3-file))
 
-	(let ((header (make-instance 'mp3-id3-header :instream mp3-file))
-		  (mem-stream)
-		  (this-frame)
-		  (frames))
-	  (declare (ignore mem-stream this-frame frames))
-	  (setf (slot-value mp3-file 'mp3-header) header)
-	  (assert header () "Must have a header to continue!")
-	  header)))
-
-	  ;; (if (header-unsynchronized-p header)
-	  ;; 	  (setf mem-stream (stream-read-sync-safe-octets instream (size header)))
-	  ;; 		(setf mem-stream instream))
-
-	  ;; 	;; NB from this point, always read from mem-stream (see IF above)
-	  ;; 	(block read-loop
-	  ;; 	  (loop
-	  ;; 		(setf this-frame (make-frame header mem-stream))
-	  ;; 		(when (null this-frame)
-	  ;; 		  (return-from read-loop nil))
-	  ;; 		(push this-frame frames)))
-	  ;; 	(setf (slot-value (slot-value mp3-header 'header) 'frames) frames)
-	  ;; 	(log-mp3-frame "~a" (vpprint (slot-value mp3-header 'header) nil))))))
+	(setf (mp3-header mp3-file) (make-instance 'mp3-id3-header :instream mp3-file))
+	(ccl:with-input-from-vector (v (stream-read-octets mp3-file (size (mp3-header mp3-file))
+													   :bits-per-byte (if (header-unsynchronized-p (flags (mp3-header mp3-file))) 7 8)))
+
+	  (block read-loop
+		(loop
+	  		(let ((this-frame (make-frame v)))
+			  (when (null this-frame)
+				(return-from read-loop nil))
+			  (push this-frame (frames (mp3-header mp3-file)))))))))

mp4-atom.lisp

@@ -258,9 +258,9 @@
 
 (defun make-mp4-atom (mp4-file &optional atom-parent-type)
   "Get current file position, read in size/type, then construct the correct atom.
- If type is an ilst type, read it all it.  If it is a container atom of interest,
- leave file position as is, since caller will want to read in nested atoms.  Otherwise,
- seek forward past end of this atom."
+If type is an ilst type, read it all it.  If it is a container atom of interest,
+leave file position as is, since caller will want to read in nested atoms.  Otherwise,
+seek forward past end of this atom."
   (log5:with-context "make-mp4-atom"
 	(let* ((pos (stream-seek mp4-file 0 :current))
 		   (siz (stream-read-u32 mp4-file))
@@ -368,6 +368,7 @@ The 'right' atoms are those in *atoms-of-interest*"
 		  (new-atom))
 
 	  (log-mp4-atom "before read-file loop, file-position = ~:d, end = ~:d" (stream-seek mp4-file 0 :current) (file-size mp4-file))
+
 	  (block stream-read-file
 		(do ()
 			((> (+ 8 (stream-seek mp4-file 0 :current)) (file-size mp4-file)))

packages.lisp

@@ -4,14 +4,14 @@
 
 (defpackage #:audio-streams
   (:export #:octets #:make-octets
-		   #:base-stream
+		   #:base-file-stream
 		   #:filename #:instream #:file-size #:endian
 		   #:stream-read-u8 #:stream-read-u16 #:stream-read-u24 #:stream-read-u32
 		   #:stream-read-string #:stream-read-octets
 		   #:stream-seek #:stream-close
 		   #:mp4-stream #:make-mp4-stream #:mp4-atoms
 		   #:mp3-stream #:make-mp3-stream #:mp3-header
-		   #:stream-read-sync-safe-u32 #:stream-read-sync-safe-octets)
+		   #:stream-read-sync-safe-u32)
   (:use #:common-lisp))
 
 (defpackage #:mp4-atom

streams.lisp

@@ -9,7 +9,7 @@
 (deftype octet () '(unsigned-byte 8))
 (defmacro make-octets (len) `(make-array ,len :element-type 'octet))
 
-(defclass base-stream ()
+(defclass base-file-stream ()
   ((filename  :accessor filename  :initarg :filename)
    (instream  :accessor instream  :initform nil)
    (endian    :accessor endian    :initarg :endian :initform nil)   ; controls endian-ness of read/writes
@@ -17,17 +17,17 @@
    (file-size :accessor file-size))
   (:documentation "Base class for all audio file types"))
 
-(defmethod initialize-instance :after ((me base-stream) &key read-only &allow-other-keys)
-  (log5:with-context "base-stream-initializer"
+(defmethod initialize-instance :after ((me base-file-stream) &key read-only &allow-other-keys)
+  (log5:with-context "base-file-stream-initializer"
   (with-slots (instream filename file-size endian) me
 	(setf instream (if read-only
 					   (open filename :direction :input :element-type 'octet)
 					   (open filename :direction :io :if-exists :overwrite :element-type 'octet)))
 	(setf file-size (file-length instream))
-	(log-stream "stream = ~a, name = ~a, size = ~:d~%endian = ~a"
-				   instream filename file-size endian))))
+	(log-stream "base-file-stream-initializer built stream = ~a, name = ~a, size = ~:d, endian = ~a"
+				instream filename file-size endian))))
 
-(defmethod stream-close ((me base-stream))
+(defmethod stream-close ((me base-file-stream))
   "Close an open stream."
   (with-slots (instream modified) me
 	(when modified
@@ -37,23 +37,19 @@
 	  (close instream)
 	  (setf instream nil))))
 
-(defmethod stream-seek ((me base-stream) offset from)
+(defmethod stream-seek ((me base-file-stream) offset from)
   "C-library like seek function. from can be one of :current, :start, :end.
 Returns the current offset into the stream"
-  (assert (member from '(:current :start :end)) () "seek takes one of :current, :start, :end")
   (with-slots (instream file-size) me
 	(ecase from
 	  (:start (file-position instream offset))
-	  (:current
-	   (let ((current (file-position instream)))
-		 (file-position instream (+ current offset))))
-	  (:end
-	   (file-position instream (- file-size offset))))))
+	  (:current (file-position instream (+ (file-position instream) offset)))
+	  (:end (file-position instream (- file-size offset))))))
 
 ;;
-;; From Practical Common Lisp by Peter Seibel.
+;; Based on a function from Practical Common Lisp by Peter Seibel.
 (defun read-octets (instream bytes &key (bits-per-byte 8) (endian :little-endian))
-  (ecase endian 
+  (ecase endian
 	(:big-endian
 	 (loop with value = 0
 		   for low-bit from 0 to (* bits-per-byte (1- bytes)) by bits-per-byte do
@@ -65,27 +61,27 @@ Returns the current offset into the stream"
 			 (setf (ldb (byte bits-per-byte low-bit) value) (read-byte instream))
 		   finally (return value)))))
 
-(defmethod stream-read-u8 ((me base-stream))
+(defmethod stream-read-u8 ((me base-file-stream))
   "read 1 byte from file"
   (with-slots (endian instream) me
 	(read-octets instream 1 :endian endian)))
 
-(defmethod stream-read-u16 ((me base-stream))
+(defmethod stream-read-u16 ((me base-file-stream))
   "read 2 bytes from file"
   (with-slots (endian instream) me
 	(read-octets instream 2 :endian endian)))
 
-(defmethod stream-read-u24 ((me base-stream))
+(defmethod stream-read-u24 ((me base-file-stream))
   "read 3 bytes from file"
   (with-slots (endian instream) me
 	(read-octets instream 3 :endian endian)))
 
-(defmethod stream-read-u32 ((me base-stream))
+(defmethod stream-read-u32 ((me base-file-stream))
   "read 4 bytes from file"
   (with-slots (endian instream) me
 	(read-octets instream 4 :endian endian)))
 
-(defmethod stream-read-string ((me base-stream) &key size (terminators nil))
+(defmethod stream-read-string ((me base-file-stream) &key size (terminators nil))
   "Read normal string from file. 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)
@@ -97,38 +93,48 @@ If terminators is supplied, it is a list of characters that can terminate a stri
 		  (when (if size (= count size) terminated) (return))
 		  (setf byte (read-byte instream))
 		  (incf count)
-		  (log-stream "count = ~d, terminators = ~a, byte-read was ~c" count terminators (code-char byte))
+		  ;;;(log-stream "count = ~d, terminators = ~a, byte-read was ~c" count terminators (code-char byte))
 		  (when (member byte terminators :test #'=)
 			(setf terminated t))
 		  (when (not terminated)
 			(write-char (code-char byte) s)))))))
 
-(defmethod stream-read-octets ((me base-stream) size)
-  "Read SIZE octets from input-file"
-  (let* ((octets (make-octets size))
-		 (read-len (read-sequence octets (slot-value me 'instream))))
-	(assert (= read-len size))
-	octets))
+(defmethod stream-read-octets ((me base-file-stream) size &key (bits-per-byte 8))
+  "Read SIZE octets from input-file.  If bits-per-byte"
+  (ecase bits-per-byte
+	(8
+	 (let ((octets (make-octets size)))
+	   (read-sequence octets (slot-value me 'instream))))
+	(7
+	 (let* ((last-byte-was-FF nil)
+			(byte nil)
+			(octets (ccl:with-output-to-vector (out)
+					  (dotimes (i size)
+						(setf byte (stream-read-u8 me))
+						(if last-byte-was-FF
+							(if (not (zerop byte))
+								(write-byte byte out))
+							(write-byte byte out))
+						(setf last-byte-was-FF (= byte #xFF))))))
+	   octets))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MP4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(log5:defcategory cat-log-mp4-stream)
-(defmacro log-mp4-stream (&rest log-stuff) `(log5:log-for (cat-log-mp4-stream) ,@log-stuff))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MP4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defclass mp4-stream (base-stream)
+(defclass mp4-stream (base-file-stream)
   ((mp4-atoms :accessor mp4-atoms :initform nil))
   (:documentation "Class to access m4a/mp4 files"))
 
 (defun make-mp4-stream (filename read-only &key)
   "Convenience function to create an instance of MP4-FILE with appropriate init args"
   (log5:with-context "make-mp4-stream"
-	(log-mp4-stream "opening ~a" filename)
+	(log-stream "make-mp4-stream is opening ~a" filename)
 	(let (handle)
 	  (handler-case 
 		  (progn
-			(setf handle (make-instance 'mp4-stream :filename filename :endian :big-endian :read-only read-only))
+			(setf handle (make-instance 'mp4-stream :filename filename :endian :little-endian :read-only read-only))
 			(with-slots (mp4-atoms) handle
-			  (log-mp4-stream "getting atoms")
+			  (log-stream "getting atoms")
 			  (setf mp4-atoms (mp4-atom:find-mp4-atoms handle))))
 		(condition (c)
 		  (warn "make-mp4-stream got condition: ~a" c)
@@ -137,11 +143,7 @@ If terminators is supplied, it is a list of characters that can terminate a stri
 		handle)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MP3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(log5:defcategory cat-log-mp3-stream)
-
-(defmacro log-mp3-stream (&rest log-stuff) `(log5:log-for (cat-log-mp3-stream) ,@log-stuff))
-
-(defclass mp3-stream (base-stream)
+(defclass mp3-stream (base-file-stream)
   ((mp3-header :accessor mp3-header :initform nil))
   (:documentation "Class to access mp3 files"))
 
@@ -149,13 +151,13 @@ If terminators is supplied, it is a list of characters that can terminate a stri
   "Convenience function to create an instance of MP3-FILE with appropriate init args.
 NB: we assume non-syncsafe as default"
   (log5:with-context "make-mp3-stream"
-	(log-mp3-stream "opening ~a" filename)
+	(log-stream "opening ~a, read-only = ~a" filename read-only)
 	(let (handle)
-	  (handler-case 
+	  (handler-case
 		  (progn
 			(setf handle (make-instance 'mp3-stream :filename filename :endian :big-endian :read-only read-only))
 			(with-slots (mp3-header) handle
-			  (log-mp3-stream "getting frames")
+			  (log-stream "getting frames")
 			  (setf mp3-header (mp3-frame:find-mp3-frames handle))))
 		(condition (c)
 		  (warn "make-mp3-stream got condition: ~a" c)
@@ -165,24 +167,21 @@ NB: we assume non-syncsafe as default"
 
 (defmethod stream-read-sync-safe-u32 ((me mp3-stream))
   "Read a sync-safe integer from file.  Used by mp3 files"
-  (let* ((ret 0))
-	(setf (ldb (byte 7 21) ret) (stream-read-u8 me))
-	(setf (ldb (byte 7 14) ret) (stream-read-u8 me))
-	(setf (ldb (byte 7 7) ret)  (stream-read-u8 me))
-	(setf (ldb (byte 7 0) ret)  (stream-read-u8 me))
-	ret))
-
-(defmethod stream-read-sync-safe-octets ((me mp3-stream) len)
-  "Used to undo sync-safe read of file"
-  (let* ((last-byte-was-FF nil)
-		 (byte nil)
-		 (de-synced-data (flexi-streams:with-output-to-sequence (out :element-type 'octet)
-						   (dotimes (i len)
-							 (setf byte (stream-read-u8 me))
-							 (if last-byte-was-FF
-								 (if (not (zerop byte))
-									 (write-byte byte out))
-								 (write-byte byte out))
-							 (setf last-byte-was-FF (= byte #xFF))))))
-	de-synced-data))
-
+  (read-octets (slot-value me 'instream) 4 :bits-per-byte 7 :endian :little-endian))
+
+
+#|
+(defun tst ()
+  (let ((foo (ccl:with-output-to-vector (f) 
+			   (write-byte #xDE f)
+			   (write-byte #xAD f)
+			   (write-byte #xBE f)
+			   (write-byte #xEF f))))
+	(ccl:with-input-from-vector (f foo)
+	  (format t "Length is ~d~%" (ccl::stream-length f))
+	  (dotimes (j 2)
+		(format t "Iteration ~d~%" j)
+		(ccl::stream-position f 0)
+		(dotimes (i (ccl::stream-length f))
+		  (format t "~d: ~x~%" i (read-byte f)))))))
+|#

taglib.asd

@@ -5,7 +5,7 @@
   :description "Pure Lisp implementation to read (and write?) tags"
   :author "Mark VandenBrink"
   :license "Public Domain"
-  :depends-on (#:log5 #:flexi-streams #:alexandria)
+  :depends-on (#:log5 #:alexandria)
   :components ((:file "packages")
 			   (:file "tag"       :depends-on ("packages"))
 			   (:file "streams"   :depends-on ("packages"))