win32: play-sound

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)

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))))

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))