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

cap and join pen% initialization

Browse Source
This commit is contained in:
Matthew Flatt 2010-08-03 14:38:58 -06:00
parent c42d95216e
commit 1851d0b0a6
1 changed files with 24 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/racket/draw/pen.rkt
View File

@ -49,16 +49,24 @@
[() (void)] [() (void)]
[([color% _color] [([color% _color]
[pen-width? _width] [pen-width? _width]
[pen-style-symbol? _style]) [pen-style-symbol? _style]
[pen-cap-symbol? [_cap 'round]]
[pen-join-symbol? [_join 'round]])
(set! color (color->immutable-color _color)) (set! color (color->immutable-color _color))
(set! width _width) (set! width _width)
(set! style _style)] (set! style _style)
(set! cap _cap)
(set! join _join)]
[([string? _color] [([string? _color]
[pen-width? _width] [pen-width? _width]
[pen-style-symbol? _style]) [pen-style-symbol? _style]
[pen-cap-symbol? [_cap 'round]]
[pen-join-symbol? [_join 'round]])
(set! color (send the-color-database find-color _color)) (set! color (send the-color-database find-color _color))
(set! width _width) (set! width _width)
(set! style _style)] (set! style _style)
(set! cap _cap)
(set! join _join)]
(init-name 'pen%)) (init-name 'pen%))
(define immutable? #f) (define immutable? #f)
@ -104,26 +112,30 @@
(define pens (make-weak-hash)) (define pens (make-weak-hash))
(super-new) (super-new)
(define/public (find-or-create-pen . args) (define/public (find-or-create-pen . args)
(let-values ([(col w s) (let-values ([(col w s c j)
(case-args (case-args
args args
[([color% _color] [([color% _color]
[pen-width? _width] [pen-width? _width]
[pen-style-symbol? _style]) [pen-style-symbol? _style]
(values (color->immutable-color _color) _width _style)] [pen-cap-symbol? [_cap 'round]]
[pen-join-symbol? [_join 'round]])
(values (color->immutable-color _color)
_width _style _cap _join)]
[([string? _color] [([string? _color]
[pen-width? _width] [pen-width? _width]
[pen-style-symbol? _style]) [pen-style-symbol? _style]
[pen-cap-symbol? [_cap 'round]]
[pen-join-symbol? [_join 'round]])
(values (send the-color-database find-color _color) (values (send the-color-database find-color _color)
_width _width _style _cap _join)]
_style)]
(method-name 'find-or-create-pen 'pen-list%))]) (method-name 'find-or-create-pen 'pen-list%))])
(let ([key (vector (send col red) (send col green) (send col blue) (let ([key (vector (send col red) (send col green) (send col blue)
w s)]) w s c j)])
(let ([e (hash-ref pens key #f)]) (let ([e (hash-ref pens key #f)])
(or (and e (or (and e
(ephemeron-value e)) (ephemeron-value e))
(let* ([f (make-object pen% col w s)] (let* ([f (make-object pen% col w s c j)]
[e (make-ephemeron key f)]) [e (make-ephemeron key f)])
(send f s-set-key key) (send f s-set-key key)
(hash-set! pens key e) (hash-set! pens key e)