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

improve initial placement of frames that seem too large

Browse Source 
svn: r6682
This commit is contained in:
Matthew Flatt 2007-06-17 05:40:14 +00:00
parent c9554c4946
commit 19af52af8b
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/mred/private/wxtop.ss
View File

@ -42,11 +42,13 @@
[yb (box 0)]) [yb (box 0)])
(wx:display-origin xb yb advisory?) (wx:display-origin xb yb advisory?)
(values (unbox xb) (unbox yb))))) (values (unbox xb) (unbox yb)))))
(define-values (init-top-x init-top-y) (define-values (left-margin top-margin init-top-x init-top-y)
(let-values ([(x y) (get-display-left-top-inset #f)] (let-values ([(x y) (get-display-left-top-inset #f)]
[(x2 y2) (get-display-left-top-inset #t)]) [(x2 y2) (get-display-left-top-inset #t)])
(values (+ 1 (- x2 x)) (values (- x2 x)
(- y2 y)
(+ 1 (- x2 x))
(+ 1 (- y2 y))))) (+ 1 (- y2 y)))))
(define top-x init-top-x) (define top-x init-top-x)
@ -413,12 +415,12 @@
(let*-values ([(w) (get-width)] (let*-values ([(w) (get-width)]
[(h) (get-height)] [(h) (get-height)]
[(sw sh) (get-display-size)] [(sw sh) (get-display-size)]
[(x x-reset?) (if (< (+ top-x w) sw) [(x x-reset?) (if (< (+ top-x w) (+ sw left-margin))
(values top-x #f) (values top-x #f)
(values (max 0 (- sw w 10)) #t))] (values (max init-top-x (- sw w 10)) #t))]
[(y y-reset?) (if (< (+ top-y h) sh) [(y y-reset?) (if (< (+ top-y h) (+ sh top-margin))
(values top-y #f) (values top-y #f)
(values (max 0 (- sh h 20)) #t))]) (values (max init-top-y (- sh h 20)) #t))])
(move x y) (move x y)
(set! top-x (if x-reset? init-top-x (+ top-x 10))) (set! top-x (if x-reset? init-top-x (+ top-x 10)))
(set! top-y (if y-reset? init-top-y (+ top-y 20)))))))] (set! top-y (if y-reset? init-top-y (+ top-y 20)))))))]