(in-package #:lempel)

(declaim (ftype (function (point) (cons (unsigned-byte 8))) point->bytes))
(defun point->bytes (p)
  (let ((window-width (1- (ash 1 window-bits))))
    (let ((offset (logand (point-offset p) #xff))
          (size (logior (ash (logand (point-offset p)
                                     (logxor window-width #xff))
                             (- 8 window-bits))
                        (point-size p))))
      (if reversed-byte-order
        (cons size offset)
        (cons offset size)))))

(defun prefix-encode (data prefix)
  (let ((result '()))
    (dolist (point data)
      (cond ((characterp point)
             (push (char-code point) result))
            ((point-p point)
             (push prefix result)
             (let ((encoded-pair (point->bytes point)))
               (push (car encoded-pair) result)
               (push (cdr encoded-pair) result)))
            (t (error "Invalid point type"))))
    (make-array (length result)
                :element-type '(unsigned-byte 8)
                :initial-contents (reverse result))))

(defun compress (data)
  (let ((result '())
        (window-width (1- (ash 1 window-bits))))
    (dotimes (cursor (length data))
      (let* ((window-start (max 0 (- cursor window-width)))
             (match (search-window data window-start cursor)))
        (if match
          (progn
            (push match result)
            (incf cursor (1- (point-size match))))
          (push (elt data cursor) result))))
    (reverse result)))

(defun search-window (data start end)
  (let ((offset 0)
        (size 0)
        (max-word-length (1- (ash 1 (- 16 window-bits)))))
    (do ((i (min (1+ end) (1- (length data))) (1+ i)))
      ((let ((match (search data data :start1 end :end1 i :start2 start :end2 end)))
         (when match
           (setf offset (- end match))
           (setf size (- i end)))
         (or (not match)
             (>= size max-word-length)
             (> i (1- (length data)))))
       (if (>= size break-even-threshold)
         (make-point :offset offset :size size)
         nil)))))