change mrlib/image-core to use pen-list% cap and join support
This commit is contained in:
parent
fa68e23c37
commit
5d7f044488
|
@ -947,32 +947,13 @@ the mask bitmap and the original bitmap are all together in a single bytes!
|
||||||
(color-blue color))))
|
(color-blue color))))
|
||||||
|
|
||||||
|
|
||||||
(define pen-ht (make-hash))
|
|
||||||
|
|
||||||
(define (pen->pen-obj/cache pen)
|
(define (pen->pen-obj/cache pen)
|
||||||
(cond
|
|
||||||
[(and (equal? 'round (pen-join pen))
|
|
||||||
(equal? 'round (pen-cap pen)))
|
|
||||||
(send the-pen-list find-or-create-pen
|
(send the-pen-list find-or-create-pen
|
||||||
(pen-color pen)
|
(pen-color pen)
|
||||||
(pen-width pen)
|
(pen-width pen)
|
||||||
(pen-style pen))]
|
(pen-style pen)
|
||||||
[else
|
(pen-cap pen)
|
||||||
(let* ([wb/f (hash-ref pen-ht pen #f)]
|
(pen-join pen)))
|
||||||
[pen-obj/f (and (weak-box? wb/f) (weak-box-value wb/f))])
|
|
||||||
(or pen-obj/f
|
|
||||||
(let ([pen-obj (pen->pen-obj pen)])
|
|
||||||
(hash-set! pen-ht pen (make-weak-box pen-obj))
|
|
||||||
pen-obj)))]))
|
|
||||||
|
|
||||||
(define (pen->pen-obj pen)
|
|
||||||
(let ([ans (make-object pen%
|
|
||||||
(pen-color pen)
|
|
||||||
(pen-width pen)
|
|
||||||
(pen-style pen))])
|
|
||||||
(send ans set-cap (pen-cap pen))
|
|
||||||
(send ans set-join (pen-join pen))
|
|
||||||
ans))
|
|
||||||
|
|
||||||
(define (to-img arg)
|
(define (to-img arg)
|
||||||
(cond
|
(cond
|
||||||
|
|
Loading…
Reference in New Issue
Block a user