Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv25992
Modified Files: incremental-redisplay.lisp Log Message: Big O changes, this time. Some more constant factors, too.
* Use a spatial tree for the "stay" records and query it. Note that I said "changes", not improvements. It's 1:30 in the morning, so I'll leave the benchmarking to others. (: * Also, build the list of gone-overlap, come-overlap, come and gone records "right" the first time around, so we can just return it unmodified, without having to mapcar (list x x) over them first.
--- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/04/20 22:53:15 1.57 +++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/04/20 23:21:35 1.58 @@ -759,7 +759,8 @@ (everywhere (or +everywhere+ (pane-viewport-region (updating-output-stream record)))) (was-table (make-hash-table :test #'equalp)) - (is-table (make-hash-table :test #'equalp))) + (is-table (make-hash-table :test #'equalp)) + (stay-tree (%make-tree-output-record-tree)))
(labels ((collect-1-was (record) (push record was) @@ -776,7 +777,8 @@ (t (let ((q (gethash (output-record-hash record) was-table))) (if (some #'(lambda (x) (output-record-equal record x)) q) - (push record stay) + (spatial-trees:insert + (make-tree-output-record-entry record 0) stay-tree) (push record come))))))) ;; Collect what was there (labels ((gather-was (record) @@ -827,29 +829,28 @@ (when check-overlapping (setf (values gone gone-overlap) (loop for k in gone - if (some (lambda (x) (region-intersects-region-p k x)) - stay) - collect k into gone-overlap* - else collect k into gone* + if (spatial-trees:search (%record-to-spatial-tree-rectangle k) + stay-tree) + collect (list k k) into gone-overlap* + else collect (list k k) into gone* finally (return (values gone* gone-overlap*)))) (setf (values come come-overlap) (loop for k in come - if (some (lambda (x) (region-intersects-region-p k x)) - stay) - collect k into come-overlap* - else collect k into come* + if (spatial-trees:search (%record-to-spatial-tree-rectangle k) + stay-tree) + collect (list k k) into come-overlap* + else collect (list k k) into come* finally (return (values come* come-overlap*))))) ;; Hmm, we somehow miss come-overlap ... (values ;; erases - (loop for k in gone collect (list k k)) + gone ;; moves nil ;; draws - (loop for k in come collect (list k k)) + come ;; erase overlapping - (append (loop for k in gone-overlap collect (list k k)) - (loop for k in come-overlap collect (list k k))) + (append gone-overlap come-overlap) ;; move overlapping nil)))))