[cl-typesetting-devel] Vertical space at the top and bottom of a page

[iso at wemba.edu.pl]

I seem to have a partial solution to the problem of
v-spacing appearing at the top of a page, but it's a
stab in the dark. I don't understand in detail how
compile-text, fit-lines, do-layout and spread-boxes
work, so I may have introduced a fatal bug.

The idea is to discard one v-spacing box at the front
of the list of boxes in a vbox and one at the rear if
it comes before (resp. after) a text-line with dy > 0,
hoping that it originated from a top or bottom margin
of an element at which the pagebreak was inserted (or
perhaps a vspace, which seems to have the same effect).

It's not a perfect solution, since some pages (or
columns) are shorter than they could be. The unwanted
v-spacing boxes should probably be removed before the
size of the box is measured, but I do not know how
to do this.

I have attached a complete example of a two-column
document (run the TEST-DOCUMENT function).

Of course, the problem of section headings appearing as
the last thing at the bottom of the page (or column)
remains unsolved. I wonder whether it would be possible
to make a simple fix by adding a parameter to
PARAGRAPH, called :forbidden-zone, which would specify
the height of a special area at the bottom of the page
(or vbox) where the paragraph must not start. Wouldn't
this be simpler to implement than a "keep-together"
option? This would not solve the problem of single
lines at the top, but at least section headings would
be kept together with the text.
-------------- next part --------------
(in-package :cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute) 
  (asdf:oos 'asdf:load-op :cl-typesetting)
  (use-package :tt))

(defun discard-unwanted-boxes (vbox)
  "Discard the first v-spacing box with dy > 0, but only if it
comes before any text-line with dy > 0. Do the same thing at the
end of the list of boxes."
  (when vbox
    (setf (tt::boxes vbox) 
	  (list-lobotomy #'discardable-box-p #'undiscardable-box-p
			 (tt::boxes vbox)))
    vbox))

#+nil
(defun discard-unwanted-boxes (vbox)
  vbox)

(defmethod undiscardable-box-p ((b tt::text-line))
  (not (zerop (tt::dy b))))

(defmethod undiscardable-box-p ((b t))
  nil)

(defmethod discardable-box-p ((b tt::v-spacing))
  (not (zerop (tt::dy b))))

(defmethod discardable-box-p ((b t))
  nil)


(defun list-lobotomy (delete-what-p stop-when-p list)
  (list-tail-lobotomy delete-what-p stop-when-p
		      (list-head-lobotomy delete-what-p stop-when-p 
					  list)))

(defun list-head-lobotomy (delete-what-p stop-when-p list)
  "Delete elements satisfying DELETE-WHAT-P at the beginning of LIST
before the first element satisfying STOP-WHEN-P."
  (if (funcall delete-what-p (car list)) 
      (cdr list)
      (do ((rest list (cdr rest)))
	  ((or (null rest)
	       (funcall stop-when-p (car rest)))
	   list)
	(let ((next (cadr rest)))
	  (when (and next (funcall delete-what-p next))
	    (rplacd rest (cddr rest)))))))

(defun list-tail-lobotomy (delete-what-p stop-when-p list)
  "Delete first (counting from the end) element of LIST that satisfies 
DELETE-WHAT-P if it comes after any element satisfying STOP-WHEN-P."
  (let ((unwanted (position-if delete-what-p list :from-end t))
	(stopper (position-if stop-when-p list :from-end t)))
    (when (and stopper unwanted (< stopper unwanted))
      (let ((l (nthcdr (1- unwanted) list)))
	(rplacd l (cddr l))))
    list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defparameter *some-text* "Compact setting of text should be
avoided, except maybe for very small portions where a given area
of white space must be used in a certain way and it would not be
possible to fit the text into the area otherwise. Introduction of
extra white space between lines of text was traditionally done
through a process called leading. The typesetter inserted thin
strips of brass with a known thickness between lines of type
blocks in the printing frame to increase the distance between the
baselines of his types.")


(defun make-some-content ()
  (compile-text ()
    (dotimes (i 100)
      (paragraph (:h-align :left 
		  :top-margin 24
		  :bottom-margin 8
		  :font-size 14)
	(format-string "Section ~d" (1+ i)))
      (paragraph (:h-align :fill
		  :top-margin 0
		  :bottom-margin 4
		  :font-size 9)
	*some-text* :hfill)
      )
    :vfill))
     

(defun test-document (&optional (filename #P"/tmp/output.pdf"))
  (with-document ()
    (let ((content (make-some-content)))
      (loop
	 while (tt::boxes content)
	 do (draw-page-2-column
	     content
	     :width 482
	     :height 708
	     :margins '(42 48 49 48)
	     :header-height 3
	     :footer-height 3
	     )))
    (write-document filename)))

(defun draw-page-2-column (content 
		   &key width height margins 
		   (header-height 12) (footer-height 12)
		   (column-gap 16)
		   )
  (destructuring-bind (left &optional (top left) (right left) (bottom top)) margins
    (let* ((x left)
           (y (- height top))
           (content-width (- width left right))
           (content-height (- height top bottom))
	   (column-width (/ (- content-width column-gap) 2.0))
           (main-height (- content-height header-height footer-height)))
      (pdf:with-page (:bounds (vector 0 0 width height))
        (pdf:with-saved-state
          (tt::stroke (discard-unwanted-boxes 
		       (make-filled-vbox content column-width main-height :top))
		      x (- y header-height))
	  (tt::stroke (discard-unwanted-boxes 
		       (make-filled-vbox content column-width main-height :top))
		      (+ x column-width column-gap) (- y header-height))
	  (pdf::move-to x y)
	  (pdf::line-to (+ x content-width) y)
	  (pdf::move-to x bottom)
	  (pdf::line-to (+ x content-width) bottom)
	  (pdf::set-line-width .3)
	  (pdf::stroke)
	  )))))