Permalink
Browse files

Work in progress on parsing more things.

  • Loading branch information...
1 parent efd6564 commit 37219eac59b062929424bbfe51fb7bf0db1a07f5 @stassats committed Mar 6, 2012
Showing with 149 additions and 58 deletions.
  1. +90 −35 ogg-page.lisp
  2. +51 −8 ogg-vorbis.lisp
  3. +1 −2 ogg.asd
  4. +0 −13 packages.lisp
  5. +7 −0 test.lisp
View
125 ogg-page.lisp
@@ -14,27 +14,38 @@
string))
(:writer (out value)))
-(define-binary-type integer (bytes (bits-per-byte 8))
+(define-binary-type integer (bytes)
(:reader (in)
- (loop with value = 0
- for lsb to (* bits-per-byte (1- bytes)) by bits-per-byte do
- (setf (ldb (byte bits-per-byte lsb) value) (read-byte in))
- finally (return value)))
+ (loop with value = 0
+ for lsb to (* 8 (1- bytes)) by 8 do
+ (setf (ldb (byte 8 lsb) value) (read-byte in))
+ finally (return value)))
(:writer (out value)
- (loop for lsb to (* bits-per-byte (1- bytes)) by bits-per-byte
- do (write-byte (ldb (byte bits-per-byte lsb) value) out))))
+ (loop for lsb to (* 8 (1- bytes)) by 8
+ do (write-byte (ldb (byte 8 lsb) value) out))))
(define-binary-type u1 () (integer :bytes 1))
(define-binary-type u4 () (integer :bytes 4))
+(define-binary-type 1-bit ()
+ (:reader (in)
+ (read-bit in))
+ (:writer (out value)))
+
+(define-binary-type n-bits (n)
+ (:reader (in)
+ (read-n-bits n in))
+ (:writer (out value)))
+
;;;
(define-binary-type vector (length)
(:reader (in)
(let ((vector (make-array length :element-type '(unsigned-byte 8))))
(read-sequence vector in)
vector))
- (:writer (out value)))
+ (:writer (out value)
+ (write-sequence value out)))
(define-binary-type header-type-flag ()
(:reader (in)
@@ -51,9 +62,9 @@
(:writer (out value)))
(define-binary-class ogg-page ()
- ((magick (ascii-string :length 4))
- (version u1)
- (type-flag header-type-flag)
+ ((magick (ascii-string :length 4))
+ (version u1)
+ (type-flag header-type-flag)
(granule-position (vector :length 8))
(bitstream-serial-number u4)
(page-sequence-number u4)
@@ -62,46 +73,90 @@
(data-size (data-size :length number-page-segments))
(data (vector :length data-size))))
-(defun parse-page (stream)
- (read-value 'ogg-page stream))
-
-(defun read-file (file)
- (with-open-file (stream file :element-type 'unsigned-byte)
- (parse-page stream)))
-
-(defmacro with-ogg-stream ((stream file) &body body)
- (let ((file-stream (gensym)))
- `(with-open-file (,file-stream ,file :element-type 'unsigned-byte)
- (let ((,stream (make-instance 'ogg-stream :stream ,file-stream)))
- ,@body))))
-
(defclass ogg-stream (fundamental-binary-stream
trivial-gray-stream-mixin)
((stream :initarg :stream
:reader ogg-stream)
(page :initform (make-instance 'ogg-page)
:reader ogg-page)
- (position :initform 0 :accessor ogg-page-position)
- (length :initform 0 :accessor ogg-page-length)))
+ (position :initform 0
+ :accessor ogg-page-position)
+ (length :initform 0
+ :accessor ogg-page-length)
+ (bits-left :initarg :bits-left
+ :initform 8
+ :accessor bits-left)))
+
+(defmacro with-ogg-stream ((stream file &key) &body body)
+ (let ((file-stream (gensym)))
+ `(with-open-file (,file-stream ,file :element-type '(unsigned-byte 8))
+ (let ((,stream (make-instance 'ogg-stream :stream ,file-stream)))
+ ,@body))))
(defun refill-stream (ogg-stream)
(with-slots (stream page position length) ogg-stream
(read-object page stream)
(setf position 0
- length (data-size page)))
+ length (data-size page)
+ (bits-left ogg-stream) 8))
ogg-stream)
(defmethod stream-read-byte ((stream ogg-stream))
- (when (= (ogg-page-position stream)
- (ogg-page-length stream))
- (refill-stream stream))
- (prog1 (aref (data (ogg-page stream))
- (ogg-page-position stream))
- (incf (ogg-page-position stream))))
+ (let ((position (ogg-page-position stream)))
+ (when (= position (ogg-page-length stream))
+ (setf position 0)
+ (refill-stream stream))
+ (let ((data (data (ogg-page stream)))
+ (bits-left (bits-left stream)))
+ (prog1
+ (cond ((= bits-left 8)
+ (aref data position))
+ (t
+ (logand (ash bits-left
+ (print (mask-field (byte (- 8 bits-left) 0) (aref data (1+ position)))))
+ (ldb (byte bits-left
+ (- 8 bits-left))
+ (aref data position)))))
+ (incf (ogg-page-position stream))))))
(defmethod stream-read-sequence ((stream ogg-stream) sequence start end &key)
- (loop for i from (or start 0) below (max (length sequence)
- (or end 0))
+ (loop for i from start below (or end (length sequence))
do (setf (aref sequence i)
(read-byte stream))
finally (return i)))
+
+(defun read-bit (stream)
+ (let ((position (ogg-page-position stream)))
+ (when (= position (ogg-page-length stream))
+ (setf position 0)
+ (refill-stream stream))
+ (let ((data (data (ogg-page stream)))
+ (bits-left (bits-left stream)))
+ (prog1
+ (logbitp (- 8 bits-left) (aref data position))
+ (cond ((= bits-left 1)
+ (incf (ogg-page-position stream))
+ (setf (bits-left stream) 8))
+ (t
+ (decf (bits-left stream))))))))
+
+(defun read-n-bits (n stream)
+ (let ((position (ogg-page-position stream)))
+ (when (= position (ogg-page-length stream))
+ (setf position 0)
+ (refill-stream stream))
+ (let ((data (data (ogg-page stream)))
+ (bits-left (bits-left stream)))
+ (prog1
+ (logand (ash bits-left
+ (mask-field (byte (- n bits-left) 0) (aref data (1+ position))))
+ (if (> bits-left n)
+ 0
+ (ldb (byte bits-left
+ (- n bits-left))
+ (aref data position))))
+ (cond ((= bits-left n)
+ (incf (ogg-page-position stream))
+ (setf (bits-left stream) 8))
+ (t
+ (decf (bits-left stream) n)))))))
View
59 ogg-vorbis.lisp
@@ -14,11 +14,12 @@
(define-tagged-binary-class vorbis ()
((packet-type u1)
- (magick (ascii-string :length 6)))
+ (magick (ascii-string :length 6)))
(:dispatch
(ecase packet-type
(1 'vorbis-id-header)
- (3 'vorbis-comment-header))))
+ (3 'vorbis-comment-header)
+ (5 'vorbis-setup-header))))
(define-binary-class vorbis-id-header (vorbis)
((version u4)
@@ -34,21 +35,63 @@
((comment-length u4)
(comment (utf8-string :length comment-length))))
+(defun parse-comment-string (string)
+ (let ((=-position (position #\= string)))
+ (assert (numberp =-position))
+ (list (intern (nstring-upcase (subseq string 0 =-position)) :keyword)
+ (subseq string (1+ =-position)))))
+
+(defun format-comments (comments)
+ (loop for (key value) on comments by #'cddr
+ collect (format nil "~:@(~a~)=~a" key value)))
+
(define-binary-type comments (length)
(:reader (in)
(loop repeat length
nconc (parse-comment-string
(comment (read-value 'comment in)))))
(:writer (out value)))
+(define-binary-type n-things (length thing)
+ (:reader (in)
+ (loop repeat length
+ collect (read-value thing in)))
+ (:writer (out value)))
+
(define-binary-class vorbis-comment-header (vorbis)
((vendor-length u4)
(vendor-string (utf8-string :length vendor-length))
(comments-length u4)
- (comments (comments :length comments-length))))
+ (comments (comments :length comments-length))
+ (framing-flag u1)))
+
+(define-binary-class vorbis-setup-header (vorbis)
+ ((vorbis-codebook-count u1)
+ (codebooks (n-things :thing 'codebook :length 2;; vorbis-codebook-count
+ ))))
+
+(define-binary-class codebook ()
+ ((sync-pattern u3)
+ (codebook-dimensions u2)
+ (n-codebook-entries u3)
+ (ordered 1-bit)
+ (code-books (codebook-entries :length n-codebook-entries
+ :ordered ordered))
+ (codebook-lookup-type (n-bits :n 5))))
+
+(defun read-unordered-codebook-entries (length stream)
+ (loop repeat length
+ for sparse = (read-bit stream)
+ collect (if (and sparse
+ (not (read-bit stream)))
+ :unused
+ (1+ (read-n-bits 5 stream)))))
+
+(define-binary-type codebook-entries (length ordered)
+ (:reader (in)
+ (if ordered
+ (error "doesn't supported unordered codebook entries")
+ (read-unordered-codebook-entries length in)))
+ (:writer (out value)))
+
-(defun parse-comment-string (string)
- (let ((=-position (position #\= string)))
- (assert (numberp =-position))
- (list (intern (nstring-upcase (subseq string 0 =-position)) :keyword)
- (subseq string (1+ =-position)))))
View
3 ogg.asd
@@ -2,8 +2,7 @@
(asdf:defsystem #:ogg
:serial t
- :depends-on (trivial-gray-streams)
+ :depends-on (binary-data trivial-gray-streams babel)
:components ((:file "packages")
- (:file "binary-data")
(:file "ogg-page")
(:file "ogg-vorbis")))
View
13 packages.lisp
@@ -1,18 +1,5 @@
;;; -*- Mode: Lisp -*-
-(defpackage #:binary-data
- (:use #:cl)
- (:export #:define-binary-class
- #:define-tagged-binary-class
- #:define-binary-type
- #:read-value
- #:write-value
- #:read-object
- #:*in-progress-objects*
- #:parent-of-type
- #:current-binary-object
- #:+null+))
-
(defpackage #:ogg
(:use #:cl #:binary-data
#:trivial-gray-streams)
View
7 test.lisp
@@ -0,0 +1,7 @@
+(in-package :ogg)
+
+(defun test ()
+ (with-ogg-stream (stream "~/01_expander.ogg")
+ (list (read-value 'vorbis stream)
+ (read-value 'vorbis stream)
+ (read-value 'vorbis stream))))

0 comments on commit 37219ea

Please sign in to comment.