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

Updated write-animated-gif to use the octree quantizer.

Browse Source 
svn: r10993
This commit is contained in:
Danny Yoo 2008-07-31 00:27:05 +00:00
parent 6b2e5f4014
commit f2a1773422
2 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/file/octree-quantize.ss
View File

@ -3,6 +3,12 @@
scheme/contract
scheme/gui/base)
;; This is an implementation of the Octree Quantization algorithm. This implementation
;; follows the sketch in:
;;
;; Dean Clark. Color Quantization using Octrees. Dr. Dobbs Portal, January 1, 1996.
;; http://www.ddj.com/184409805
;; quantize: bytes (integer-in 1 255) -> (values bytes gif-colormap color)
;; Adaptively quantizes 24-bit image data to fit within, at most, 256 colors

7
collects/mrlib/gif.ss
View File

@ -4,7 +4,8 @@
scheme/class
scheme/list
net/gifwrite
scheme/contract)
scheme/contract
(prefix-in octree: file/octree-quantize))
(provide write-gif
write-animated-gif)
@ -43,7 +44,7 @@
(let ([last-argb-thunk (last argb-thunks)])
(for-each (lambda (argb-thunk)
(let-values ([(pixels colormap transparent)
(quantize (argb-thunk))])
(octree: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)
@ -54,7 +55,7 @@
(gif-end gif))))
;; Build images and quantize all at once:
(let-values ([(pixels colormap transparent)
(quantize (apply bytes-append (map (lambda (t) (t)) argb-thunks)))])
(octree:quantize (apply bytes-append (map (lambda (t) (t)) argb-thunks)))])
(call-with-output-file*
filename
(lambda (p)