[cl-pdf-devel] Named destinations proposal and small amendments

[Eric Marsden]

>>>>> "di" == Dmitri Ivanov <divanov at aha.ru> writes:

  di> 1) Sketch of code implementing named destinations,
  di> 2) Suggestion of the single add-link function replacing multiple
  di> add-<whatever>-link functions,
  di> 3) An example.

  I looked into implementing something similar a while ago (I was
  trying to add support for PDF Annotations: text annotations, link
  annotations etc, but lost enthusiasm after a while).

  I also moved to a single ADD-LINK function, but made it a generic
  function dispatching on specializations of a DESTINATION class. I
  think this is more extensible than dispatching by hand inside
  ADD-LINK. Rough code follows.



(defclass destination () ())

(defclass explicit-destination (destination)
  ((page :initarg :page
         :type integer
         :accessor destination-page)
   (position :initarg :position
             :initform "/Fit"
             :accessor destination-position)))

(defmethod write-object ((dest explicit-destination) &optional root-level)
  (declare (ignore root-level))
  (write-object (vector (destination-page dest) (destination-position dest))))

(defclass named-destination (destination)
  ((name :initarg :name :accessor destination-name)))

(defclass action-destination (destination)
  ((action :initarg :action :accessor destination-action)))

(defclass uri-destination (action-destination)
  ((uri :initarg :uri :accessor destination-uri)))

(defmethod add-link (x y dx dy (dest destination))
  (make-instance 'link-annotation
                 :rect (vector x y (+ x dx) (+ y dy))
                 :border border
                 :destination dest))

(defclass annotation (indirect-object)
  ((type :accessor annotation-type :initarg :type)
   (rect :accessor annotation-rect :initarg :rect)
   (border :accessor annotation-border :initarg :border :initform #(0 0 0))))

(defmethod initialize-instance :after ((annotation annotation) &rest init-options
                                       &key flags &allow-other-keys)
  (declare (type (or null integer) flags))
  (vector-push-extend annotation (annotations *page*))
  (setf (content annotation)
	(make-instance 'dictionary
		       :dict-values `(("/Type" . "/Annot")
                                      ("/Subtype" . ,(annotation-type annotation))
				      ("/Rect" . ,(annotation-rect annotation))
                                      ,@(when flags `(("/F" . ,flags)))))))

;; unfortunately this type of annotation does not seem to be displayed
;; by xpdf or by Ghostscript. It works with Acrobat Reader. 
(defclass text-annotation (annotation)
  ((type :initform "/Text")
   (text :accessor annotation-text :initarg :text)))

(defmethod initialize-instance :after ((annotation text-annotation) &rest init-options &key &allow-other-keys)
  (add-dict-value (content annotation)
                  "/Contents" (format nil "(~A)" (annotation-text annotation))))

(defclass link-annotation (annotation)
  ((type :initform "/Link")
   (destination :accessor annotation-destination :initarg :destination)))

(defmethod initialize-instance :after ((annotation link-annotation) &rest init-options &key &allow-other-keys)
  (add-dict-value (content annotation)
                  "/Dest" (annotation-destination annotation)))

;; FIXME add free-text-annotation, line-annotation, square-annotation,
;; highlight-annotation, underline-annotation

-- 
Eric Marsden                          <URL:http://www.laas.fr/~emarsden/>