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

add get-display-count' and #:screen argument to get-display-size'

Browse Source 
and to `get-display-left-top-inset'

 add -M <monitor> option to Slideshow

original commit: 23a2a075eaa636b27ec0700a054d49989ae53a0e
This commit is contained in:
Matthew Flatt 2011-07-18 17:24:09 -06:00
parent bd5f04dc44
commit 15bfdb93aa
11 changed files with 198 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mred/mred-sig.rkt
View File

@ -79,6 +79,7 @@ get-choices-from-user
get-color-from-user
get-default-shortcut-prefix
get-directory
get-display-count
get-display-depth
get-display-left-top-inset
get-display-size

1
collects/mred/private/mred.rkt
View File

@ -242,6 +242,7 @@
play-sound
get-display-size
get-display-left-top-inset
get-display-count
get-color-from-user
get-font-from-user
append-editor-operation-menu-items

1
collects/mred/private/wx/cocoa/platform.rkt
View File

@ -61,6 +61,7 @@
bell
display-size
display-origin
display-count
flush-display
fill-private-color
cancel-quit

71
collects/mred/private/wx/cocoa/procs.rkt
View File

@ -42,6 +42,7 @@
cancel-quit
display-origin
display-size
display-count
bell
hide-cursor
get-display-depth
@ -88,31 +89,59 @@
(define (check-for-break) #f)
(define (display-origin xb yb all?)
(if all?
(atomically
(with-autorelease
(let* ([screen (tell (tell NSScreen screens) objectAtIndex: #:type _NSUInteger 0)]
[f (tell #:type _NSRect screen visibleFrame)])
(set-box! xb (->long (NSPoint-x (NSRect-origin f)))))))
(define (display-origin xb yb all? num)
(if (or all? (positive? num))
(unless (atomically
(with-autorelease
(let ([screens (tell NSScreen screens)])
(if (num . < . (tell #:type _NSUInteger screens count))
(let* ([screen (tell screens objectAtIndex: #:type _NSUInteger num)]
[f (if (zero? num)
(tell #:type _NSRect screen visibleFrame)
(tell #:type _NSRect screen frame))])
(set-box! xb (->long (NSPoint-x (NSRect-origin f))))
(unless (zero? num)
(let* ([screen0 (tell screens objectAtIndex: #:type _NSUInteger 0)]
[f0 (tell #:type _NSRect screen0 frame)])
(set-box! yb (->long (- (+ (NSPoint-y (NSRect-origin f))
(NSSize-height (NSRect-size f)))
(NSSize-height (NSRect-size f0)))))))
#t)
#f))))
(error 'get-display-left-top-inset "no such monitor: ~v" num))
(set-box! xb 0))
(set-box! yb (get-menu-bar-height)))
(when (zero? num)
(set-box! yb 0))
(set-box! yb (+ (unbox yb) (get-menu-bar-height))))
(define (display-size xb yb all?)
(define (display-size xb yb all? num)
(unless (atomically
(with-autorelease
(let ([screens (tell NSScreen screens)])
(if (num . < . (tell #:type _NSUInteger screens count))
(let* ([screen (tell screens objectAtIndex: #:type _NSUInteger num)]
[f (if all?
(tell #:type _NSRect screen frame)
(tell #:type _NSRect screen visibleFrame))])
(set-box! xb (->long (NSSize-width (NSRect-size f))))
(set-box! yb (->long (- (NSSize-height (NSRect-size f))
(cond
[all? 0]
[(positive? num) 0]
[(tell #:type _BOOL NSMenu menuBarVisible) 0]
;; Make result consistent when menu bar is hidden:
[else
(get-menu-bar-height)]))))
#t)
#f))))
(error 'get-display-size "no such monitor: ~v" num)))
(define (display-count)
(atomically
(with-autorelease
(let* ([screen (tell (tell NSScreen screens) objectAtIndex: #:type _NSUInteger 0)]
[f (if all?
(tell #:type _NSRect screen frame)
(tell #:type _NSRect screen visibleFrame))])
(set-box! xb (->long (NSSize-width (NSRect-size f))))
(set-box! yb (->long (- (NSSize-height (NSRect-size f))
(cond
[all? 0]
[(tell #:type _BOOL NSMenu menuBarVisible) 0]
;; Make result consistent when menu bar is hidden:
[else
(get-menu-bar-height)]))))))))
(let ([screens (tell NSScreen screens)])
(tell #:type _NSUInteger screens count)))))
(define-appkit NSBeep (_fun -> _void))
(define (bell) (NSBeep))

21
collects/mred/private/wx/gtk/frame.rkt
View File

@ -21,6 +21,7 @@
(protect-out frame%
display-origin
display-size
display-count
location->window))
;; ----------------------------------------
@ -488,23 +489,29 @@
(define-gdk gdk_screen_get_height (_fun _GdkScreen -> _int))
(define-gdk gdk_screen_get_monitor_geometry (_fun _GdkScreen _int _GdkRectangle-pointer -> _void))
(define-gdk gdk_screen_get_n_monitors (_fun _GdkScreen -> _int))
(define (monitor-rect num)
(define (monitor-rect who num)
(let ([s (gdk_screen_get_default)]
[r (make-GdkRectangle 0 0 0 0)])
(unless (num . < . (gdk_screen_get_n_monitors s))
(error who "no such monitor: ~v" num))
(gdk_screen_get_monitor_geometry s num r)
r))
(define (display-origin x y all?)
(let ([r (monitor-rect 0)])
(set-box! x (GdkRectangle-x r))
(set-box! y (GdkRectangle-y r))))
(define (display-origin x y all? num)
(let ([r (monitor-rect 'get-display-left-top-inset num)])
(set-box! x (- (GdkRectangle-x r)))
(set-box! y (- (GdkRectangle-y r)))))
(define (display-size w h all?)
(let ([r (monitor-rect 0)])
(define (display-size w h all? num)
(let ([r (monitor-rect 'get-display-size num)])
(set-box! w (GdkRectangle-width r))
(set-box! h (GdkRectangle-height r))))
(define (display-count)
(gdk_screen_get_n_monitors (gdk_screen_get_default)))
(define (location->window x y)
(for/or ([f (in-hash-keys all-frames)])
(let ([fx (send f get-x)]

1
collects/mred/private/wx/gtk/platform.rkt
View File

@ -62,6 +62,7 @@
bell
display-size
display-origin
display-count
flush-display
fill-private-color
cancel-quit

1
collects/mred/private/wx/platform.rkt
View File

@ -48,6 +48,7 @@
bell
display-size
display-origin
display-count
flush-display
fill-private-color
cancel-quit

84
collects/mred/private/wx/win32/frame.rkt
View File

@ -21,7 +21,8 @@
(provide
(protect-out frame%
display-size
display-origin))
display-origin
display-count))
(define-user32 SetLayeredWindowAttributes (_wfun _HWND _COLORREF _BYTE _DWORD -> _BOOL))
(define-user32 GetActiveWindow (_wfun -> _HWND))
@ -35,6 +36,12 @@
(define-user32 IsZoomed (_wfun _HWND -> _BOOL))
(define-user32 EnumDisplayMonitors (_wfun _HDC
_pointer
(_wfun #:atomic? #t _pointer _HDC _RECT-pointer _pointer
-> _BOOL)
_pointer -> _BOOL))
(define-user32 SystemParametersInfoW (_wfun _UINT _UINT _pointer _UINT -> (r : _BOOL)
-> (unless r (failed 'SystemParametersInfo))))
(define-cstruct _MINMAXINFO ([ptReserved _POINT]
@ -58,27 +65,60 @@
(define SPI_GETWORKAREA #x0030)
(define (display-size xb yb all?)
(if all?
(atomically
(let ([hdc (GetDC #f)])
(set-box! xb (GetDeviceCaps hdc HORZRES))
(set-box! yb (GetDeviceCaps hdc VERTRES))
(ReleaseDC #f hdc)))
(let ([r (make-RECT 0 0 0 0)])
(SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
(set-box! xb (- (RECT-right r) (RECT-left r)))
(set-box! yb (- (RECT-bottom r) (RECT-top r))))))
(define (get-all-screen-rects)
(let ([rects null])
(EnumDisplayMonitors #f #f (lambda (mon dc r ptr)
(set! rects (cons
(list (RECT-left r)
(RECT-top r)
(RECT-right r)
(RECT-bottom r))
rects))
#t)
#f)
(reverse rects)))
(define (display-origin xb yb avoid-bars?)
(if avoid-bars?
(let ([r (make-RECT 0 0 0 0)])
(SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
(set-box! xb (RECT-left r))
(set-box! yb (RECT-top r)))
(begin
(set-box! xb 0)
(set-box! yb 0))))
(define (display-size xb yb all? num)
(cond
[(positive? num)
(let ([rs (get-all-screen-rects)])
(unless (num . < . (length rs))
(error 'get-display-size "no such monitor: ~v" num))
(let ([r (list-ref rs num)])
(set-box! xb (- (caddr r) (car r)))
(set-box! yb (- (cadddr r) (cadr r)))))]
[all?
(atomically
(let ([hdc (GetDC #f)])
(set-box! xb (GetDeviceCaps hdc HORZRES))
(set-box! yb (GetDeviceCaps hdc VERTRES))
(ReleaseDC #f hdc)))]
[else
(let ([r (make-RECT 0 0 0 0)])
(SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
(set-box! xb (- (RECT-right r) (RECT-left r)))
(set-box! yb (- (RECT-bottom r) (RECT-top r))))]))
(define (display-origin xb yb avoid-bars? num)
(cond
[(positive? num)
(let ([rs (get-all-screen-rects)])
(unless (num . < . (length rs))
(error 'get-display-left-top-inset "no such monitor: ~v" num))
(let ([r (list-ref rs num)])
(set-box! xb (- (car r)))
(set-box! yb (- (cadr r)))))]
[avoid-bars?
(let ([r (make-RECT 0 0 0 0)])
(SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
(set-box! xb (RECT-left r))
(set-box! yb (RECT-top r)))]
[else
(set-box! xb 0)
(set-box! yb 0)]))
(define (display-count)
(length (get-all-screen-rects)))
(define mouse-frame #f)
@ -391,7 +431,7 @@
[wh (box 0)]
[wx (box 0)]
[wy (box 0)])
(display-size sw sh #f)
(display-size sw sh #f 0)
(if wrt
(begin
(send wrt get-size ww wh)

1
collects/mred/private/wx/win32/platform.rkt
View File

@ -62,6 +62,7 @@
bell
display-size
display-origin
display-count
flush-display
fill-private-color
cancel-quit

68
collects/mred/private/wxtop.rkt
View File

@ -1,11 +1,10 @@
(module wxtop mzscheme
(module wxtop racket/base
(require mzlib/class
mzlib/class100
mzlib/etc
mzlib/list
(prefix wx: "kernel.rkt")
(prefix wx: "wxme/editor-canvas.rkt")
(prefix wx: "wxme/editor-snip.rkt")
(prefix-in wx: "kernel.rkt")
(prefix-in wx: "wxme/editor-canvas.rkt")
(prefix-in wx: "wxme/editor-snip.rkt")
"lock.rkt"
"helper.rkt"
"const.rkt"
@ -15,14 +14,15 @@
"wxwindow.rkt"
"wxcontainer.rkt")
(provide (protect active-main-frame
set-root-menu-wx-frame!)
(provide (protect-out active-main-frame
set-root-menu-wx-frame!)
get-display-size
get-display-left-top-inset
(protect make-top-container%
make-top-level-window-glue%
wx-frame%
wx-dialog%))
get-display-count
(protect-out make-top-container%
make-top-level-window-glue%
wx-frame%
wx-dialog%))
;; Weak boxed:
(define active-main-frame (make-weak-box #f))
@ -32,19 +32,27 @@
(set! root-menu-wx-frame f))
(define get-display-size
(opt-lambda ([full-screen? #f])
(lambda ([full-screen? #f] #:monitor [monitor 0])
(unless (exact-nonnegative-integer? monitor)
(raise-type-error 'get-display-size "exact non-negative integer" monitor))
(let ([xb (box 0)]
[yb (box 0)])
(wx:display-size xb yb full-screen?)
(wx:display-size xb yb full-screen? monitor)
(values (unbox xb) (unbox yb)))))
(define get-display-left-top-inset
(opt-lambda ([advisory? #f])
(lambda ([advisory? #f] #:monitor [monitor 0])
(unless (exact-nonnegative-integer? monitor)
(raise-type-error 'get-display-left-top-inset "exact non-negative integer" monitor))
(let ([xb (box 0)]
[yb (box 0)])
(wx:display-origin xb yb advisory?)
(wx:display-origin xb yb advisory? monitor)
(values (unbox xb) (unbox yb)))))
(define get-display-count
(lambda ()
(wx:display-count)))
(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)])
@ -55,7 +63,7 @@
(define top-x init-top-x)
(define top-y init-top-y)
(define top-level-windows (make-hash-table 'weak))
(define top-level-windows (make-weak-hasheq))
;; make-top-container%: adds the necessary functionality to wx:frame% and
;; wx:dialog%.
@ -99,8 +107,8 @@
[parent-for-center parent]
[show-ht (make-hash-table)]
[fake-show-ht (make-hash-table)])
[show-ht (make-hasheq)]
[fake-show-ht (make-hasheq)])
(override
[enable
@ -192,17 +200,17 @@
(when perform-updates?
(when pending-redraws?
(force-redraw))
(when (positive? (hash-table-count fake-show-ht))
(when (positive? (hash-count fake-show-ht))
(let ([t fake-show-ht])
(set! fake-show-ht (make-hash-table))
(hash-table-for-each
(set! fake-show-ht (make-hasheq))
(hash-for-each
t
(lambda (win v?)
(send win really-show #t)))))
(when (positive? (hash-table-count show-ht))
(when (positive? (hash-count show-ht))
(let ([t show-ht])
(set! show-ht (make-hash-table))
(hash-table-for-each
(set! show-ht (make-hasheq))
(hash-for-each
t
(lambda (win v?)
(send win show v?))))))])]
@ -221,7 +229,7 @@
(lambda (child show?)
(if perform-updates?
(send child show show?)
(hash-table-put! show-ht child show?)))]
(hash-set! show-ht child show?)))]
[show-control
(lambda (child on?)
@ -230,10 +238,10 @@
(child . is-a? . wx-frame%)
(child . is-a? . wx-dialog%))
(begin
(hash-table-remove! fake-show-ht child)
(hash-remove! fake-show-ht child)
(send child really-show on?))
(begin
(hash-table-put! fake-show-ht child #t)
(hash-set! fake-show-ht child #t)
(send child fake-show on?))))]
;; force-redraw: receives a message from to redraw the
@ -353,8 +361,8 @@
(when on?
(position-for-initial-show))
(if on?
(hash-table-put! top-level-windows this #t)
(hash-table-remove! top-level-windows this))
(hash-set! top-level-windows this #t)
(hash-remove! top-level-windows this))
(as-exit ; as-exit because there's an implicit wx:yield for dialogs
do-show))])
@ -713,7 +721,7 @@
(or (send event get-control-down)
(send event get-meta-down)
(send event get-alt-down)
(hash-table-get function-keys (send event get-key-code) #f))
(hash-ref function-keys (send event get-key-code) #f))
(begin
(send menu-bar on-demand)
(send menu-bar handle-key event))))])

42
collects/scribblings/gui/global-draw-funcs.scrbl
View File

@ -14,6 +14,12 @@ Normally, drawing is automatically flushed to the screen. Use
other actions depend on updating the display.}
@defproc[(get-display-count) exact-positive-integer?]{
Returns the number of monitors currently active. On Windows and Mac OS X,
the result can change at any time.
}
@defproc[(get-display-depth)
exact-nonnegative-integer?]{
@ -21,36 +27,44 @@ Returns the depth of the main display (a value of 1 denotes a monochrome display
}
@defproc[(get-display-left-top-inset [avoid-bars? any/c #f])
@defproc[(get-display-left-top-inset [avoid-bars? any/c #f]
[#:monitor monitor exact-nonnegative-integer? 0])
(values exact-nonnegative-integer? exact-nonnegative-integer?)]{
When the optional argument is @racket[#f] (the default), this function
returns the offset of the main screen's origin from the
top-left of the physical screen. On Unix and Windows, the result is
returns the offset of @racket[monitor]'s origin from the
top-left of the physical monitor. For @racket[monitor] @racket[0], on Unix and Windows, the result is
always @racket[0] and @racket[0]; on Mac OS X, the result is
@racket[0] and the height of the menu bar.
@racket[0] and the height of the menu bar. To position a frame
at a given @racket[monitor]'s top-left corner, use the negated results from
@racket[get-display-left-top-inset] as the frame's position.
When the optional argument is true, this function returns the amount
space at the left and top of the main screen that is occupied by the
task bar (Windows) or menu bar and dock (Mac OS X). On Unix, the
result is always @racket[0] and @racket[0].
When the optional @racket[avoid-bars?] argument is true, for @racket[monitor]
@racket[0], @racket[get-display-left-top-inset] function returns the
amount space at the left and top of the monitor that is occupied by
the task bar (Windows) or menu bar and dock (Mac OS X). On Unix, for
monitor @racket[0], the result is always @racket[0] and @racket[0].
For monitors other than @racket[0], @racket[avoid-bars?] has no effect.
}
If @racket[monitor] is not less than the current number of available monitors, the
@racket[exn:fail] exception is raised.}
@defproc[(get-display-size [full-screen? any/c #f])
@defproc[(get-display-size [full-screen? any/c #f]
[#:monitor monitor exact-nonnegative-integer? 0])
(values exact-nonnegative-integer? exact-nonnegative-integer?)]{
@index["screen resolution"]{Gets} the physical size of the display in
@index["screen resolution"]{Gets} the physical size of the specified @racket[monitor] in
pixels. On Windows, this size does not include the task bar by
default. On Mac OS X, this size does not include the menu bar or
dock area by default.
On Windows and Mac OS X, if the optional argument is true, then
On Windows and Mac OS X, if the optional argument is true and @racket[monitor] is @racket[0], then
the task bar, menu bar, and dock area are included in the result.
Returns the screen's width and height.
If @racket[monitor] is not less than the current number of available monitors, the
@racket[exn:fail] exception is raised.}
}
@defproc[(is-color-display?)
boolean?]{