testing sound playing under windows for rsound

s16vec-play-testing.rkt

#lang racket

(require ffi/vector
         ffi/unsafe
         (rename-in racket/contract [-> c->])
         (planet clements/portaudio/portaudio)
         (planet clements/portaudio/callback-support))

;; this module provides a function that plays a sound.

(define nat? exact-nonnegative-integer?)

(provide/contract [s16vec-play (c-> s16vector? nat? (or/c false? nat?) integer?
                                    (c-> void?))])

;; it would use less memory to use stream-play, but
;; there's an unacceptable 1/2-second lag in starting
;; a new place.

(define channels 2)

;; given an s16vec, a starting frame, a stopping frame or 
;; false, and a sample rate, play the sound.
(define (s16vec-play s16vec start-frame pre-stop-frame sample-rate)
  (define total-frames (/ (s16vector-length s16vec) channels))
  (define stop-frame (or pre-stop-frame
                        total-frames))
  (check-args s16vec total-frames start-frame stop-frame)
  (define sound-frames (- stop-frame start-frame))  
  (pa-maybe-initialize)
  (define copying-info (make-copying-info s16vec start-frame stop-frame))
  (define chosen-device (pa-get-default-output-device))
  (define promised-latency (device-low-output-latency chosen-device))
  (define stream 
    (stream-open copying-info chosen-device promised-latency sample-rate))
  (pa-set-stream-finished-callback stream copying-info-free)
  (pa-start-stream stream)
  (define (stopper)
    (pa-maybe-stop-stream stream))
  stopper)


;; copied from stream-play:
;; stream-open : stream-info natural? real? real? -> stream
;; open the given device using the given stream-info, latency, and sample-rate.
(define (stream-open copying-info device-number latency sample-rate)
  (define sr/i (exact->inexact sample-rate))
  (define output-stream-parameters
    (make-pa-stream-parameters
     device-number ;; device
     2             ;; channels
     '(paInt16)    ;; sample format
     latency       ;; latency
     #f))            ;; host-specific info
  (pa-open-stream
   #f ;; input parameters
   output-stream-parameters
   sr/i
   0 ;; frames-per-buffer
   '() ;; stream-flags
   copying-callback
   copying-info))

(define (check-args vec total-frames start-frame stop-frame)
  (unless (integer? total-frames)
    (raise-type-error 's16vec-play "vector of length divisible by 2" 0 vec start-frame stop-frame))
  (when (<= total-frames start-frame)
    (raise-type-error 's16vec-play "start frame < total number of frames" 1 vec start-frame stop-frame))
  (when (< total-frames stop-frame)
    (raise-type-error 's16vec-play "end frame < total number of frames" 2 vec start-frame stop-frame))
  (when (< stop-frame start-frame)
    (raise-type-error 's16vec-play "start frame <= end frame" 1 vec start-frame stop-frame)))


;; TESTING

(define vec-len 8000)
(define s16vec (make-s16vector vec-len))
(for ([i vec-len])
  (s16vector-set! s16vec i 
                  (inexact->exact
                   (round (* 32767 (* 0.1 (sin (* i 1/44100 440 2 pi))))))))
(s16vec-play s16vec 0 #f 44100)