misc-deps
/
lux
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add support for positions x, y of a window on a specified monitor (or the current one) (#4) 

* add support for placing the window at a particular position in the specified monitor

* remove dust
This commit is contained in:
Laurent Orseau 2017-08-30 14:34:32 +01:00 committed by Jay McCarthy
parent dc48fe9f7e
commit 9812d00d3a
3 changed files with 171 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
chaos/gui.rkt
View File

@ -4,7 +4,8 @@
racket/contract/base
racket/gui/base
racket/async-channel
lux/chaos)
lux/chaos
"gui/utils.rkt")
;; Robby says that I could rework this to remove the event-ch by
;; having capturing the continuation, storing it, and then calling it
@ -30,8 +31,11 @@
#:start-fullscreen? [start-fullscreen? #f]
#:icon [icon #f]
#:frame-style [frame-style '()]
#:x [the-start-x 'center]
#:y [the-start-y 'center]
#:width [the-init-w 800]
#:height [the-init-h 600])
#:height [the-init-h 600]
#:monitor [monitor #f])
(define-values (start-x start-y init-w init-h)
(cond
[start-fullscreen?
@ -39,10 +43,8 @@
(define-values (w h) (get-display-size #t))
(values (* -1 x) (* -1 y) w h)]
[else
(values #f #f the-init-w the-init-h)]))
(values the-start-x the-start-y the-init-w the-init-h)]))
;; xxx start-x/y isn't working
(define events-ch (make-async-channel))
(define gframe%
(class frame%
@ -66,13 +68,9 @@
(send c get-client-size)))
((unbox drawer) cw ch dc))
;; (printf "starting at ~v\n" (vector start-x start-y))
(define f
(new gframe%
[label ""]
[x start-x]
[y start-y]
[width init-w]
[height init-h]
[style frame-style]))
@ -111,11 +109,14 @@
#f)
(yield the-refresh-sema))
(cond
[start-fullscreen?
(send f move start-x start-y)]
[else
(send f center)])
(define-values (x y)
(find-x/y start-x
start-y
#:width (send f get-width)
#:height (send f get-height)
#:monitor monitor))
(send f move x y)
(send f show #t)
(when icon
@ -144,8 +145,14 @@
(listof symbol?)
#:icon
(or/c #f path-string? (is-a?/c bitmap%))
#:x
(or/c exact-nonnegative-integer? (one-of/c 'left 'center 'right))
#:y
(or/c exact-nonnegative-integer? (one-of/c 'top 'center 'bottom))
#:width
exact-nonnegative-integer?
#:height
exact-nonnegative-integer?)
exact-nonnegative-integer?
#:monitor
(or/c false/c exact-nonnegative-integer?))
chaos?)]))

135
chaos/gui/utils.rkt Normal file
View File

@ -0,0 +1,135 @@
#lang racket/gui
(require bazaar/debug
racket/contract/base)
(define nnint? nonnegative-integer?)
(provide
(contract-out
[get-mouse-x/y
(->* ()
()
(values nnint? nnint?))]
[get-display-info
(->* (nnint?)
()
(values nnint? nnint? nnint? nnint?))]
[find-monitor
(->* (nnint? nnint?)
()
(or/c false/c nnint?))]
[find-mouse-monitor
(->* ()
()
(or/c false/c nnint?))]
[find-x/y
(->* ((or/c nnint? (one-of/c 'left 'center 'right))
(or/c nnint? (one-of/c 'top 'center 'bottom)))
(#:width
nnint?
#:height
nnint?
#:monitor
(or/c false/c nnint?))
(values nnint? nnint?))]))
;; Returns the coordinates of the mouse pointer
(define (get-mouse-x/y)
(define-values (pt st)
(get-current-mouse-state))
(values (send pt get-x)
(send pt get-y)))
;; Returns the position x, y and the sizes w, h of the provided display/monitor number
(define (get-display-info disp)
(define-values (-x0 -y0)
(if (= disp 0)
(values 0 0) ; to avoid the bars and menus on first monitor
(get-display-left-top-inset #:monitor disp)))
(define-values (w h)
(get-display-size #:monitor disp))
(values (- -x0) (- -y0) w h))
;; Returns the display/monitor that contains the coordinates x,y, or #f if not found
(define (find-monitor x y)
(define n-disp (get-display-count))
(let loop ([disp 0])
(cond
[(>= disp n-disp) #f]
[else
(define-values (x0 y0 w h)
(get-display-info disp))
(if (and (<= x0 x (+ x0 w))
(<= y0 y (+ y0 h)))
disp
(loop (+ disp 1)))])))
;; Returns the display/monitor number that contains the mouse pointer
(define (find-mouse-monitor)
(define-values (pt st)
(get-current-mouse-state))
(find-monitor (send pt get-x) (send pt get-y)))
;; Returns the position x, y in pixels for where to place a frame of size fr-w, fr-h
;; on the specified monitor. If monitor is #f, then the monitor where the mouse
;; pointer is is used.
;; pos-x: (or/c non-negative-integer? (one-of 'left 'center 'right))
;; pos-y: (or/c non-negative-integer?
(define (find-x/y pos-x pos-y
#:width [fr-w 0]
#:height [fr-h 0]
#:monitor [monitor #f])
(when (and monitor (not (<= 0 monitor (- (get-display-count) 1))))
(error "Invalid monitor number" monitor))
(define disp (or monitor (find-mouse-monitor) 0))
(define-values (disp-x0 disp-y0 disp-w disp-h)
(get-display-info disp))
(define x
(cond [(eq? pos-x 'left)
disp-x0]
[(eq? pos-x 'center)
(+ disp-x0 (quotient (- disp-w fr-w) 2))]
[(eq? pos-x 'right)
(+ disp-x0 disp-w (- fr-w))]
[else (+ disp-x0 pos-x)]))
(define y
(cond [(eq? pos-y 'top)
disp-y0]
[(eq? pos-y 'center)
(+ disp-y0 (quotient (- disp-h fr-h) 2))]
[(eq? pos-y 'bottom)
(+ disp-y0 disp-h (- fr-h))]
[else (+ disp-y0 pos-y)]))
(values x y))
(module+ drracket
(define n-displays (get-display-count))
(for/list ([d (in-range n-displays)])
(define-values (x y)
(get-display-left-top-inset #:monitor d))
(define-values (w h)
(get-display-size #:monitor d))
(vars->assoc d x y w h))
(define fr
(new frame%
[label "test"]
[width 400]
[height 100]))
(send fr show true)
(for* ([monitor (in-sequences (in-value #f)
(in-range (get-display-count)))]
[xx (in-list '(0 100 300 left center right))]
[yy (in-list '(0 200 400 top center bottom))])
(displayln (list monitor xx yy))
(define-values (x y)
(find-x/y xx yy
#:width (send fr get-width)
#:height (send fr get-height)
#:monitor monitor))
(send fr set-label (format "~a, ~a(~a), ~a(~a)" monitor xx x yy y))
(send fr move x y)
(sleep/yield 1 #;0.5))
)

17
scribblings/lux.scrbl
View File

@ -140,16 +140,27 @@ This module provides the standard @tech{chaos} that most users of
[#:icon icon
(or/c #f path-string? (is-a?/c bitmap%))
#f]
[#:x x
(or/c exact-nonnegative-integer? (one-of/c 'left 'center 'right))
'center]
[#:y y
(or/c exact-nonnegative-integer? (one-of/c 'top 'center 'bottom))
'center]
[#:width width
exact-nonnegative-integer?
800]
[#:height height
exact-nonnegative-integer?
600])
600]
[#:monitor monitor
(or/c false/c exact-nonnegative-integer?)
#f])
chaos?]{
Returns a @tech{chaos} that opens a GUI frame with a canvas to draw
on. The default size of the frame is
Returns a @tech{chaos} that opens a GUI frame with a canvas to draw on.
The frame is placed at position @racket[x],@racket[y] on monitor @racket[monitor];
if @racket[monitor] is @racket[#f], the monitor containing the mouse pointer is used.
The default size of the frame is
@racket[width]x@racket[height]. The icon for the application is set to
@racket[icon]. If @racket[start-fullscreen?] is true, then the frame
is initially fullscreen. The frame's style is set to