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

fixed threading bug

Browse Source 
svn: r16534
This commit is contained in:
Robby Findler 2009-11-04 01:33:11 +00:00
parent 0feac0f636
commit 2ededd26fc
1 changed files with 21 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/drscheme/private/drscheme-normal.ss
View File

@ -109,7 +109,7 @@
(define interpolate-evolution-bdc (make-object bitmap-dc%)) (define interpolate-evolution-bdc (make-object bitmap-dc%))
;; number of greyscale stages (between the logos above) ;; number of greyscale stages (between the logos above)
(define stages 5) (define stages 0)
;; number of increments (per cycle) to dedicate to ;; number of increments (per cycle) to dedicate to
;; an unfaded version of the logos. must be > 0. ;; an unfaded version of the logos. must be > 0.
@ -153,11 +153,7 @@
[m (modulo index (+ stages pause-time))]) [m (modulo index (+ stages pause-time))])
(cond (cond
[(< m pause-time) [(< m pause-time)
(set! splash-evolution-bitmap (list-ref plt-logo-evolution q)) (set! splash-evolution-bitmap (list-ref plt-logo-evolution q))]
(when (= q (+ stages pause-time -1))
(set! stage-bitmaps 'cleared-out-stage-bitmaps)
(set! splash-evolution-bitmap 'cleared-out-splash-evolution-bitmap)
(set! plt-logo-evolution 'cleared-out-plt-logo-evolution))]
[else [else
(let* ([before-inc (- m pause-time)] (let* ([before-inc (- m pause-time)]
[after-inc (- (- (length stage-bitmaps) 1) before-inc)]) [after-inc (- (- (length stage-bitmaps) 1) before-inc)])
@ -220,7 +216,8 @@
(thread (thread
(λ () (λ ()
(let loop ([i 0]) (let loop ([i 0])
(when (<= i evolution-last-stage) (cond
[(<= i evolution-last-stage)
(let* ([now (current-milliseconds)] (let* ([now (current-milliseconds)]
[next-stage-start (+ start-time (* last-times-delta (/ i (+ evolution-last-stage 1))))] [next-stage-start (+ start-time (* last-times-delta (/ i (+ evolution-last-stage 1))))]
[delta (- next-stage-start now)]) [delta (- next-stage-start now)])
@ -230,7 +227,14 @@
(λ () (λ ()
(update-bitmap-stage/index i) (update-bitmap-stage/index i)
(refresh-splash)))) (refresh-splash))))
(loop (+ i 1)))))) (loop (+ i 1))]
[else
(parameterize ([current-eventspace (get-splash-eventspace)])
(queue-callback
(λ ()
(set! stage-bitmaps 'cleared-out-stage-bitmaps)
(set! splash-evolution-bitmap 'cleared-out-splash-evolution-bitmap)
(set! plt-logo-evolution 'cleared-out-plt-logo-evolution))))]))))
(vector splash-evolution w h)] (vector splash-evolution w h)]
[else [else
(build-path (collection-path "icons") "plt-logo-red-shiny.png")]))] (build-path (collection-path "icons") "plt-logo-red-shiny.png")]))]