suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

optimized drawing a little bit

Browse Source 
svn: r9474
This commit is contained in:
Robby Findler 2008-04-25 13:52:21 +00:00
parent 88ac43f545
commit 00eb1303e4
1 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/drscheme/syncheck.ss
View File

@ -294,6 +294,7 @@ If the namespace does not, they are colored the unbound color.
(define tacked-hash-table (make-hasheq)) (define tacked-hash-table (make-hasheq))
(define cursor-location #f) (define cursor-location #f)
(define cursor-text #f) (define cursor-text #f)
(define cursor-eles #f)
(define/private (find-poss text left-pos right-pos) (define/private (find-poss text left-pos right-pos)
(let ([xlb (box 0)] (let ([xlb (box 0)]
[ylb (box 0)] [ylb (box 0)]
@ -385,6 +386,7 @@ If the namespace does not, they are colored the unbound color.
(set! arrow-vectors #f) (set! arrow-vectors #f)
(set! cursor-location #f) (set! cursor-location #f)
(set! cursor-text #f) (set! cursor-text #f)
(set! cursor-eles #f)
(when any-tacked? (when any-tacked?
(invalidate-bitmap-cache)) (invalidate-bitmap-cache))
(update-docs-background #f) (update-docs-background #f)
@ -644,6 +646,7 @@ If the namespace does not, they are colored the unbound color.
(when (and cursor-location cursor-text) (when (and cursor-location cursor-text)
(set! cursor-location #f) (set! cursor-location #f)
(set! cursor-text #f) (set! cursor-text #f)
(set! cursor-eles #f)
(let ([f (get-top-level-window)]) (let ([f (get-top-level-window)])
(when f (when f
(send f update-status-line 'drscheme:check-syntax:mouse-over #f))) (send f update-status-line 'drscheme:check-syntax:mouse-over #f)))
@ -661,15 +664,18 @@ If the namespace does not, they are colored the unbound color.
(let* ([arrow-vector (hash-ref arrow-vectors cursor-text (λ () #f))] (let* ([arrow-vector (hash-ref arrow-vectors cursor-text (λ () #f))]
[eles (and arrow-vector (vector-ref arrow-vector cursor-location))]) [eles (and arrow-vector (vector-ref arrow-vector cursor-location))])
(update-docs-background eles)
(when eles (unless (equal? cursor-eles eles)
(update-status-line eles) (set! cursor-eles eles)
(for-each (λ (ele) (update-docs-background eles)
(cond (when eles
[(arrow? ele) (update-status-line eles)
(update-arrow-poss ele)])) (for-each (λ (ele)
eles) (cond
(invalidate-bitmap-cache))))] [(arrow? ele)
(update-arrow-poss ele)]))
eles)
(invalidate-bitmap-cache)))))]
[else [else
(update-docs-background #f) (update-docs-background #f)
(let ([f (get-top-level-window)]) (let ([f (get-top-level-window)])
@ -678,6 +684,7 @@ If the namespace does not, they are colored the unbound color.
(when (or cursor-location cursor-text) (when (or cursor-location cursor-text)
(set! cursor-location #f) (set! cursor-location #f)
(set! cursor-text #f) (set! cursor-text #f)
(set! cursor-eles #f)
(invalidate-bitmap-cache))])) (invalidate-bitmap-cache))]))
(super on-event event)] (super on-event event)]
[(send event button-down? 'right) [(send event button-down? 'right)