diff options
| -rw-r--r-- | common.lisp | 12 | ||||
| -rw-r--r-- | decode.lisp | 27 |
2 files changed, 23 insertions, 16 deletions
diff --git a/common.lisp b/common.lisp index a061ca1..1c11703 100644 --- a/common.lisp +++ b/common.lisp @@ -7,3 +7,15 @@ (defstruct point (offset 0 :type fixnum) (size 0 :type fixnum)) + +(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))))) 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))))) |