remove unnecessary finalization (GTK+ 3)
Essentially the same as the GTK+ 2 repair.
This commit is contained in:
parent
1c65d669f3
commit
e67865a8ba
|
@ -97,16 +97,13 @@
|
|||
(XFreePixmap dpy pixmap)))
|
||||
(lambda ()
|
||||
(proc dpy win w h d)))))))
|
||||
(define-x11 XDestroyWindow (_fun _Display _Window -> _void)
|
||||
#:wrap (deallocator cadr))
|
||||
|
||||
;; No finalization here, because we rely on destroying the
|
||||
;; enclosing window to release a created window, if
|
||||
;; necessary.
|
||||
(define-x11 XDestroyWindow (_fun _Display _Window -> _void))
|
||||
(define-x11 XCreateSimpleWindow (_fun _Display _Window
|
||||
_int _int _int _int
|
||||
_int _long _long
|
||||
-> _Window)
|
||||
#:wrap (lambda (proc)
|
||||
(lambda (dpy win x y w h bw b bg)
|
||||
(((allocator (lambda (win)
|
||||
(XDestroyWindow dpy win)))
|
||||
(lambda ()
|
||||
(proc dpy win x y w h bw b bg)))))))
|
||||
-> _Window))
|
||||
|
||||
|
|
22
gui-test/tests/gracket/gc-blits.rkt
Normal file
22
gui-test/tests/gracket/gc-blits.rkt
Normal file
|
@ -0,0 +1,22 @@
|
|||
#lang racket/base
|
||||
(require racket/class
|
||||
racket/gui/base)
|
||||
|
||||
(define w 50)
|
||||
(define h 50)
|
||||
(define on (make-bitmap w h))
|
||||
(define off (make-bitmap w h))
|
||||
(send (send on make-dc) draw-rectangle 5 5 (- w 10) (- h 10))
|
||||
|
||||
(send
|
||||
(for/fold ([prev-f #f]) ([i (in-range 10)])
|
||||
(define f (new frame% [label "GC Blit"] [width 100] [height 100]))
|
||||
(define c (new canvas% [parent f]))
|
||||
(register-collecting-blit c 0 0 w h on off)
|
||||
(send f show #t)
|
||||
(collect-garbage)
|
||||
(yield (system-idle-evt))
|
||||
(when prev-f (send prev-f show #f))
|
||||
f)
|
||||
show #f)
|
||||
|
Loading…
Reference in New Issue
Block a user