extend invalidate-bitmap-cache' in editor<%>' with 'display-end option
which the framework's background-rectangle implementation can use to queue refreshes for changing rectangles, instead of requiring a full-canvas refresh
This commit is contained in:
Matthew Flatt
parent
5afc2970a3
commit
aac7e0b58a
|
|
@ -144,98 +144,45 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(send (get-style-list) find-named-style "Standard"))
|
||||
|
||||
(define/private (invalidate-rectangles rectangles)
|
||||
(let ([b1 (box 0)]
|
||||
[b2 (box 0)]
|
||||
[b3 (box 0)]
|
||||
[b4 (box 0)]
|
||||
[canvases (get-canvases)])
|
||||
(let-values ([(min-left max-right)
|
||||
(cond
|
||||
[(null? canvases)
|
||||
(let ([admin (get-admin)])
|
||||
(if admin
|
||||
(begin
|
||||
(send admin get-view b1 b2 b3 b4)
|
||||
(let* ([this-left (unbox b1)]
|
||||
[this-width (unbox b3)]
|
||||
[this-right (+ this-left this-width)])
|
||||
(values this-left
|
||||
this-right)))
|
||||
(values #f #f)))]
|
||||
[else
|
||||
(let loop ([left #f]
|
||||
[right #f]
|
||||
[canvases canvases])
|
||||
(cond
|
||||
[(null? canvases)
|
||||
(values left right)]
|
||||
[else
|
||||
(let-values ([(this-left this-right)
|
||||
(send (car canvases)
|
||||
call-as-primary-owner
|
||||
(λ ()
|
||||
(send (get-admin) get-view b1 b2 b3 b4)
|
||||
(let* ([this-left (unbox b1)]
|
||||
[this-width (unbox b3)]
|
||||
[this-right (+ this-left this-width)])
|
||||
(values this-left
|
||||
this-right))))])
|
||||
(if (and left right)
|
||||
(loop (min this-left left)
|
||||
(max this-right right)
|
||||
(cdr canvases))
|
||||
(loop this-left
|
||||
this-right
|
||||
(cdr canvases))))]))])])
|
||||
(when (and min-left max-right)
|
||||
(let loop ([left #f]
|
||||
[top #f]
|
||||
[right #f]
|
||||
[bottom #f]
|
||||
[rectangles rectangles]
|
||||
[refresh? #f])
|
||||
(cond
|
||||
[(null? rectangles)
|
||||
(when left
|
||||
(let ([width (- right left)]
|
||||
[height (- bottom top)])
|
||||
(when refresh?
|
||||
(for-each (λ (canvas) (send canvas refresh))
|
||||
canvases))
|
||||
(when (and (> width 0)
|
||||
(> height 0))
|
||||
(invalidate-bitmap-cache left top width height))))]
|
||||
[else (let* ([r (car rectangles)]
|
||||
|
||||
[adjust (λ (w f)
|
||||
(+ w (f (case (rectangle-style r)
|
||||
[(dot hollow-ellipse) 8]
|
||||
[else 0]))))]
|
||||
[this-left (if (number? (rectangle-left r))
|
||||
(adjust (rectangle-left r) -)
|
||||
min-left)]
|
||||
[this-right (if (number? (rectangle-right r))
|
||||
(adjust (rectangle-right r) +)
|
||||
max-right)]
|
||||
[this-top (adjust (rectangle-top r) -)]
|
||||
[this-bottom (adjust (rectangle-bottom r) +)])
|
||||
(if (and left top right bottom)
|
||||
(loop (min this-left left)
|
||||
(min this-top top)
|
||||
(max this-right right)
|
||||
(max this-bottom bottom)
|
||||
(cdr rectangles)
|
||||
(or refresh?
|
||||
(not (number? (rectangle-left r)))
|
||||
(not (number? (rectangle-right r)))))
|
||||
(loop this-left
|
||||
this-top
|
||||
this-right
|
||||
this-bottom
|
||||
(cdr rectangles)
|
||||
(or refresh?
|
||||
(not (number? (rectangle-left r)))
|
||||
(not (number? (rectangle-right r)))))))]))))))
|
||||
(let loop ([left #f]
|
||||
[top #f]
|
||||
[right #f]
|
||||
[bottom #f]
|
||||
[rectangles rectangles])
|
||||
(cond
|
||||
[(null? rectangles)
|
||||
(when left
|
||||
(let ([width (if (number? right) (- right left) 'display-end)]
|
||||
[height (if (number? bottom) (- bottom top) 'display-end)])
|
||||
(when (and (or (symbol? width) (> width 0))
|
||||
(or (symbol? height) (> height 0)))
|
||||
(invalidate-bitmap-cache left top width height))))]
|
||||
[else (let* ([r (car rectangles)]
|
||||
[adjust (λ (w f)
|
||||
(+ w (f (case (rectangle-style r)
|
||||
[(dot hollow-ellipse) 8]
|
||||
[else 0]))))]
|
||||
[this-left (if (number? (rectangle-left r))
|
||||
(adjust (rectangle-left r) -)
|
||||
0.0)]
|
||||
[this-right (if (number? (rectangle-right r))
|
||||
(adjust (rectangle-right r) +)
|
||||
'display-end)]
|
||||
[this-top (adjust (rectangle-top r) -)]
|
||||
[this-bottom (adjust (rectangle-bottom r) +)])
|
||||
(if (and left top right bottom)
|
||||
(loop (min this-left left)
|
||||
(min this-top top)
|
||||
(if (and (number? this-right) (number? right))
|
||||
(max this-right right)
|
||||
'display-end)
|
||||
(max this-bottom bottom)
|
||||
(cdr rectangles))
|
||||
(loop this-left
|
||||
this-top
|
||||
this-right
|
||||
this-bottom
|
||||
(cdr rectangles))))])))
|
||||
|
||||
(define/private (recompute-range-rectangles)
|
||||
(let* ([b1 (box 0)]
|
||||
|
|
|
|||
|
|
@ -137,8 +137,10 @@
|
|||
|
||||
(define update-left 0.0)
|
||||
(define update-right 0.0)
|
||||
(define update-right-end #f)
|
||||
(define update-top 0.0)
|
||||
(define update-bottom 0.0)
|
||||
(define update-bottom-end #f)
|
||||
(define update-nonempty? #f)
|
||||
(define no-implicit-update? #f)
|
||||
|
||||
|
|
@ -1409,8 +1411,8 @@
|
|||
delayedscroll-x delayedscroll-y
|
||||
delayedscroll-w delayedscroll-h
|
||||
#t delayedscrollbias)))
|
||||
(let ([r (+ x w)]
|
||||
[b (+ y h)])
|
||||
(let ([r (if (symbol? w) x (+ x w))]
|
||||
[b (if (symbol? h) y (+ y h))])
|
||||
(let ([x (max x 0.0)]
|
||||
[y (max y 0.0)]
|
||||
[r (max r 0.0)]
|
||||
|
|
@ -1422,51 +1424,42 @@
|
|||
(begin
|
||||
(set! update-top y)
|
||||
(set! update-left x)
|
||||
(set! update-bottom (if (h . < . 0) h b))
|
||||
(set! update-right (if (w . < . 0) w r))
|
||||
(set! update-bottom b)
|
||||
(set! update-bottom-end (and (symbol? h) h))
|
||||
(set! update-right r)
|
||||
(set! update-right-end (and (symbol? w) w))
|
||||
(set! update-nonempty? #t))
|
||||
(begin
|
||||
(set! update-top (min y update-top))
|
||||
(set! update-left (min x update-left))
|
||||
(let ([ub (if (and (h . < . 0) (update-bottom . > . 0))
|
||||
(- update-bottom)
|
||||
update-bottom)])
|
||||
(set! update-bottom
|
||||
(if (ub . < . 0)
|
||||
(if (and (h . < . 0) (h . < . ub))
|
||||
h
|
||||
(if (and (h . > . 0)
|
||||
((- b) . < . ub))
|
||||
(- b)
|
||||
ub))
|
||||
(max b ub))))
|
||||
(let ([ur (if (and (w . < . 0) (update-right . > . 0))
|
||||
(- update-right)
|
||||
update-right)])
|
||||
(set! update-right
|
||||
(if (ur . < . 0)
|
||||
(if (and (w . < . 0) (w . < . ur))
|
||||
w
|
||||
(if (and (w . > . 0)
|
||||
((- r) . < . ur))
|
||||
(- r)
|
||||
ur))
|
||||
(max r ur))))))
|
||||
(set! update-bottom (max b update-bottom))
|
||||
(when (symbol? b)
|
||||
(if (eq? b 'display-end)
|
||||
(set! update-bottom-end 'display-end)
|
||||
(unless (eq? update-bottom-end 'display-end)
|
||||
(set! update-bottom-end 'end))))
|
||||
(set! update-right (max r update-right))
|
||||
(when (symbol? r)
|
||||
(if (eq? r 'display-end)
|
||||
(set! update-right-end 'display-end)
|
||||
(unless (eq? update-right-end 'display-end)
|
||||
(set! update-right-end 'end))))))
|
||||
|
||||
(unless (or (positive? sequence)
|
||||
(not s-admin)
|
||||
flow-locked?)
|
||||
(check-recalc)
|
||||
|
||||
(when (update-bottom . < . 0)
|
||||
(set! update-bottom (- update-bottom))
|
||||
(when (update-bottom . < . real-height)
|
||||
(set! update-bottom real-height)))
|
||||
|
||||
(when (update-right . < . 0)
|
||||
(set! update-right (- update-right))
|
||||
(when (update-right . < . real-width)
|
||||
(set! update-right real-width)))
|
||||
(let-boxes ([vx 0.0] [vy 0.0] [vw 0.0] [vh 0.0])
|
||||
(when (or (eq? update-bottom-end 'display-end)
|
||||
(eq? update-right-end 'display-end))
|
||||
(send s-admin get-max-view x y w h))
|
||||
(case update-bottom-end
|
||||
[(end) (set! update-bottom (max update-bottom real-height))]
|
||||
[(display-end) (set! update-bottom (max update-bottom vh))])
|
||||
(case update-right-end
|
||||
[(end) (set! update-right (max update-right real-width))]
|
||||
[(display-end) (set! update-right (max update-right vw))]))
|
||||
|
||||
(set! update-nonempty? #f)
|
||||
|
||||
|
|
@ -1520,9 +1513,9 @@
|
|||
|
||||
(def/override (invalidate-bitmap-cache [real? [x 0.0]]
|
||||
[real? [y 0.0]]
|
||||
[(make-alts nonnegative-real? (symbol-in end)) [w 'end]]
|
||||
[(make-alts nonnegative-real? (symbol-in end)) [h 'end]])
|
||||
(update x y (if (symbol? w) -1.0 w) (if (symbol? h) -1.0 h)))
|
||||
[(make-alts nonnegative-real? (symbol-in end display-end)) [w 'end]]
|
||||
[(make-alts nonnegative-real? (symbol-in end display-end)) [h 'end]])
|
||||
(update x y w h))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -277,8 +277,8 @@
|
|||
(define refresh-end 0)
|
||||
(define refresh-l 0.0)
|
||||
(define refresh-t 0.0)
|
||||
(define refresh-r 0.0)
|
||||
(define refresh-b 0.0)
|
||||
(define refresh-r 0.0) ; can be 'display-end
|
||||
(define refresh-b 0.0) ; can be 'display-end
|
||||
|
||||
(define last-draw-l 0.0)
|
||||
(define last-draw-t 0.0)
|
||||
|
|
@ -3908,8 +3908,8 @@
|
|||
#t))))
|
||||
|
||||
(define/public (refresh-box L T w h)
|
||||
(let ([B (+ T h)]
|
||||
[R (+ L w)])
|
||||
(let ([B (if (eq? h 'display-end) h (+ T h))]
|
||||
[R (if (eq? w 'display-end) w (+ L w))])
|
||||
(if refresh-box-unset?
|
||||
(begin
|
||||
(set! refresh-l L)
|
||||
|
|
@ -3920,11 +3920,13 @@
|
|||
(begin
|
||||
(when (L . < . refresh-l)
|
||||
(set! refresh-l L))
|
||||
(when (R . > . refresh-r)
|
||||
(when (or (eq? R 'display-end)
|
||||
(R . > . refresh-r))
|
||||
(set! refresh-r R))
|
||||
(when (T . < . refresh-t)
|
||||
(set! refresh-t T))
|
||||
(when (B . > . refresh-b)
|
||||
(when (or (eq? B 'display-end)
|
||||
(B . > . refresh-b))
|
||||
(set! refresh-b B))))
|
||||
|
||||
(set! draw-cached-in-bitmap? #f)))
|
||||
|
|
@ -3943,10 +3945,10 @@
|
|||
|
||||
(def/override (invalidate-bitmap-cache [real? [x 0.0]]
|
||||
[real? [y 0.0]]
|
||||
[(make-alts nonnegative-real? (symbol-in end)) [w 'end]]
|
||||
[(make-alts nonnegative-real? (symbol-in end)) [h 'end]])
|
||||
(let ([w (if (symbol? w) (- total-width x) w)]
|
||||
[h (if (symbol? h) (- total-height y) h)])
|
||||
[(make-alts nonnegative-real? (symbol-in end display-end)) [w 'end]]
|
||||
[(make-alts nonnegative-real? (symbol-in end display-end)) [h 'end]])
|
||||
(let ([w (if (eq? w 'end) (- total-width x) w)]
|
||||
[h (if (eq? h 'end) (- total-height y) h)])
|
||||
|
||||
(refresh-box x y w h)
|
||||
(when (zero? delay-refresh)
|
||||
|
|
@ -4809,9 +4811,13 @@
|
|||
(values left right top bottom)
|
||||
(values
|
||||
(max refresh-l left)
|
||||
(min refresh-r right)
|
||||
(if (eq? refresh-r 'display-end)
|
||||
right
|
||||
(min refresh-r right))
|
||||
(max refresh-t top)
|
||||
(min refresh-b bottom)))])
|
||||
(if (eq? refresh-b 'display-end)
|
||||
bottom
|
||||
(min refresh-b bottom))))])
|
||||
(set! refresh-unset? #t)
|
||||
(set! refresh-box-unset? #t)
|
||||
(set! refresh-all? #f)
|
||||
|
|
@ -4884,8 +4890,12 @@
|
|||
#t))
|
||||
(values (max refresh-l left)
|
||||
(max top refresh-t)
|
||||
(min right refresh-r)
|
||||
(min bottom refresh-b)
|
||||
(if (eq? refresh-r 'display-end)
|
||||
right
|
||||
(min right refresh-r))
|
||||
(if (eq? refresh-b 'display-end)
|
||||
bottom
|
||||
(min bottom refresh-b))
|
||||
#t))
|
||||
(values left top right bottom refresh-all?))])
|
||||
|
||||
|
|
|
|||
|
|
@ -1006,8 +1006,8 @@ See also @method[editor<%> insert-file].
|
|||
|
||||
@defmethod[(invalidate-bitmap-cache [x real? 0.0]
|
||||
[y real? 0.0]
|
||||
[width (or/c (and/c real? (not/c negative?)) 'end) 'end]
|
||||
[height (or/c (and/c real? (not/c negative?)) 'end) 'end])
|
||||
[width (or/c (and/c real? (not/c negative?)) 'end 'display-end) 'end]
|
||||
[height (or/c (and/c real? (not/c negative?)) 'end 'display-end) 'end])
|
||||
void?]{
|
||||
|
||||
When @method[editor<%> on-paint] is overridden, call this method when
|
||||
|
|
@ -1018,7 +1018,13 @@ The @scheme[x], @scheme[y], @scheme[width], and @scheme[height]
|
|||
coordinates. If @scheme[width]/@scheme[height] is @scheme['end], then
|
||||
the total height/width of the editor (as reported by
|
||||
@method[editor<%> get-extent]) is used. Note that the editor's size
|
||||
can be smaller than the visible region of its @techlink{display}.
|
||||
can be smaller than the visible region of its @techlink{display}. If
|
||||
@scheme[width]/@scheme[height] is @scheme['display-end], then the
|
||||
largest height/width of the editor's views (as reported by
|
||||
@method[editor-admin% get-max-view]) is used. If
|
||||
@scheme[width]/@scheme[height] is not @scheme['display-end], then
|
||||
the given @scheme[width]/@scheme[height] is constrained to the
|
||||
editor's size.
|
||||
|
||||
The default implementation triggers a redraw of the editor, either
|
||||
immediately or at the end of the current edit sequence (if any)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user