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

bug fixes

Browse Source 
svn: r11441
This commit is contained in:
Robby Findler 2008-08-26 21:38:25 +00:00
parent 233dbc86e4
commit eb3ab9d9b2
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/drscheme/private/first-line-text.ss
View File

@ -59,7 +59,8 @@
(local-to-global #f by) (local-to-global #f by)
(cond (cond
[(<= (unbox by) h) [(<= (unbox by) h)
(send admin scroll-to localx (- localy h) width height refresh? bias)] ;; the max is relevant when we're already scrolled to the top.
(send admin scroll-to localx (max 0 (- localy h)) width height refresh? bias)]
[else [else
(send admin scroll-to localx localy width height refresh? bias)]))] (send admin scroll-to localx localy width height refresh? bias)]))]
[else [else
@ -85,8 +86,8 @@
[admin (get-admin)]) [admin (get-admin)])
(unless admin (send admin get-view #f by #f #f #f)) (unless admin (send admin get-view #f by #f #f #f))
(cond (cond
[(and (< y h) [(and admin
admin (< y h)
(not (= (unbox by) 0))) (not (= (unbox by) 0)))
(send admin scroll-to (send event get-x) 0 0 0 #t) (send admin scroll-to (send event get-x) 0 0 0 #t)
(super on-event event)] (super on-event event)]
@ -106,7 +107,8 @@
[old-brush (send dc get-brush)] [old-brush (send dc get-brush)]
[old-smoothing (send dc get-smoothing)] [old-smoothing (send dc get-smoothing)]
[old-α (send dc get-alpha)] [old-α (send dc get-alpha)]
[old-font (send dc get-font)]) [old-font (send dc get-font)]
[old-text-foreground (send dc get-text-foreground)])
(send dc set-font (get-font)) (send dc set-font (get-font))
(send dc set-smoothing 'aligned) (send dc set-smoothing 'aligned)
(let-values ([(tw th _1 _2) (send dc get-text-extent first-line)]) (let-values ([(tw th _1 _2) (send dc get-text-extent first-line)])
@ -140,8 +142,10 @@
(+ (unbox by) dy) (+ (unbox by) dy)
(unbox bw) (unbox bw)
th) th)
(send dc set-text-foreground (send the-color-database find-color "black"))
(send dc draw-text first-line (+ (unbox bx) dx) (+ (unbox by) dy))) (send dc draw-text first-line (+ (unbox bx) dx) (+ (unbox by) dy)))
(send dc set-text-foreground old-text-foreground)
(send dc set-font old-font) (send dc set-font old-font)
(send dc set-pen old-pen) (send dc set-pen old-pen)
(send dc set-brush old-brush) (send dc set-brush old-brush)