9058a148f8
The `gdk_window_ensure_native` call for window freeze and thaw really is needed, but since it is incompatible with transparent canvases, don't use freeze and thaw at all for those. Meanwhile, repair the backing bitmap for both GTK+ 2 and 3 for a transparent canvas when a scale is in effect. And go back to using X11 bitmaps for backing a canvas on GTK+ 3; I'm not sure that's the right choice, but probably putting the bitmap data on the X server instead of client is the right thing. Finally, restore GL bitmap support (partly by using X11 bitmaps to back a canvas). GL rendering to a canvas with a backing scale is not yet right, either for GTK+ 2 or 3.
244 lines
7.0 KiB
Racket
244 lines
7.0 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
racket/class
|
|
"utils.rkt"
|
|
"types.rkt"
|
|
"window.rkt"
|
|
"frame.rkt"
|
|
"x11.rkt"
|
|
"win32.rkt"
|
|
"gl-context.rkt"
|
|
"../../lock.rkt"
|
|
"../common/backing-dc.rkt"
|
|
racket/draw/unsafe/cairo
|
|
racket/draw/private/dc
|
|
racket/draw/private/bitmap
|
|
racket/draw/private/local
|
|
ffi/unsafe/alloc)
|
|
|
|
(provide
|
|
(protect-out dc%
|
|
do-backing-flush
|
|
x11-bitmap%
|
|
|
|
gdk_gc_new
|
|
gdk_gc_unref
|
|
gdk_gc_set_rgb_fg_color
|
|
gdk_gc_set_line_attributes
|
|
gdk_draw_rectangle))
|
|
|
|
(define-gdk gdk_cairo_create (_fun _pointer -> _cairo_t)
|
|
#:wrap (allocator cairo_destroy))
|
|
|
|
(define-gdk gdk_gc_unref (_fun _pointer -> _void)
|
|
#:wrap (deallocator)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_gc_new (_fun _GdkWindow -> _pointer)
|
|
#:wrap (allocator gdk_gc_unref)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_gc_set_rgb_fg_color (_fun _pointer _GdkColor-pointer -> _void)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_gc_set_line_attributes (_fun _pointer _int _int _int _int -> _void)
|
|
#:make-fail make-not-available)
|
|
(define-gdk gdk_draw_rectangle (_fun _GdkWindow _pointer _gboolean _int _int _int _int -> _void)
|
|
#:make-fail make-not-available)
|
|
|
|
(define-cstruct _GdkVisual-rec ([type-instance _pointer]
|
|
[ref_count _uint]
|
|
[qdata _pointer]
|
|
[type _int]
|
|
[depth _int]))
|
|
(define-gdk gdk_visual_get_system (_fun -> _GdkVisual-rec-pointer))
|
|
|
|
(define x11-bitmap%
|
|
(class bitmap%
|
|
(init w h gtk)
|
|
|
|
(define sf
|
|
(if gtk3?
|
|
(if gtk
|
|
(->screen (gtk_widget_get_scale_factor gtk))
|
|
(display-bitmap-resolution 0 (lambda () 1.0)))
|
|
(->screen 1.0)))
|
|
(define/private (scale x)
|
|
(min (max 1 (ceiling (inexact->exact (* sf x)))) 32000))
|
|
|
|
(define-values (pixmap xdisplay xvisual)
|
|
(let ([gdk-win (and gtk (widget-window gtk))])
|
|
(if gtk3?
|
|
(let* ([gdk-win (or gdk-win
|
|
(gdk_screen_get_root_window
|
|
(gdk_screen_get_default)))]
|
|
[xdisplay (gdk_x11_display_get_xdisplay
|
|
(if gdk-win
|
|
(gdk_window_get_display gdk-win)
|
|
(gdk_display_get_default)))]
|
|
[visual (gdk_window_get_visual gdk-win)])
|
|
(values (XCreatePixmap xdisplay
|
|
(gdk_x11_window_get_xid gdk-win)
|
|
(scale w) (scale h)
|
|
(gdk_visual_get_depth visual))
|
|
xdisplay
|
|
(gdk_x11_visual_get_xvisual visual)))
|
|
(let ([pixmap (gdk_pixmap_new gdk-win
|
|
(scale w)
|
|
(scale h)
|
|
(if gdk-win
|
|
-1
|
|
(GdkVisual-rec-depth
|
|
(gdk_visual_get_system))))])
|
|
(values pixmap
|
|
(gdk_x11_display_get_xdisplay
|
|
(gdk_drawable_get_display pixmap))
|
|
(gdk_x11_visual_get_xvisual
|
|
(gdk_drawable_get_visual pixmap)))))))
|
|
|
|
(define s
|
|
(cairo_xlib_surface_create xdisplay
|
|
(if gtk3?
|
|
(cast pixmap _Pixmap _ulong)
|
|
(gdk_x11_drawable_get_xid pixmap))
|
|
xvisual
|
|
(scale w)
|
|
(scale h)))
|
|
|
|
(define gl #f)
|
|
|
|
(super-make-object (make-alternate-bitmap-kind
|
|
w
|
|
h
|
|
sf))
|
|
|
|
;; initialize bitmap to white:
|
|
(let ([cr (cairo_create s)])
|
|
(cairo_set_source_rgba cr 1.0 1.0 1.0 1.0)
|
|
(cairo_paint cr)
|
|
(cairo_destroy cr))
|
|
|
|
;; `get-gdk-pixmap' and `install-gl-context' are
|
|
;; localized in "gl-context.rkt"
|
|
(define/public (get-gdk-pixmap) pixmap)
|
|
(define/public (install-gl-context new-gl) (set! gl new-gl))
|
|
|
|
(define/override (get-bitmap-gl-context) gl)
|
|
|
|
(define/override (ok?) #t)
|
|
(define/override (is-color?) #t)
|
|
(define/override (has-alpha-channel?) #f)
|
|
|
|
(define/override (get-cairo-surface) s)
|
|
|
|
(define/override (release-bitmap-storage)
|
|
(atomically
|
|
(cairo_surface_destroy s)
|
|
(if gtk3?
|
|
(XFreePixmap xdisplay pixmap)
|
|
(gobject-unref pixmap))
|
|
(set! s #f)))))
|
|
|
|
(define cairo-bitmap%
|
|
(class bitmap%
|
|
(init w h gtk)
|
|
(super-make-object w h #f #t
|
|
(if gtk3?
|
|
(if gtk
|
|
(->screen (gtk_widget_get_scale_factor gtk))
|
|
(display-bitmap-resolution 0 (lambda () 1.0)))
|
|
(->screen 1.0)))))
|
|
|
|
(define win32-bitmap%
|
|
(class bitmap%
|
|
(init w h gdk-win)
|
|
(super-make-object (make-alternate-bitmap-kind w h))
|
|
|
|
(define s
|
|
(if (not gdk-win)
|
|
(cairo_win32_surface_create_with_dib CAIRO_FORMAT_RGB24 w h)
|
|
(atomically
|
|
(let ([hdc (GetDC (gdk_win32_drawable_get_handle gdk-win))])
|
|
(begin0
|
|
(cairo_win32_surface_create_with_ddb hdc
|
|
CAIRO_FORMAT_RGB24 w h)
|
|
(ReleaseDC hdc))))))
|
|
|
|
(define/override (ok?) #t)
|
|
(define/override (is-color?) #t)
|
|
(define/override (has-alpha-channel?) #f)
|
|
|
|
(define/override (get-cairo-surface) s)
|
|
|
|
(define/override (release-bitmap-storage)
|
|
(atomically
|
|
(cairo_surface_destroy s)
|
|
(set! s #f)))))
|
|
|
|
(define dc%
|
|
(class backing-dc%
|
|
(init [(cnvs canvas)]
|
|
transparent?)
|
|
(inherit end-delay)
|
|
(define canvas cnvs)
|
|
(define gl #f)
|
|
(define can-delay? (not (and gtk3? transparent?)))
|
|
|
|
(super-new [transparent? transparent?])
|
|
|
|
(define/override (get-gl-context)
|
|
(or gl
|
|
(let ([v (create-widget-gl-context (send canvas get-client-gtk))])
|
|
(when v (set! gl v))
|
|
v)))
|
|
|
|
(define/override (make-backing-bitmap w h)
|
|
(cond
|
|
[(and (eq? 'unix (system-type))
|
|
(send canvas get-canvas-background))
|
|
(make-object x11-bitmap% w h (send canvas get-client-gtk))]
|
|
[(and (eq? 'windows (system-type))
|
|
(send canvas get-canvas-background))
|
|
(make-object win32-bitmap% w h (widget-window (send canvas get-client-gtk)))]
|
|
[else
|
|
;; Transparent canvas always use a Cairo bitmap:
|
|
(make-object cairo-bitmap% (max 1 w) (max 1 h) (send canvas get-client-gtk))]))
|
|
|
|
(define/override (get-backing-size xb yb)
|
|
(send canvas get-client-size xb yb))
|
|
|
|
(define/override (get-size)
|
|
(let ([xb (box 0)]
|
|
[yb (box 0)])
|
|
(send canvas get-virtual-size xb yb)
|
|
(values (unbox xb) (unbox yb))))
|
|
|
|
(define/override (queue-backing-flush)
|
|
;; Re-enable expose events so that the queued
|
|
;; backing flush will be handled:
|
|
(end-delay)
|
|
(send canvas queue-backing-flush))
|
|
|
|
(define/override (flush)
|
|
(send canvas flush))
|
|
|
|
(define/override (request-delay)
|
|
(if can-delay?
|
|
(request-flush-delay (send canvas get-flush-window))
|
|
(void)))
|
|
(define/override (cancel-delay req)
|
|
(when can-delay?
|
|
(cancel-flush-delay req)))))
|
|
|
|
(define (do-backing-flush canvas dc win-or-cr)
|
|
(send dc on-backing-flush
|
|
(lambda (bm)
|
|
(let ([w (box 0)]
|
|
[h (box 0)])
|
|
(send canvas get-client-size w h)
|
|
(let ([cr (if gtk3?
|
|
win-or-cr
|
|
(gdk_cairo_create win-or-cr))])
|
|
(cairo_scale cr (->screen 1.0) (->screen 1.0))
|
|
(backing-draw-bm bm cr (unbox w) (unbox h) 0 0 (->screen 1.0))
|
|
(unless gtk3?
|
|
(cairo_destroy cr)))))))
|