diff --git a/gui-lib/mred/private/wx/win32/sound.rkt b/gui-lib/mred/private/wx/win32/sound.rkt index 6d291ec4..1ebd27f8 100644 --- a/gui-lib/mred/private/wx/win32/sound.rkt +++ b/gui-lib/mred/private/wx/win32/sound.rkt @@ -1,6 +1,10 @@ #lang racket/base (require ffi/unsafe racket/class + racket/runtime-path + setup/cross-system + (for-syntax racket/base + setup/cross-system) "../../lock.rkt" "utils.rkt" "types.rkt" @@ -15,9 +19,9 @@ (define SND_ASYNC #x0001) (define SND_NOSTOP #x0010) -(define previous-done-sema #f) - -(define (play-sound path async?) +;; Plays a sound using PlaySOund directly, which is limited +;; to playing a single sound at a time in the process: +(define (in-process-play-sound path async?) (let ([path (simplify-path path #f)] [done (make-semaphore)]) (and (let ([p (path->string @@ -34,3 +38,37 @@ (or (semaphore-try-wait? done) (PlaySoundW #f #f (bitwise-ior SND_ASYNC SND_NOSTOP)) (loop))))))) +(define previous-done-sema #f) + +;; Runs a separate process to play a sound using a very +;; small executable: +(define (other-process-play-sound path async?) + (define c (make-custodian)) + (define-values (s i o e) + (parameterize ([current-custodian c] + [current-subprocess-custodian-mode 'kill]) + (subprocess #f #f #f + (car racket-playsound.exe) + 'exact + (path->string + (simplify-path + (path->complete-path path)))))) + (close-input-port i) + (close-input-port e) + (close-output-port o) + (unless async? + (dynamic-wind + void + (lambda () (subprocess-wait s)) + (lambda () (subprocess-kill s #t))))) + +(define-runtime-path-list racket-playsound.exe + (if (eq? 'windows (cross-system-type)) + (list '(so "racket-playsound.exe")) + null)) + +(define (play-sound path async?) + (if (and (pair? racket-playsound.exe) + (file-exists? (car racket-playsound.exe))) + (other-process-play-sound path async?) + (in-process-play-sound path async?)))