improved the caching in the contour window drawing so it does allocation on each redraw

svn: r10964

original commit: 8c022426f44253464bb4c4baec9e0358fd7a5a50
This commit is contained in:
Robby Findler 2008-07-29 14:00:43 +00:00
parent 2f9180a470
commit c474319f09

View File

@ -819,15 +819,22 @@ WARNING: printf is rebound in the body of the unit to always
(set/f! lb 0) (set/f! lb 0)
(set/f! rb 0)) (set/f! rb 0))
(define cache-function #f) (define cache-function void)
(define cache-str #f) (define cache-str (make-string 1 #\space))
(define container-str (make-string 1 #\space))
(inherit get-text!)
(define/override (draw dc x y left top right bottom dx dy draw-caret) (define/override (draw dc x y left top right bottom dx dy draw-caret)
(let ([str (get-text 0 (get-count))]) (let ([len (get-count)])
(when (or (not cache-function) (unless (= len (string-length container-str))
(not (equal? cache-str str))) (set! container-str (make-string len #\space))
(set! cache-function (for-each/sections str)) (set! cache-function void))
(set! cache-str str))) (get-text! container-str 0 len 0)
(unless (string=? container-str cache-str)
(set! cache-function (for-each/sections container-str))
(set! cache-str (make-string len #\space))
(get-text! cache-str 0 len 0)))
(when (<= top y bottom) (when (<= top y bottom)
(cache-function dc x y))) (cache-function dc x y)))
@ -989,7 +996,6 @@ WARNING: printf is rebound in the body of the unit to always
(send delegate last-position) (send delegate last-position)
(send delegate last-position)) (send delegate last-position))
(loop (send snip next))))) (loop (send snip next)))))
(for-each (for-each
(λ (range) (λ (range)
(send delegate unhighlight-range (send delegate unhighlight-range