(defstruct box x0 y0 x1 y1 children bordered)

(defun box-size (b)
  (values (- (box-x1 b) (box-x0 b))
          (- (box-y1 b) (box-y0 b))))

(defun box-translate (b dx dy)
  (make-box :x0 (+ (box-x0 b) dx)
            :y0 (+ (box-y0 b) dy)
            :x1 (+ (box-x1 b) dx)
            :y1 (+ (box-y1 b) dy)
            :children (loop for child in (box-children b)
                            collect (box-translate child dx dy))
            :bordered (box-bordered b)))

(defun box-translate-to (b x y)
  (box-translate b (- x (box-x0 b)) (- y (box-y0 b))))

(defun box-surround (b delta)
  (make-box :x0 (- (box-x0 b) delta)
            :y0 (- (box-y0 b) delta)
            :x1 (+ (box-x1 b) delta)
            :y1 (+ (box-y1 b) delta)
            :children (list b)
            :bordered nil))

(defun bordered (b) (setf (box-bordered b) t) b)

(defun box-adjoin (b1 b2 delta direction)
  (multiple-value-bind (x1 y1) (box-size b1)
    (multiple-value-bind (x2 y2) (box-size b2)
      (ecase direction
        ((:h)
         (make-box :x0 0 :y0 0
                   :x1 (+ x1 x2 (* 3 delta))
                   :y1 (+ (max y1 y2) (* 2 delta))
                   :children (list (box-translate-to b1 delta delta)
                                   (box-translate-to b2 (+ x1 (* 2 delta)) delta))
                   :bordered nil))
        ((:v)
         (make-box :x0 0 :y0 0
                   :x1 (+ (max x1 x2) (* 2 delta))
                   :y1 (+ y1 y2 (* 3 delta))
                   :children (list (box-translate-to b1 delta delta)
                                   (box-translate-to b2 delta (+ y1 (* 2 delta))))
                   :bordered nil))))))

(defun orthogonal (direction)
  (ecase direction
    ((:h) :v)
    ((:v) :h)))

(defun numerals (n size delta direction)
  (if (zerop n)
    (box-surround (make-box :x0 0 :y0 0 :x1 size :y1 size :bordered t) delta)
    (box-adjoin (numeral n size delta (orthogonal direction))
                (numerals (1- n) size delta (orthogonal direction))
                delta
                direction)))

(defun numeral (n size delta direction)
  (if (zerop n)
    (make-box :x0 0 :y0 0 :x1 size :y1 size :bordered t)
    (bordered (numerals (1- n) size delta direction))))

(defun flatten (b)
  (let ((rest (loop for child in (box-children b) nconc (flatten child))))
    (if (box-bordered b)
      (cons (list (box-x0 b) (box-y0 b) (box-x1 b) (box-y1 b)) rest)
      rest)))

(defun show-flattened (boxes dx dy &optional (stream t))
  (princ "%!PS
/box { /y1 exch def /x1 exch def /y0 exch def /x0 exch def
       x0 y0 moveto x1 y0 lineto x1 y1 lineto x0 y1 lineto closepath stroke }
     bind def
"  stream)
  (loop for (x0 y0 x1 y1) in boxes do
    (format stream "~A ~A ~A ~A box~%" (+ x0 dx) (+ y0 dy) (+ x1 dx) (+ y1 dy)))
  (princ "showpage
" stream))