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

Added JPEG compression to compiled-bitmap' and compiled-bitmap-list'

Browse Source 
Added "whirl and pinch" transform
This commit is contained in:
Neil Toronto 2012-02-01 21:59:01 -07:00
parent 999e481785
commit dc677998f0
9 changed files with 319 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
collects/images/compile-time.rkt
View File

@ -1,33 +1,103 @@
#lang racket/base
(require (for-syntax racket/base racket/class racket/draw)
(require (for-syntax racket/base
racket/class racket/draw racket/math)
racket/class racket/draw)
(provide compiled-bitmap compiled-bitmap-list)
(define-for-syntax (make-3d-bitmap ctxt bm)
(define p (open-output-bytes))
(send bm save-file p 'png)
(with-syntax ([bs (datum->syntax ctxt (get-output-bytes p))])
(syntax/loc ctxt
(make-object bitmap% (open-input-bytes bs) 'png/alpha))))
(begin-for-syntax
(define (save-png bm)
(define p (open-output-bytes))
(send bm save-file p 'png)
(define bs (get-output-bytes p))
;(printf "Wrote PNG: ~v bytes~n" (bytes-length bs))
bs)
(define (save-jpeg bm quality)
(define w (send bm get-width))
(define h (send bm get-height))
(define bs (make-bytes (* 4 w h)))
(send bm get-argb-pixels 0 0 w h bs #t)
(for ([i (in-range 0 (* 4 w h) 4)])
(define a (bytes-ref bs i))
(bytes-set! bs i 255)
(bytes-set! bs (+ i 1) a)
(bytes-set! bs (+ i 2) a)
(bytes-set! bs (+ i 3) a))
(define alpha-bm (make-bitmap w h #f))
(send alpha-bm set-argb-pixels 0 0 w h bs)
(define alpha-p (open-output-bytes))
(send alpha-bm save-file alpha-p 'jpeg quality)
(send bm get-argb-pixels 0 0 w h bs #f)
(define rgb-bm (make-bitmap w h #f))
(send rgb-bm set-argb-pixels 0 0 w h bs #f)
(define rgb-p (open-output-bytes))
(send rgb-bm save-file rgb-p 'jpeg quality)
(define alpha-bs (get-output-bytes alpha-p))
(define rgb-bs (get-output-bytes rgb-p))
;(printf "Wrote JPEG: ~v bytes~n" (+ (bytes-length alpha-bs) (bytes-length rgb-bs)))
(values alpha-bs rgb-bs))
(define (make-3d-bitmap ctxt bm quality)
(cond [(= quality 100)
(with-syntax ([bs (datum->syntax ctxt (save-png bm))])
(syntax/loc ctxt (load-png bs)))]
[else
(define-values (alpha-bs rgb-bs) (save-jpeg bm quality))
(with-syntax ([alpha-bs (datum->syntax ctxt alpha-bs)]
[rgb-bs (datum->syntax ctxt rgb-bs)])
(syntax/loc ctxt (load-jpeg alpha-bs rgb-bs)))]))
)
(define (load-png bs)
(read-bitmap (open-input-bytes bs) 'png/alpha))
(define (load-jpeg alpha-bs rgb-bs)
(define alpha-bm (read-bitmap (open-input-bytes alpha-bs) 'jpeg))
(define rgb-bm (read-bitmap (open-input-bytes rgb-bs) 'jpeg))
(define w (send rgb-bm get-width))
(define h (send rgb-bm get-height))
(define new-bs (make-bytes (* 4 w h)))
(send rgb-bm get-argb-pixels 0 0 w h new-bs #f)
(define bs (make-bytes (* 4 w h)))
(send alpha-bm get-argb-pixels 0 0 w h bs #f)
(for ([i (in-range 0 (* 4 w h) 4)])
(define a (bytes-ref bs (+ i 2)))
(bytes-set! new-bs i a))
(define new-bm (make-bitmap w h))
(send new-bm set-argb-pixels 0 0 w h new-bs #f)
new-bm)
(define-syntax (compiled-bitmap stx)
(syntax-case stx ()
[(_ expr) (syntax/loc stx
(let-syntax ([maker (λ (inner-stx)
(define bm expr)
(unless (is-a? bm bitmap%)
(raise-syntax-error
'compiled-bitmap
(format "expected argument of type <bitmap%>; given ~e" bm)
#'expr))
(make-3d-bitmap inner-stx bm))])
(maker)))]))
[(_ expr)
(syntax/loc stx (compiled-bitmap expr 100))]
[(_ expr quality)
(syntax/loc stx
(let-syntax ([maker (λ (inner-stx)
(define bm expr)
(unless (is-a? bm bitmap%)
(raise-syntax-error
'compiled-bitmap
(format "expected argument of type <bitmap%>; given ~e" bm)
#'expr))
(make-3d-bitmap inner-stx bm quality))])
(maker)))]))
(define-syntax (compiled-bitmap-list stx)
(syntax-case stx ()
[(_ expr)
(syntax/loc stx (compiled-bitmap-list expr 100))]
[(_ expr quality)
(syntax/loc stx
(let-syntax ([maker (λ (inner-stx)
(define bms expr)
@ -37,6 +107,6 @@
(format "expected argument of type <list of bitmap%>; given ~e" bms)
#'expr))
(with-syntax ([(bm (... ...))
(map (λ (e) (make-3d-bitmap inner-stx e)) bms)])
(map (λ (e) (make-3d-bitmap inner-stx e quality)) bms)])
#'(list bm (... ...))))])
(maker)))]))

39
collects/images/logos.rkt
View File

@ -150,13 +150,14 @@
lambda-fm)]
[fm (flomap-cc-superimpose
(draw-icon-flomap
256 256 (λ (dc)
(send dc set-pen "lightblue" 2 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-ellipse 7 7 242 242)
(send dc set-pen lambda-outline-color 4 'solid)
(send dc draw-ellipse 2 2 252 252))
scale)
32 32 (λ (dc)
(send dc set-pen lambda-outline-color 1/2 'solid)
(send dc set-brush "white" 'solid)
(draw-ellipse/smoothed dc -0.25 -0.25 32.5 32.5)
(send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent)
(draw-ellipse/smoothed dc 0.5 0.5 31 31))
(/ height 32))
fm)])
fm)))
@ -288,11 +289,12 @@
(flomap-cc-superimpose
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen lambda-outline-color 1/2 'solid)
(send dc set-brush "white" 'solid)
(draw-ellipse/smoothed dc -0.25 -0.25 32.5 32.5)
(send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-ellipse 0.5 0.5 31 31)
(send dc set-pen lambda-outline-color 1/2 'solid)
(send dc draw-ellipse -0.25 -0.25 32.5 32.5))
(draw-ellipse/smoothed dc 0.5 0.5 31 31))
scale)
earth-fm
land-fm)))
@ -332,10 +334,12 @@
-28 4 -44 12 -60 32))
1/8 1/8))
(define racket-r-outline-color (make-object color% 64 16 16))
(define (racket-r-flomap color height)
(draw-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc lambda-outline-color 3/8 'solid)
(set-icon-pen dc racket-r-outline-color 3/8 'solid)
(send dc set-brush color 'solid)
(draw-path-commands dc racket-r-commands 0 0))
(/ height 32)))
@ -352,9 +356,9 @@
[height]
(define scale (/ height 32))
(define sphere-fm
(let* ([indent-fm (racket-r-flomap lambda-outline-color height)]
(let* ([indent-fm (racket-r-flomap racket-r-outline-color height)]
[indent-dfm (flomap->deep-flomap indent-fm)]
[indent-dfm (deep-flomap-raise indent-dfm (* -1.5 scale))]
[indent-dfm (deep-flomap-raise indent-dfm (* -0.75 scale))]
[indent-dfm (deep-flomap-smooth-z indent-dfm (* 0.5 scale))]
[sphere-fm (draw-icon-flomap
32 32 (λ (dc)
@ -373,14 +377,12 @@
scale)]
[sphere-dfm (flomap->deep-flomap sphere-fm)]
[sphere-dfm (deep-flomap-bulge-spheroid sphere-dfm (* 14 scale))]
[sphere-dfm (deep-flomap-raise sphere-dfm (* 0 scale))]
[sphere-dfm (deep-flomap-cc-superimpose 'add sphere-dfm indent-dfm)])
(deep-flomap-render-icon sphere-dfm glass-logo-material)))
(define r-fm
(let* ([r-fm (racket-r-flomap light-metal-icon-color height)]
[r-dfm (flomap->deep-flomap r-fm)]
;[r-dfm (deep-flomap-emboss r-dfm (* 2 scale) (* 8 scale))]
[r-dfm (deep-flomap-bulge-round r-dfm (* 48 scale))]
[r-dfm (deep-flomap-smooth-z r-dfm (* 1/2 scale))])
(deep-flomap-render-icon r-dfm metal-material)))
@ -388,11 +390,12 @@
(flomap-cc-superimpose
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen racket-r-outline-color 1/2 'solid)
(send dc set-brush "white" 'solid)
(draw-ellipse/smoothed dc -0.25 -0.25 32.5 32.5)
(send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-ellipse 0.5 0.5 31 31)
(send dc set-pen lambda-outline-color 1/2 'solid)
(send dc draw-ellipse -0.25 -0.25 32.5 32.5))
(draw-ellipse/smoothed dc 0.5 0.5 31 31))
scale)
sphere-fm
r-fm)))

44
collects/images/private/flomap-effects.rkt
View File

@ -1,16 +1,18 @@
#lang typed/racket/base
(require racket/flonum
(require racket/flonum racket/math racket/match racket/list
(except-in racket/fixnum fl->fx fx->fl)
racket/match racket/list
"flonum.rkt"
"flomap-struct.rkt"
"flomap-pointwise.rkt"
"flomap-blur.rkt"
"flomap-composite.rkt")
"flomap-composite.rkt"
"flomap-resize.rkt"
"flomap-transform.rkt")
(provide flomap-outline flomap-outlined
flomap-shadow flomap-shadowed)
flomap-shadow flomap-shadowed
flomap-whirl-morph)
(: colorize-alpha (flomap (Listof Real) -> flomap))
(define (colorize-alpha fm color)
@ -65,3 +67,37 @@
(case-lambda
[(fm amt) (flomap-outlined fm amt #f)]
[(fm amt c) (flomap-cc-superimpose (flomap-outline fm amt c) fm)]))
(define blend-start 1/3)
(define blend-end 2/3)
(: flomap-whirl-morph (flomap flomap -> (Real -> flomap)))
(define (flomap-whirl-morph fm1 fm2)
(define w (max (flomap-width fm1) (flomap-width fm2)))
(define h (max (flomap-height fm1) (flomap-height fm2)))
(let ([fm1 (flomap-crop fm1 w h 1/2 1/2)]
[fm2 (flomap-crop fm2 w h 1/2 1/2)])
(define: (whirled-fm1 [t : Real]) : flomap
(define t1 (sqr t))
(define trans1
(transform-compose (whirl-and-pinch-transform (* t1 (* -8 pi)) (* -4 t1) 1)
(rotate-transform (* t1 (* -1 pi)))))
(flomap-transform fm1 trans1 0 w 0 h))
(define: (whirled-fm2 [t : Real]) : flomap
(define t2 (sqr (- 1 t)))
(define trans2
(transform-compose (rotate-transform (* t2 (* 1 pi)))
(whirl-and-pinch-transform (* t2 (* 8 pi)) (* -4 t2) 1)))
(flomap-transform fm2 trans2 0 w 0 h))
(λ (t)
(cond [(t . <= . 0) fm1]
[(t . >= . 1) fm2]
[else
(cond [(t . <= . blend-start) (whirled-fm1 t)]
[(t . >= . blend-end) (whirled-fm2 t)]
[else
(define b (/ (- t blend-start) (- blend-end blend-start)))
(fm+ (fm* (- 1 b) (whirled-fm1 t)) (fm* b (whirled-fm2 t)))])]))))

40
collects/images/private/flomap-struct.rkt
View File

@ -53,24 +53,28 @@
(: flomap-bilinear-ref (flomap Integer Real Real -> Flonum))
(define (flomap-bilinear-ref fm k x y)
(match-define (flomap vs c w h) fm)
(unless (and (k . >= . 0) (k . < . c))
(raise-type-error 'flomap-bilinear-ref (format "nonnegative fixnum < ~e" c) k))
(let ([x (- (exact->inexact x) 0.5)]
[y (- (exact->inexact y) 0.5)])
(define floor-x (floor x))
(define floor-y (floor y))
(define x0 (fl->fx floor-x))
(define y0 (fl->fx floor-y))
(define x1 (fx+ x0 1))
(define y1 (fx+ y0 1))
(define v00 (unsafe-flomap-ref vs c w h k x0 y0))
(define v10 (unsafe-flomap-ref vs c w h k x1 y0))
(define v01 (unsafe-flomap-ref vs c w h k x0 y1))
(define v11 (unsafe-flomap-ref vs c w h k x1 y1))
(define xα (- x floor-x))
(fl-convex-combination (fl-convex-combination v00 v10 xα)
(fl-convex-combination v01 v11 xα)
(- y floor-y))))
(cond [(and (k . >= . 0) (k . < . c))
(let ([x (- (exact->inexact x) 0.5)]
[y (- (exact->inexact y) 0.5)])
(cond [(and (x . > . -0.5) (x . < . (+ 0.5 (fx->fl w)))
(y . > . -0.5) (y . < . (+ 0.5 (fx->fl h))))
(define floor-x (floor x))
(define floor-y (floor y))
(define x0 (fl->fx floor-x))
(define y0 (fl->fx floor-y))
(define x1 (fx+ x0 1))
(define y1 (fx+ y0 1))
(define v00 (unsafe-flomap-ref vs c w h k x0 y0))
(define v10 (unsafe-flomap-ref vs c w h k x1 y0))
(define v01 (unsafe-flomap-ref vs c w h k x0 y1))
(define v11 (unsafe-flomap-ref vs c w h k x1 y1))
(define xα (- x floor-x))
(fl-convex-combination (fl-convex-combination v00 v10 xα)
(fl-convex-combination v01 v11 xα)
(- y floor-y))]
[else 0.0]))]
[else
(raise-type-error 'flomap-bilinear-ref (format "nonnegative fixnum < ~e" c) 1 fm k x y)]))
;; ===================================================================================================
;; Construction and conversion

70
collects/images/private/flomap-transform.rkt
View File

@ -1,15 +1,15 @@
#lang typed/racket/base
(require racket/flonum
(require racket/match racket/math racket/flonum
(except-in racket/fixnum fl->fx fx->fl)
racket/match
"flonum.rkt"
"flomap-struct.rkt")
(provide flomap-flip-horizontal flomap-flip-vertical flomap-transpose
flomap-cw-rotate flomap-ccw-rotate
invertible-2d-function Flomap-Transform
flomap-transform rotate-transform
(struct-out invertible-2d-function) Flomap-Transform
transform-compose rotate-transform whirl-and-pinch-transform
flomap-transform
)
(: flomap-flip-horizontal (flomap -> flomap))
@ -47,6 +47,17 @@
(define-type Flomap-Transform (Integer Integer -> invertible-2d-function))
(: transform-compose (Flomap-Transform Flomap-Transform -> Flomap-Transform))
(define ((transform-compose t1 t2) w h)
(match-define (invertible-2d-function f1 g1) (t1 w h))
(match-define (invertible-2d-function f2 g2) (t2 w h))
(invertible-2d-function (λ: ([x : Flonum] [y : Flonum])
(let-values ([(x y) (f2 x y)])
(f1 x y)))
(λ: ([x : Flonum] [y : Flonum])
(let-values ([(x y) (g1 x y)])
(g2 x y)))))
(: flomap-transform (case-> (flomap Flomap-Transform -> flomap)
(flomap Flomap-Transform Real Real Real Real -> flomap)))
(define flomap-transform
@ -70,7 +81,7 @@
(x-loop (fx+ x 1))]
[else
(y-loop (fx+ y 1))]))))
(flomap-transform fm t (- x-min 0.5) (+ x-max 0.5) (- y-min 0.5) (+ y-max 0.5))]
(flomap-transform fm t x-min x-max y-min y-max)]
[(fm t x-min x-max y-min y-max)
(let ([x-min (exact->inexact x-min)]
[x-max (exact->inexact x-max)]
@ -111,3 +122,52 @@
[y (- y y-mid)])
(values (+ x-mid (+ (* x cos-θ) (* y sin-θ)))
(+ y-mid (- (* y cos-θ) (* x sin-θ)))))))))
(: flexpt (Flonum Flonum -> Flonum))
(define (flexpt b x)
(exp (* x (fllog b))))
(: whirl-and-pinch-function (Real Real Real Integer Integer
-> (Flonum Flonum -> (values Flonum Flonum))))
(define (whirl-and-pinch-function θ pinch radius w h)
(let ([θ (exact->inexact θ)]
[pinch (- (exact->inexact pinch))]
[radius (exact->inexact radius)])
(define pinch-exp
(cond [(pinch . >= . 0.0) pinch]
[else (/ pinch (- 1.0 pinch))]))
(define x-mid (* 0.5 (fx->fl w)))
(define y-mid (* 0.5 (fx->fl h)))
(define-values (x-scale y-scale)
(cond [(x-mid . < . y-mid) (values (/ y-mid x-mid) 1.0)]
[(x-mid . > . y-mid) (values 1.0 (/ x-mid y-mid))]
[else (values 1.0 1.0)]))
(define fm-radius (* 0.5 (fx->fl (max w h))))
(define fm-radius^2 (* radius (sqr fm-radius)))
(define x-max (+ 0.5 (fx->fl w)))
(define y-max (+ 0.5 (fx->fl h)))
(λ: ([x : Flonum] [y : Flonum])
(define dx (* (- x x-mid) x-scale))
(define dy (* (- y y-mid) y-scale))
(define r^2 (+ (sqr dx) (sqr dy)))
(cond [(r^2 . < . fm-radius^2)
(define r (flsqrt (/ r^2 fm-radius^2)))
(define factor (cond [(or (r . = . 0.0) (pinch . = . 0.0)) 1.0]
[else (flexpt r pinch-exp)]))
(define pinched-dx (* dx factor))
(define pinched-dy (* dy factor))
(define ang (* θ (sqr (- 1.0 r))))
(define cos-a (cos ang))
(define sin-a (sin ang))
(define old-x (+ (/ (- (* pinched-dx cos-a) (* pinched-dy sin-a)) x-scale) x-mid))
(define old-y (+ (/ (+ (* pinched-dx sin-a) (* pinched-dy cos-a)) y-scale) y-mid))
(values (max -0.5 (min x-max old-x))
(max -0.5 (min y-max old-y)))]
[else
(values x y)]))))
(: whirl-and-pinch-transform (Real Real Real -> Flomap-Transform))
(define ((whirl-and-pinch-transform θ pinch radius) w h)
(invertible-2d-function
(whirl-and-pinch-function (- θ) (- pinch) radius w h)
(whirl-and-pinch-function θ pinch radius w h)))

11
collects/images/private/flonum.rkt
View File

@ -18,10 +18,13 @@
(: unsafe-flvector-set! (FlVector Integer Flonum -> Void))
(define unsafe-flvector-set! flvector-set!)
(define-syntax-rule (fl->fx x)
(let ([i (fl->exact-integer x)])
(with-asserts ([i fixnum?])
i)))
(define-syntax (fl->fx stx)
(syntax-case stx ()
[(_ x)
(syntax/loc stx
(let ([i (fl->exact-integer x)])
(with-asserts ([i fixnum?])
i)))]))
(define-syntax-rule (fx->fl i)
(->fl i))

16
collects/images/scribblings/compile-time.scrbl
View File

@ -24,15 +24,21 @@ To reduce the startup time of programs that use computed bitmaps, use the macros
The macros defined here compute bitmaps at expansion time, and expand to the bitmap's @racket[bytes] and a simple wrapper that converts @racket[bytes] to a @racket[bitmap%].
Thus, fully expanded, compiled modules contain (more or less) literal bitmap values, which do not need to be computed again when the module is @racket[require]d by another.
The literal bitmap values are encoded in @link["http://en.wikipedia.org/wiki/Portable_Network_Graphics"]{PNG} format, so they are compressed in the compiled module.
The literal bitmap values are encoded in @link["http://en.wikipedia.org/wiki/Portable_Network_Graphics"]{PNG} or @link["http://en.wikipedia.org/wiki/JPEG"]{JPEG} format, so they are compressed in the compiled module.
To get the most from compiled bitmaps during development, it is best to put them in files that are changed infrequently.
For example, for games, we suggest having a separate module called something like @tt{images.rkt} or @tt{resources.rkt} that @racket[provide]s all the game's images.
@defform[(compiled-bitmap expr)]{
@defform[(compiled-bitmap expr [quality])]{
Evaluates @racket[expr] at expansion time, which must return a @racket[bitmap%], and returns to the bitmap at run time.
Keep in mind that @racket[expr] has access only to expansion-time values, not run-time values.
If @racket[quality] is @racket[100], the bitmap is stored as a PNG.
If @racket[quality] is between @racket[0] and @racket[99] inclusive, it is stored as a JPEG with quality @racket[quality].
(See @method[bitmap% save-file].)
If the bitmap has an alpha channel, its alpha channel is stored as a separate JPEG.
The default value is @racket[100].
Generally, to use this macro, wrap a @racket[bitmap%]-producing expression with it and move any identifiers it depends on into the expansion phase.
For example, suppose we are computing a large PLT logo at run time:
@codeblock|{#lang racket}|
@ -58,8 +64,9 @@ Note that @racketmodname[images/logos] is now required @racket[for-syntax], so t
has access to the identifier @racket[plt-logo].
}
@defform[(compiled-bitmap-list expr)]{
@defform[(compiled-bitmap-list expr [quality])]{
Like @racket[compiled-bitmap], but it expects @racket[expr] to return a @racket[list] of @racket[bitmap%]s, and it returns the list at run time.
The @racket[quality] argument works as in @racket[compiled-bitmap], but is applied to all the images in the list.
Use this for animations. For example,
@codeblock|{#lang racket}|
@ -73,7 +80,8 @@ Use this for animations. For example,
(define running-stickman-frames
(compiled-bitmap-list
(for/list ([t (in-range 0 1 (/ 1 num-stickman-frames))])
(running-stickman-icon t "red" "white" "red" 32))))
(running-stickman-icon t "red" "white" "red" 32))
50))
]
This computes
@interaction[#:eval ctime-eval running-stickman-frames]

63
collects/images/tests/effects-tests.rkt Normal file
View File

@ -0,0 +1,63 @@
#lang racket/gui
(require images/gui
images/compile-time
(for-syntax racket/math
images/private/flomap
images/logos)
images/private/flomap
images/logos)
(define frame-delay 1/30)
(begin-for-syntax
(define size 256)
(define blur 8)
(define frame-num 10)
(define end-frame-quality 90)
(define mid-frame-quality 35)
(define background-fm (make-flomap/components size size '(1 1 1 1)))
(define plt-fm
(flomap-shadowed (flomap-inset (plt-flomap (- size (* 4 blur))) (* 2 blur))
blur '(0 0 0.1)))
(define racket-fm
(flomap-shadowed (flomap-inset (racket-flomap (- size (* 4 blur))) (* 2 blur))
blur '(0.1 0 0)))
(define logo-flomap* (flomap-whirl-morph plt-fm racket-fm))
(define (logo-flomap t)
(flomap-cc-superimpose background-fm (logo-flomap* t))))
(define logo-frames
(time
(append (list (compiled-bitmap (time (flomap->bitmap (logo-flomap 0)))
end-frame-quality))
(compiled-bitmap-list
(time
(for/list ([t (in-range 1 frame-num)])
(flomap->bitmap (logo-flomap (/ t frame-num)))))
mid-frame-quality)
(list (compiled-bitmap (time (flomap->bitmap (logo-flomap 1)))
end-frame-quality)))))
(define frame (new frame% [label "Whirl Morph Logo"] [width 256] [height 256]))
(define canvas (make-object bitmap-canvas% frame (first logo-frames)))
(send frame show #t)
(for ([_ (in-range 5)])
(for ([frame (in-list logo-frames)])
(send canvas set-bitmap frame)
(send canvas refresh)
(sleep/yield frame-delay))
(sleep 1)
(for ([frame (in-list (reverse logo-frames))])
(send canvas set-bitmap frame)
(send canvas refresh)
(sleep/yield frame-delay))
(sleep 1))
(send frame show #f)

1
collects/meta/props
View File

@ -970,6 +970,7 @@ path/s is either such a string or a list of them.
"collects/icons/private/mkheart.rkt" drdr:command-line #f
"collects/icons/private/svg/render-png.rkt" drdr:command-line #f
"collects/images" responsible (ntoronto)
"collects/images/tests/effects-tests.rkt" drdr:command-line #f
"collects/lang" responsible (mflatt robby matthias)
"collects/lang/htdp-langs.rkt" drdr:command-line (gracket-text "-t" *)
"collects/lang/plt-pretty-big.rkt" drdr:command-line (gracket-text "-t" *)