Adding COLUMN-BOX, and alignment options

blit.lisp

@@ -215,25 +215,39 @@ This variable is sometimes used to disable recording for editing purposes.")
 ;;;    **
 (defmethod blit (canvas (box row-box) x y)
   (let ((padding (row-box-padding box))
-        #+#:ignore
         (height (height box))
-        #+#:ignore
-        (baseline (baseline box))
+        (align (row-box-align box))
         (extent (height-above-baseline box)))
     (labels ((rec (boxes x)
                (unless (null boxes)
-                 (let ((the-box (first boxes)))
-                   (blit canvas
-                         the-box
-                         x
-                         ;; Align on the baselines.
-                         (+ y (- extent (height-above-baseline the-box)))
-                         #+#:ignore     ; This will vertically center
-                         (+ y (floor (- height (height the-box)) 2))))
-
-                 (rec (rest boxes) (+ x padding (width (first boxes)))))))
+                 (let* ((the-box (first boxes))
+                        (delta
+                          (ecase align
+                            (:top 0)
+                            (:middle (floor (- height (height the-box)) 2))
+                            (:baseline (- extent (height-above-baseline the-box)))
+                            (:bottom (- height (height the-box))))))
+                   (blit canvas the-box x (+ y delta))
+                   (rec (rest boxes) (+ x padding (width the-box)))))))
       (rec (row-box-contents box) x))))
 
+(defmethod blit (canvas (box column-box) x y)
+  (let ((padding (column-box-padding box))
+        (align (column-box-align box))
+        ;; Width of a column box is defined to be the max width of contents
+        (width (width box)))
+    (labels ((rec (boxes y)
+               (unless (null boxes)
+                 (let* ((the-box (first boxes))
+                        (delta
+                          (ecase align
+                            (:left 0)
+                            (:middle (floor (- width (width the-box)) 2))
+                            (:right (- width (width the-box))))))
+                   (blit canvas the-box (+ x delta) y)
+                   (rec (rest boxes) (+ y (height the-box) padding))))))
+      (rec (column-box-contents box) y))))
+
 (defmethod blit (canvas (box picture-box) x y)
   (loop :for c :in (picture-box-picture box)
         :for i :from 0

boxes.lisp

@@ -350,16 +350,26 @@ N.B., Successive calls may return the same object."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Row Boxes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(deftype vertical-alignment ()
+  "The alignments available for ROW-BOX."
+  '(member :top :baseline :middle :bottom))
+
 (defclass row-box (box)
   ((padding :initarg :padding
             :type (integer 0)
             :accessor row-box-padding)
    (contents :initarg :contents
-             :accessor row-box-contents))
+             :accessor row-box-contents)
+   (align :initarg :align
+          :accessor row-box-align
+          :type verticle-alignment
+          :documentation "Contents can be aligned :TOP,
+          :BASELINE (default), :MIDDLE, or :BOTTOM."))
   (:documentation "A horizontal concatenation of boxes."))
 
-(defun row-box (boxes &key (padding 0))
+(defun row-box (boxes &key (padding 0) (align :baseline))
   (make-instance 'row-box :padding padding
+                          :align align
                           :contents boxes))
 
 (defmethod width ((box row-box))
@@ -537,3 +547,45 @@ N.B., Successive calls may return the same object."
 
 (defmethod baseline ((box sqrt-box))
   (baseline (sqrt-box-base box)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; COLUMN BOXES ;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deftype horizontal-alignment ()
+  "HORIZONTAL-ALIGNMENT specifies the alignments for COLUMN-BOX."
+  '(member :left :middle :right))
+
+(defclass column-box (box)
+  ((padding :initarg :padding
+            :type (integer 0)
+            :accessor column-box-padding)
+   (align :initarg :align
+          :accessor column-box-align
+          :type horizontal-alignment
+          :documentation "Contents can be aligned :LEFT (default),
+          :MIDDLE, or :RIGHT.")
+   (contents :initarg :contents
+             :accessor column-box-contents))
+  (:documentation "A vertical concatenation of boxes."))
+
+(defun column-box (boxes &key (padding 0) (align :left))
+  (make-instance 'column-box :padding padding
+                             :align align
+                             :contents boxes))
+
+(defmethod width ((box column-box))
+  (maximum (column-box-contents box)
+           :key #'width))
+
+(defmethod height ((box column-box))
+  (let* ((items (column-box-contents box))
+         (nb-items (length items)))
+    (+ (sum items :key #'height)
+       (if (zerop nb-items) ; account for padding
+           0
+           (* (1- nb-items)
+              (column-box-padding box))))))
+
+(defmethod baseline ((box column-box))
+  (floor (height box) 2))
+
+

package.lisp

@@ -45,7 +45,10 @@
    #:frac-box
    #:*frac-box-vinculum-padding*
    #:frame-box
+   #:vertical-alignment
    #:row-box
+   #:horizontal-alignment
+   #:column-box
    #:picture-box
    #:limits-box
    #:sqrt-box