[mcclim-cvs] CVS mcclim
ahefner
ahefner at common-lisp.net
Tue Mar 20 01:48:40 UTC 2007
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv22720
Modified Files:
recording.lisp
Log Message:
Optimize a few cases in recompute-extent-for-changed-child, generalizing
an optimization by Robert Strandh.
--- /project/mcclim/cvsroot/mcclim/recording.lisp 2007/02/05 03:06:14 1.130
+++ /project/mcclim/cvsroot/mcclim/recording.lisp 2007/03/20 01:48:38 1.131
@@ -608,10 +608,10 @@
(defmethod clear-output-record ((record basic-output-record))
(error "Cannot clear ~S." record))
-(defmethod clear-output-record :before ((record compound-output-record))
+(defmethod clear-output-record :before ((record compound-output-record))
(let ((sheet (find-output-record-sheet record)))
(when sheet
- (map-over-output-records #'note-output-record-lost-sheet record 0 0 sheet))))
+ (map-over-output-records #'note-output-record-lost-sheet record 0 0 sheet))))
(defmethod clear-output-record :after ((record compound-output-record))
;; XXX banish x and y
@@ -774,63 +774,78 @@
(setf (rectangle-edges* record)
(values new-x1 new-y1 new-x2 new-y2)))))))
-
(defmethod recompute-extent-for-changed-child
((record compound-output-record) changed-child
old-min-x old-min-y old-max-x old-max-y)
(with-bounding-rectangle* (ox1 oy1 ox2 oy2) record
(with-bounding-rectangle* (cx1 cy1 cx2 cy2) changed-child
- ;; If record is currently empty, use the child's bbox directly. Else..
- ;; Does the new rectangle of the child contain the original rectangle?
- ;; If so, we can use min/max to grow record's current rectangle.
- ;; If not, the child has shrunk, and we need to fully recompute.
- (multiple-value-bind (nx1 ny1 nx2 ny2)
- (cond
- ;; The child has been deleted; who knows what the
- ;; new bounding box might be.
- ((not (output-record-parent changed-child))
- (%tree-recompute-extent* record))
- ;; Only one child of record, and we already have the bounds.
- ((eql (output-record-count record) 1)
- (values cx1 cy1 cx2 cy2))
- ;; If our record occupied no space (had no children, or had only
- ;; children similarly occupying no space, hackishly determined by
- ;; null-bounding-rectangle-p), recompute the extent now, otherwise
- ;; the next COND clause would, as an optimization, attempt to extend
- ;; our current bounding rectangle, which is invalid.
- ((null-bounding-rectangle-p record)
- (%tree-recompute-extent* record))
- ;; In the following cases, we can grow the new bounding rectangle
- ;; from its previous state:
- ((or
- ;; If the child was originally empty, it should not have affected
- ;; previous computation of our bounding rectangle.
- ;; This is hackish for reasons similar to the above.
- (and (zerop old-min-x) (zerop old-min-y)
- (zerop old-max-x) (zerop old-max-y))
- ;; New child bounds contain old child bounds, so use min/max
- ;; to extend the already-calculated rectangle.
- (and (<= cx1 old-min-x) (<= cy1 old-min-y)
- (>= cx2 old-max-x) (>= cy2 old-max-y)))
- (values (min cx1 ox1) (min cy1 oy1)
- (max cx2 ox2) (max cy2 oy2)))
- ;; No shortcuts - we must compute a new bounding box from those of
- ;; all our children. We want to avoid this - in worst cases, such as
- ;; a toplevel output history, large graph, or table, there may exist
- ;; thousands of children. Without the above optimizations,
- ;; construction becomes O(N^2) due to bounding rectangle calculation.
- (t (%tree-recompute-extent* record)))
- ;; XXX banish x, y
- (with-slots (x y)
- record
- (setf x nx1 y ny1)
- (setf (rectangle-edges* record) (values nx1 ny1 nx2 ny2))
- (let ((parent (output-record-parent record)))
- (unless (or (null parent)
- (and (= nx1 ox1) (= ny1 oy1)
- (= nx2 ox2) (= nx2 oy2)))
- (recompute-extent-for-changed-child parent record
- ox1 oy1 ox2 oy2)))))))
+ (let ((child-was-empty (and (= old-min-x old-min-y) ; =(
+ (= old-max-x old-max-y))))
+ ;; If record is currently empty, use the child's bbox directly. Else..
+ ;; Does the new rectangle of the child contain the original rectangle?
+ ;; If so, we can use min/max to grow record's current rectangle.
+ ;; If not, the child has shrunk, and we need to fully recompute.
+ (multiple-value-bind (nx1 ny1 nx2 ny2)
+ (cond
+ ;; The child has been deleted, but none of its edges contribute
+ ;; to the bounding rectangle of the parent, so the bounding
+ ;; rectangle cannot be changed by its deletion.
+ ;; This is also true if the child was empty.
+ ((or child-was-empty
+ (and (output-record-parent changed-child)
+ (> old-min-x ox1)
+ (> old-min-y oy1)
+ (< old-max-x ox2)
+ (< old-max-y oy2)))
+ (values ox1 oy1 ox2 oy2))
+ ;; The child has been deleted; who knows what the
+ ;; new bounding box might be.
+ ((not (output-record-parent changed-child))
+ (%tree-recompute-extent* record))
+ ;; Only one child of record, and we already have the bounds.
+ ((eql (output-record-count record) 1)
+ (values cx1 cy1 cx2 cy2))
+ ;; If our record occupied no space (had no children, or had only
+ ;; children similarly occupying no space, hackishly determined by
+ ;; null-bounding-rectangle-p), recompute the extent now, otherwise
+ ;; the next COND clause would, as an optimization, attempt to extend
+ ;; our current bounding rectangle, which is invalid.
+ ((null-bounding-rectangle-p record)
+ (%tree-recompute-extent* record))
+ ;; In the following cases, we can grow the new bounding rectangle
+ ;; from its previous state:
+ ((or
+ ;; If the child was originally empty, it should not have affected
+ ;; previous computation of our bounding rectangle.
+ child-was-empty
+ ;; No child edge which may have defined the bounding rectangle of
+ ;; the parent has shrunk inward, so min/max the new child rectangle
+ ;; against the existing rectangle. Other edges of the child may have
+ ;; moved, but this can't affect the parent bounding rectangle.
+ (and (or (> old-min-x ox1) (>= old-min-x cx1))
+ (or (> old-min-y oy1) (>= old-min-y cy1))
+ (or (< old-max-x ox2) (<= old-max-x cx2))
+ (or (< old-max-y oy2) (<= old-max-y cy2))))
+ ;; In these cases, we can grow the rectangle using min/max.
+ (values (min cx1 ox1) (min cy1 oy1)
+ (max cx2 ox2) (max cy2 oy2)))
+ ;; No shortcuts - we must compute a new bounding box from those of
+ ;; all our children. We want to avoid this - in worst cases, such as
+ ;; a toplevel output history, large graph, or table, there may exist
+ ;; thousands of children. Without the above optimizations,
+ ;; construction becomes O(N^2) due to bounding rectangle calculation.
+ (t (%tree-recompute-extent* record)))
+ ;; XXX banish x, y
+ (with-slots (x y)
+ record
+ (setf x nx1 y ny1)
+ (setf (rectangle-edges* record) (values nx1 ny1 nx2 ny2))
+ (let ((parent (output-record-parent record)))
+ (unless (or (null parent)
+ (and (= nx1 ox1) (= ny1 oy1)
+ (= nx2 ox2) (= nx2 oy2)))
+ (recompute-extent-for-changed-child parent record
+ ox1 oy1 ox2 oy2))))))))
record)
;; There was once an :around method on recompute-extent-for-changed-child here,
@@ -1975,9 +1990,9 @@
(with-slots (strings) record
(if (= 1 (length strings))
(styled-string-string (first strings))
- (with-output-to-string (result)
- (loop for styled-string in strings
- do (write-string (styled-string-string styled-string) result))))))
+ (with-output-to-string (result)
+ (loop for styled-string in strings
+ do (write-string (styled-string-string styled-string) result))))))
;;; 16.3.4. Top-Level Output Records
(defclass stream-output-history-mixin ()
More information about the Mcclim-cvs
mailing list