src/bit-streams.lisp @ adcbdf9b281a

(in-package :tdcb)

;;;; Common -------------------------------------------------------------------
(defclass bit-stream (trivial-gray-streams:fundamental-binary-stream)
  ((underlying-stream :accessor underlying-stream :initarg :underlying-stream :type stream)
   (rack :accessor rack :type (unsigned-byte 8) :initform 0)
   (mask :accessor mask :type (unsigned-byte 8) :initform #b10000000)))

(defmethod close ((stream bit-stream) &key abort)
  (when (open-stream-p (underlying-stream stream))
    (close (underlying-stream stream) :abort abort)))

(defmethod stream-element-type ((stream bit-stream))
  'bit)

(defmethod stream-file-position ((stream bit-stream))
  (error "Cannot change position of a bit stream."))


;;;; Output -------------------------------------------------------------------
(defclass bit-output-stream (bit-stream trivial-gray-streams:fundamental-binary-output-stream) ())

(defun make-bit-output-stream (stream)
  (make-instance 'bit-output-stream :underlying-stream stream))


(declaim (inline write-bit%))
(defun write-bit% (stream bit)
  (when (plusp bit)
    (logiorf (rack stream) (mask stream)))
  (when (zerop (ashf (mask stream) -1))
    (write-byte (rack stream) (underlying-stream stream))
    (setf (rack stream) 0
          (mask stream) #b10000000)))
(defun write-bits (stream byte &optional (count 1))
  (loop :with mask = (ash 1 (1- count))
        :until (zerop mask)
        :do (progn (write-bit% stream (logand mask byte))
                   (ashf mask -1)))
  byte)


(defmethod trivial-gray-streams:stream-write-byte ((stream bit-output-stream) bit)
  (write-bit% stream bit))

(defmethod close ((stream bit-output-stream) &key abort)
  (declare (ignore abort))
  (unless (= (mask stream) #b10000000)
    (write-byte (rack stream) (underlying-stream stream)))
  (call-next-method))

(with-open-stream (s (make-bit-output-stream *standard-output*)) (write-byte #b00101010 s))


;;;; Input -------------------------------------------------------------------
(defclass bit-input-stream (bit-stream trivial-gray-streams:fundamental-binary-input-stream) ())

(defun make-bit-input-stream (stream)
  (make-instance 'bit-input-stream :underlying-stream stream))


(declaim (inline read-bit))
(defun read-bit (stream)
  (when (= (mask stream) #b10000000)
    (setf (rack stream) (read-byte (underlying-stream stream))))
  (prog1 (if (zerop (logand (mask stream) (rack stream)))
           0
           1)
    (when (zerop (ashf (mask stream) -1))
      (setf (mask stream) #b10000000))))

(defun read-bits (stream count)
  (loop :with result = 0
        :with mask = (ash 1 (1- count))
        :until (zerop mask)
        :do (progn (when (plusp (read-bit stream))
                     (logiorf result mask))
                   (ashf mask -1))
        :finally (return result)))


(defmethod trivial-gray-streams:stream-read-byte ((stream bit-input-stream))
  (read-bit stream))


#; Scratch --------------------------------------------------------------------

(defparameter *o* (make-bit-output-stream *standard-output*))

(defparameter *s* (flexi-streams:make-in-memory-input-stream #(#b00101010 #b01010100)))
(defparameter *i* (make-bit-input-stream *s*))

(losh:bits (read-bits *i* 4))

(read-byte *s*)