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

Use bitmap' instead of icon->pict'

Browse Source 
Rename `pict->icon' to `pict->bitmap' and put in `slideshow/pict'
This commit is contained in:
Neil Toronto 2011-12-01 17:03:39 -07:00
parent daf371059d
commit 076453dacc
6 changed files with 47 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/icons/main.rkt
View File

@ -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

27
collects/icons/private/svg.rkt
View File

@ -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

39
collects/icons/scribblings/icons.scrbl
View File

@ -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)))
]

2
collects/icons/tests/icon-tests.rkt
View File

@ -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)]

6
collects/scribblings/slideshow/picts.scrbl
View File

@ -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?)]{

19
collects/slideshow/pict.rkt
View File

@ -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%))])
))