37 lines
989 B
Racket
37 lines
989 B
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
racket/class
|
|
"../../lock.rkt"
|
|
"utils.rkt"
|
|
"types.rkt"
|
|
"const.rkt")
|
|
|
|
(provide
|
|
(protect-out play-sound))
|
|
|
|
(define-winmm PlaySoundW (_wfun _string/utf-16 _pointer _DWORD -> _BOOL))
|
|
|
|
(define SND_SYNC #x0000)
|
|
(define SND_ASYNC #x0001)
|
|
(define SND_NOSTOP #x0010)
|
|
|
|
(define previous-done-sema #f)
|
|
|
|
(define (play-sound path async?)
|
|
(let ([path (simplify-path path #f)]
|
|
[done (make-semaphore)])
|
|
(and (let ([p (path->string
|
|
(cleanse-path (path->complete-path path)))])
|
|
(atomically
|
|
(when previous-done-sema (semaphore-post previous-done-sema))
|
|
(set! previous-done-sema done)
|
|
(PlaySoundW p #f SND_ASYNC)))
|
|
(or async?
|
|
;; Implement synchronous playing by polling, where
|
|
;; PlaySound with no sound file and SND_NOSTOP polls.
|
|
(let loop ()
|
|
(sleep 0.1)
|
|
(or (semaphore-try-wait? done)
|
|
(PlaySoundW #f #f (bitwise-ior SND_ASYNC SND_NOSTOP))
|
|
(loop)))))))
|