chunk.lisp

   1 ;;;
   2 ;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
   3 ;;;
   4 ;;; Redistribution and use in source and binary forms, with or without
   5 ;;; modification, are permitted provided that the following conditions
   6 ;;; are met:
   7 ;;;
   8 ;;;   * Redistributions of source code must retain the above copyright
   9 ;;;     notice, this list of conditions and the following disclaimer.
  10 ;;;
  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.
  15 ;;;
  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.
  27 ;;;
  28
  29 (in-package #:zpng)
  30
  31 ;;; Chunks
  32
  33 (defclass chunk ()
  34   ((buffer :initarg :buffer :reader buffer)
  35    (pos :initform 4 :accessor pos)))
  36
  37 (defun chunk-write-byte (byte chunk)
  38   "Save one byte to CHUNK."
  39   (setf (aref (buffer chunk) (pos chunk)) byte)
  40   (incf (pos chunk)))
  41
  42 (defun chunk-write-uint32 (integer chunk)
  43   "Save INTEGER to CHUNK as four bytes."
  44   (let ((buffer (buffer chunk))
  45         (i (pos 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))))
  51
  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
  54 data size SIZE."
  55   (let ((buffer (make-array (+ size 4) :element-type '(unsigned-byte 8))))
  56     (setf (aref buffer 0) a
  57           (aref buffer 1) b
  58           (aref buffer 2) c
  59           (aref buffer 3) d)
  60     (make-instance 'chunk
  61                    :buffer buffer)))
  62
  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))