(defun replace-hex-escape (string &optional (start 0)) 
  (let ((esc-start (position #\% string :start start)))
    (cond ((not (null esc-start))
           (let ((esc-end (+ 3 esc-start)))
             (cons (subseq string start esc-start)
                   (cons (hex->char-string (subseq string (1+ esc-start) esc-end))
                         (replace-hex-escape string esc-end)))))
          (t (list (subseq string start))))))


(defun difference-one-do (lst)
  (let ((copy-lst (copy-list lst)))
    (do ((counter 0 (1+ counter))
         (true-counter 0))
        ((= counter (1- (length lst))) (if (= counter true-counter)
                                         t))
      (if (or (= (first copy-lst) (1+ (second copy-lst)))
              (= (first copy-lst) (1- (second copy-lst))))
        (progn 
          (incf true-counter)
          (setf copy-lst (cdr copy-lst)))))))

(defun rieger-simple (cd)
  (initialize)
  (let ((max-depth 5))
    (push cd *queue-1*)
    (push cd *memory-1*)
    (loop
      (let ((c (pop *queue-1*)))
        (cond ((or (null c) (>= (cd-depth c) max-depth))
               (format t "~%The queue is empty. No more inferences.~%Here's what we got:~%")
               (return (print-memory *memory-1*)))
              (t
               (dolist (rule *rules*)
                 (let ((infcd (draw-inference c rule)))
                   (cond ((null infcd)
                          (format t "~%No inference derived"))
                         ((null (check-circular *memory-1* infcd))
                          (push infcd *memory-1*)
                          (push infcd *queue-1*))
                         (t
                          (format t "~%Circular inference detected...")))))))))))

(defun intersectp (x1 y1 x2 y2 x3 y3 x4 y4)   
  (let ((dx1 (- x1 x2))
        (dx2 (- x3 x4))
        (dy1 (- y1 y2))
        (dy2 (- y3 y4)))
    (cond ((and (zerop dx1) (zerop dx2))
           nil)
          ((zerop dx1)
           (let* ((m2 (/ dy2 dx2))
                  (b2 (- y3 (* x3 m2))))
             (values x1 (+ (* m2 x1) b2))))   
          ((zerop dx2)
           (let* ((m1 (/ dy1 dx1))
                  (b1 (- y1 (* x1 m1))))
             (values x3 (+ (* m1 x3) b1))))
          ((= (/ dy1 dx1) (/ dy2 dx2))
           nil)
          (t (let* ((m1 (/ dy1 dx1))
                    (m2 (/ dy2 dx2))
                    (b1 (- y1 (* x1 m1)))
                    (b2 (- y3 (* x3 m2)))
                    (x-intersect (/ (- b2 b1) (- m1 m2)))
                    (y-intersect (+ (* m1 x-intersect) b1)))
               (values x-intersect y-intersect))))))

(defun stream-subst (old new in out)
  (let* ((pos 0)
         (len (length old))
         (buf (new-buf len))
         (from-buf nil))
    (do ((c (read-char in nil :eof)
            (or (setf from-buf (buf-next buf))
                (read-char in nil :eof))))
        ((eql c :eof))
      (cond ((or (char= c (char old pos))
                 (string= "+" (char old pos)))
             (incf pos)
             (cond ((= pos len)
                    (princ new out)
                    (setf pos 0)
                    (buf-clear buf))
                   ((not from-buf)
                    (buf-insert c buf))))
            ((zerop pos)
             (princ c out)
             (when from-buf
               (buf-pop buf)
               (buf-reset buf)))
            (t
             (unless from-buf
               (buf-insert c buf))
             (princ (buf-pop buf) out)
             (buf-reset buf)
             (setf pos 0))))
    (buf-flush buf out)))