closures.lisp

   1 ;;;; $Id: closures.lisp,v 1.1 2007/12/07 17:14:28 xach Exp $
   2
   3 (in-package #:salza2)
   4
   5 (defun make-huffman-writer (huffman-codes bitstream)
   6   (let ((codes (codes huffman-codes))
   7         (sizes (sizes huffman-codes))
   8         (buffer (buffer bitstream))
   9         (callback (callback bitstream)))
  10     (lambda (value)
  11       (setf (bits bitstream)
  12             (merge-bits (aref codes value)
  13                         (aref sizes value)
  14                         buffer
  15                         (bits bitstream)
  16                         callback)))))
  17
  18 (defun make-byte-writer (bitstream)
  19   (let ((buffer (buffer bitstream))
  20         (callback (callback bitstream)))
  21     (lambda (byte)
  22       (setf (bits bitstream)
  23             (merge-byte byte buffer (bits bitstream) callback)))))