cleaning up, squashing bugs, etc

audio-streams.lisp

@@ -26,30 +26,30 @@
 (defmacro make-octets (len) `(make-array ,len :element-type 'octet))
 
 (defclass mem-stream ()
-   ((fn    :accessor fn    :initform nil :initarg :fn)
-    (index :accessor index :initform 0)
-    (len   :accessor len   :initform 0)
-    (vect  :accessor vect  :initform nil :initarg :vect))
+   ((stream-filename :accessor stream-filename :initform nil :initarg :stream-filename)
+    (index           :accessor index           :initform 0)
+    (stream-size     :accessor stream-size     :initform 0)
+    (vect            :accessor vect            :initform nil :initarg :vect))
    (:documentation "A thin-wrapper class over mmaped-files and/or vectors"))
 
  (defmacro with-mem-stream-slots ((instance) &body body)
-   `(with-slots (fn index len vect) ,instance
-      (declare (integer index len)
+   `(with-slots (stream-filename index stream-size vect) ,instance
+      (declare (integer index stream-size)
                (type (array (unsigned-byte 8) 1) vect))
       ,@body))
 
  (defun make-mem-stream (v) (make-instance 'mem-stream :vect v))
- (defun make-mmap-stream (f) (make-instance 'mem-stream :fn f))
+ (defun make-mmap-stream (f) (make-instance 'mem-stream :stream-filename f))
 
  (defmethod initialize-instance :after ((stream mem-stream) &key)
    (with-mem-stream-slots (stream)
-     (when fn
-       (setf vect (ccl:map-file-to-octet-vector fn)))
-     (setf len (length vect))))
+     (when stream-filename
+       (setf vect (ccl:map-file-to-octet-vector stream-filename)))
+     (setf stream-size (length vect))))
 
  (defmethod stream-close ((stream mem-stream))
    (with-mem-stream-slots (stream)
-     (when fn
+     (when stream-filename
        (ccl:unmap-octet-vector vect))
      (setf vect nil)))
 
@@ -61,21 +61,18 @@
         (if (zerop offset)
             index
             (incf index offset)))
-        (:end (setf index (- len offset))))))
-
- ;;; probably should just rename :ACCESSOR LEN to STREAM-SIZE? XXX
- (defmethod stream-size ((stream mem-stream)) (len stream))
-
- (defun read-n-bytes (stream n-bytes &key (bits-per-byte 8))
-   (fastest
-     (with-mem-stream-slots (stream)
-       (when (<= (+ index n-bytes) len)
-         (loop with value = 0
-               for low-bit downfrom (* bits-per-byte (1- n-bytes)) to 0 by bits-per-byte do
-                 (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
-                 (incf index)
-               finally (return-from read-n-bytes value))))
-     nil))
+        (:end (setf index (- stream-size offset))))))
+
+(defun read-n-bytes (stream n-bytes &key (bits-per-byte 8))
+  (fastest
+    (with-mem-stream-slots (stream)
+      (when (<= (+ index n-bytes) stream-size)
+        (loop with value = 0
+              for low-bit downfrom (* bits-per-byte (1- n-bytes)) to 0 by bits-per-byte do
+                (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
+                (incf index)
+              finally (return-from read-n-bytes value))))
+    nil))
 
  (declaim (inline read-n-bytes))
 
@@ -88,8 +85,8 @@
  (defmethod stream-read-sequence ((stream mem-stream) size &key (bits-per-byte 8))
    (fastest
      (with-mem-stream-slots (stream)
-       (when (> (+ index size) len)
-         (setf size (- len index)))
+       (when (> (+ index size) stream-size)
+         (setf size (- stream-size index)))
        (ecase bits-per-byte
          (8 (let ((octets (make-array size :element-type 'octet :displaced-to vect :displaced-index-offset index :adjustable nil)))
               (incf index size)
@@ -122,9 +119,9 @@
    (let* ((new-stream (make-mmap-stream filename))
           (ret-stream))
      (cond ((mp4-atom:is-valid-m4-file new-stream)
-            (setf ret-stream (make-instance 'mp4-file-stream :vect (vect new-stream) :fn (fn new-stream))))
+            (setf ret-stream (make-instance 'mp4-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) :fn (fn new-stream)))))
+            (setf ret-stream (make-instance 'mp3-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream)))))
      (stream-close new-stream)
      ret-stream))
 

id3-frame.lisp

@@ -71,31 +71,33 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
     (format stream "title = <~a>, artist = <~a>, album = <~a>, year = <~a>, comment = <~a>, track = <~d>, genre = ~d (~a)"
             title artist album year comment track genre (mp3-tag:get-id3v1-genre genre))))
 
-(defmethod initialize-instance :after ((me v21-tag-header) &key instream)
+;;; NB: no ":after" here
+(defmethod initialize-instance ((me v21-tag-header) &key instream)
   "Read in a V2.1 tag.  Caller will have stream-seek'ed file to correct location and ensured that TAG was present"
   (log5:with-context "v21-frame-initializer"
-    (log-id3-frame "reading v2.1 tag")
-    (with-slots      (title artist album year comment genre track) me
-      (setf track nil)
+    (log-id3-frame "reading v2.1 tag from ~:d" (stream-seek instream 0))
+    (with-slots (title artist album year comment genre track) me
       (setf title    (upto-null (stream-read-string-with-len instream 30)))
       (setf artist   (upto-null (stream-read-string-with-len instream 30)))
       (setf album    (upto-null (stream-read-string-with-len instream 30)))
       (setf year     (upto-null (stream-read-string-with-len instream 4)))
-      (setf comment  (stream-read-string-with-len instream 30))
 
       ;; In V21, a comment can be split into comment and track #
       ;; find the first #\Null then check to see if that index < 28.  If so, the check the last two bytes being
       ;; non-zero---if so, then track can be set to integer value of last two bytes
-      (let ((trimmed-comment (upto-null comment))
-            (trck 0))
-        (when (<= (length trimmed-comment) 28)
-          (setf (ldb (byte 8 8) trck) (char-code (aref comment 28)))
-          (setf (ldb (byte 8 0) trck) (char-code (aref comment 29)))
-          (setf comment trimmed-comment)
+
+        (let* ((c (stream-read-sequence instream 30))
+               (first-null (find 0 c))
+               (trck 0))
+          (when (and first-null (<= first-null 28))
+            (setf (ldb (byte 8 8) trck) (aref c 28))
+            (setf (ldb (byte 8 0) trck) (aref c 29)))
+          (setf comment (upto-null (map 'string #'code-char c)))
           (if (> trck 0)
               (setf track trck)
-              (setf track nil))))
-      (setf genre    (stream-read-u8 instream))
+              (setf track nil)))
+
+      (setf genre (stream-read-u8 instream))
       (log-id3-frame "v21 tag: ~a" (vpprint me nil)))))
 
 (defclass id3-ext-header ()
@@ -968,7 +970,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
     (log5:with-context "find-id3-frames"
 
-      (log-id3-frame "~a is a valid mp3 file" (fn mp3-file))
+      (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))
       (with-slots (size ext-header frames flags version) (id3-header mp3-file)
@@ -988,7 +990,7 @@ NB: 2.3 and 2.4 extended flags are different..."
             ;; Start reading frames from memory stream
             (multiple-value-bind (_ok _frames) (read-loop version mem-stream)
               (if (not _ok)
-                  (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (fn mp3-file)))
+                  (warn-user "File ~a had errors finding mp3 frames. potentially missed frames!" (stream-filename mp3-file)))
               (log-id3-frame "ok = ~a, returning ~d frames" _ok (length _frames))
               (setf frames _frames)
               _ok)))))))

mp3-tag.lisp

@@ -231,7 +231,7 @@
   (let ((frames (get-frames me '("TCO" "TCON"))))
     (when frames
       (when (> (length frames) 1)
-        (warn-user "file ~a has more than one genre frame, will only use the first" (fn me)))
+        (warn-user "file ~a has more than one genre frame, will only use the first" (stream-filename me)))
       (let ((count)
             (end)
             (str (info (first frames))))
@@ -343,7 +343,7 @@
 (defmethod show-tags ((me mp3-file-stream) &key (raw nil))
   "Show the tags for an mp3-file.  If RAW is non-nil, dump all the frames; else, print out a subset."
   (if raw
-      (format t "~a~%~a~%" (fn me)
+      (format t "~a~%~a~%" (stream-filename me)
               (with-output-to-string (s)
                 (when (audio-info me)
                   (mpeg::vpprint (audio-info me) s)
@@ -366,7 +366,7 @@
             (track (track me))
             (writer (writer me))
             (year (year me)))
-        (format t "~a~%~a~%" (fn me)
+        (format t "~a~%~a~%" (stream-filename me)
                 (if (audio-info me)
                     (mpeg::vpprint (audio-info me) nil) ""))
         (when album (format t "~4talbum: ~a~%" album))

mp4-atom.lisp

@@ -484,7 +484,7 @@ Loop through this container and construct constituent atoms"
 
       (when (= 0 siz)
         (error "trying to make an atom ~a with size of 0 at offset ~:d in file ~a"
-               (as-string typ) pos (fn mp4-file)))
+               (as-string typ) pos (stream-filename mp4-file)))
 
       (setf atom (make-instance (find-atom-class typ) :atom-size siz :atom-type typ :atom-file-position pos :mp4-file mp4-file :atom-parent-type parent-type))
       (log-mp4-atom "make-mp4-atom: made ~a" (vpprint atom nil))
@@ -525,7 +525,7 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
   (log5:with-context "find-mp4-atoms"
 
     (log-mp4-atom "find-mp4-atoms: ~a, before read-file loop, file-position = ~:d, end = ~:d"
-                  (fn mp4-file) (stream-seek mp4-file) (stream-size mp4-file))
+                  (stream-filename mp4-file) (stream-seek mp4-file) (stream-size mp4-file))
 
     (let ((atoms))
       (atom-read-loop mp4-file (stream-size mp4-file)

mp4-tag.lisp

@@ -36,7 +36,7 @@
 
 (defmethod show-tags ((me mp4-file-stream) &key (raw nil))
   "Show the tags for an MP4-FILE. If RAW is non-nil, dump the DATA atoms; else show subset of DATA atoms"
-  (format t "~a~%" (fn me))
+  (format t "~a~%" (stream-filename me))
   (if raw
       (progn
         (mp4-atom:mp4-show-raw-tag-atoms me)

mpeg.lisp

@@ -337,8 +337,8 @@
 
 (defmethod vpprint ((me vbr-info) stream)
   (with-vbr-info-slots (me)
-    (format stream "tag = ~a, flags = 0x~x, frames = ~:d, bytes = ~:d, tocs = ~d, scale = ~d, "
-            tag flags frames bytes tocs scale)))
+    (format stream "tag = ~a, flags = 0x~x, frame~p = ~:d, bytes = ~:d, tocs = ~d, scale = ~d, "
+            tag flags frames frames bytes tocs scale)))
 
 (defun find-first-sync (in)
   (fastest
@@ -447,8 +447,8 @@
 
 (defmethod vpprint ((me mpeg-audio-info) stream)
   (with-slots (is-vbr sample-rate bit-rate len version layer n-frames) me
-    (format stream "~:d frames read, ~a, ~a, ~:[CBR,~;VBR,~] sample rate: ~:d Hz, bit rate: ~:d Kbps, duration: ~:d:~2,'0d"
-            n-frames
+    (format stream "~:d frame~p read, ~a, ~a, ~:[CBR,~;VBR,~] sample rate: ~:d Hz, bit rate: ~:d Kbps, duration: ~:d:~2,'0d"
+            n-frames n-frames
             (get-mpeg-version-string version)
             (get-layer-string layer)
             is-vbr
@@ -480,12 +480,15 @@ Else, we assume CBR and calculate the duration, etc."
               (setf n-frames 1)
               (setf is-vbr t)
               (setf len (float (* (frames (vbr first-frame)) (/ (samples first-frame) (sample-rate first-frame)))))
-              (setf bit-rate  (float (/ (* 8 (bytes (vbr first-frame)) ) len))))
+              (if (not (zerop len))
+                  (setf bit-rate  (float (/ (* 8 (bytes (vbr first-frame))) len)))
+                  (setf bit-rate 0)))
             (let* ((first (pos first-frame))
                    (last (- (audio-streams:stream-size in) (if (id3-frame::v21-tag-header (id3-header in)) 128 0)))
-                   (n-frames (round (/ (float (- last first)) (float (size first-frame)))))
-                   (n-sec   (round (/ (float (* (size first-frame) n-frames)) (float (* 125 (float (/ (bit-rate first-frame) 1000))))))))
+                   (n-fr (round (/ (float (- last first)) (float (size first-frame)))))
+                   (n-sec   (round (/ (float (* (size first-frame) n-fr)) (float (* 125 (float (/ (bit-rate first-frame) 1000))))))))
               (setf is-vbr nil)
+              (setf n-frames 1) ; just set it to 1
               (setf len n-sec)
               (setf bit-rate (float (bit-rate first-frame))))))
 

packages.lisp

@@ -15,7 +15,7 @@
            #:mp3-file-stream #:mp4-file-stream #:base-mem-stream
            #:id3-header #:audio-info #:mp4-atoms
            #:parse-mp3-file #:parse-mp4-file #:parse-audio-file
-           #:make-mem-stream #:make-file-stream #:fn
+           #: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
            #:stream-decode-utf-8-string #:stream-decode-string #:stream-read-iso-string-with-len