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

fix some racket/gui tests and fix cocoa frame centering

Browse Source 
original commit: 347869fc9e90560493f39654afd7037be7dac690
This commit is contained in:
Matthew Flatt 2010-11-25 08:02:33 -07:00
parent 1779a3853f
commit 4723df4a89
2 changed files with 17 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -451,15 +451,15 @@
#:type _NSRect (make-NSRect (make-NSPoint #:type _NSRect (make-NSRect (make-NSPoint
(if (or (eq? dir 'both) (if (or (eq? dir 'both)
(eq? dir 'horizontal)) (eq? dir 'horizontal))
(/ (- (NSSize-width (NSRect-size s)) (quotient (- (NSSize-width (NSRect-size s))
(NSSize-width (NSRect-size f))) (NSSize-width (NSRect-size f)))
2) 2)
(NSPoint-x (NSRect-origin f))) (NSPoint-x (NSRect-origin f)))
(if (or (eq? dir 'both) (if (or (eq? dir 'both)
(eq? dir 'vertical)) (eq? dir 'vertical))
(/ (- (NSSize-height (NSRect-size s)) (quotient (- (NSSize-height (NSRect-size s))
(NSSize-height (NSRect-size f))) (NSSize-height (NSRect-size f)))
2) 2)
(NSPoint-x (NSRect-origin f)))) (NSPoint-x (NSRect-origin f))))
(NSRect-size f)) (NSRect-size f))
display: #:type _BOOL #t))) display: #:type _BOOL #t)))

27
collects/tests/gracket/windowing.rktl
View File

@ -66,7 +66,7 @@
(test #t `(client-size ,f ,cw ,ch ,w ,h) (and (<= 1 cw w) (<= 1 ch h)))) (test #t `(client-size ,f ,cw ,ch ,w ,h) (and (<= 1 cw w) (<= 1 ch h))))
(stv f refresh)) (stv f refresh))
(define (area-tests f sw? sh? no-stretch?) (define (area-tests f sw? sh? no-stretch? use-client-size?)
(printf "Area ~a\n" f) (printf "Area ~a\n" f)
(let ([x (send f min-width)] (let ([x (send f min-width)]
[y (send f min-height)]) [y (send f min-height)])
@ -75,7 +75,9 @@
(stv (send f get-top-level-window) reflow-container) (stv (send f get-top-level-window) reflow-container)
(pause) ; to make sure size has taken effect (pause) ; to make sure size has taken effect
(let-values ([(w h) (if no-stretch? (let-values ([(w h) (if no-stretch?
(send f get-size) (if use-client-size?
(send f get-client-size)
(send f get-size))
(values 0 0))]) (values 0 0))])
(printf "Size ~a x ~a\n" w h) (printf "Size ~a x ~a\n" w h)
(when no-stretch? (when no-stretch?
@ -95,7 +97,7 @@
(stv f min-height y))) (stv f min-height y)))
(define (containee-tests f sw? sh? m) (define (containee-tests f sw? sh? m)
(area-tests f sw? sh? #f) (area-tests f sw? sh? #f #f)
(printf "Containee ~a\n" f) (printf "Containee ~a\n" f)
(st m f horiz-margin) (st m f horiz-margin)
(st m f vert-margin) (st m f vert-margin)
@ -166,7 +168,7 @@
(st my-l b get-plain-label) (st my-l b get-plain-label)
(stv b set-label &-l))) (stv b set-label &-l)))
(let ([f (make-object frame% "Yes & No" #f 150 151 20 21)]) (let ([f (make-object frame% "Yes & No" #f 150 151 70 21)])
(let ([init-tests (let ([init-tests
(lambda (hidden?) (lambda (hidden?)
(st "Yes & No" f get-label) (st "Yes & No" f get-label)
@ -177,15 +179,8 @@
(stv f set-label "Yes & No") (stv f set-label "Yes & No")
(st #f f get-parent) (st #f f get-parent)
(st f f get-top-level-window) (st f f get-top-level-window)
(case (system-type 'os) (st 70 f get-x)
[(unix) (st 21 f get-y)
(st 21 f get-x)
(if hidden?
(st 43 f get-y)
(st 22 f get-y))]
[else
(st 20 f get-x)
(st 21 f get-y)])
(st 150 f get-width) (st 150 f get-width)
(st 151 f get-height) (st 151 f get-height)
(stvals (list (send f get-width) (send f get-height)) f get-size) (stvals (list (send f get-width) (send f get-height)) f get-size)
@ -218,7 +213,7 @@
[container-tests [container-tests
(lambda () (lambda ()
(printf "Container\n") (printf "Container\n")
(area-tests f #t #t #t) (area-tests f #t #t #t #t)
(let-values ([(x y) (send f container-size null)]) (let-values ([(x y) (send f container-size null)])
(st x f min-width) (st x f min-width)
(st y f min-height)) (st y f min-height))
@ -263,7 +258,7 @@
(stv f iconize #t) (stv f iconize #t)
(pause) (pause)
(pause) (pause)
(st #t f is-iconized?) ; NB: test will fail on MacOS (st #t f is-iconized?)
(stv f show #t) (stv f show #t)
(pause) (pause)
(st #f f is-iconized?) (st #f f is-iconized?)
@ -1010,7 +1005,7 @@
(test-controls panel frame) (test-controls panel frame)
(if win? (if win?
((if % containee-window-tests window-tests) panel #t #t (and % frame) frame 0) ((if % containee-window-tests window-tests) panel #t #t (and % frame) frame 0)
(area-tests panel #t #t #f)) (area-tests panel #t #t #f #f))
(when (is-a? panel panel%) (when (is-a? panel panel%)
(st #t panel get-orientation (is-a? panel horizontal-panel%))) (st #t panel get-orientation (is-a? panel horizontal-panel%)))
(container-tests panel win?) (container-tests panel win?)