From 3d73a0bd78af6d00e1f59f03aad116a5fe84b044 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 15 Oct 2010 09:50:02 -0600
Subject: [PATCH] win32: play-sound

---
 collects/mred/private/wx/win32/procs.rkt |  2 +-
 collects/mred/private/wx/win32/sound.rkt | 20 ++++++++++++++++++++
 collects/mred/private/wx/win32/utils.rkt |  3 +++
 3 files changed, 24 insertions(+), 1 deletion(-)
 create mode 100644 collects/mred/private/wx/win32/sound.rkt

diff --git a/collects/mred/private/wx/win32/procs.rkt b/collects/mred/private/wx/win32/procs.rkt
index ada8bb7e44..0aa996362b 100644
--- a/collects/mred/private/wx/win32/procs.rkt
+++ b/collects/mred/private/wx/win32/procs.rkt
@@ -15,6 +15,7 @@
                     get-panel-background)
          "filedialog.rkt"
          "colordialog.rkt"
+         "sound.rkt"
 	 racket/draw)
 
 (provide
@@ -58,7 +59,6 @@
  make-gl-bitmap
  check-for-break)
 
-(define-unimplemented play-sound)
 (define-unimplemented find-graphical-system-path)
 (define-unimplemented location->window)
 (define-unimplemented send-event)
diff --git a/collects/mred/private/wx/win32/sound.rkt b/collects/mred/private/wx/win32/sound.rkt
new file mode 100644
index 0000000000..02aa963bf6
--- /dev/null
+++ b/collects/mred/private/wx/win32/sound.rkt
@@ -0,0 +1,20 @@
+#lang racket/base
+(require ffi/unsafe
+         racket/class
+         "utils.rkt"
+         "types.rkt"
+         "const.rkt")
+
+(provide play-sound)
+
+(define-winmm PlaySoundW (_wfun _string/utf-16 _pointer _DWORD -> _BOOL))
+
+(define SND_SYNC   #x0000)
+(define SND_ASYNC  #x0001)
+
+(define (play-sound path async?)
+  (let ([path (simplify-path path #f)])
+    ;; FIXME: sync sound play blocks all Racket threads
+    (PlaySoundW (if (path? path) (path->string path) path)
+                #f
+                (if async? SND_ASYNC SND_SYNC))))
diff --git a/collects/mred/private/wx/win32/utils.rkt b/collects/mred/private/wx/win32/utils.rkt
index afda3e7568..7965023dbd 100644
--- a/collects/mred/private/wx/win32/utils.rkt
+++ b/collects/mred/private/wx/win32/utils.rkt
@@ -12,6 +12,7 @@
 	 define-comdlg32
 	 define-shell32
 	 define-uxtheme
+	 define-winmm
          define-mz
          failed
 
@@ -49,6 +50,7 @@
 (define comdlg32-lib (ffi-lib "comdlg32.dll"))
 (define shell32-lib (ffi-lib "shell32.dll"))
 (define uxtheme-lib (ffi-lib "uxtheme.dll"))
+(define winmm-lib (ffi-lib "winmm.dll"))
 
 (define-ffi-definer define-gdi32 gdi32-lib)
 (define-ffi-definer define-user32 user32-lib)
@@ -57,6 +59,7 @@
 (define-ffi-definer define-comdlg32 comdlg32-lib)
 (define-ffi-definer define-shell32 shell32-lib)
 (define-ffi-definer define-uxtheme uxtheme-lib)
+(define-ffi-definer define-winmm winmm-lib)
 
 (define-kernel32 GetLastError (_wfun -> _DWORD))