diff options
Diffstat (limited to 'decode.lisp')
| -rw-r--r-- | decode.lisp | 89 |
1 files changed, 47 insertions, 42 deletions
diff --git a/decode.lisp b/decode.lisp index f52b4f9..b9e1010 100644 --- a/decode.lisp +++ b/decode.lisp @@ -4,12 +4,12 @@ (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)) +(defun prefix-decode (input prefix) + (let ((bits (make-array (* 8 (length input)) :element-type '(unsigned-byte 1))) + (decoded-input (queue:new)) (point-count 0)) - (dotimes (i (length data)) - (byte->bits (elt data i) bits (* 8 i))) + (dotimes (i (length input)) + (byte->bits (elt input i) bits (* 8 i))) (do ((i 0)) ((>= i (length bits)) nil) (cond ((and (<= i (- (length bits) 8)) (= (bits->byte bits i) prefix)) @@ -21,15 +21,19 @@ (let ((prefix-bits (make-array 8 :element-type '(unsigned-byte 1)))) (byte->bits prefix prefix-bits 0) (dotimes (j 8) - (queue:push (elt prefix-bits j) result)) + (queue:push (elt prefix-bits j) decoded-input)) (incf i 16))) (progn - (queue:push point result) + (setf (point-size point) (* 8 (point-size point))) + (setf (point-offset point) (* 8 (point-offset point))) + (queue:push point decoded-input) (incf i 24))))) - (t (queue:push (elt bits i) result) - (incf i)))) + (t (let ((step-size 2)) + (dotimes (j step-size) + (queue:push (elt bits (+ i j)) decoded-input)) + (incf i step-size))))) (format t "point count: ~a~&" point-count) - (let* ((uncompressed-data (decompress (queue:to-list result))) + (let* ((uncompressed-data (decompress (queue:to-list decoded-input))) (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)))) @@ -37,41 +41,42 @@ (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))) + (let ((uncompressed-size + (let ((size 0)) + (dolist (point data) + (cond ((point-p point) + (incf size (point-size point))) + (t (incf size)))) + size)) (fill-count 0)) - (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)) (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) - (incf fill-count)) - (t (error (format nil "cannot handle type ~a" (type-of point)))))) - (assert (= fill-count (length result))) - result)) + (let ((result (make-array uncompressed-size :element-type '(unsigned-byte 1)))) + (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)) (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) + (incf fill-count)) + (t (error (format nil "cannot handle type ~a" (type-of point)))))) + (assert (= fill-count (length result))) + result))) (declaim (ftype (function ((unsigned-byte 8) (unsigned-byte 8)) point) byte-pair->point)) (defun byte-pair->point (b1 b2) (let ((offset (if reversed-byte-order b2 b1)) (size (if reversed-byte-order b1 b2)) - (max-word-length (1- (ash 1 (- 16 window-bits))))) - (make-point :offset (* 8 (logior offset - (ash (logand size (logxor #xff max-word-length)) - (- window-bits 8)))) - :size (* 8 (logand size max-word-length))))) - -(declaim (ftype (function (list) fixnum) get-uncompressed-size)) -(defun get-uncompressed-size (data) - (let ((size 0)) - (dolist (point data) - (cond ((point-p point) - (if (= (point-size point) 0) - (incf size 8) - (incf size (point-size point)))) - (t (incf size)))) - size)) + (max-word-length (1- (ash 1 (- 16 window-bits)))) + (max-offset-length (1- (ash 1 window-bits)))) + (if (>= window-bits 8) + (make-point :offset (logior offset + (ash (logand size (logxor #xff max-word-length)) + (- window-bits 8))) + :size (logand size max-word-length)) + (make-point :offset (logand offset max-offset-length) + :size (logior size (ash (logand offset (logxor #xff max-offset-length)) + (- 16 window-bits 8))))))) |