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

fix locks on some racket/draw tables to work right in atomic mode

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-28 12:12:53 -07:00
parent 3e3ed33cbf
commit 36e9e6fa20
3 changed files with 33 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/racket/draw/private/brush.rkt
View File

@ -1,5 +1,6 @@
#lang scheme/base
(require scheme/class
ffi/unsafe/atomic
"color.ss"
"syntax.ss"
"local.ss"
@ -116,14 +117,17 @@
(method-name 'find-or-create-brush 'brush-list%))])
(let ([key (vector (send col red) (send col green) (send col blue)
s)])
(let ([e (hash-ref brushes key #f)])
(or (and e
(ephemeron-value e))
(let* ([f (make-object brush% col s)]
[e (make-ephemeron key f)])
(send f s-set-key key)
(hash-set! brushes key e)
f)))))))
(start-atomic)
(begin0
(let ([e (hash-ref brushes key #f)])
(or (and e
(ephemeron-value e))
(let* ([f (make-object brush% col s)]
[e (make-ephemeron key f)])
(send f s-set-key key)
(hash-set! brushes key e)
f)))
(end-atomic))))))
(define the-brush-list (new brush-list%))

17
collects/racket/draw/private/font.rkt
View File

@ -264,14 +264,15 @@
(vector size (and face (string->immutable-string face)) family
style weight underlined? smoothing size-in-pixels?)]
(method-name 'find-or-create-font font-list%))])
(let ([e (hash-ref fonts key #f)])
(or (and e
(ephemeron-value e))
(let* ([f (apply make-object font% (vector->list key))]
[e (make-ephemeron key f)])
(send f s-set-table-key key)
(hash-set! fonts key e)
f))))))
(atomically
(let ([e (hash-ref fonts key #f)])
(or (and e
(ephemeron-value e))
(let* ([f (apply make-object font% (vector->list key))]
[e (make-ephemeron key f)])
(send f s-set-table-key key)
(hash-set! fonts key e)
f)))))))
(define the-font-list (new font-list%))

20
collects/racket/draw/private/pen.rkt
View File

@ -1,5 +1,6 @@
#lang scheme/base
(require scheme/class
ffi/unsafe/atomic
"color.ss"
"syntax.ss"
"local.ss"
@ -159,14 +160,17 @@
(method-name 'find-or-create-pen 'pen-list%))])
(let ([key (vector (send col red) (send col green) (send col blue)
w s c j)])
(let ([e (hash-ref pens key #f)])
(or (and e
(ephemeron-value e))
(let* ([f (make-object pen% col w s c j)]
[e (make-ephemeron key f)])
(send f s-set-key key)
(hash-set! pens key e)
f)))))))
(start-atomic)
(begin0
(let ([e (hash-ref pens key #f)])
(or (and e
(ephemeron-value e))
(let* ([f (make-object pen% col w s c j)]
[e (make-ephemeron key f)])
(send f s-set-key key)
(hash-set! pens key e)
f)))
(end-atomic))))))
(define the-pen-list (new pen-list%))