From 1f3e14da072bb581c2567a6c4e8679ae7f155b12 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 28 Apr 2007 04:59:21 +0000
Subject: [PATCH] speed up quantization

svn: r6066
---
 collects/net/gifwrite.ss | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/collects/net/gifwrite.ss b/collects/net/gifwrite.ss
index c830e07f6c..d80929e8eb 100644
--- a/collects/net/gifwrite.ss
+++ b/collects/net/gifwrite.ss
@@ -440,7 +440,16 @@
 
   (define (quantize argb)
     (let* ([len (quotient (bytes-length argb) 4)]
-           [result (make-bytes len)])
+           [result (make-bytes len)]
+           [rgb-key (lambda (r g b)
+                      (bitwise-ior (bitwise-ior
+                                    (arithmetic-shift r 16)
+                                    (arithmetic-shift g 8))
+                                   b))]
+           [key->rgb (lambda (k)
+                       (vector (arithmetic-shift k -16)
+                               (bitwise-and #xFF (arithmetic-shift k -8))
+                               (bitwise-and #xFF k)))])
       (let loop ([masks (list
                          ;; 8 bits per color
                          (lambda (v) v)
@@ -458,7 +467,7 @@
                                0)))])
         (let ([mask (car masks)]
               [transparent #f]
-              [table (make-hash-table 'equal)]
+              [table (make-hash-table)] ; relying on fixnums
               [idx 0])
           ;; Iterate over image to count colors
           ;; (as reduced by mask)
@@ -471,7 +480,7 @@
                              (set! transparent idx)
                              (set! idx (add1 idx)))
                            transparent)
-                         (let ([vec (vector
+                         (let ([vec (rgb-key
                                      (mask (bytes-ref argb (+ 1 pos)))
                                      (mask (bytes-ref argb (+ 2 pos)))
                                      (mask (bytes-ref argb (+ 3 pos))))])
@@ -481,8 +490,9 @@
                                    (hash-table-put! table vec idx)
                                    (set! idx (add1 idx))
                                    (sub1 idx))))))])
-                (bytes-set! result i (min 255 this-idx)))
-              (loop (add1 i) (+ pos 4))))
+                (unless (= this-idx 256)
+                  (bytes-set! result i this-idx)
+                  (loop (add1 i) (+ pos 4))))))
           (if ((hash-table-count table) . > . (if transparent
                                                   255
                                                   256))
@@ -505,6 +515,6 @@
                         (hash-table-for-each 
                          table
                          (lambda (k v)
-                           (vector-set! t v k)))
+                           (vector-set! t v (key->rgb k))))
                         (vector->list t))
                       transparent)))))))