From 5d7f04448802ef955c59cd68d47ed667652f2783 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 21 Jul 2010 16:19:12 -0600 Subject: [PATCH] change mrlib/image-core to use pen-list% cap and join support --- collects/mrlib/image-core.rkt | 31 ++++++------------------------- 1 file changed, 6 insertions(+), 25 deletions(-) diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt index 9e474ebbef..9608c0823e 100644 --- a/collects/mrlib/image-core.rkt +++ b/collects/mrlib/image-core.rkt @@ -947,32 +947,13 @@ the mask bitmap and the original bitmap are all together in a single bytes! (color-blue color)))) -(define pen-ht (make-hash)) - (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 - (pen-color pen) - (pen-width pen) - (pen-style pen))] - [else - (let* ([wb/f (hash-ref pen-ht pen #f)] - [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)) + (send the-pen-list find-or-create-pen + (pen-color pen) + (pen-width pen) + (pen-style pen) + (pen-cap pen) + (pen-join pen))) (define (to-img arg) (cond