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

initial support for GTK+ 3 on Wayland

Browse Source 
GL contexts and GC blits don't work, dialog placement doesn't work,
and checkbox animations seem to interefere with updating --- but at
least things mostly work.

Relevant to racket/racket#1547
This commit is contained in:
Matthew Flatt 2017-01-03 07:13:25 -07:00
parent 84433c528c
commit 48c1b28284
7 changed files with 122 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
gui-lib/mred/private/wx/gtk/canvas.rkt
View File

@ -17,6 +17,7 @@
"const.rkt"
"types.rkt"
"window.rkt"
"queue.rkt"
"client-window.rkt"
"widget.rkt"
"dc.rkt"
@ -613,7 +614,7 @@
;; A transparent canvas can't have a native window, so we
;; need to release any freezes befre the window implementation
;; might change.
(when transparentish? (unrealize)))
(when (or transparentish? wayland?) (unrealize)))
(define/public (begin-refresh-sequence)
(send dc suspend-flush))

3
gui-lib/mred/private/wx/gtk/dc.rkt
View File

@ -4,6 +4,7 @@
racket/class
"utils.rkt"
"types.rkt"
"queue.rkt"
"window.rkt"
"frame.rkt"
"x11.rkt"
@ -195,9 +196,11 @@
(define/override (make-backing-bitmap w h)
(cond
[(and (not is-transparentish?)
(not wayland?)
(eq? 'unix (system-type)))
(make-object x11-bitmap% w h (send canvas get-client-gtk))]
[(and (not is-transparentish?)
(not wayland?)
(eq? 'windows (system-type)))
(make-object win32-bitmap% w h (widget-window (send canvas get-client-gtk)))]
[else

22
gui-lib/mred/private/wx/gtk/frame.rkt
View File

@ -16,6 +16,7 @@
"cursor.rkt"
"pixbuf.rkt"
"resolution.rkt"
"queue.rkt"
"../common/queue.rkt")
(provide
@ -88,6 +89,8 @@
[max_aspect _double]
[win_gravity _int]))
(define-gtk gtk_window_set_geometry_hints (_fun _GtkWindow _GtkWidget _GdkGeometry-pointer _int -> _void))
(define-gtk gtk_widget_get_allocated_width (_fun _GtkWidget -> _int))
(define-gtk gtk_widget_get_allocated_height (_fun _GtkWidget -> _int))
(define-gtk gtk_layout_new (_fun (_pointer = #f) (_pointer = #f) -> _GtkWidget))
(define-gtk gtk_layout_put (_fun _GtkWidget _GtkWidget _int _int -> _void))
@ -107,11 +110,15 @@
(lambda (gtk a)
(let ([wx (gtk->wx gtk)])
(when wx
(define-values (w h) (if gtk3?
(gtk_window_get_size gtk)
(values (GdkEventConfigure-width a)
(GdkEventConfigure-height a))))
(send wx remember-size
(->normal (GdkEventConfigure-x a))
(->normal (GdkEventConfigure-y a))
(->normal (GdkEventConfigure-width a))
(->normal (GdkEventConfigure-height a)))))
(->normal w)
(->normal h))))
#f))
(define-cstruct _GdkEventWindowState ([type _int]
@ -266,9 +273,18 @@
(define/public (enforce-size min-x min-y max-x max-y inc-x inc-y)
(define (to-max v) (if (= v -1) #x3FFFFF (->screen v)))
(set! saved-enforcements (vector min-x min-y max-x max-y))
(define-values (dx dy)
(if wayland?
;; Hints work at a layer of geometry below some offset that
;; `gtk_window_get_size` works but above where allocations
;; work:
(let-values ([(w h) (gtk_window_get_size gtk)])
(values (- (gtk_widget_get_allocated_width gtk) w)
(- (gtk_widget_get_allocated_height gtk) h)))
(values 0 0)))
(gtk_window_set_geometry_hints gtk gtk
(make-GdkGeometry (->screen min-x) (->screen min-y)
(to-max max-x) (to-max max-y)
(+ dx (to-max max-x)) (+ dy (to-max max-y))
0 0
(->screen inc-x) (->screen inc-y)
0.0 0.0

117
gui-lib/mred/private/wx/gtk/gcwin.rkt
View File

@ -6,6 +6,7 @@
"utils.rkt"
"types.rkt"
"window.rkt"
"queue.rkt"
"pixbuf.rkt"
"x11.rkt")
@ -19,7 +20,7 @@
bitmap->gc-bitmap))
;; Gtk2, only:
(define-cstruct _GdkWindowAttr
(define-cstruct _GdkWindowAttr2
([title _string]
[event_mask _int]
[x _int]
@ -36,6 +37,29 @@
[override_redirect _gboolean]
[type_hint _int]))
;; Gtk3, only:
(define-cstruct _GdkWindowAttr3
([title _string]
[event_mask _int]
[x _int]
[y _int]
[width _int]
[height _int]
[wclass _int] ; GDK_INPUT_OUTPUT
[visual _pointer]
[window_type _int] ; GDK_WINDOW_CHILD
[cursor _pointer]
[wmclass_name _string]
[wmclass_class _string]
[override_redirect _gboolean]
[type_hint _int]))
(define make-GdkWindowAttr
(if gtk3?
(lambda (t e x y w h wc vis cm wt c wmc_n wmc_c o th)
(make-GdkWindowAttr3 t e x y w h wc vis wt c wmc_n wmc_c o th))
make-GdkWindowAttr2))
(define << arithmetic-shift)
(define GDK_WA_TITLE (1 . << . 1))
@ -52,12 +76,19 @@
(define GDK_WINDOW_CHILD 2)
(define-gdk gdk_window_new (_fun _GdkWindow _GdkWindowAttr-pointer _uint -> _GdkWindow))
(define-gdk gdk_window_new (_fun _GdkWindow
(if gtk3?
_GdkWindowAttr3-pointer
_GdkWindowAttr2-pointer)
_uint -> _GdkWindow))
(define-gdk gdk_window_show _fpointer)
(define-gdk gdk_window_show-p _fpointer
#:c-id gdk_window_show)
(define-gdk gdk_window_hide _fpointer)
(define-gdk gdk_display_flush _fpointer)
(define-gdk gdk_window_show (_fun _GdkWindow -> _void))
;; Gtk2
(define-gdk gdk_draw_pixbuf _fpointer
#:make-fail make-not-available)
@ -69,9 +100,11 @@
(define-x11 XMapRaised _fpointer #:fail (lambda () #f))
(define-x11 XUnmapWindow _fpointer #:fail (lambda () #f))
(define use-x11? (and gtk3? (not wayland?)))
(define (bitmap->gc-bitmap bm client-gtk)
(cond
[gtk3?
[use-x11?
; Generate an X11 Pixmap
(define gwin (widget-window client-gtk))
(define display (gdk_x11_display_get_xdisplay (gdk_window_get_display gwin)))
@ -109,7 +142,7 @@
(define (create-gc-window client-gtk x y w h)
(define cwin (widget-window client-gtk))
(cond
[gtk3?
[use-x11?
;; Work at the level of X11 to change the screen without an event loop
(define display (gdk_x11_display_get_xdisplay (gdk_window_get_display cwin)))
(define s (gtk_widget_get_scale_factor client-gtk))
@ -132,51 +165,61 @@
(define (free-gc-window win)
(cond
[gtk3? (XDestroyWindow (car win) (cdr win))]
[use-x11? (XDestroyWindow (car win) (cdr win))]
[else (g_object_unref win)]))
(define (make-draw win gc-bitmap w h)
(cond
[gtk3? (vector 'ptr_ptr_ptr->void
XSetWindowBackgroundPixmap
(car win)
(cdr win)
gc-bitmap)]
[else (vector 'ptr_ptr_ptr_int_int_int_int_int_int_int_int_int->void
gdk_draw_pixbuf
win #f gc-bitmap
0 0 0 0 w h
0 0 0)]))
[use-x11? (vector
(vector 'ptr_ptr_ptr->void
XSetWindowBackgroundPixmap
(car win)
(cdr win)
gc-bitmap))]
[gtk3? (vector)]
[else (vector
(vector 'ptr_ptr_ptr_int_int_int_int_int_int_int_int_int->void
gdk_draw_pixbuf
win #f gc-bitmap
0 0 0 0 w h
0 0 0))]))
(define (make-flush)
(vector 'ptr_ptr_ptr->void gdk_display_flush (gdk_display_get_default) #f #f))
(vector
(vector 'ptr_ptr_ptr->void gdk_display_flush (gdk_display_get_default) #f #f)))
(define (vector* . l)
(for*/vector ([v (in-list l)] [e (in-vector v)]) e))
(define (make-gc-show-desc win gc-bitmap w h)
(cond
[gtk3? (vector
(make-draw win gc-bitmap w h)
(vector 'ptr_ptr_ptr->void
XMapRaised
(car win)
(cdr win)
#f)
(make-flush))]
[else (vector
(vector 'ptr_ptr_ptr->void gdk_window_show win #f #f)
[use-x11? (vector*
(make-draw win gc-bitmap w h)
(vector
(vector 'ptr_ptr_ptr->void
XMapRaised
(car win)
(cdr win)
#f))
(make-flush))]
[else (vector*
(vector
(vector 'ptr_ptr_ptr->void gdk_window_show-p win #f #f))
(make-draw win gc-bitmap w h)
(make-flush))]))
(define (make-gc-hide-desc win gc-bitmap w h)
(vector
(vector*
;; draw the ``off'' bitmap so we can flush immediately
(make-draw win gc-bitmap w h)
(make-flush)
;; hide the window; it may take a while for the underlying canvas
;; to refresh:
(if gtk3?
(vector 'ptr_ptr_ptr->void
XUnmapWindow
(car win)
(cast (cdr win) _Window _pointer)
#f)
(vector 'ptr_ptr_ptr->void gdk_window_hide win #f #f))))
(vector
;; hide the window; it may take a while for the underlying canvas
;; to refresh:
(if use-x11?
(vector 'ptr_ptr_ptr->void
XUnmapWindow
(car win)
(cast (cdr win) _Window _pointer)
#f)
(vector 'ptr_ptr_ptr->void gdk_window_hide win #f #f)))))

5
gui-lib/mred/private/wx/gtk/procs.rkt
View File

@ -156,9 +156,10 @@
(define/top (make-screen-bitmap [exact-positive-integer? w]
[exact-positive-integer? h])
(if (eq? 'unix (system-type))
(if (and (eq? 'unix (system-type))
(not wayland?))
(make-object x11-bitmap% w h #f)
(make-object bitmap% w h #f #t)))
(make-object bitmap% w h #f #t (display-bitmap-resolution 0 (lambda () 1.0)))))
(define/top (make-gl-bitmap [exact-positive-integer? w]
[exact-positive-integer? h]

14
gui-lib/mred/private/wx/gtk/queue.rkt
View File

@ -16,6 +16,7 @@
try-to-sync-refresh
set-widget-hook!
x11-display)
wayland?
;; from common/queue:
current-eventspace
queue-event
@ -90,6 +91,19 @@
(gdk_set_program_class (cast v _pointer _string))))
display))))
;; ----------------------------------------
;; Check for Wayland vs. X11
(define-gdk gdk_display_get_default (_fun -> _GdkDisplay))
(define-gdk gdk_display_get_name (_fun _GdkDisplay -> _string))
(define wayland?
(and gtk3?
(regexp-match? #rx"^wayland"
(gdk_display_get_name
(gdk_display_get_default)))))
;; ------------------------------------------------------------
;; Gtk event pump

2
gui-lib/mred/private/wx/gtk/window.rkt
View File

@ -916,7 +916,7 @@
;; windows; that means we have to be extra careful that
;; the underlying window doesn't change while a freeze is
;; in effect; the `reset-child-freezes` helps with that.
(unless (and transparentish? gtk3?)
(unless (or (and transparentish? gtk3?) wayland?)
(gdk_window_ensure_native win))
(begin
(gdk_window_freeze_updates win)