added Neil's logos to drscheme's splash

svn: r16505

collects/drscheme/private/drscheme-normal.ss

@@ -229,6 +229,25 @@
     (set-splash-event-callback eli-event)
     (send splash-canvas refresh)))
 
+;; assumes that the width & height of all of the bitmaps
+;; in this list are the same.
+(define plt-logo-evolution
+  (map (λ (x) (make-object bitmap% (build-path (collection-path "icons") x)))
+       '("plt-logo-red-flat.png"
+         "plt-logo-red-gradient.png"
+         "plt-logo-red-diffuse.png"
+         "plt-logo-red-shiny.png")))
+
+(define (logo-index val range)
+  (min (max (floor (* (length plt-logo-evolution) (/ val range))) 0)
+       (- (length plt-logo-evolution) 1)))
+
+(define (splash-evolution dc val range w h)
+  (send dc draw-bitmap 
+        (list-ref plt-logo-evolution (logo-index val range))
+        0
+        0))
+
 (start-splash
  (cond
    [(or prince-kuhio-day? kamehameha-day?)
@@ -241,6 +260,14 @@
     (build-path (collection-path "icons") "texas-plt-bw.gif")]
    [(and halloween? high-color?)
     (build-path (collection-path "icons") "PLT-pumpkin.png")]
+   [(and high-color?  
+         (send (car plt-logo-evolution) ok?))
+    (set-refresh-splash-on-gauge-change?! (λ (val range) 
+                                            (not (equal? (logo-index val range)
+                                                         (logo-index (- val 1) range)))))
+    (vector splash-evolution
+            (send (car plt-logo-evolution) get-width)
+            (send (car plt-logo-evolution) get-height))]
    [high-color?
     (build-path (collection-path "icons") "PLT-206.png")]
    [(= (get-display-depth) 1)

collects/framework/splash.ss

@@ -18,6 +18,7 @@
          set-splash-char-observer
          set-splash-event-callback
          get-splash-event-callback
+         set-refresh-splash-on-gauge-change?!
          get-splash-width
          get-splash-height)
 
@@ -44,6 +45,9 @@
 (define (set-splash-event-callback cb) (set! splash-event-callback cb))
 (define (get-splash-event-callback cb) splash-event-callback)
 
+(define (refresh-splash-on-gauge-change? start range) #f)
+(define (set-refresh-splash-on-gauge-change?! f) (set! refresh-splash-on-gauge-change? f))
+
 (define (refresh-splash)
   
   (define (recompute-bitmap/refresh)
@@ -185,8 +189,9 @@
     (set! splash-current-width (+ splash-current-width 1))
     (when (<= splash-current-width splash-max-width)
       (send gauge set-value splash-current-width)
-      (unless (member gauge (send gauge-panel get-children))
+      (when (or (not (member gauge (send gauge-panel get-children)))
                 ;; when the gauge is not visible, we'll redraw the canvas
+                (refresh-splash-on-gauge-change? splash-current-width splash-max-width))
         (refresh-splash)))
     (old-load f expected)))