output.lisp

   1 ;;;; $Id: output.lisp,v 1.1.1.1 2007/12/03 19:43:34 xach Exp $
   2
   3 (in-package #:salza2)
   4
   5 (defun output-error (data start end)
   6   (declare (ignore data start end))
   7   (error "No output callback defined!"))
   8
   9 (defclass output ()
  10   ((data
  11     :initarg :data
  12     :accessor data
  13     :documentation "An octet vector that holds compressed data to
  14     be processed by the applicaton callback.")
  15    (start
  16     :initarg :start
  17     :accessor start
  18     :documentation "The index of the first octet of compressed data.")
  19    (end
  20     :initarg :end
  21     :accessor end
  22     :documentation "The index after last octet of compressed data.")
  23    (callback
  24     :initarg :callback
  25     :accessor callback
  26     :documentation "A designator for a function of three
  27     arguments: an octet vector, start, and end. The application
  28     can treat octets START through END-1 as compressed data to
  29     process as needed."))
  30   (:default-initargs
  31    :data (make-array 4096 :element-type 'octet)
  32    :start 0
  33    :end 0
  34    :callback 'output-error))
  35
  36 (defgeneric call-callback (object)
  37   (:method (output)
  38     (funcall (callback output) (data output) (start output) (end output))
  39     (setf (start output) 0
  40           (end output) 0)))
  41
  42 (defgeneric fullp (object)
  43   (:method ((output output))
  44     (= (end output) (length (data output)))))
  45
  46 (defgeneric output-octet (octet output)
  47   (:method (octet output)
  48     (setf (aref (data output) (end output)) octet)
  49     (when (fullp output)
  50       (call-callback output))))
  51
  52 (defgeneric output-literal (code output)
  53   (:method (code output)
  54     (print (list 'output-literal code))))
  55
  56 (defgeneric output-distance (distance output)
  57   (:method (distance output)
  58     (print (list 'output-distance distance))))
  59
  60 (defgeneric output-length (length output)
  61   (:method (length output)
  62     (print (list 'output-length length))))