/[mcclim]/mcclim/recording.lisp
ViewVC logotype

Diff of /mcclim/recording.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.140 by ahefner, Sun Feb 3 22:54:13 2008 UTC revision 1.141 by ahefner, Sun Apr 13 07:32:40 2008 UTC
# Line 991  were added." Line 991  were added."
991    (remhash entry (%tree-record-children-cache record)))    (remhash entry (%tree-record-children-cache record)))
992    
993  (defmethod output-record-children ((record standard-tree-output-record))  (defmethod output-record-children ((record standard-tree-output-record))
994    (map 'list    (with-bounding-rectangle* (min-x min-y max-x max-y) record
995         #'tree-output-record-entry-record      (map 'list
996         (spatial-trees:search           #'tree-output-record-entry-record
997          (%record-to-spatial-tree-rectangle record)           (spatial-trees:search
998          ;; The form below intends to fix output-record-children not            ;; Originally, (%record-to-spatial-tree-rectangle record).
999          ;; reporting empty children, which may lie outside the reported            ;; The form below intends to fix output-record-children not
1000          ;; bounding rectangle of their parent.            ;; reporting empty children, which may lie outside the reported
1001          ;; Assumption: null bounding records are always at the origin.            ;; bounding rectangle of their parent.
1002          ;; I've never noticed this violated, but it's out of line with            ;; Assumption: null bounding records are always at the origin.
1003          ;; what null-bounding-rectangle-p checks, and setf of            ;; I've never noticed this violated, but it's out of line with
1004          ;; output-record-position may invalidate it. Seems to work, but            ;; what null-bounding-rectangle-p checks, and setf of
1005          ;; fix that and try again later.            ;; output-record-position may invalidate it. Seems to work, but
1006          #+NIL            ;; fix that and try again later.
1007          (rectangles:make-rectangle            ;; Note that max x or y may be less than zero..
1008           :lows (list 0 0) #| `(,(bounding-rectangle-min-x r) ,(bounding-rectangle-min-y r)) |#            (rectangles:make-rectangle
1009           :highs `(,(bounding-rectangle-max-x record) ,(bounding-rectangle-max-y record)))             :lows  (list (min 0 min-x) (min 0 min-y))
1010         (%tree-record-children record))))             :highs (list (max 0 max-x) (max 0 max-y)))
1011              (%tree-record-children record)))))
1012    
1013  (defmethod add-output-record (child (record standard-tree-output-record))  (defmethod add-output-record (child (record standard-tree-output-record))
1014    (let ((entry (make-tree-output-record-entry child (incf (last-insertion-nr record)))))    (let ((entry (make-tree-output-record-entry child (incf (last-insertion-nr record)))))

Legend:
Removed from v.1.140  
changed lines
  Added in v.1.141

  ViewVC Help
Powered by ViewVC 1.1.5