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

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

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