cleanup continues, formatting, etc

audio-streams.lisp

@@ -29,9 +29,12 @@
 
 (defmacro with-mem-stream-slots ((instance) &body body)
   `(with-slots (fn index len vect) ,instance
+     (declare (integer index len))
+     ;; XXX Breaks things: (type (simple-array (unsigned-byte 8) (*)) vect))
      ,@body))
 
 (defun make-mem-stream (v) (make-instance 'mem-stream :vect v))
+(defun make-mmap-stream (f) (make-instance 'mem-stream :fn f))
 
 (defmethod initialize-instance :after ((stream mem-stream) &key)
   (with-mem-stream-slots (stream)
@@ -60,6 +63,7 @@
            (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))
@@ -80,12 +84,12 @@
 
 (defmethod stream-read-sequence ((stream mem-stream) size &key (bits-per-byte 8))
   (with-mem-stream-slots (stream)
-    (if (> (+ index size) len)
-        (return-from stream-read-sequence nil)) ; size too large to read
+    (when (> (+ index size) len)
+      (setf size (- len index)))
     (ecase bits-per-byte
-      (8 (let ((ret (make-array size :element-type 'octet :displaced-to vect :displaced-index-offset index :adjustable nil)))
+      (8 (let ((octets (make-array size :element-type 'octet :displaced-to vect :displaced-index-offset index :adjustable nil)))
            (incf index size)
-           ret))
+           (values octets size)))
       (7
        (let* ((last-byte-was-FF nil)
               (byte nil)
@@ -97,7 +101,7 @@
                                   (write-byte byte out))
                               (write-byte byte out))
                           (setf last-byte-was-FF (= byte #xFF))))))
-         octets)))))
+         (values octets size))))))
 
 (defclass mp3-file-stream (mem-stream)
   ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")

mp4-atom.lisp

@@ -340,28 +340,28 @@ Loop through this container and construct constituent atoms"
        ((not ,test))
      ,@body))
 
-(defun read-descriptor-len (instream)
-  "Get the ES descriptor's length."
-  (let* ((tmp (stream-read-u8 instream))
-         (len (logand tmp #x7f)))
-    (declare (type (unsigned-byte 8) tmp))
-    (while (not (zerop (logand #x80 tmp)))
-      (setf tmp (stream-read-u8 instream))
-      (setf len (logior (ash len 7) (logand tmp #x7f))))
-    len))
+;; (defun read-descriptor-len (instream)
+;;   "Get the ES descriptor's length."
+;;   (let* ((tmp (stream-read-u8 instream))
+;;          (len (logand tmp #x7f)))
+;;     (declare (type (unsigned-byte 8) tmp))
+;;     (while (not (zerop (logand #x80 tmp)))
+;;       (setf tmp (stream-read-u8 instream))
+;;       (setf len (logior (ash len 7) (logand tmp #x7f))))
+;;     len))
 
 (defmethod initialize-instance :after ((me atom-esds) &key (mp4-file nil) &allow-other-keys)
   (with-slots (version flags esid s-priority obj-id s-type buf-size max-bit-rate avg-bit-rate) me
     (setf version  (stream-read-u8 mp4-file))
     (setf flags    (stream-read-u24 mp4-file))
     (assert (= 3 (stream-read-u8 mp4-file)) () "Expected a description tag of 3")
-    (let* ((len1 (read-descriptor-len mp4-file))
+    (let* ((len1 (stream-read-u32 mp4-file :bits-per-byte 7))
            (end-of-atom (+ (stream-seek mp4-file) len1)))
       (setf esid (stream-read-u16 mp4-file))
       (setf s-priority (stream-read-u8 mp4-file))
       ;; XXX should do some range checking here against LEN1...
       (assert (= 4 (stream-read-u8 mp4-file)) () "Expected tag type of 4")
-      (read-descriptor-len mp4-file) ; eat, but don't store descriptor header len
+      (stream-read-u32 mp4-file :bits-per-byte 7) ; eat, but don't store descriptor header len
       (setf obj-id (stream-read-u8 mp4-file))
       (setf s-type (stream-read-u8 mp4-file))
       (setf buf-size (stream-read-u24 mp4-file))

mpeg.lisp

@@ -374,6 +374,8 @@
           nxt-frame
           nil))))
 
+(defparameter *max-frames-to-read* most-positive-fixnum "when trying to determine bit-rate, etc, read at most this many frames")
+
 (defun map-frames (in func &key (start-pos nil) (read-payload nil) (max nil))
   (log5:with-context "next-frame"
     (log-mpeg-frame "mapping frames, start pos ~:d" start-pos)
@@ -439,7 +441,6 @@
             (floor (/ len 60)) (round (mod len 60)))))
 
 
-(defparameter *max-frames-to-read* most-positive-fixnum "when trying to determine bit-rate, etc, read at most this many frames")
 (defun get-mpeg-audio-info (in &key (max-frames *max-frames-to-read*))
   "Get MPEG Layer 3 audio information."
   (log5:with-context "get-mpeg-audio-info"

packages.lisp

@@ -3,7 +3,7 @@
 (in-package #:cl-user)
 
 (defpackage #:utils
-  (:export #:warn-user #:printable-array #:upto-null #:has-extension)
+  (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null #:has-extension)
   (:use #:common-lisp))
 
 (defpackage #:iso-639-2
@@ -56,7 +56,6 @@
            #:+itunes-track-n+)
   (:use #:common-lisp #:audio-streams #:utils))
 
-
 (defpackage #:id3-frame
   (:export #:id3-frame #:find-id3-frames #:id3-frame-condition #:vpprint #:header #:get-frame-info
            #:encoding #:lang #:desc #:val #:comment #:artist #:album #:year #:comment #:year

taglib-tests.lisp

@@ -8,7 +8,7 @@
 (in-package #:taglib-tests)
 
 ;;; some convenient songs to parse
-(defparameter *song-m4a* "Queen/Queen 01 Keep Yourself Alive.m4a")
+(defparameter *song-m4a* "Queen/Queen I/01 Keep Yourself Alive.m4a")
 (defparameter *song-mp3* "Queen/Sheer Heart Attack/07 In The Lap Of The Gods.mp3")
 
 ;;;
@@ -36,7 +36,7 @@
          (handler-case
              (setf foo (parse-mp4-file file))
            (condition (c)
-             (utils:warn-user "File: ~a~%Got condition: <~a>~%" file c)))
+             (utils:warn-user "File: ~a~%Got condition: <~a>" file c)))
       (when foo (stream-close foo)))
     foo))
 
@@ -60,7 +60,7 @@
          (handler-case
              (setf foo (parse-mp3-file file))
            (condition (c)
-             (utils:warn-user "File: ~a~%Got condition: <~a>~%" file c)))
+             (utils:warn-user "File: ~a~%Got condition: <~a>" file c)))
       (when foo (stream-close foo)))
     foo))
 

utils.lisp

@@ -2,21 +2,23 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:utils)
 
+(defparameter *break-on-warn-user* nil "set to T if you'd like to stop in warn user")
+
+;;; COMPLETELY UNPORTABLE!!!
 (defun warn-user (format-string &rest args)
   "print a warning error to *ERROR-OUTPUT* and continue"
-  ;; COMPLETELY UNPORTABLE!!!
+  (when *break-on-warn-user* (break "Breaking in WARN-USER"))
   (format *error-output* "~&********************************************************************************~%")
   (format *error-output* "~&~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
   (apply #'format *error-output* format-string args)
   (format *error-output* "**********************************************************************************~%"))
 
-
 (defparameter *max-raw-bytes-print-len* 10 "Max number of octets to print from an array")
 
-(defun printable-array (array)
+(defun printable-array (array &optional (max-len *max-raw-bytes-print-len*))
   "Given an array, return a string of the first *MAX-RAW-BYTES-PRINT-LEN* bytes"
   (let* ((len (length array))
-         (print-len (min len *max-raw-bytes-print-len*))
+         (print-len (min len max-len))
          (printable-array (make-array print-len :displaced-to array)))
     (format nil "[~:d of ~:d bytes] <~x>" print-len len printable-array)))