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

racket/gui: fix refresh for right-aligned or centered paragraphs in text%

Browse Source
This commit is contained in:
Matthew Flatt 2012-01-30 11:01:18 -07:00
parent 6b6beb601e
commit 6e01d1586a
2 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/mred/private/wxme/mline.rkt
View File

@ -1069,11 +1069,11 @@ Debugging tools:
;; ---------------------------------------- ;; ----------------------------------------
(define (update-graphics mline media dc padding-l padding-t) (define (update-graphics mline media dc padding-l padding-t max-line-width)
(define (update-left) (define (update-left)
(and (bit-overlap? (mline-flags mline) CALC-LEFT) (and (bit-overlap? (mline-flags mline) CALC-LEFT)
(not (eq? (mline-left mline) NIL)) (not (eq? (mline-left mline) NIL))
(update-graphics (mline-left mline) media dc padding-l padding-t))) (update-graphics (mline-left mline) media dc padding-l padding-t max-line-width)))
(define (update-here) (define (update-here)
(and (and
(bit-overlap? (mline-flags mline) CALC-HERE) (bit-overlap? (mline-flags mline) CALC-HERE)
@ -1144,19 +1144,31 @@ Debugging tools:
(set-width mline (- totalwidth padding-l)) (set-width mline (- totalwidth padding-l))
(unless (= maxscroll (mline-numscrolls mline)) (unless (= maxscroll (mline-numscrolls mline))
(set-scroll-length mline maxscroll)) (set-scroll-length mline maxscroll))
(define (send-refresh-box w h)
(define x-delta
(case (if max-line-width
(let-boxes ([is-first? #f]
[para #f])
(set-box! para (get-paragraph-style mline is-first?))
(paragraph-alignment para))
'left)
[(left) 0]
[(right) (max 0 (- max-line-width w))]
[else (max 0 (/ (- max-line-width w) 2))]))
(send media refresh-box (+ padding-l x-delta) y w h))
(if (= maxh (mline-h mline)) (if (= maxh (mline-h mline))
(send media refresh-box padding-l y bigwidth maxh) (send-refresh-box bigwidth maxh)
(begin (begin
(set-height mline maxh) (set-height mline maxh)
(let ([bigwidth (max 1e5 ;; really want viewable width, but > ok (let ([bigwidth (max 1e5 ;; really want viewable width, but > ok
(send media get-s-total-width))] (send media get-s-total-width))]
[bigheight (+ maxh (send media get-s-total-height))]) [bigheight (+ maxh (send media get-s-total-height))])
(send media refresh-box padding-l y bigwidth bigheight)))))))) (send-refresh-box bigwidth bigheight))))))))
#t))) #t)))
(define (update-right) (define (update-right)
(and (bit-overlap? (mline-flags mline) CALC-RIGHT) (and (bit-overlap? (mline-flags mline) CALC-RIGHT)
(not (eq? (mline-right mline) NIL)) (not (eq? (mline-right mline) NIL))
(update-graphics (mline-right mline) media dc padding-l padding-t))) (update-graphics (mline-right mline) media dc padding-l padding-t max-line-width)))
(let ([left? (update-left)] (let ([left? (update-left)]
[here? (update-here)] [here? (update-here)]

3
collects/mred/private/wxme/text.rkt
View File

@ -4783,7 +4783,8 @@
(let ([-changed? (let ([-changed?
(or (mline-update-graphics (unbox line-root-box) this dc (or (mline-update-graphics (unbox line-root-box) this dc
padding-l padding-t) padding-l padding-t
max-line-width)
-changed?)]) -changed?)])
(if (and (not -changed?) (if (and (not -changed?)