#lang racket
(require "../portaudio.rkt"
"../callback-support.rkt"
"helpers.rkt"
ffi/vector
ffi/unsafe
rackunit
rackunit/text-ui)
(define twopi (* 2 pi))
(run-tests
(test-suite "portaudio"
(let ()
(pa-maybe-initialize)
(define (open-test-stream callback streaming-info-ptr buffer-frames)
(pa-open-default-stream
0 2 'paInt16 44100.0 buffer-frames callback streaming-info-ptr))
(define (test-start)
(sleep 2)
(printf "starting now... "))
(define (test-end)
(printf "... ending now.\n")
(sleep 1))
(define log-counter 0)
(define log empty)
(define log2 empty)
(define log3 empty)
(define srinv (exact->inexact (/ 1 44100)))
(define (fill-buf ptr frames index)
(unless (= frames 1024)
(error 'fill-buf "expected 1024 frames, got ~s\n"
frames))
(define base-frames (* index 1024))
(define base-t (exact->inexact (* base-frames srinv)))
(for ([i (in-range 1024)])
(define t (+ base-t (* i srinv)))
(define sample (inexact->exact (round (* 32767 (* 0.2 (sin (* twopi t 403)))))))
(define sample-idx (* channels i))
(ptr-set! ptr _sint16 sample-idx sample)
(ptr-set! ptr _sint16 (add1 sample-idx) sample)))
(define (call-fill-buf streaming-info-ptr)
(match (buffer-if-waiting streaming-info-ptr)
[#f #f]
[(list ptr frames idx finished-thunk)
(set! log-counter (+ log-counter 1))
(fill-buf ptr frames idx)
(finished-thunk)]))
(let ()
(define (left-half rads)
(cond [(<= rads (* 1/2 pi)) rads]
[(<= rads (* 3/2 pi)) (- pi rads)]
[else (- rads (* 2 pi))]))
(define (frac n)
(- n (floor n)))
(define t1 (make-s16vector 2048 0))
(time (fill-buf (s16vector->cpointer t1) 1024 3))
(for ([i (in-range 2048)])
(define t (floor (/ i 2)))
(check-= (asin (* 5.0 (/ (s16vector-ref t1 i) 32767.0)))
(left-half (* twopi (frac (* (/ 1 44100) (* (+ (* 3 1024) t) 403)))))
1e-2)))
(let ()
(define buffer-frames 1024)
(match-define (list stream-info place-channel)
(make-streaming-info buffer-frames))
(check-not-false (buffer-if-waiting stream-info))
(define stream (open-test-stream streaming-callback
stream-info
buffer-frames))
(pa-set-stream-finished-callback stream streaming-info-free)
(thread
(lambda ()
(let loop ()
(place-channel-get place-channel)
(set! log3 (cons (pa-get-stream-time stream) log3))
(loop))))
(printf "total silence\n")
(test-start)
(pa-start-stream stream)
(sleep 1.0)
(place-kill place-channel)
(pa-maybe-stop-stream stream)
(pa-maybe-stop-stream stream)
(pa-maybe-stop-stream stream)
(test-end)
(define diffs (for/list ([j (in-list (rest log3))]
[i (in-list log3)])
(- i j)))
(printf "faults: ~s\n" (stream-fails stream-info))
(printf "log3 diffs: ~s\n" diffs))
(let ()
(define buffer-frames 1024)
(match-define (list stream-info signal-channel)
(make-streaming-info buffer-frames))
(define stream (open-test-stream streaming-callback
stream-info
buffer-frames))
(pa-set-stream-finished-callback stream streaming-info-free)
(printf "tone at 403 Hz\n")
(define filling-thread
(thread
(lambda ()
(call-fill-buf stream-info)
(for ([i (in-range 1000)])
(place-channel-get signal-channel)
(set! log2 (cons (pa-get-stream-time stream) log2))
(call-fill-buf stream-info)))))
(test-start)
(pa-start-stream stream)
(sleep 1.0)
(place-kill signal-channel)
(pa-maybe-stop-stream stream)
(pa-maybe-stop-stream stream)
(pa-maybe-stop-stream stream)
(test-end)
(kill-thread filling-thread)
(define diffs (for/list ([j (in-list (rest log2))]
[i (in-list log2)])
(- i j)))
(printf "log2 diffs: \n~s\n" diffs)
(printf "log: \n~s\n" log)
(printf "fails: ~s\n" (stream-fails stream-info))
(check-equal? log-counter 44))
(let ()
(define abort-box (box #f))
(define callback-info (make-sndplay-record tone-buf-330))
(define stream (open-test-stream copying-callback callback-info))
(printf "1/2 second @ 330 Hz\n")
(test-start)
(pa-start-stream stream)
(sleep 0.5)
(test-end))
)))