work around win64 drawing problem

Merge to 5.1.2
(cherry picked from commit 8711aa6c5d)
This commit is contained in:
Matthew Flatt 2011-07-21 17:26:38 -06:00 committed by Eli Barzilay
parent 8ccff338fd
commit ad4377d44b

View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require ffi/unsafe (require ffi/unsafe
ffi/winapi
racket/class racket/class
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
@ -20,6 +21,8 @@
request-flush-delay request-flush-delay
cancel-flush-delay)) cancel-flush-delay))
(define-gdi32 SelectClipRgn (_wfun _pointer _pointer -> _int))
(define win32-bitmap% (define win32-bitmap%
(class bitmap% (class bitmap%
(init w h hwnd [gl-config #f]) (init w h hwnd [gl-config #f])
@ -70,6 +73,21 @@
(super-new [transparent? transparent?]) (super-new [transparent? transparent?])
(inherit internal-get-bitmap)
(define/override (reset-clip cr)
(super reset-clip cr)
;; Work around a Cairo(?) bug. When a clipping
;; region is set, we draw text, and then the clipping
;; region is changed, the change doesn't take
;; until we draw more text --- but only under Win64,
;; and only with DDB surfaces.
(when win64?
(let ([bm (internal-get-bitmap)])
(when (bm . is-a? . win32-bitmap%)
(SelectClipRgn (cairo_win32_surface_get_dc
(send bm get-cairo-surface))
#f)))))
(define gl #f) (define gl #f)
(define/override (get-gl-context) (define/override (get-gl-context)
(or gl (or gl