sane/read.lisp

   1 (in-package :sane)
   2
   3 (defclass blockwise-binary-input-stream (trivial-gray-stream-mixin)
   4   ((refill-buffer-function)
   5    (buflen                 :initarg  :buflen :initform 256)
   6    (buffer                 :initform nil)
   7    (buffer-fill            :initform 0)
   8    (buffer-pointer         :initform 0)
   9    (eof                    :initform nil))
  10
  11   (:documentation
  12 "This is an input stream that reads input from a function,
  13 REFILL-BUFFER-FUNCTION, which has the signature
  14
  15    (REFILL-BUFFER-FUNCTION buffer length)
  16
  17 where BUFFER is an array of length LENGTH. The function must return two
  18 values: the number of bytes read and nil/t depending on whether we've got to
  19 eof.
  20
  21 There is a STREAM-READ-BYTE function specialized on this class, which 'does
  22 the right thing'."))
  23
  24 (defmethod initialize-instance :after ((stream blockwise-binary-input-stream)
  25                                        &key)
  26   (setf (slot-value stream 'buffer)
  27         (make-array (slot-value stream 'buflen)
  28                     :element-type '(unsigned-byte 8))))
  29
  30 (defmethod stream-open ((stream blockwise-binary-input-stream))
  31   "On the superclass, this is a no-op."  nil)
  32
  33 (defclass sane-blocking-stream (blockwise-binary-input-stream)
  34   ((device         :reader   device     :initarg :device)
  35    (parameters     :reader   parameters :initform nil))
  36
  37   (:documentation
  38 "SANE-BLOCKING-STREAM masks reading from a scanner device as reading from a
  39 stream. Once STREAM-OPEN has been called on the stream, the PARAMETERS slot will
  40 contain an instance of the SANE::PARAMETERS class valid for the scanner. In
  41 particular, since sane_start will have been called, the members will be valid at
  42 this point."))
  43
  44 (defmethod initialize-instance :before ((stream sane-blocking-stream)
  45                                         &key device)
  46   (unless (subtypep (type-of device) 'device)
  47     (error "Cannot create a sane-blocking-stream with a device of type ~A"
  48            (type-of device)))
  49
  50   (setf (slot-value stream 'device) device)
  51
  52   (setf (slot-value stream 'refill-buffer-function)
  53         (lambda (buffer length) (refill-buffer! buffer (handle device)
  54                                                 length))))
  55
  56 (defmethod stream-open ((stream sane-blocking-stream))
  57   "Open the scanner as a stream. After this operation, the PARAMETERS slot is
  58 valid on STREAM."
  59   (ensure-ok (sane-lowlevel::sane_start (handle (device stream)))
  60              "Could not start scanning operation.")
  61   (setf (slot-value stream 'parameters) (get-parameters (device stream))))
  62
  63 (defmethod stream-read-byte ((stream blockwise-binary-input-stream))
  64   (with-slots (buffer buffer-fill buffer-pointer eof refill-buffer-function)
  65       stream
  66     (cond
  67       ((< buffer-pointer buffer-fill)
  68        (incf buffer-pointer)
  69        (aref buffer (1- buffer-pointer)))
  70
  71       (eof :eof)
  72
  73       (t
  74        (multiple-value-bind (length-read now-eof)
  75            (funcall refill-buffer-function buffer (slot-value stream 'buflen))
  76          (setf eof now-eof)
  77          (setf buffer-fill length-read)
  78          (setf buffer-pointer 0)
  79          (stream-read-byte stream))))))
  80
  81 (defun refill-buffer! (buffer handle length)
  82   (let ((eof nil))
  83
  84     (with-foreign-objects ((fbuffer :uchar length)
  85                            (length-read :int))
  86
  87       (case (sane-lowlevel::sane_read handle fbuffer
  88                                       length length-read)
  89         (:SANE_STATUS_GOOD nil)
  90
  91         ((:SANE_STATUS_EOF :SANE_STATUS_CANCELLED)
  92          (setf eof t))
  93
  94         (t
  95          (error "Unhandled error refilling buffer.")))
  96
  97       (iterate (for i from 0 to (1- (mem-ref length-read :int)))
  98                (setf (aref buffer i) (mem-aref fbuffer :uchar i)))
  99
 100       (values (mem-ref length-read :int) eof))))
 101
 102 (defmacro with-open-scanner-stream (stream device &body forms)
 103   "Open up a binary gray stream STREAM reading from DEVICE and execute FORMS
 104 with it open."
 105
 106   `(let ((,stream (make-instance 'sane-blocking-stream :device ,device)))
 107      (stream-open ,stream)
 108
 109      ,@forms))