suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjusted the splash screen code so that the christmas day easter egg is optional (defaultly off)

Browse Source 
original commit: 44753bc690292b114d934416ff2a096efc44199f
This commit is contained in:
Robby Findler 2010-09-01 13:21:45 -05:00
parent 1947ad1240
commit bb17de3e20
2 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/framework/splash.rkt
View File

@ -72,8 +72,8 @@
(splash-paint-callback dc)]
[else
(splash-paint-callback dc
(send gauge get-value)
(send gauge get-range)
(send (get-gauge) get-value)
(send (get-gauge) get-range)
(get-splash-width)
(get-splash-height))])
(for-each (λ (icon)
@ -88,7 +88,7 @@
(define (set-splash-progress-bar?! b?)
(send gauge-panel change-children
(λ (l) (if b? (list gauge) '()))))
(λ (l) (if b? (list (get-gauge)) '()))))
(define (splash-paint-callback dc)
(if splash-bitmap
@ -107,10 +107,11 @@
(set! icons (cons (make-icon bm x y) icons))
(refresh-splash))
(define (start-splash splash-draw-spec _splash-title width-default)
(define (start-splash splash-draw-spec _splash-title width-default #:allow-funny? [allow-funny? #f])
(unless allow-funny? (set! funny? #f))
(set! splash-title _splash-title)
(set! splash-max-width (max 1 (splash-get-preference (get-splash-width-preference-name) width-default)))
(send gauge set-range splash-max-width)
(send (get-gauge) set-range splash-max-width)
(send splash-tlw set-label splash-title)
(let/ec k
(define (no-splash)
@ -188,8 +189,8 @@
(define (splash-load-handler old-load f expected)
(set! splash-current-width (+ splash-current-width 1))
(when (<= splash-current-width splash-max-width)
(send gauge set-value splash-current-width)
(when (or (not (member gauge (send gauge-panel get-children)))
(send (get-gauge) set-value splash-current-width)
(when (or (not (member (get-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)))
@ -303,10 +304,15 @@
(define panel (make-object vertical-pane% splash-tlw))
(define splash-canvas (new splash-canvas% [parent panel] [style '(no-autoclear)]))
(define gauge-panel (make-object horizontal-pane% panel))
(define gauge
(if funny?
(make-object funny-gauge% gauge-panel)
(make-object gauge% #f splash-max-width gauge-panel '(horizontal))))
(define get-gauge
(let ([gauge #f])
(λ ()
(unless gauge
(set! gauge
(if funny?
(make-object funny-gauge% gauge-panel)
(make-object gauge% #f splash-max-width gauge-panel '(horizontal)))))
gauge)))
(send panel stretchable-width #f)
(send panel stretchable-height #f)
(send gauge-panel set-alignment 'center 'top)

5
collects/scribblings/framework/splash.scrbl
View File

@ -22,7 +22,8 @@ that number to control the gauge along the bottom of the splash screen.
exact-nonnegative-integer?
exact-nonnegative-integer?))]
[splash-title string?]
[width-default exact-nonnegative-integer?])
[width-default exact-nonnegative-integer?]
#:allow-funny? [allow-funny? #f])
void?]{
Starts a new splash screen. The splash screen is created in its own, new
@tech[#:doc '(lib "scribblings/gui/gui.scrbl") #:key "eventspace"]{eventspace}.
@ -43,7 +44,7 @@ that number to control the gauge along the bottom of the splash screen.
(in order) the current value of the gauge, the maximum value of the gauge, and the width and the height
of the area to draw.
The @racket[allow-funny?] argument determines if a special gauge is used on Christmas day.
}
@defproc[(shutdown-splash) void?]{