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

Adding a five-second pause to the end of an animated-gif. Added #:last-frame-delay parameter to mrlib/gif's write-animated-gif function.

Browse Source 
svn: r10927
This commit is contained in:
Danny Yoo 2008-07-26 21:48:29 +00:00
parent 616ec71325
commit 323ae22f12
2 changed files with 36 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/htdp/world.ss
View File

@ -781,7 +781,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))
(write-animated-gif bitmap-list intv ANIMATED-GIF-FILE #:one-at-a-time? #t #:last-frame-delay 500))
(define ANIMATED-GIF-FILE "i-animated.gif")

58
collects/mrlib/gif.ss
View File

@ -2,21 +2,22 @@
(module gif scheme/base
(require scheme/gui/base
scheme/class
scheme/list
net/gifwrite
scheme/contract)
(provide write-gif
write-animated-gif)
(define (force-bm bm) (if (procedure? bm) (bm) bm))
(define (split-bytes b len offset)
(if (= offset (bytes-length b))
null
(cons (subbytes b offset (+ offset len))
(split-bytes b len (+ offset len)))))
(define (write-gifs bms delay filename one-at-a-time?)
(define (write-gifs bms delay filename one-at-a-time? last-frame-delay)
(let* ([init (force-bm (car bms))]
[w (send init get-width)]
[h (send init get-height)])
@ -39,13 +40,17 @@
(let* ([gif (gif-start p w h 0 #f)])
(when delay
(gif-add-loop-control gif 0))
(for-each (lambda (argb-thunk)
(let-values ([(pixels colormap transparent)
(quantize (argb-thunk))])
(when (or transparent delay)
(gif-add-control gif 'any #f (or delay 0) transparent))
(gif-add-image gif 0 0 w h #f colormap pixels)))
argb-thunks)
(let ([last-argb-thunk (last argb-thunks)])
(for-each (lambda (argb-thunk)
(let-values ([(pixels colormap transparent)
(quantize (argb-thunk))])
(when (or transparent delay)
(gif-add-control gif 'any #f (or delay 0) transparent))
(gif-add-image gif 0 0 w h #f colormap pixels)
(when (and last-frame-delay (eq? argb-thunk last-argb-thunk))
(gif-add-control gif 'any #f last-frame-delay transparent)
(gif-add-image gif 0 0 w h #f colormap pixels))))
argb-thunks))
(gif-end gif))))
;; Build images and quantize all at once:
(let-values ([(pixels colormap transparent)
@ -56,17 +61,24 @@
(let* ([gif (gif-start p w h 0 colormap)])
(when delay
(gif-add-loop-control gif 0))
(for-each (lambda (pixels)
(when (or transparent delay)
(gif-add-control gif 'any #f (or delay 0) transparent))
(gif-add-image gif 0 0 w h #f #f pixels))
(split-bytes pixels (* w h) 0))
(let* ([pixelss (split-bytes pixels (* w h) 0)]
[last-pixels (last pixelss)])
(for-each (lambda (pixels)
(when (or transparent delay)
(gif-add-control gif 'any #f (or delay 0) transparent))
(gif-add-image gif 0 0 w h #f #f pixels)
(when (and last-frame-delay (eq? pixels last-pixels))
(gif-add-control gif 'any #f last-frame-delay transparent)
(gif-add-image gif 0 0 w h #f colormap pixels)))
pixelss))
(gif-end gif)))))))))
(define (write-gif bm filename)
(write-gifs (list bm) #f filename #f))
(define (write-animated-gif bms delay filename #:one-at-a-time? [one-at-a-time? #f])
(write-gifs bms delay filename one-at-a-time?))
(write-gifs (list bm) #f filename #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))
)