edc56ee8de
Provided by Eli Barzilay. This approach is better than a separate process, because creating too many processes can overwhelm the OS. Also, MCI supports more sound formats.
65 lines
1.9 KiB
Racket
65 lines
1.9 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
ffi/winapi
|
|
racket/class
|
|
"../../lock.rkt"
|
|
"utils.rkt"
|
|
"types.rkt"
|
|
"const.rkt")
|
|
|
|
(provide
|
|
(protect-out play-sound))
|
|
|
|
(define BUFFER-SIZE 512)
|
|
(define BUFFER-BYTES-SIZE (* 2 BUFFER-SIZE))
|
|
|
|
(define-winmm mciGetErrorStringW
|
|
(_fun _int
|
|
[buf : _pointer = (malloc BUFFER-BYTES-SIZE)]
|
|
[_int = BUFFER-SIZE]
|
|
-> [ret : _bool]
|
|
-> (and ret (cast buf _pointer _string/utf-16))))
|
|
|
|
(define-winmm mciSendStringW
|
|
(_fun _string/utf-16 [_pointer = #f] [_int = 0] [_pointer = #f]
|
|
-> [ret : _int]
|
|
-> (if (zero? ret)
|
|
(void)
|
|
(error 'mciSendStringW "~a" (mciGetErrorStringW ret)))))
|
|
|
|
(define (mci-send fmt . args)
|
|
(mciSendStringW (apply format fmt args)))
|
|
|
|
(define-winmm mciSendStringW*
|
|
(_fun _string/utf-16
|
|
[buf : _pointer = (malloc BUFFER-BYTES-SIZE)]
|
|
[_int = BUFFER-SIZE]
|
|
[_pointer = #f]
|
|
-> [ret : _int]
|
|
-> (if (zero? ret)
|
|
(cast buf _pointer _string/utf-16)
|
|
(error 'mciSendStringW* "~a" (mciGetErrorStringW ret))))
|
|
#:c-id mciSendStringW)
|
|
|
|
(define (mci-send* fmt . args)
|
|
(mciSendStringW* (apply format fmt args)))
|
|
|
|
(define (play-sound file async?)
|
|
;; Generated ID is unique enough, because we only
|
|
;; instantiate this library in one place:
|
|
(define id (gensym 'play))
|
|
(define (done msec)
|
|
(when msec (sleep (/ msec 1000)))
|
|
(mci-send "close ~a" id))
|
|
(with-handlers ([void (lambda (e) (done #f) (raise e))])
|
|
;; adding "type waveaudio" will make it work only for wavs (no mp3 etc)
|
|
(mci-send "open \"~a\" alias ~a" (simplify-path file) id)
|
|
(mci-send "set ~a time format milliseconds" id)
|
|
(define len (let ([s (mci-send* "status ~a length" id)])
|
|
(string->number s)))
|
|
(unless len (error 'play "mci did not return a numeric length"))
|
|
(mci-send "play ~a" id)
|
|
(if async? (thread (lambda () (done (+ len 5000)))) (done len)))
|
|
;; Report success, since otherwise we throw an error:
|
|
#t)
|