Windows: change play-sound to run an external program

Running a sound through a separate process allows multiple
sounds to be played at once.

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)
+;; Plays a sound using PlaySOund directly, which is limited
-
+;; to playing a single sound at a time in the process:
-(define (play-sound path async?)
+(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?)))