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]
#:start-fullscreen? [start-fullscreen? #f]
#:icon [icon #f]
#:width [init-w 800]
#:height [init-h 600])
#:width [the-init-w #f]
#: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 gframe%
(class frame%
@ -50,12 +61,19 @@
(send c get-height)
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 '(fullscreen-button)]))
[style
(if start-fullscreen?
'(hide-menu-bar no-resize-border)
'())]))
(define gl-config
(match mode
@ -85,10 +103,12 @@
#f)
(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)
(when start-fullscreen?
(send f fullscreen #t))
(when icon
(define icon-bm