table-formatting.lisp

;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-

;;;  (c) copyright 2001 by Alexey Dejneka (adejneka@comail.ru)
;;;  (c) copyright 2003 by Gilbert Baumann <unk6@rz.uni-karlsruhe.de>

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA  02111-1307  USA.

;;; TODO:
;;;
;;; - Check types: RATIONAL, COORDINATE, REAL?
;;; - Check default values of unsupplied arguments.
;;; - Better error detection.
;;; - 
;;; - Multiple columns:
;;; - - all columns are assumed to have the same width;
;;; - - all columns have the same number of rows; they should have the
;;;     same height.
;;; - :MOVE-CURSOR T support.
;;; - All types of widths, heights.
;;;   width, height too?
;;; - Item list formatting: what is :EQUALIZE-COLUMN-WIDTHS?!
;;;
;;; - We should think about inserting actual gutter into the output
;;;   records so that the bounding box of a row or a cell it its
;;;   logical dimension.

;;; - I would prefer if the INITIALIZE-INSTANCE would grok spacing and
;;;   all. Hmm, is that correct?

;;; The question araise if we need to support something like:
;;; (formatting-row ()
;;;   (with-output-as-presentation ()
;;;     (formatting-cell ())
;;;     (formatting-cell ())))

;;; Further: Should this table be somehow dynamic? That is when cell
;;; contents change also rerun the layout protocol? Or is that somehow
;;; covered by the incremental redisplay?

;;; Guess, we just do, it couldn't hurt.

(in-package :clim-internals)

(defvar *table-suppress-update* nil
  "Used to control whether changes to table cells propagate upwards.")

;;; Cell formatting

;;; STANDARD-CELL-OUTPUT-RECORD class
(defclass standard-cell-output-record (cell-output-record
                                       standard-sequence-output-record)
  ((align-x    :initarg :align-x    :reader cell-align-x)
   (align-y    :initarg :align-y    :reader cell-align-y)
   (min-width  :initarg :min-width  :reader cell-min-width)
   (min-height :initarg :min-height :reader cell-min-height))
  (:default-initargs
   :align-x :left :align-y :baseline :min-width 0 :min-height 0))

;;; If this were a primary method it wouldn't override the default
;;; behavior for the parent being a compound-output-record because of
;;; the order of the argument list.
(defmethod recompute-extent-for-changed-child :around
    (record (changed-child standard-cell-output-record)
     old-min-x old-min-y old-max-x old-max-y)
  (unless *table-suppress-update*
    (call-next-method))
  record)

(defun table-cell-allowed-as-child-of (record)
  "Internal. A predicate which decides whether 'record' can take a
table cell as argument."
  ;; We allow a cell output record here if any ancestor is a
  ;; table-row, column or list-item. Note: This is probably not 100%
  ;; correct, as I have no idea what happens when you nest graphs and
  ;; tables ...
  (or (row-output-record-p record)
      (column-output-record-p record)
      (item-list-output-record-p record)
      (and (output-record-parent record)
           (table-cell-allowed-as-child-of (output-record-parent record)))))

(defun assert-table-cell-allowed (record)
  "Internal. Assert that the a table cell is allowed here and if not
   barf."
  (unless (table-cell-allowed-as-child-of record)
    (error "Sorry ~S not within ~S, ~S or ~S."
           'formatting-cell
           'formatting-row
           'formatting-column
           'formatting-item-list)))

(defmethod invoke-formatting-cell (stream cont
                                   &key (align-x :left)
                                        (align-y :baseline)
                                        (min-width 0)
                                        (min-height 0)
                                        (record-type 'standard-cell-output-record)
                                   &allow-other-keys)
  (invoke-with-new-output-record
   stream
   (lambda (stream record)
     (declare (ignore record))
     (letf (((stream-cursor-position stream) (values 0 0)))
       (funcall cont stream)))
   record-type
   nil
   :align-x align-x
   :align-y align-y
   :min-width (parse-space stream min-width :horizontal)
   :min-height (parse-space stream min-height :vertical)))

(defgeneric invoke-formatting-cell (stream cont
                                    &key align-x align-y min-width min-height record-type
                                    &allow-other-keys))

(defmacro formatting-cell ((&optional (stream t)
				      &rest more
				      &key align-x align-y
				      (min-width 0) (min-height 0)
				      (record-type ''standard-cell-output-record))
                           &body body)
  (declare (ignorable align-x align-y))
  (setq stream (stream-designator-symbol stream '*standard-output*))
  (with-keywords-removed (more (:record-type :min-width :min-height))
    (with-gensyms (record)
      ;; Blow off order-of-evaluation issues for the moment...
      `(with-new-output-record
	   (,stream ,record-type ,record ,@more
		    :min-width (parse-space ,stream ,min-width :horizontal)
		    :min-height (parse-space ,stream ,min-height :vertical))
	 (letf (((stream-cursor-position ,stream) (values 0 0)))
	   ,@body)))))


;;; Generic block formatting
(defclass block-output-record-mixn ()
  ()
  (:documentation "The class representing one-dimensional blocks of cells."))

(defgeneric map-over-block-cells (function block)
  (:documentation "Applies the FUNCTION to all cells in the BLOCK."))

(defmethod map-over-block-cells (function (block block-output-record-mixn))
  ;; ### we need to do better
  (labels ((foo (row-record)
             (map-over-output-records
              (lambda (record)
                (if (cell-output-record-p record)
		    (funcall function record)
		    (foo record)))
              row-record)))
    (declare (dynamic-extent #'foo))
    (foo block)))


;;; Row formatting

(defgeneric map-over-row-cells (function row-record)
  (:documentation "Applies FUNCTION to all the cells in the row
ROW-RECORD, skipping intervening non-table output record structures.
FUNCTION is a function of one argument, an output record corresponding
to a table cell within the row."))

;;; STANDARD-ROW-OUTPUT-RECORD class
(defclass standard-row-output-record (row-output-record
                                      block-output-record-mixn
                                      standard-sequence-output-record)
  ())

(defmethod map-over-row-cells (function
                               (row-record standard-row-output-record))
  (map-over-block-cells function row-record))

(defmacro formatting-row ((&optional (stream t)
			  &rest more
			  &key (record-type ''standard-row-output-record))
			  &body body)
  (setf stream (stream-designator-symbol stream '*standard-output*))
  (with-gensyms (record)
    (with-keywords-removed (more (:record-type))
      `(with-new-output-record (,stream ,record-type ,record ,@more)
	 ,@body))))

(defgeneric invoke-formatting-row (stream cont record-type &rest initargs))

(defmethod invoke-formatting-row (stream cont record-type &rest initargs)
  (apply #'invoke-with-new-output-record stream
	 (lambda (s r)
	   (declare (ignore r))
	   (funcall cont s))
	 record-type initargs))


;;; Column formatting

(defgeneric map-over-column-cells (function column-record)
  (:documentation "Applies FUNCTION to all the cells in the column
COLUMN-RECORD, skipping intervening non-table output record
structures. FUNCTION is a function of one argument, an output record
corresponding to a table cell within the column."))

;;; STANDARD-COLUMN-OUTPUT-RECORD class
(defclass standard-column-output-record (column-output-record
                                         block-output-record-mixn
                                         standard-sequence-output-record)
  ())

(defmethod map-over-column-cells (function (column-record standard-column-output-record))
  (map-over-block-cells function column-record))

(defmacro formatting-column ((&optional (stream t)
					&rest more
                                        &key (record-type
                                        ''standard-column-output-record))
			     
                             &body body)
  (setf stream (stream-designator-symbol stream '*standard-output*))
  (with-gensyms (record)
    (with-keywords-removed (more (:record-type))
      `(with-new-output-record (,stream ,record-type ,record ,@more)
	 ,@body))))

(defgeneric invoke-formatting-column (stream cont record-type &rest initargs))

(defmethod invoke-formatting-column (stream cont record-type &rest initargs)

  (apply #'invoke-with-new-output-record stream (lambda (s r) r (funcall cont s)) record-type initargs))


;;; Table formatting

(defgeneric map-over-table-elements (function table-record type)
  (:documentation "Applies FUNCTION to all the rows or columns of
TABLE-RECORD that are of type TYPE. TYPE is one of :ROW, :COLUMN or
:ROW-OR-COLUMN. FUNCTION is a function of one argument. The function
skips intervening non-table output record structures."))
(defgeneric adjust-table-cells (table-record stream))
(defgeneric adjust-multiple-columns (table-record stream))

;;; STANDARD-TABLE-OUTPUT-RECORD class
(defclass standard-table-output-record (table-output-record
                                        standard-sequence-output-record)
  (;; standard slots
   (x-spacing :initarg :x-spacing)
   (y-spacing :initarg :y-spacing)
   (multiple-columns :initarg :multiple-columns)
   (multiple-columns-x-spacing :initarg :multiple-columns-x-spacing)
   (equalize-column-widths :initarg :equalize-column-widths)
   ;; book keeping -- communication from adjust-table-cells to
   ;; adjust-multiple-columns
   (widths)
   (heights)                            ;needed?
   (rows)))

(defmethod initialize-instance :after ((table standard-table-output-record)
                                       &rest initargs)
  (declare (ignore initargs))
  (unless (slot-boundp table 'multiple-columns-x-spacing)
    (setf (slot-value table 'multiple-columns-x-spacing)
          (slot-value table 'x-spacing))))

(defmacro formatting-table ((&optional (stream t)
                                       &rest args
                                       &key x-spacing y-spacing
                                            multiple-columns
                                            multiple-columns-x-spacing
                                            equalize-column-widths (move-cursor t)
                                            (record-type ''standard-table-output-record)
                                       &allow-other-keys)
                            &body body)
  (declare (ignore x-spacing y-spacing multiple-columns
                   multiple-columns-x-spacing
                   equalize-column-widths move-cursor record-type))
  (gen-invoke-trampoline 'invoke-formatting-table
                         (list (stream-designator-symbol stream
							 '*standard-output*))
                         args
                         body))

(defun invoke-formatting-table
    (stream continuation
     &key x-spacing y-spacing
     multiple-columns
     multiple-columns-x-spacing
     equalize-column-widths
     (move-cursor t)
     (record-type 'standard-table-output-record)
     &allow-other-keys)
  (setq x-spacing (parse-space stream (or x-spacing #\Space) :horizontal))
  (setq y-spacing (parse-space stream (or y-spacing
                                          (stream-vertical-spacing stream))
                               :vertical))
  (setq multiple-columns-x-spacing
        (if multiple-columns-x-spacing
            (parse-space stream multiple-columns-x-spacing :horizontal)
            x-spacing))
  (with-new-output-record
      (stream record-type table
              :x-spacing x-spacing
              :y-spacing y-spacing
              :multiple-columns multiple-columns
              :multiple-columns-x-spacing multiple-columns-x-spacing
              :equalize-column-widths equalize-column-widths)
    (multiple-value-bind (cursor-old-x cursor-old-y)
	(stream-cursor-position stream)
      (let ((*table-suppress-update* t))
	(with-output-recording-options (stream :record t :draw nil)
	  (funcall continuation stream)
	  (force-output stream))
	(with-output-recording-options (stream :record nil :draw nil)
	  (adjust-table-cells table stream)
	  (when multiple-columns (adjust-multiple-columns table stream))
	  (setq *table-suppress-update* nil)
	  (tree-recompute-extent table)))
      #+NIL
      (setf (output-record-position table)
	    (values cursor-old-x cursor-old-y))
      (replay table stream)
      (if move-cursor
	  ;; FIXME!!!
	  ;; Yeah, fix me -- what is wrong with that?
	  (setf (stream-cursor-position stream)
		(values (bounding-rectangle-max-x table)
			(bounding-rectangle-max-y table)))
	  (setf (stream-cursor-position stream)
		(values cursor-old-x cursor-old-y)))))
  (fit-pane-to-output stream))

;;; Think about rewriting this using a common superclass for row and
;;; column records.

(defmethod map-over-table-elements
    (function (table-record standard-table-output-record) (type (eql :row)))
  (labels ((row-mapper (table-record)
             (map-over-output-records
              (lambda (record)
                (if (row-output-record-p record)
		    (funcall function record)
		    (row-mapper record)))
              table-record)))
    (declare (dynamic-extent #'row-mapper))
    (row-mapper table-record)))

(defmethod map-over-table-elements
    (function (table-record standard-table-output-record) (type (eql :column)))
  (labels ((col-mapper (table-record)
             (map-over-output-records
              (lambda (record)
                (if (column-output-record-p record)
		    (funcall function record)
		    (col-mapper record)))
              table-record)))
    (declare (dynamic-extent #'col-mapper))
    (col-mapper table-record)))

(defmethod map-over-table-elements (function
				    (table-record standard-table-output-record)
				    (type (eql :row-or-column)))
  (labels ((row-and-col-mapper (table-record)
             (map-over-output-records
              (lambda (record)
                (if (or (row-output-record-p record)
			(column-output-record-p record)) 
		    (funcall function record)
		    (row-and-col-mapper record)))
              table-record)))
    (declare (dynamic-extent #'row-and-col-mapper))
    (row-and-col-mapper table-record)))


;;; Item list formatting

(defgeneric map-over-item-cells (function item-list-record)
  )
(defgeneric adjust-item-list-cells (item-list-record stream))

(defclass standard-item-list-output-record (item-list-output-record
                                            block-output-record-mixn
                                            standard-sequence-output-record)
  ((x-spacing :initarg :x-spacing)
   (y-spacing :initarg :y-spacing)
   (initial-spacing :initarg :initial-spacing)
   (row-wise :initarg :row-wise)
   (n-rows :initarg :n-rows)
   (n-columns :initarg :n-columns)
   (max-width :initarg :max-width)
   (max-height :initarg :max-height)))

(defmethod map-over-item-cells (function
                                (item-list-record standard-item-list-output-record))
  (map-over-block-cells function item-list-record))

(defun invoke-format-item-list (stream continuation
                                &key x-spacing y-spacing n-columns n-rows
                                     max-width max-height
                                     initial-spacing (row-wise t) (move-cursor t)
                                (record-type
                                 'standard-item-list-output-record))
  (setq x-spacing (parse-space stream (or x-spacing #\Space) :horizontal))
  (setq y-spacing (parse-space stream (or y-spacing
                                          (stream-vertical-spacing stream))
                               :vertical))
  (with-new-output-record
      (stream record-type item-list
              :x-spacing x-spacing
              :y-spacing y-spacing
              :initial-spacing initial-spacing
              :row-wise row-wise
              :n-rows n-rows
              :n-columns n-columns
              :max-width max-width
              :max-height max-height)
    (multiple-value-bind (cursor-old-x cursor-old-y)
        (stream-cursor-position stream)
      (with-output-recording-options (stream :record t :draw nil)
        (funcall continuation stream)
        (force-output stream))
      (adjust-item-list-cells item-list stream)
      (setf (output-record-position item-list)
            (stream-cursor-position stream))
      (if move-cursor
          (setf (stream-cursor-position stream)
                (values (bounding-rectangle-max-x item-list)
                        (bounding-rectangle-max-y item-list)))
        (setf (stream-cursor-position stream)
              (values cursor-old-x cursor-old-y)))
      (replay item-list stream)
      item-list)))

(defun format-items (items
                     &rest args
                     &key (stream *standard-output*)
                          printer presentation-type
                          cell-align-x cell-align-y
                     &allow-other-keys)
  (let ((printer (if printer
                     (if presentation-type
                         #'(lambda (item stream)
                             (with-output-as-presentation (stream item presentation-type)
                               (funcall printer item stream)))
                         printer)
                     (if presentation-type
                         #'(lambda (item stream)
                             (present item presentation-type :stream stream))
                         #'prin1))))
    (with-keywords-removed (args (:stream :printer :presentation-type
                                  :cell-align-x :cell-align-y))
      (apply #'invoke-format-item-list
             stream
             #'(lambda (stream)
                 (map nil
                      #'(lambda (item)
                          (formatting-cell (stream :align-x cell-align-x
                                                   :align-y cell-align-y)
                                           (funcall printer item stream)))
                      items))
             args))))

(defmacro formatting-item-list ((&optional (stream t)
                                 &rest args
                                 &key x-spacing y-spacing n-columns n-rows
                                      stream-width stream-height
                                      max-width max-height
                                      initial-spacing (row-wise t) (move-cursor t)
                                      record-type &allow-other-keys)
                                &body body)
  (declare (ignore x-spacing y-spacing n-columns n-rows
                   stream-width stream-height
                   max-width max-height
                   initial-spacing row-wise move-cursor
                   record-type))
  (setf stream (stream-designator-symbol stream '*standard-output*))
  (gen-invoke-trampoline 'invoke-format-item-list
                         (list stream)
                         args
                         body))

;;; Helper function

(defun make-table-array (table-record)
  "Given a table record, creates an array of arrays of cells in row major
  order. Returns (array-of-cells number-of-rows number-of-columns)"
  (let* ((row-based (block
			find-table-type
		      (map-over-table-elements
		       (lambda (thing)
			 (cond ((row-output-record-p thing)
				(return-from find-table-type t))
			       ((column-output-record-p thing)
				(return-from find-table-type nil))
			       (t
				(error "Something is wrong."))))
		       table-record
		       :row-or-column)
		      ;; It's empty
		      (return-from make-table-array (values nil 0 0))))
	 (rows (make-array 1
			   :adjustable t
			   :fill-pointer (if row-based
					     0
					     nil)
			   :initial-element nil))
	 (number-of-columns 0))
    (if row-based
	(map-over-table-elements
	 (lambda (row)
	   (let ((row-array (make-array 4 :adjustable t :fill-pointer 0)))
	     (map-over-row-cells (lambda (cell)
				   (vector-push-extend cell row-array))
				 row)
	     (vector-push-extend row-array rows)
	     (maxf number-of-columns (length row-array))))
	 table-record
	 :row)
	(let ((col-index 0))
	  (map-over-table-elements
	   (lambda (col)
	     (let ((row-index 0))
	       (map-over-column-cells
		(lambda (cell)
		  (when (>= row-index (length rows))
		    (adjust-array rows (1+ row-index) :initial-element nil))
		  (let ((row-array (aref rows row-index)))
		    (cond ((null row-array)
			   (setf row-array
				 (make-array (1+ col-index)
					     :adjustable t
					     :initial-element nil))
			   (setf (aref rows row-index) row-array))
			  ((>= col-index (length row-array))
			   (adjust-array row-array (1+ col-index)
					 :initial-element nil))
			  (t nil))
		    (setf (aref row-array col-index) cell))
		  (incf row-index))
		col))
	     (incf col-index))
	   table-record
	   :column)
	  (setq number-of-columns col-index)))
    (values rows (length rows) number-of-columns)))
  
(defmethod adjust-table-cells ((table-record standard-table-output-record)
			       stream)
  (with-slots (x-spacing y-spacing equalize-column-widths) table-record
    ;; Note: for the purpose of layout it is pretty much irrelevant if
    ;;       this is a table by rows or a table by columns
    ;;
    ;; Since we have :baseline vertical alignment (and no :char
    ;; horizontal alignment like in HTML), we always work from rows.
    (multiple-value-bind (rows nrows ncols)
	(make-table-array table-record)
      (unless rows
	(return-from adjust-table-cells nil))

      (let ((widthen  (make-array ncols :initial-element 0))
	    (heights  (make-array nrows :initial-element 0))
	    (ascents  (make-array nrows :initial-element 0))
	    (descents (make-array nrows :initial-element 0)))
	;; collect widthen, heights
	(loop for row across rows
	   for i from 0 do
	   (loop for cell across row
	      for j from 0 do
	      ;; we have cell at row i col j at hand.
	      ;; width:
	      (multiple-value-bind (x1 y1 x2 y2) (bounding-rectangle* cell)
		(maxf (aref widthen j)
		      (max (- x2 x1) (cell-min-width cell)))
		(maxf (aref heights i)
		      (max (- y2 y1) (cell-min-height cell)))
		(when (eq (cell-align-y cell) :baseline)
		  (multiple-value-bind (baseline) (output-record-baseline cell)
		    (maxf (aref ascents i) baseline)
		    (maxf (aref descents i) (- y2 y1 baseline)))))))

	;; baseline aligned cells can force the row to be taller.
	(loop for i from 0 below nrows do
	     (maxf (aref heights i) (+ (aref ascents i) (aref descents i))))

	(when (slot-value table-record 'equalize-column-widths)
	  (setf widthen (make-array ncols :initial-element (reduce #'max widthen :initial-value 0))))

	(setf (slot-value table-record 'widths) widthen
	      (slot-value table-record 'heights) heights
	      (slot-value table-record 'rows) rows)
          
	;; Finally just put the cells where they belong.

	(multiple-value-bind (cx cy) (stream-cursor-position stream)
	  (loop for row across rows
	     for y = cy then (+ y h y-spacing)
	     for h across heights
	     for ascent across ascents
	     do
	     (loop for cell across row
		for x = cx then (+ x w x-spacing) 
		for w across widthen do
		(adjust-cell* cell x y w h ascent))))))))




(defmethod adjust-multiple-columns ((table standard-table-output-record) stream)
  (with-slots (widths heights rows
               multiple-columns multiple-columns-x-spacing x-spacing y-spacing)
      table
    (let* ((mcolumn-width
            ;; total width of a column of the "meta" table.
            (+ (reduce #'+ widths)
               (* (1- (length widths)) x-spacing)
               multiple-columns-x-spacing))
           (n-columns
            (max 1
                 (if (eq multiple-columns t)
                     (floor (+ (- (stream-text-margin stream)
                                  (stream-cursor-position stream))
                               multiple-columns-x-spacing)
                            (+ mcolumn-width multiple-columns-x-spacing))
                     multiple-columns)))
           (column-size (ceiling (length rows) n-columns)) )
      (let ((y 0) (dy 0))
        (loop for row across rows
              for h across heights
              for i from 0
              do
              (multiple-value-bind (ci ri) (floor i column-size)
                (when (zerop ri)
                    (setf dy (- y)))
                (let ((dx (* ci mcolumn-width)))
                  (loop for cell across row do
                        (multiple-value-bind (x y) (output-record-position cell)
                          (setf (output-record-position cell)
                                (values (+ x dx) (+ y dy))))))
                (incf y h)
                (incf y y-spacing)))) )))

(defmethod adjust-item-list-cells ((item-list standard-item-list-output-record)
                                   stream)
  (with-slots (x-spacing y-spacing initial-spacing row-wise) item-list
    ;;
    ;; What we do:
    ;;
    ;; First we collect the items, then we figure out the width of the
    ;; single initial column. While doing so we collect the heights.
    (let ((items nil)
          (width 0)
          (heights nil))
      ;;
      (map-over-item-cells (lambda (item)
                             (push item items))
                           item-list)
      (setf items (reverse items))
      (setf heights (make-array (length items)))
      ;;
      (loop for item in items
            for i from 0
            do
            (with-bounding-rectangle* (x1 y1 x2 y2) item
              (maxf width (- x2 x1))
              (setf (aref heights i) (- y2 y1))))
      ;;
      ;; Now figure out the number of rows and the number of columns to
      ;; layout to.
      ;;
      (let ((stream-width (- (stream-text-margin stream) (stream-cursor-position stream)
                             (if initial-spacing
                                 x-spacing
                                 0)))
            (N (length items))
            (column-width
             (+ width x-spacing)))
        ;; ### note that the floors below are still not correct
        (multiple-value-bind (n-columns n-rows)
            (with-slots (n-columns n-rows max-width max-height) item-list
              (cond (n-columns
                     (values n-columns (ceiling N n-columns)))
                    (n-rows
                     (values (ceiling N n-rows) n-rows))
                    (max-width
                     (let ((n-columns (max 1 (floor (+ max-width x-spacing)
                                                    (+ column-width x-spacing)))))
                       (values n-columns (ceiling N n-columns))))
                    (max-height
                     ;; difficult
                     ;; ###
                     (let ((n-rows (max 1 (floor (+ max-height y-spacing)
                                                 (+ (reduce #'max heights :initial-value 0)
                                                    (* (1- (length heights)) y-spacing)
                                                    y-spacing)))))
                       (values (ceiling N n-rows) n-rows)))
                    (t
                     (let ((n-columns (max 1 (floor (+ stream-width x-spacing)
                                                    (+ column-width x-spacing)))))
                       (values n-columns (ceiling N n-columns))))))
          ;;
          (cond (row-wise
                 ;; Here is the catch: When this is row-wise, this not
                 ;; not so different from a table.
                 ;; ### do the cells put alongside expose baseline adjust?
                 (let ((y 0))
                   (loop for yi below n-rows
                         while items
                         do
                         (let ((h 0))
                           (loop for xi below n-columns
                                 for x = (if initial-spacing (floor x-spacing 2) 0)
                                 then (+ x width x-spacing)
                                 while items
                                 do
                                 (let ((item (pop items)))
                                   (maxf h (bounding-rectangle-height item))
                                   (adjust-cell* item x y width
                                                 (bounding-rectangle-height item)
                                                 (output-record-baseline item))))
                           (incf y (+ h y-spacing))))))
                (t
                 ;; This is somewhat easier ...
                 (let (h)
                   (loop for xi below n-columns
                         for x = (if initial-spacing (floor x-spacing 2) 0)
                         then (+ x width x-spacing)
                         while items
                         do
                         (loop for yi below n-rows
                               for y = 0 then (+ y y-spacing h)
                               while items do
                               (let ((item (pop items)))
                                 (setf h (bounding-rectangle-height item))
                                 (adjust-cell* item x y width h (output-record-baseline item)))))))))))))

(defun adjust-cell* (cell x y w h ascent)
  (setf (output-record-position cell)
        (values
         (case (cell-align-x cell)
           ((nil :left)   x)            ;###
           (:center (+ x (/ (- w (bounding-rectangle-width cell)) 2)))
           (:right  (- (+ x w) (bounding-rectangle-width cell))))
         (case (cell-align-y cell)
           (:top    y)
           (:bottom (- (+ y h) (bounding-rectangle-height cell)))
           (:center (+ y (/ (- h (bounding-rectangle-height cell)) 2)))
           ((nil :baseline)
            (multiple-value-bind (baseline) (output-record-baseline cell)
              ;; make (+ y ascents) line up with (+ y1 b)
              ;; that is y+a = y1+b -> y1= y+a-b
              (+ y (- ascent baseline))))))))