[wip] array-box

blit.lisp

@@ -382,3 +382,32 @@ This variable is sometimes used to disable recording for editing purposes.")
           (sqrt-box-base box)
           (+ 2 shift x)
           (1+ y))))
+
+(defun array-box-row-max-height (box row-num)
+  (loop :with dims := (array-box-cell-dimensions box)
+        :for col-num :below (array-dimension dims 1)
+        :maximize (car (aref dims row-num col-num))))
+
+(defun array-box-column-max-width (box col-num)
+  (loop :with dims := (array-box-cell-dimensions box)
+        :for row-num :below (array-dimension dims 0)
+        :maximize (cdr (aref dims row-num col-num))))
+
+(defmethod blit (canvas (box array-box) x y)
+  (width box)
+  (height box)
+  (let* ((contents (array-box-contents box))
+         (rows (array-dimension contents 0))
+         (cols (array-dimension contents 1))
+         (cell-dims (array-box-cell-dimensions box)))
+    (let ((y-offset 0))
+      (dotimes (row rows)
+        (let ((x-offset 0)
+              (max-height (array-box-row-max-height box row)))
+          (dotimes (col cols)
+            (let ((max-width (array-box-column-max-width box col)))
+              (destructuring-bind (cell-height . cell-width) (aref cell-dims row col)
+                (declare (ignore cell-height cell-width))
+                (blit canvas (aref contents row col) (+ x x-offset) (+ y y-offset))
+                (incf x-offset (+ max-width (array-box-column-padding box))))))
+          (incf y-offset (+ max-height (array-box-row-padding box))))))))

boxes.lisp

@@ -1,6 +1,6 @@
 ;;;; boxes.lisp
 ;;;;
-;;;; Copyright (c) 2013-2018 Robert Smith
+;;;; Copyright (c) 2013-2019 Robert Smith
 ;;;;
 ;;;; Basic building blocks of a "formula".
 
@@ -362,7 +362,7 @@ N.B., Successive calls may return the same object."
              :accessor row-box-contents)
    (align :initarg :align
           :accessor row-box-align
-          :type verticle-alignment
+          :type vertical-alignment
           :documentation "Contents can be aligned :TOP,
           :BASELINE (default), :MIDDLE, or :BOTTOM."))
   (:documentation "A horizontal concatenation of boxes."))
@@ -589,3 +589,75 @@ N.B., Successive calls may return the same object."
   (floor (height box) 2))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; ARRAY BOXES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass array-box (box)
+  ((row-padding :initarg :row-padding
+                :type (integer 0)
+                :reader array-box-row-padding)
+   (row-alignments :initarg :row-alignments
+                   :reader array-box-row-alignments
+                   :type vector ;; vector of VERTICAL-ALIGNMENT
+                   :documentation "Contents can be aligned :TOP, :BASELINE (default), :MIDDLE, or :BOTTOM.")
+   (column-padding :initarg :column-padding
+                   :type (integer 0)
+                   :reader array-box-column-padding
+                   :documentation "The spacing between each column.")
+   (column-alignments :initarg :column-alignments
+                      :reader array-box-column-alignments
+                      :type vector ;; vector of HORIZONTAL-ALIGNMENT
+                      :documentation "Contents can be aligned :LEFT (default), :MIDDLE, or :RIGHT.")
+   (contents :initarg :contents
+             :accessor array-box-contents)
+   (cell-dimensions :initarg :cell-dimensions
+                    :reader array-box-cell-dimensions
+                    ;; array of (HEIGHT . WIDTH) conses.
+                    ))
+  (:default-initargs :row-padding 0
+                     :column-padding 1)
+  (:documentation "A vertical concatenation of boxes."))
+
+(defun make-array-box (rows cols)
+  (make-instance 'array-box :row-padding 1
+                            :column-padding 1
+                            :row-alignments (make-array cols :initial-element ':baseline)
+                            :column-alignments (make-array cols :initial-element ':middle)
+                            :contents (make-array (list rows cols) :initial-element (box nil))
+                            :cell-dimensions (let ((a (make-array (list rows cols))))
+                                               (dotimes (row rows a)
+                                                 (dotimes (col cols)
+                                                   (setf (aref a row col) (cons 0 0)))))))
+
+(defmethod width ((box array-box))
+  (let* ((contents (array-box-contents box))
+         (num-rows (array-dimension contents 0))
+         (num-cols (array-dimension contents 1))
+         (cell-dimensions (array-box-cell-dimensions box)))
+    (flet ((col-width (col-num)
+             (loop :for row-num :below num-rows
+                   :for w := (width (aref contents row-num col-num))
+                   :do (rplacd (aref cell-dimensions row-num col-num) w)
+                   :maximize w)))
+      (+ (* (1- num-cols)
+            (array-box-column-padding box))
+         (loop :for col-num :below num-cols
+               :sum (col-width col-num))))))
+
+(defmethod height ((box array-box))
+  (let* ((contents (array-box-contents box))
+         (num-rows (array-dimension contents 0))
+         (num-cols (array-dimension contents 1))
+         (cell-dimensions (array-box-cell-dimensions box)))
+    (flet ((row-height (row-num)
+             (loop :for col-num :below num-cols
+                   :for h := (height (aref contents row-num col-num))
+                   :do (rplaca (aref cell-dimensions row-num col-num) h)
+                   :maximize h)))
+      (+ (* (1- num-rows)
+            (array-box-row-padding box))
+         (loop :for row-num :below num-rows
+               :sum (row-height row-num))))))
+
+(defmethod baseline ((box array-box))
+  (floor (height box) 2))
+