From 49b08ef0dbd0d7ed261db66576ca52ed5658b727 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 2 Nov 2009 21:41:20 +0000 Subject: [PATCH] added Neil's logos to drscheme's splash svn: r16505 original commit: ca5a7e604bed578e22aeb2f427d4424b00c8cf0d --- collects/framework/splash.ss | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/collects/framework/splash.ss b/collects/framework/splash.ss index 47802f3d..1c2e4122 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)))