diff --git a/collects/drscheme/private/drscheme-normal.ss b/collects/drscheme/private/drscheme-normal.ss index ee29eba9c4..755b146992 100644 --- a/collects/drscheme/private/drscheme-normal.ss +++ b/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,7 +260,15 @@ (build-path (collection-path "icons") "texas-plt-bw.gif")] [(and halloween? high-color?) (build-path (collection-path "icons") "PLT-pumpkin.png")] - [high-color? + [(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) (build-path (collection-path "icons") "pltbw.gif")] diff --git a/collects/framework/splash.ss b/collects/framework/splash.ss index 47802f3d6e..1c2e412253 100644 --- a/collects/framework/splash.ss +++ b/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 the gauge is not visible, we'll redraw the canvas + (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))) diff --git a/collects/icons/plt-logo-red-diffuse.png b/collects/icons/plt-logo-red-diffuse.png new file mode 100644 index 0000000000..8b56be425c Binary files /dev/null and b/collects/icons/plt-logo-red-diffuse.png differ diff --git a/collects/icons/plt-logo-red-flat.png b/collects/icons/plt-logo-red-flat.png new file mode 100644 index 0000000000..e8830883d1 Binary files /dev/null and b/collects/icons/plt-logo-red-flat.png differ diff --git a/collects/icons/plt-logo-red-gradient.png b/collects/icons/plt-logo-red-gradient.png new file mode 100644 index 0000000000..6df513f022 Binary files /dev/null and b/collects/icons/plt-logo-red-gradient.png differ diff --git a/collects/icons/plt-logo-red-shiny.png b/collects/icons/plt-logo-red-shiny.png new file mode 100644 index 0000000000..f08a8d341f Binary files /dev/null and b/collects/icons/plt-logo-red-shiny.png differ