From 076453daccd07cf5b7f138511597b9f3d4f35aa7 Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Thu, 1 Dec 2011 17:03:39 -0700 Subject: [PATCH] Use `bitmap' instead of `icon->pict' Rename `pict->icon' to `pict->bitmap' and put in `slideshow/pict' --- collects/icons/main.rkt | 2 -- collects/icons/private/svg.rkt | 27 ++++----------- collects/icons/scribblings/icons.scrbl | 39 ++++++++++------------ collects/icons/tests/icon-tests.rkt | 2 +- collects/scribblings/slideshow/picts.scrbl | 6 ++++ collects/slideshow/pict.rkt | 19 +++++++++-- 6 files changed, 47 insertions(+), 48 deletions(-) diff --git a/collects/icons/main.rkt b/collects/icons/main.rkt index 53d33b4506..85776debb1 100644 --- a/collects/icons/main.rkt +++ b/collects/icons/main.rkt @@ -11,8 +11,6 @@ icon-style/c toolbar-icon-height default-icon-style - icon->pict - pict->icon load-icon-pict load-icon format-icon-name diff --git a/collects/icons/private/svg.rkt b/collects/icons/private/svg.rkt index 210a381078..3d840036cf 100644 --- a/collects/icons/private/svg.rkt +++ b/collects/icons/private/svg.rkt @@ -16,32 +16,17 @@ (defparam toolbar-icon-height (>/c 0) 16) (defparam default-icon-style (or/c 'diffuse 'shiny) 'diffuse) -(defproc (icon->pict [icon (is-a?/c bitmap%)]) pict? - (bitmap icon)) - -(defproc (pict->icon [p pict?]) (is-a?/c bitmap%) - (define w (pict-width p)) - (define h (pict-height p)) - (define bm (make-bitmap (max 1 (inexact->exact (ceiling w))) - (max 1 (inexact->exact (ceiling h))))) - (define dc (make-object bitmap-dc% bm)) - (send dc set-smoothing 'smoothed) - (draw-pict p dc 0 0) - bm) - (defproc (load-icon-pict [category string?] [name string?] [height (>=/c 0)]) pict? (define hs (icon-category-heights category)) (define icon-height (let ([h (for/first ([h (in-list hs)] #:when (height . <= . h)) h)]) (if h h (last hs)))) - (define icon - (make-object bitmap% - (build-path svg-icons-base-path (format "~a/~a/~a.png" category icon-height name)) - 'png/alpha)) - (scale (icon->pict icon) (/ height icon-height))) + (define icon-path + (build-path svg-icons-base-path (format "~a/~a/~a.png" category icon-height name))) + (scale (bitmap icon-path) (/ height icon-height))) (defproc (load-icon [category string?] [name string?] [height (>=/c 0)]) (is-a?/c bitmap%) - (pict->icon (load-icon-pict category name height))) + (pict->bitmap (load-icon-pict category name height))) (defproc (format-icon-name [name string?] [color icon-color/c] [style (or/c icon-style/c #f) (default-icon-style)]) string? @@ -183,7 +168,7 @@ (syntax/loc stx (begin (defproc (f [color icon-color/c] [height (>=/c 0)] [style icon-style/c (default-icon-style)]) (is-a?/c bitmap%) - (pict->icon (f-pict color height style))) + (pict->bitmap (f-pict color height style))) ...)))])) (define-syntax (define-wrapped-icon-fun/no-color stx) @@ -194,7 +179,7 @@ (syntax/loc stx (begin (defproc (f [height (>=/c 0)] [style icon-style/c (default-icon-style)]) (is-a?/c bitmap%) - (pict->icon (f-pict height style))) + (pict->bitmap (f-pict height style))) ...)))])) (define-wrapped-icon-fun diff --git a/collects/icons/scribblings/icons.scrbl b/collects/icons/scribblings/icons.scrbl index 3d1d412144..5db80bccbe 100644 --- a/collects/icons/scribblings/icons.scrbl +++ b/collects/icons/scribblings/icons.scrbl @@ -74,7 +74,7 @@ Icon sizes are given as heights to make it easier to append them horizontally. In the following example, applying @racket[load-icon] is equivalent to @racket[(plt-logo 100 'diffuse)]: @interaction[#:eval icon-eval (load-icon "logo" "plt-logo-diffuse" 100)] -(In the interactions window, you would have to send the result of applying @racket[load-icon] to @racket[icon->pict] to see it.) +(In the interactions window, you would have to send the result of applying @racket[load-icon] to @racket[bitmap] to see it.) @doc-apply[icon-categories]{ Returns a list of all the icon categories. @@ -221,36 +221,33 @@ A contract that identifies icon styles. It is more flexible, but a little more complicated, to load icons as @racket[pict]s. As picts, icons can easily be appended, inset, superimposed, blurred, and more. - -To use these functions effectively, you should require @racketmodname[icons] and @racketmodname[slideshow/pict] together. - -Almost all of the functions in preceeding sections are defined in terms of the functions documented in this section. +Almost all of the functions in preceeding sections are defined in terms of the @racket[pict]-producing functions documented in this section. @interaction-eval[#:eval icon-eval (require slideshow/pict)] -@doc-apply[load-icon-pict]{ -Corresponds to @racket[load-icon]. In fact, @racket[load-icon] uses @racket[load-icon-pict] to load the icon as a @racket[pict], and passes it to @racket[pict->icon]. -} +To use these functions effectively, you should require @racketmodname[icons] and @racketmodname[slideshow/pict] together. +Use @racket[bitmap] to convert a @racket[bitmap%] (e.g. an icon) to a @racket[pict], and @racket[pict->bitmap] to convert back. -@doc-apply[icon->pict] -@doc-apply[pict->icon]{ -Convert from an icon to a @racket[pict], and back. - -The conversion from @racket[pict]s to icons can be lossy because it renders vector graphics as a bitmap. For example, converting text can look especially horrible: +Converting from @racket[pict]s to bitmaps can be lossy. For example, converting text can look especially horrible: @interaction[#:eval icon-eval (scale (text "Hello" null 10) 5) - (scale (icon->pict (pict->icon (text "Hello" null 10))) 5)] + (scale (bitmap (pict->bitmap (text "Hello" null 10))) 5)] -Therefore, when composing icons from parts, work only with @racket[pict]s, and convert to an icon as the last step. +Therefore, when composing icons from parts, try to work only with @racket[pict]s, and convert to an icon using @racket[pict->bitmap] as the last step. -On the other hand, @racket[(compose pict->icon icon->pict)] always returns an equivalent icon: +When composing icons from parts, it is fine to use @racket[pict]s converted from @racket[bitmap%]s. +Without scaling or rotating, the conversion is lossless: @interaction[#:eval icon-eval (define not-blurry (magnifying-glass-icon 'green 64 'shiny)) not-blurry - (define still-not-blurry - (for/fold ([icon not-blurry]) ([i (in-range 30)]) - (pict->icon (icon->pict icon)))) - still-not-blurry] + (for/fold ([icon not-blurry]) ([i (in-range 30)]) + (pict->bitmap (bitmap icon)))] + +Avoid converting between @racket[pict]s and @racket[bitmap%]s more than once if bitmap-backed @racket[pict]s are scaled, rotated by angles that are not multiples of 90 degrees, or superimposed or appended at non-integer coordinates. +Avoid scaling up in general. + +@doc-apply[load-icon-pict]{ +Corresponds to @racket[load-icon]. In fact, @racket[load-icon] uses @racket[load-icon-pict] to load the icon as a @racket[pict], and passes it to @racket[pict->bitmap]. } @doc-apply[go-icon-pict] @@ -360,5 +357,5 @@ For convenience, write functions to load the icon; for example, height)) (define (silly-walk-icon color height [style (default-icon-style)]) - (pict->icon (silly-walk-icon-pict color height style))) + (pict->bitmap (silly-walk-icon-pict color height style))) ] diff --git a/collects/icons/tests/icon-tests.rkt b/collects/icons/tests/icon-tests.rkt index f336f30e37..95718f219b 100644 --- a/collects/icons/tests/icon-tests.rkt +++ b/collects/icons/tests/icon-tests.rkt @@ -75,7 +75,7 @@ 3/4)) (define not-blurry - (let* ([1x (compose icon->pict pict->icon)] + (let* ([1x (compose bitmap pict->bitmap)] [2x (compose 1x 1x)] [4x (compose 2x 2x)] [8x (compose 4x 4x)] diff --git a/collects/scribblings/slideshow/picts.scrbl b/collects/scribblings/slideshow/picts.scrbl index e911925ae8..f3ded6765d 100644 --- a/collects/scribblings/slideshow/picts.scrbl +++ b/collects/scribblings/slideshow/picts.scrbl @@ -1074,6 +1074,12 @@ Draws @racket[pict] to @racket[dc], with its top-left corner at offset (@racket[x], @racket[y]).} +@defproc[(pict->bitmap [pict pict?]) + (is-a?/c bitmap%)]{ + +Returns a @racket[bitmap%] with an alpha channel, no larger than @racket[pict], with @racket[pict] drawn on it in the top-left corner (@racket[0], @racket[0]).} + + @defproc[(make-pict-drawer [pict pict?]) ((is-a?/c dc<%>) real? real? . -> . void?)]{ diff --git a/collects/slideshow/pict.rkt b/collects/slideshow/pict.rkt index 3a3ab89009..aa29106944 100644 --- a/collects/slideshow/pict.rkt +++ b/collects/slideshow/pict.rkt @@ -7,8 +7,9 @@ [pin-line t:pin-line] [pin-arrow-line t:pin-arrow-line] [pin-arrows-line t:pin-arrows-line]) - (only-in racket/draw dc-path%) - (only-in racket/class new send)) + (only-in racket/draw dc-path% make-bitmap bitmap% bitmap-dc%) + (only-in racket/class new send make-object is-a?/c) + racket/contract) (define (hline w h #:segment [seg #f]) (if seg @@ -200,6 +201,16 @@ (standard-fish w h direction color eye-color open-mouth))]) standard-fish)) + (define (pict->bitmap p) + (define w (pict-width p)) + (define h (pict-height p)) + (define bm (make-bitmap (max 1 (inexact->exact (ceiling w))) + (max 1 (inexact->exact (ceiling h))))) + (define dc (make-object bitmap-dc% bm)) + (send dc set-smoothing 'smoothed) + (draw-pict p dc 0 0) + bm) + (provide hline vline frame pict-path? @@ -262,4 +273,6 @@ standard-fish find-pen find-brush) - (rename-out [fish standard-fish]))) + (rename-out [fish standard-fish]) + (contract-out [pict->bitmap (pict? . -> . (is-a?/c bitmap%))]) + ))