2 ;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
4 ;;; Redistribution and use in source and binary forms, with or without
5 ;;; modification, are permitted provided that the following conditions
8 ;;; * Redistributions of source code must retain the above copyright
9 ;;; notice, this list of conditions and the following disclaimer.
11 ;;; * Redistributions in binary form must reproduce the above
12 ;;; copyright notice, this list of conditions and the following
13 ;;; disclaimer in the documentation and/or other materials
14 ;;; provided with the distribution.
16 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
17 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
18 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
20 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
22 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
23 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
24 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34 ((buffer :initarg
:buffer
:reader buffer
)
35 (pos :initform
4 :accessor pos
)))
37 (defun chunk-write-byte (byte chunk
)
38 "Save one byte to CHUNK."
39 (setf (aref (buffer chunk
) (pos chunk
)) byte
)
42 (defun chunk-write-uint32 (integer chunk
)
43 "Save INTEGER to CHUNK as four bytes."
44 (let ((buffer (buffer chunk
))
46 (setf (aref buffer
(+ i
0)) (ldb (byte 8 24) integer
)
47 (aref buffer
(+ i
1)) (ldb (byte 8 16) integer
)
48 (aref buffer
(+ i
2)) (ldb (byte 8 8) integer
)
49 (aref buffer
(+ i
3)) (ldb (byte 8 0) integer
)
50 (pos chunk
) (+ i
4))))
52 (defun make-chunk (a b c d size
)
53 "Make a chunk that uses A, B, C, and D as the signature bytes, with
55 (let ((buffer (make-array (+ size
4) :element-type
'(unsigned-byte 8))))
56 (setf (aref buffer
0) a
63 (defun write-chunk (chunk stream
)
64 (write-uint32 (- (pos chunk
) 4) stream
)
65 (write-sequence (buffer chunk
) stream
:end
(pos chunk
))
66 (write-uint32 (checksum (buffer chunk
) (pos chunk
)) stream
))