suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Windows play-sound: avoid leaks and shutdown on custodian

Browse Source 
Also, stop a synchronous sound on a break exception.
This commit is contained in:
Matthew Flatt 2016-01-04 17:53:40 -07:00
parent edc56ee8de
commit 76c305852b
1 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
gui-lib/mred/private/wx/win32/sound.rkt
View File

@ -1,8 +1,9 @@
#lang racket/base #lang racket/base
(require ffi/unsafe (require ffi/unsafe
ffi/winapi ffi/winapi
ffi/unsafe/custodian
ffi/unsafe/atomic
racket/class racket/class
"../../lock.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"const.rkt") "const.rkt")
@ -48,17 +49,29 @@
;; Generated ID is unique enough, because we only ;; Generated ID is unique enough, because we only
;; instantiate this library in one place: ;; instantiate this library in one place:
(define id (gensym 'play)) (define id (gensym 'play))
(define cust (make-custodian))
(call-as-atomic
(lambda ()
(mci-send "open \"~a\" alias ~a" (simplify-path file) id)
(register-finalizer-and-custodian-shutdown
id
(lambda (id)
(mci-send "close ~a" id))
cust)))
(define (done msec) (define (done msec)
(when msec (sleep (/ msec 1000))) (when msec (sleep (/ msec 1000)))
(mci-send "close ~a" id)) (custodian-shutdown-all cust))
(with-handlers ([void (lambda (e) (done #f) (raise e))]) (dynamic-wind
;; adding "type waveaudio" will make it work only for wavs (no mp3 etc) void
(mci-send "open \"~a\" alias ~a" (simplify-path file) id) (lambda ()
(mci-send "set ~a time format milliseconds" id) (mci-send "set ~a time format milliseconds" id)
(define len (let ([s (mci-send* "status ~a length" id)]) (define len (let ([s (mci-send* "status ~a length" id)])
(string->number s))) (string->number s)))
(unless len (error 'play "mci did not return a numeric length")) (unless len (error 'play "mci did not return a numeric length"))
(mci-send "play ~a" id) (mci-send "play ~a" id)
(if async? (thread (lambda () (done (+ len 5000)))) (done len))) (if async? (thread (lambda () (done (+ len 5000)))) (done len)))
(lambda ()
(unless async?
(done #f))))
;; Report success, since otherwise we throw an error: ;; Report success, since otherwise we throw an error:
#t) #t)