Bit stream decoder

1 files changed, 11 insertions, 16 deletions

diff --git a/decode.lisp b/decode.lisp
index d569f6f..f52b4f9 100644
--- a/decode.lisp
+++ b/decode.lisp
@@ -2,7 +2,8 @@
 
 (declaim (optimize (debug 3) (safety 3)))
 
-(declaim (ftype (function ((array (unsigned-byte 8)) (unsigned-byte 8)) (array (unsigned-byte 1))) prefix-decode))
+(declaim (ftype (function ((array (unsigned-byte 8)) (unsigned-byte 8)) (array (unsigned-byte 8)))
+                prefix-decode))
 (defun prefix-decode (data prefix)
   (let ((bits (make-array (* 8 (length data)) :element-type '(unsigned-byte 1)))
         (result (queue:new))
@@ -28,18 +29,24 @@
             (t (queue:push (elt bits i) result)
                (incf i))))
     (format t "point count: ~a~&" point-count)
-    (decompress (queue:to-list result))))
+    (let* ((uncompressed-data (decompress (queue:to-list result)))
+           (output (make-array (/ (length uncompressed-data) 8) :element-type '(unsigned-byte 8))))
+      (dotimes (i (length output))
+        (setf (elt output i) (bits->byte uncompressed-data (* i 8))))
+      output)))
 
 (declaim (ftype (function (list) (array (unsigned-byte 1))) decompress))
 (defun decompress (data)
   (let ((result (make-array (get-uncompressed-size data) :element-type '(unsigned-byte 1)))
         (fill-count 0))
-    (format t "uncompressed size: ~a~&" (length result))
+    (format t "uncompressed size: ~a bits ~a bytes~&" (length result) (/ (length result) 8))
     (dolist (point data)
       (cond ((point-p point)
              (let ((start (- fill-count (point-offset point))))
                (dotimes (j (point-size point))
-                 (setf (elt result (+ fill-count j)) (elt result (+ start j))))
+                 (setf (elt result (+ fill-count j)) (if (> (+ start j) 0)
+                                                       (elt result (+ start j))
+                                                       0)))
                (incf fill-count (point-size point))))
             ((typep point '(unsigned-byte 1))
              (setf (elt result fill-count) point)
@@ -68,15 +75,3 @@
                (incf size (point-size point))))
             (t (incf size))))
     size))
-
-(declaim (ftype (function ((array (unsigned-byte 1)) fixnum) (unsigned-byte 8)) bits->byte))
-(defun bits->byte (data index)
-  (let ((byte 0))
-    (dotimes (i 8)
-      (setf byte (logior byte (ash (elt data (+ index i)) (- 7 i)))))
-    byte))
-
-(declaim (ftype (function ((unsigned-byte 8) (array (unsigned-byte 1)) fixnum)) byte->bits))
-(defun byte->bits (data bits index)
-  (dotimes (i 8)
-    (setf (elt bits (+ index i)) (ash (logand data (ash 1 (- 7 i))) (- i 7)))))