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

fix alpha plus draw-bitmap

Browse Source 
original commit: 86f0db41bcfef0dc68b7dd47dcc3ad8cd9000801
This commit is contained in:
Matthew Flatt 2010-07-29 18:45:39 -06:00
parent 1d62d8420e
commit a95c0b901c
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mred/private/wx/common/freeze.rkt
View File

@ -3,7 +3,7 @@
racket/draw/hold racket/draw/hold
"utils.rkt" "utils.rkt"
"queue.rkt" "queue.rkt"
"../../lock.rkt") ffi/unsafe/atomic)
(unsafe!) (unsafe!)
(provide call-as-unfreeze-point (provide call-as-unfreeze-point
@ -25,7 +25,7 @@
(let ([b (box null)]) (let ([b (box null)])
(parameterize ([freezer-box b]) (parameterize ([freezer-box b])
;; In atomic mode: ;; In atomic mode:
(as-entry (lambda () (thunk))) (call-as-atomic (lambda () (thunk)))
;; Out of atomic mode: ;; Out of atomic mode:
(let ([l (unbox b)]) (let ([l (unbox b)])
(for ([k (in-list (reverse l))]) (for ([k (in-list (reverse l))])
@ -69,7 +69,7 @@
(unless b (unless b
(internal-error "constrained-reply not within an unfreeze point")) (internal-error "constrained-reply not within an unfreeze point"))
(if (eq? (current-thread) (eventspace-handler-thread es)) (if (eq? (current-thread) (eventspace-handler-thread es))
(if (pair? b) (if (pair? (unbox b))
;; already suspended, so push this work completely: ;; already suspended, so push this work completely:
(set-box! b (cons thunk (unbox b))) (set-box! b (cons thunk (unbox b)))
;; try to do some work: ;; try to do some work:
@ -79,7 +79,7 @@
(when (and ready? (should-give-up?)) (when (and ready? (should-give-up?))
(scheme_call_with_composable_no_dws (scheme_call_with_composable_no_dws
(lambda (proc) (lambda (proc)
(set-box! (freezer-box) (cons proc (freezer-box))) (set-box! b (cons proc (unbox b)))
(scheme_restore_on_atomic_timeout prev) (scheme_restore_on_atomic_timeout prev)
(scheme_abort_continuation_no_dws (scheme_abort_continuation_no_dws
freeze-tag freeze-tag