From f2a1773422feaa4ec112e97467c6a671a3123008 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 31 Jul 2008 00:27:05 +0000 Subject: [PATCH] Updated write-animated-gif to use the octree quantizer. svn: r10993 --- collects/file/octree-quantize.ss | 6 ++++++ collects/mrlib/gif.ss | 7 ++++--- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/collects/file/octree-quantize.ss b/collects/file/octree-quantize.ss index 174e23b18e..f53bb164c7 100644 --- a/collects/file/octree-quantize.ss +++ b/collects/file/octree-quantize.ss @@ -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 diff --git a/collects/mrlib/gif.ss b/collects/mrlib/gif.ss index 215255b548..e89b2f2379 100644 --- a/collects/mrlib/gif.ss +++ b/collects/mrlib/gif.ss @@ -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)