fullscreen

This commit is contained in:
Jay McCarthy 2015-04-27 20:45:28 -04:00
parent 6099125a86
commit c67f68bfad
1 changed files with 27 additions and 7 deletions

View File

@ -28,8 +28,19 @@
(define (make-gui #:mode [mode 'draw] (define (make-gui #:mode [mode 'draw]
#:start-fullscreen? [start-fullscreen? #f] #:start-fullscreen? [start-fullscreen? #f]
#:icon [icon #f] #:icon [icon #f]
#:width [init-w 800] #:width [the-init-w #f]
#:height [init-h 600]) #:height [the-init-h #f])
(define-values (start-x start-y init-w init-h)
(cond
[start-fullscreen?
(define-values (x y) (get-display-left-top-inset #t))
(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)]))
;; xxx start-x/y isn't working
(define events-ch (make-async-channel)) (define events-ch (make-async-channel))
(define gframe% (define gframe%
(class frame% (class frame%
@ -50,12 +61,19 @@
(send c get-height) (send c get-height)
dc)) dc))
(printf "starting at ~v\n" (vector start-x start-y))
(define f (define f
(new gframe% (new gframe%
[label ""] [label ""]
[x start-x]
[y start-y]
[width init-w] [width init-w]
[height init-h] [height init-h]
[style '(fullscreen-button)])) [style
(if start-fullscreen?
'(hide-menu-bar no-resize-border)
'())]))
(define gl-config (define gl-config
(match mode (match mode
@ -79,16 +97,18 @@
(define the-refresh-sema (make-semaphore 0)) (define the-refresh-sema (make-semaphore 0))
(define (refresh!) (define (refresh!)
(queue-callback (queue-callback
(λ () (λ ()
(send c refresh-now) (send c refresh-now)
(semaphore-post the-refresh-sema)) (semaphore-post the-refresh-sema))
#f) #f)
(yield the-refresh-sema)) (yield the-refresh-sema))
(send f center) (cond
[start-fullscreen?
(send f move start-x start-y)]
[else
(send f center)])
(send f show #t) (send f show #t)
(when start-fullscreen?
(send f fullscreen #t))
(when icon (when icon
(define icon-bm (define icon-bm