;;; pdf-page-numbers - renumbers pages in PDF files
;;; Michael Weber <michaelw@foldr.org>, 2006-08-02
;;; Requires: cl-pdf cl-pdf-parser

(defpackage #:pdf-page-numbers
  (:use #:cl)
  (:export #:clear-page-numbers
           #:clear-box
           #:page-numbers
           #:with-existing-pages
           #:iota
           #:enumerate))

(in-package #:pdf-page-numbers)

#||
(pdf:with-existing-document (#p"old.pdf")
  (with-existing-pages ()
    (pdf:insert-original-page-content)
    (clear-page-numbers 308 148 :font-size 10.0)
    (page-numbers 308 148 :font "Times-Bold" :font-size 10.0))
  (pdf:write-document #p"new.pdf"))
||#

(defvar *page-number* 0)
(defvar *debug* nil)

(defun clear-page-numbers (x y &key (font "Times-Roman") (font-size 12.0) justify (debug *debug*))
  (let* ((font (pdf:get-font font))
         (descender (* font-size (pdf:descender (pdf:font-metrics font))))
         (text-width (pdf::text-width "0000" font font-size))
         (x-pos (cond ((not justify) (+ x (- (/ text-width 2))))
                      ((evenp *page-number*) x)
                      (t (+ x (- text-width)))))
         (y-pos (+ y descender)))
    (pdf:with-saved-state
      (unless debug
        (pdf:set-color-stroke :white))
      (pdf:set-color-fill :white)
      (pdf:rectangle x-pos y-pos text-width font-size)
      (pdf:fill-and-stroke))
    (values)))

(defun clear-box (x y text-width &key (font "Times-Roman") (font-size 12.0) (debug *debug*))
  (let* ((font (pdf:get-font font))
         (descender (* font-size (pdf:descender (pdf:font-metrics font))))
         (x-pos x)
         (y-pos (+ y descender)))
    (pdf:with-saved-state
      (unless debug
        (pdf:set-color-stroke :white))
      (pdf:set-color-fill :white)
      (pdf:rectangle x-pos y-pos text-width font-size)
      (pdf:fill-and-stroke))
    (values)))

(defun page-numbers (x y &key (font "Times-Roman") (font-size 12.0) justify)
  (let ((font (pdf:get-font font))                    
        (page-num/s (princ-to-string *page-number*))
        (draw-fn (cond ((not justify) #'pdf:draw-centered-text)
                       ((evenp *page-number*) #'pdf:draw-right-text)
                       (t #'pdf:draw-left-text))))
    (funcall draw-fn x y page-num/s font font-size)
    (values)))

(defmacro with-existing-pages ((&key (range ''() rangep) (numbering `#'1+))
                               &body body)
  "RANGE denotes physical page numbers, starting at 0."
  (let (($phys-page-num (gensym "PHYS-PAGE-NUM-"))
        ($numbering (gensym "NUMBERING-")))
    `(loop with ,$numbering = ,numbering
           for ,$phys-page-num
           in ,(if rangep
                   range
                   `(iota (length (pdf::pages pdf::*root-page*))))
           for *page-number* = (funcall ,$numbering ,$phys-page-num)
           do (pdf:with-existing-page (,$phys-page-num)
                ,@body))))

(defun iota (count &key (start 0) (stride 1))
  (loop repeat count for x upfrom start by stride collect x))

(defun enumerate (&key (from 0) (by 1))
  (let ((count from))
    (lambda (&rest args)
      (declare (ignore args))
      (prog1 count (incf count by)))))

#||
(pdf:with-existing-document (#p"/tmp/pdmc/Preliminary/prelim-unnumbered.pdf")
  (with-existing-pages (:range (iota 94 :start 6)
                        :numbering (enumerate :from 1))
    (pdf:insert-original-page-content)
    (let ((x (if (evenp *page-number*) 135 480))
          (y (if (<= 50 *page-number* 64) 104 149)))
      (clear-page-numbers 308 y :font-size 10.0)
      (page-numbers x y :font "Times-Bold" :font-size 10.0 :justify t)))
  (pdf:write-document #p"/tmp/pdmc/Preliminary/prelim.pdf"))
||#

#||
(pdf:with-existing-document (#p"Desktop/proceedings/proceedings.pdf")
  (with-existing-pages (:range (iota 155 :start 4)
                        :numbering (enumerate :from 1))
    (pdf:insert-original-page-content)
    (let ((x (if (evenp *page-number*) 135 480))
          (y 100)
          (size 11.0)
          (text-width (- 480 135)))
      (when (<= 3 *page-number* 20)
        (clear-page-numbers 308 149 :font-size size))
      (when (<= 40 *page-number* 55)
        (let ((x (if (evenp *page-number*) 135 480)))
          (clear-page-numbers x 690 :font-size size)))
      (when (<= 57 *page-number* 73)
        (clear-box 135 740 text-width :font-size size))
      (when (<= 90 *page-number* 106)
        (clear-page-numbers 308 100 :font-size size))
      (when (<= 108 *page-number* 124)
        (clear-page-numbers 308 100 :font-size size))
      (when (<= 141 *page-number* 154)
        (clear-box 135 690 text-width :font-size size))
      (page-numbers x y :font "Times-Roman" :font-size size :justify t)))
  (pdf:write-document #p"/tmp/rv-2008-numbered.pdf"))
||#