[mcclim-cvs] CVS mcclim/Drei

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv15402/Drei

Modified Files:
	drei-redisplay.lisp 
Log Message:
Try to reduce the number of calls to `draw-rectangle*' in Drei.

This improved performance in my trivial test by 15%.


--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp	2008/01/14 18:42:43	1.27
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp	2008/01/14 19:57:02	1.28
@@ -594,17 +594,12 @@
         (with-accessors ((stroke-x1 x1) (stroke-y1 y1)
                          (stroke-x2 x2) (stroke-y2 y2)) stroke-dimensions
           (setf stroke-x1 0 stroke-y1 0
-                stroke-x2 0 stroke-y2 0))))
-    ;; Clear from end of line to end of sheet.
-    (clear-rectangle* stream line-x2 line-y1
-                      (bounding-rectangle-width stream)
-                      (+ line-y1 (max line-height old-line-height)
-                         (stream-vertical-spacing stream)))))
+                stroke-x2 0 stroke-y2 0))))))
 
-(defun draw-line-strokes (stream view initial-pump-state
+(defun draw-line-strokes (pane view initial-pump-state
                           start-offset cursor-x cursor-y)
   "Pump strokes from `view', using `initial-pump-state' to begin
-with, and draw them on `stream'. The line is set to start at the
+with, and draw them on `pane'. The line is set to start at the
 buffer offset `start-offset', and will be drawn starting
 at (`cursor-x', `cursor-y')."
   (let* ((line (line-information view (displayed-lines-count view)))
@@ -612,7 +607,7 @@
          (old-line-width (dimensions-width (line-dimensions line)))
          (orig-x-offset cursor-x)
          (offset-change (- start-offset (line-start-offset line)))
-         (line-spacing (stream-vertical-spacing stream)))
+         (line-spacing (stream-vertical-spacing pane)))
     (setf (line-start-offset line) start-offset
           (line-stroke-count line) 0)
     ;; So yeah, this is fairly black magic, but it's not actually
@@ -624,29 +619,38 @@
            for stroke-dimensions = (stroke-dimensions stroke)
            for pump-state = (put-stroke view line initial-pump-state offset-change) then
            (put-stroke view line pump-state offset-change)
-           do (update-stroke-dimensions stream view stroke cursor-x cursor-y)
+           do (update-stroke-dimensions pane view stroke cursor-x cursor-y)
            (setf cursor-x (x2 stroke-dimensions))
            maximizing (dimensions-height stroke-dimensions) into line-height
            maximizing (+ (center stroke-dimensions) cursor-y) into baseline
            summing (dimensions-width stroke-dimensions) into line-width
            when (stroke-at-end-of-line (buffer view) stroke)
            return (values line-width line-height baseline pump-state))
+      ;; Loop over the strokes and clear the parts of the pane that
+      ;; has to be redrawn, trying to minimise the number of calls to
+      ;; `clear-rectangle*'..
+      (flet ((maybe-clear (x1 x2)
+               (unless (= x1 x2)
+                 (clear-rectangle* pane x1 cursor-y x2
+                                   (+ cursor-y line-height line-spacing)))))
+        (loop with last-clear-x = orig-x-offset
+           for stroke-index below (line-stroke-count line)
+           for stroke = (aref (line-strokes line) stroke-index)
+           for stroke-dimensions = (stroke-dimensions stroke)
+           do (unless (= baseline (+ cursor-y (center stroke-dimensions)))
+                (invalidate-stroke stroke))
+           (unless (stroke-dirty stroke)
+             (maybe-clear last-clear-x (x1 stroke-dimensions))
+             (setf last-clear-x (x2 stroke-dimensions)))
+           ;; This clears from end of line to the end of the sheet.
+           finally (maybe-clear last-clear-x (bounding-rectangle-width pane))))
       ;; Now actually draw them in a way that makes sure they all
       ;; touch the bottom of the line.
-      (loop with last-clear-x = orig-x-offset
-         for stroke-index below (line-stroke-count line)
+      (loop for stroke-index below (line-stroke-count line)
          for stroke = (aref (line-strokes line) stroke-index)
          for stroke-dimensions = (stroke-dimensions stroke)
-         do (unless (= baseline (+ cursor-y (center stroke-dimensions)))
-              (invalidate-stroke stroke))
-         (when (stroke-dirty stroke)
-           (clear-rectangle* stream (x1 stroke-dimensions) cursor-y
-                             (x2 stroke-dimensions)
-                             (+ cursor-y line-height line-spacing))
-           (setf last-clear-x (x2 stroke-dimensions)))
-         (draw-stroke stream view stroke
-                      (x1 stroke-dimensions) baseline)
-         finally (progn (end-line-cleaning-up stream line orig-x-offset cursor-y
+         do (draw-stroke pane view stroke (x1 stroke-dimensions) baseline)
+         finally (progn (end-line-cleaning-up pane line orig-x-offset cursor-y
                                               line-width old-line-width
                                               line-height old-line-height)
                         (incf (displayed-lines-count view))