change world animated GIFs to not loop

svn: r11242
This commit is contained in:
Matthew Flatt 2008-08-14 17:17:57 +00:00
parent 512c6c49cc
commit fcabbbf576
4 changed files with 21 additions and 17 deletions

View File

@ -791,7 +791,7 @@ Matthew
(define intv (if (> +inf.0 *the-delta* 0) (inexact->exact (floor (* 100 *the-delta*))) 5))
(when (file-exists? ANIMATED-GIF-FILE)
(delete-file ANIMATED-GIF-FILE))
(write-animated-gif bitmap-list intv ANIMATED-GIF-FILE #:one-at-a-time? #t #:last-frame-delay 500))
(write-animated-gif bitmap-list intv ANIMATED-GIF-FILE #:one-at-a-time? #t #:loop? #f))
(define ANIMATED-GIF-FILE "i-animated.gif")

View File

@ -17,7 +17,7 @@
(cons (subbytes b offset (+ offset len))
(split-bytes b len (+ offset len)))))
(define (write-gifs bms delay filename one-at-a-time? last-frame-delay)
(define (write-gifs bms delay filename one-at-a-time? last-frame-delay loop?)
(let* ([init (force-bm (car bms))]
[w (send init get-width)]
[h (send init get-height)])
@ -38,7 +38,7 @@
filename
(lambda (p)
(let* ([gif (gif-start p w h 0 #f)])
(when delay
(when loop?
(gif-add-loop-control gif 0))
(let ([last-argb-thunk (last argb-thunks)])
(for-each (lambda (argb-thunk)
@ -74,11 +74,12 @@
(gif-end gif)))))))))
(define (write-gif bm filename)
(write-gifs (list bm) #f filename #f #f))
(write-gifs (list bm) #f filename #f #f #f))
(define (write-animated-gif bms delay filename
#:one-at-a-time? [one-at-a-time? #f]
#:last-frame-delay [last-frame-delay #f])
(write-gifs bms delay filename one-at-a-time? last-frame-delay))
#:last-frame-delay [last-frame-delay #f]
#:loop? [loop? (and delay #t)])
(write-gifs bms delay filename one-at-a-time? last-frame-delay loop?))
)

View File

@ -25,31 +25,34 @@ transparent pixels in the generated GIF image.}
(-> (is-a?/c bitmap%))))]
[delay-csec (integer-in 0 #xFFFFFFFF)]
[filename path-string]
[#:loop loop? any/c (and delay-csec #t)]
[#:one-at-a-time? one-at-a-time? any/c #f]
[#:last-frame-delay last-frame-delay (or/c (integer-in 0 #xFFFFFFFF) false/c) #f])
void?]{
Writes the bitmaps in @scheme[bitmap-list] to @scheme[filename] as an
animated GIF. The @scheme[bitmap-list] list can contain a mixture of
Writes the bitmaps in @scheme[bitmaps] to @scheme[filename] as an
animated GIF. The @scheme[bitmaps] list can contain a mixture of
@scheme[bitmap%] objects and thunks (each called just once) that
produce @scheme[bitmap%] objects. The @scheme[delay-csec] argument is
the amount of time in 1/100s of a second to wait between transitions.
If @scheme[loop?] is a true value, then the GIF is marked as a looping
animation.
If @scheme[one-at-a-time?] is @scheme[#f], then the content of all
images is collected and quantized at once, to produce a single
colortable; a drawback to this approach is that it uses more memory,
and it allows less color variation among animation frames. Even when
@scheme[one-at-a-time?] is @scheme[#f], the result of each thunk in
@scheme[bitmap-list] is converted to a byte-string one at a time
@scheme[bitmaps] is converted to a byte-string one at a time
(which helps avoid bitmap-count limits under Windows).
If @scheme[one-at-a-time?] is true, then the bitmaps are quantized and
written to the file one at a time; that is, for each thunk in
@scheme[bitmap-list], its result is written and discarded before
another thunk is called. A drawback to this approach is that a
separate colortable is written for each frame in the animation, which
can make the resulting file large.
@scheme[bitmaps], its result is written and discarded before another
thunk is called. A drawback to this approach is that a separate
colortable is written for each frame in the animation, which can make
the resulting file large.
If @scheme[last-frame-delay] is not false, a delay of
@scheme[last-frame-delay] (in 1/100s of a second) will be added to the
last frame.}
@scheme[last-frame-delay] (in 1/100s of a second) is added to the last
frame. This extra delay is useful when @scheme[loop?] is true.}

View File

@ -248,7 +248,7 @@
[(null? lst) null]
[(null? (cdr lst))
(let ([last (car lst)])
(list (just-before (close-white-square-bracket) last)))]
(list (just-before (close-white-square-bracket) last) ""))]
[else (cons (car lst) (loop (cdr lst)))])))]
[(multi)
(cons (hbl-append
@ -259,7 +259,7 @@
[(null? lst) null]
[(null? (cdr lst))
(let ([last (car lst)])
(list (just-before (close-white-square-bracket) last)))]
(list (just-before (close-white-square-bracket) last) ""))]
[(null? (cddr lst))
(cons (car lst) (loop (cdr lst)))]
[else (list* (car lst)