Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 154 lines (134 sloc) 5.079 kb
efd6564 Stas Boukarev Initial commit.
authored
1 ;;; -*- Mode: Lisp -*-
2
3 ;;; This software is in the public domain and is
4 ;;; provided with absolutely no warranty.
5
6 (in-package #:ogg)
7
8 (define-binary-type ascii-string (length)
9 (:reader (in)
10 (let ((string (make-string length)))
11 (loop for i below length
12 do (setf (char string i)
13 (code-char (read-byte in))))
14 string))
15 (:writer (out value)))
16
37219ea Stas Boukarev Work in progress on parsing more things.
authored
17 (define-binary-type integer (bytes)
efd6564 Stas Boukarev Initial commit.
authored
18 (:reader (in)
37219ea Stas Boukarev Work in progress on parsing more things.
authored
19 (loop with value = 0
20 for lsb to (* 8 (1- bytes)) by 8 do
21 (setf (ldb (byte 8 lsb) value) (read-byte in))
22 finally (return value)))
efd6564 Stas Boukarev Initial commit.
authored
23 (:writer (out value)
37219ea Stas Boukarev Work in progress on parsing more things.
authored
24 (loop for lsb to (* 8 (1- bytes)) by 8
25 do (write-byte (ldb (byte 8 lsb) value) out))))
efd6564 Stas Boukarev Initial commit.
authored
26
27 (define-binary-type u1 () (integer :bytes 1))
75a6f9a Stas Boukarev Fix bit reading.
authored
28 (define-binary-type u2 () (integer :bytes 2))
29 (define-binary-type u3 () (integer :bytes 3))
efd6564 Stas Boukarev Initial commit.
authored
30 (define-binary-type u4 () (integer :bytes 4))
31
37219ea Stas Boukarev Work in progress on parsing more things.
authored
32 (define-binary-type 1-bit ()
33 (:reader (in)
34 (read-bit in))
35 (:writer (out value)))
36
37 (define-binary-type n-bits (n)
38 (:reader (in)
39 (read-n-bits n in))
40 (:writer (out value)))
41
efd6564 Stas Boukarev Initial commit.
authored
42 ;;;
43
44 (define-binary-type vector (length)
45 (:reader (in)
46 (let ((vector (make-array length :element-type '(unsigned-byte 8))))
47 (read-sequence vector in)
48 vector))
37219ea Stas Boukarev Work in progress on parsing more things.
authored
49 (:writer (out value)
50 (write-sequence value out)))
efd6564 Stas Boukarev Initial commit.
authored
51
52 (define-binary-type header-type-flag ()
53 (:reader (in)
54 (let ((byte (read-byte in)))
55 (values (logbitp 0 byte)
56 (logbitp 1 byte)
57 (logbitp 3 byte))))
58 (:writer (out value)))
59
60 (define-binary-type data-size (length)
61 (:reader (in)
62 (loop repeat length
63 sum (read-byte in)))
64 (:writer (out value)))
65
66 (define-binary-class ogg-page ()
37219ea Stas Boukarev Work in progress on parsing more things.
authored
67 ((magick (ascii-string :length 4))
68 (version u1)
69 (type-flag header-type-flag)
efd6564 Stas Boukarev Initial commit.
authored
70 (granule-position (vector :length 8))
71 (bitstream-serial-number u4)
72 (page-sequence-number u4)
73 (crc u4)
74 (number-page-segments u1)
75 (data-size (data-size :length number-page-segments))
76 (data (vector :length data-size))))
77
0340f33 Stas Boukarev Fix gray-streams and binary-data.
authored
78 (defclass ogg-stream (fundamental-binary-input-stream)
efd6564 Stas Boukarev Initial commit.
authored
79 ((stream :initarg :stream
80 :reader ogg-stream)
81 (page :initform (make-instance 'ogg-page)
82 :reader ogg-page)
37219ea Stas Boukarev Work in progress on parsing more things.
authored
83 (position :initform 0
84 :accessor ogg-page-position)
85 (length :initform 0
86 :accessor ogg-page-length)
87 (bits-left :initarg :bits-left
88 :initform 8
89 :accessor bits-left)))
90
91 (defmacro with-ogg-stream ((stream file &key) &body body)
92 (let ((file-stream (gensym)))
93 `(with-open-file (,file-stream ,file :element-type '(unsigned-byte 8))
94 (let ((,stream (make-instance 'ogg-stream :stream ,file-stream)))
95 ,@body))))
efd6564 Stas Boukarev Initial commit.
authored
96
97 (defun refill-stream (ogg-stream)
98 (with-slots (stream page position length) ogg-stream
0340f33 Stas Boukarev Fix gray-streams and binary-data.
authored
99 (binary-data::read-object page stream)
efd6564 Stas Boukarev Initial commit.
authored
100 (setf position 0
37219ea Stas Boukarev Work in progress on parsing more things.
authored
101 length (data-size page)
102 (bits-left ogg-stream) 8))
efd6564 Stas Boukarev Initial commit.
authored
103 ogg-stream)
104
105 (defmethod stream-read-byte ((stream ogg-stream))
37219ea Stas Boukarev Work in progress on parsing more things.
authored
106 (let ((position (ogg-page-position stream)))
107 (when (= position (ogg-page-length stream))
108 (setf position 0)
109 (refill-stream stream))
110 (let ((data (data (ogg-page stream)))
111 (bits-left (bits-left stream)))
8defb0d Stas Boukarev Fix another bit reading bug. Allows to parse more codebook lengths.
authored
112 (cond ((= bits-left 8)
113 (prog1
114 (aref data position)
115 (incf (ogg-page-position stream))))
116 (t
117 (read-n-bits 8 stream))))))
efd6564 Stas Boukarev Initial commit.
authored
118
119 (defmethod stream-read-sequence ((stream ogg-stream) sequence start end &key)
37219ea Stas Boukarev Work in progress on parsing more things.
authored
120 (loop for i from start below (or end (length sequence))
efd6564 Stas Boukarev Initial commit.
authored
121 do (setf (aref sequence i)
122 (read-byte stream))
123 finally (return i)))
37219ea Stas Boukarev Work in progress on parsing more things.
authored
124
125 (defun read-bit (stream)
c251dc3 Stas Boukarev Fix single bit reading.
authored
126 (plusp (read-n-bits 1 stream)))
37219ea Stas Boukarev Work in progress on parsing more things.
authored
127
128 (defun read-n-bits (n stream)
0d83ffd Stas Boukarev ogg-page: Add reading more than 8 bits at once.
authored
129 (cond ((> n 8)
130 (multiple-value-bind (quot rem) (floor n 8)
131 (logior (read-n-bits rem stream))))
132 (t
133 (let ((position (ogg-page-position stream)))
134 (when (= position (ogg-page-length stream))
135 (setf position 0)
136 (refill-stream stream))
137 (let ((data (data (ogg-page stream)))
138 (bits-left (bits-left stream)))
139 (prog1
140 (if (> n bits-left)
141 (logior (ldb (byte (min n bits-left) (- 8 bits-left))
142 (aref data position))
143 (ash (ldb (byte (- n bits-left) 0)
144 (aref data (1+ position)))
145 bits-left))
146 (ldb (byte (min n bits-left) (- 8 bits-left))
147 (aref data position)))
148 (cond ((> n bits-left)
149 (incf (ogg-page-position stream))
150 (setf (bits-left stream)
151 (- 8 (- n bits-left))))
152 (t
153 (decf (bits-left stream) n)))))))))
Something went wrong with that request. Please try again.