diff --git a/audio-decoder.rkt b/audio-decoder.rkt index cd6ee29..6519421 100644 --- a/audio-decoder.rkt +++ b/audio-decoder.rkt @@ -217,6 +217,7 @@ (define/contract (audio-stop handle) (-> audio-handle? void?) + (dbg-sound "audio-stop called") (let ((stopper (audio-reader-stopper (audio-handle-driver handle)))) (void (stopper (audio-handle-driver-handle handle))))) diff --git a/audio-placed-player.rkt b/audio-placed-player.rkt index 10fe5e2..0cc63a4 100644 --- a/audio-placed-player.rkt +++ b/audio-placed-player.rkt @@ -13,7 +13,7 @@ (define (eq-seconds? s1 s2) (let ((s1* (inexact->exact (round s1))) (s2* (inexact->exact (round s2)))) - (= s1 s2))) + (= s1* s2*))) (define (placed-player ch-in) (let ((ch-evt #f) @@ -29,7 +29,6 @@ (current-bits -1) (current-rate -1) (current-channels -1) - (current-duration -1) (current-volume 100.0) (req-volume 100.0) (max-buf-secs 4) @@ -38,7 +37,6 @@ (player-state 'stopped) (decoder-buf-info #f) (decoder-meta #f) - (decoder #f) (feeding-audio #f) (feed-interrupted #f) ) @@ -66,37 +64,59 @@ (place-channel-get ch-in) (async-channel-get ch-in))) - (define (audio-read-worker) + (define (audio-read-worker ao-dec file-id) + (set! feeding-audio #t) (set! play-thread (thread (λ () - (set! feeding-audio #t) - (audio-read ao-dec) - (set! feeding-audio #f) - (state "audio-read-worker: just after audio-read" evt) - (if feed-interrupted - (set! feed-interrupted #f) - (begin - (evt '(audio-done)) - (let ((bufsize #f)) - (let loop () - (let ((nbfs (with-ao-h 'done - (ao-bufsize-async ao-h)))) - (if (eq? nbfs 'done) - 'done - (cond - ((eq? bufsize #f) (set! bufsize nbfs) (loop)) - ((= nbfs 0) (set! bufsize 0) 'done) - ((> nbfs bufsize) (set! bufsize nbfs) 'done) - (else (set! bufsize nbfs) (sleep 0.1) (loop))) - ) + (with-handlers ([exn:fail? + (λ (e) + (dbg-sound "Exception in audio-read-worker: ~a" e) + (set! feeding-audio #f) + (set! feed-interrupted #f) + (set! player-state 'stopped) + (evt (list 'exception (exn-message e))))]) + (dynamic-wind + void + (λ () + (dbg-sound "audio-read start") + (audio-read ao-dec) + (dbg-sound "audio-read end") + ) + (λ () (set! feeding-audio #f))) + (state "audio-read-worker: just after audio-read" evt) + (if feed-interrupted + (set! feed-interrupted #f) + (begin + (evt '(audio-done)) + (let ((bufsize #f)) + (let loop () + (let ((nbfs (with-ao-h 'done + (ao-bufsize-async ao-h)))) + (if (eq? nbfs 'done) + (begin + (set! bufsize 0) + 'done) + (cond + ((eq? bufsize #f) (set! bufsize nbfs) (loop)) + ((= nbfs 0) (set! bufsize 0) 'done) + ((> nbfs bufsize) (set! bufsize nbfs) 'done) + (else + (check-paused) + (set! bufsize nbfs) + (sleep 0.1) + (loop))) + ) + ) ) + ;; Alleen de actuele worker mag de globale spelerstatus beëindigen. + ;; Een oude drain-worker mag hoogstens zichzelf opruimen. + (when (and (= bufsize 0) (= file-id current-file-id)) + (set! player-state 'stopped) + (state "audio-read-worker: after read with bufsize 0" evt)) ) - (when (= bufsize 0) - (set! player-state 'stopped) - (state "audio-read-worker: after read with bufsize 0" evt)) ) ) - ) + ) ) ) ) @@ -117,13 +137,15 @@ (with-ao-h 'no-op (ao-pause ao-h #t)) (state "check-paused: player-state = paused" evt) (let loop () - (sleep 0.3) + (sleep 0.1) (when (eq? player-state 'paused) (loop))) - (when (eq? player-state 'playing) - (with-ao-h 'no-op (ao-pause ao-h #f)) - (state "check-paused: player-stat = playing" evt) - ) + ; If the player is no longer paused, we unpause the ao stream, + ; also if the player is no longer playing (i.e. player-state = stopped) + ; in which case, we expect ao-clear-async to have been executed, which + ; means the playing queue is empty. + (with-ao-h 'no-op (ao-pause ao-h #f)) + (state (format "check-paused: player-state = ~a" player-state) evt) #t) #f)) @@ -138,40 +160,59 @@ (duration (hash-ref buf-info 'duration)) ) - (set! decoder type) (set! decoder-buf-info buf-info) - (with-ao-h 'no-op - (when (not (and - (= current-bits bits-per-sample) - (= current-rate rate) - (= current-channels channels))) - (ao-close ao-h) - (set! ao-h #f))) + (when (not (and + (= current-bits bits-per-sample) + (= current-rate rate) + (= current-channels channels))) + ; If we need to reopen the ao device with different bit-rates, + ; we need to wait until the ao sample queue is empty + (let loop () + (let* ((s (with-ao-h -1 (ao-at-second ao-h)))) + (unless (or (= s -1) (eq-seconds? stored-seconds s)) + (set! stored-seconds s) + (state "audio-play: seconds changes (III)" evt))) + (let ((bufsize (with-ao-h 0 (ao-bufsize-async ao-h)))) + (if (= bufsize 0) + (with-mutex ao-mutex + (when (ao-valid? ao-h) + (ao-close ao-h)) + (set! ao-h #f)) + (begin (sleep 0.1) (loop))))) + ) - (when (eq? ao-h #f) - (set! ao-h (ao-open-live bits-per-sample - rate channels - 'native-endian)) - (set! current-bits bits-per-sample) - (set! current-rate rate) - (set! current-channels channels) + (with-mutex ao-mutex + (when (eq? ao-h #f) + (dbg-sound "opening ao-h for ~a ~a" current-file-id files-playing) + (set! ao-h (ao-open-live bits-per-sample + rate channels + 'native-endian)) + ) + (with-ao-h 'no-op + (ao-set-volume! ao-h current-volume) + (set! current-bits bits-per-sample) + (set! current-rate rate) + (set! current-channels channels) + ) ) (check-volume) (with-ao-h 'no-op + (when (not (eq? player-state 'stopped)) (ao-play ao-h current-file-id second duration buffer buf-len ao-type) - ) + )) (check-paused) - (let* ((s (inexact->exact (round (* (ao-at-second ao-h) 10))))) + (let* ((s* (with-ao-h 0 (ao-at-second ao-h))) + (s (inexact->exact (round (* s* 10))))) (unless (= s current-deci-seconds) (set! current-deci-seconds s) - (set! current-seconds (ao-at-second ao-h)))) + (set! current-seconds s*))) (unless (eq-seconds? stored-seconds current-seconds) (set! stored-seconds current-seconds) - (state"audio-play: seconds changed (I)" evt)) + (state "audio-play: seconds changed (I)" evt)) (let* ((buf-size (with-ao-h 0 (ao-bufsize-async ao-h))) (buf-seconds (exact->inexact (/ buf-size @@ -187,7 +228,7 @@ (unless (= s current-deci-seconds) (set! current-deci-seconds s) - (set! current-seconds (with-ao-h 0 (ao-at-second ao-h)))) + (set! current-seconds s*)) (unless (eq-seconds? stored-seconds current-seconds) (set! stored-seconds current-seconds) @@ -216,31 +257,53 @@ (set! current-bits -1) (set! current-rate -1) (set! current-channels -1) - (set! current-duration -1) (set! decoder-buf-info #f) (set! decoder-meta #f) ) (define (stop-and-cleanup) + (dbg-sound "stop and cleanup called") + (set! feed-interrupted #t) + + (with-ao-h 'no-op (ao-clear-async ao-h)) + (set! player-state 'stopped) (unless (eq? ao-dec #f) (audio-stop ao-dec)) - (with-ao-h 'no-op - (ao-clear-async ao-h) - (ao-close ao-h)) - (thread-wait play-thread) (set! ao-dec #f) - (set! ao-h #f) - (set! player-state 'stopped) + + (with-ao-h 'no-op (ao-clear-async ao-h)) + + (when (thread? play-thread) (thread-wait play-thread)) + (set! play-thread #f) + + (with-mutex ao-mutex + (when (ao-valid? ao-h) + (ao-close ao-h) + ) + (set! ao-h #f)) + + (set! feed-interrupted #f) + (set! feeding-audio #f) + (cleanup) - (state "stop-and-cleanup: stopped/cleaned" evt) + + (state "stop-and-cleanup: stopped/cleaned" evt 'force) + player-state ) (define (start file) - + (dbg-sound "starting ~a" file) (when feeding-audio + (dbg-sound "interrupting feed") (set! feed-interrupted #t) - (audio-stop ao-dec) + (with-ao-h 'no-op (ao-clear-async ao-h)) + (set! player-state 'stopped) + (when (audio-handle? ao-dec) + (audio-stop ao-dec)) + (dbg-sound "clearing ao-h queue") + (with-ao-h 'no-op (ao-clear-async ao-h)) + (dbg-sound "waiting for feed to stop") (let loop () (if feeding-audio (begin @@ -249,9 +312,11 @@ (with-ao-h 'no-op (ao-clear-async ao-h)) ) ) + (dbg-sound "waiting for play thread") + (when (thread? play-thread) (thread-wait play-thread)) + (dbg-sound "oke done") ) - (set! ao-dec (audio-open file audio-meta audio-play)) (set! current-file-id (+ current-file-id 1)) (let ((f (build-path file))) (set! files-playing (cons @@ -259,13 +324,16 @@ (filter (λ (e) (= (car e) (- current-file-id 1))) files-playing)))) + (set! ao-dec (audio-open file audio-meta audio-play)) + (when (eq? player-state 'stopped) (set! player-state 'playing)) - (audio-read-worker)) + (audio-read-worker ao-dec current-file-id)) (define (pause paused) - (set! player-state (if paused 'paused 'playing))) - + (when (or (eq? player-state 'paused) + (eq? player-state 'playing)) + (set! player-state (if paused 'paused 'playing)))) (define (seek percentage) (with-ao-h 'no-op @@ -283,7 +351,7 @@ (hash-set! h 'decoder (if (audio-handle? ao-dec) (audio-kind ao-dec) #f)) (hash-set! h 'msg msg) (hash-set! h 'file (let ((r (filter (λ (e) - (eq? (car e) m-id)) + (and (not (eq? m-id #f)) (= (car e) m-id))) files-playing))) (if (null? r) #f (cdar r)))) (hash-set! h 'state player-state) @@ -308,72 +376,107 @@ ) (let ((m-id (hash-ref h 'at-music-id))) - (unless (or (eq? m-id #f) (= m-id 0) ) + (unless (and (null? force) (or (eq? m-id #f) (= m-id 0))) (cb (list 'state h)))) ) ) - + (let loop () (let* ((data (get)) - (cmd (car data))) - - (early-return - ((? (eq? cmd 'quit) => (stop-and-cleanup) - ~ (begin - (state "quit" evt 'force) - (put '(quit))))) + (cmd (car data)) + (in-rpc #f)) - (with-handlers ([exn:fail? (λ (e) - (if (eq? ch-evt #f) - (raise e) - (evt (list 'exception e))))]) - (if (eq? cmd 'init) - (begin - (set! ch-out (cadr data)) - (set! ch-evt (caddr data)) - (put '(initialized))) - (begin - (when (or (eq? ch-out #f) (eq? ch-evt #f)) - (error "placed player not initialized")) - (cond - ((eq? cmd 'buf-seconds) - (set! min-buf-secs (if (< (cadr data) 2) 2 (cadr data))) - (set! max-buf-secs (if (> (caddr data) 30) 30 (caddr data))) - (put '(ok)) - ) - ((eq? cmd 'open) + (define-syntax do-rpc + (syntax-rules (in-rpc) + ((_ b1 ...) + (begin + (set! in-rpc #t) + (let ((r (begin b1 ...))) + (set! in-rpc #f) + (put r)))))) + + (with-handlers ([exn:fail? (λ (e) + (if (eq? ch-evt #f) + (raise e) + (begin + (evt (list 'exception + (exn-message e))) + (when in-rpc + (put (list 'error + (exn-message e))) + (set! in-rpc #f)) + (loop)) + ))]) + + (cond + ((eq? cmd 'quit) (do-rpc + (stop-and-cleanup) + (state "quit" evt 'force) + '(quit))) + ((eq? cmd 'init) (do-rpc + (set! ch-out (cadr data)) + (set! ch-evt (caddr data)) + '(initialized)) + (loop)) + (else + (when (or (eq? ch-out #f) (eq? ch-evt #f)) + (error "placed player not initialized")) + + (unless (eq? cmd 'quit) + (cond + ((eq? cmd 'buf-seconds) + (do-rpc + (let* ((clamp (λ (x) (min 30 (max 2 x)))) + (a (clamp (cadr data))) + (b (clamp (caddr data)))) + (set! min-buf-secs (min a b)) + (set! max-buf-secs (max a b)) + '(ok)))) + ((eq? cmd 'open) + (do-rpc (let ((file (cadr data))) (start file) - (put '(ok)) - )) - ((eq? cmd 'seek) + '(ok)))) + ((eq? cmd 'seek) + (do-rpc (let ((percentage (cadr data))) (seek percentage) - (put '(ok)))) - ((eq? cmd 'pause) + '(ok)))) + ((eq? cmd 'pause) + (do-rpc (let ((paused (cadr data))) (pause paused) - (put '(ok)))) - ((eq? cmd 'paused) - (put (list (eq? player-state 'paused)))) - ((eq? cmd 'volume) + '(ok)))) + ((eq? cmd 'paused) + (do-rpc + (list (eq? player-state 'paused)))) + ((eq? cmd 'volume) + (do-rpc (let ((percentage (cadr data))) - (volume percentage) - (put '(ok)))) - ((eq? cmd 'get-volume) - (put (list current-volume))) - ((eq? cmd 'stop) + (volume (exact->inexact percentage)) + '(ok)))) + ((eq? cmd 'get-volume) + (do-rpc + (list current-volume))) + ((eq? cmd 'stop) + (do-rpc (stop-and-cleanup) - (put '(ok))) - ((eq? cmd 'state) - (state "'state command" put)) - (else - (error (format "Unknown command ~a" cmd))) - ) - ) - ) - ) - (loop))) + '(ok))) + ((eq? cmd 'state) + (do-rpc + (let ((st #f)) + (state "'state command" (λ (s) (set! st s)) 'force) + st))) + (else + (do-rpc + (list 'error (format "Unknown command ~a" cmd)))) + ) + (loop) + ) + ) + ) + ) + ) ) ) - ) + ) \ No newline at end of file diff --git a/ffmpeg-decoder.rkt b/ffmpeg-decoder.rkt index b0229e0..d049e92 100644 --- a/ffmpeg-decoder.rkt +++ b/ffmpeg-decoder.rkt @@ -128,7 +128,9 @@ (ffi-handler 'read (lambda (info pos buffer size) (if (eq? info 'done) - (set-ffmpeg-handle-stop! handle #t) + (begin + (dbg-sound "ffmpeg read: ~a ~a ~a" info pos size) + (set-ffmpeg-handle-stop! handle #t)) (give-audio handle info pos buffer size))) (lambda (pcm-pos rate channels sample-bits sample-bytes pcm-length) (handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length))) @@ -138,6 +140,7 @@ (ffi-handler 'delete))) (define (ffmpeg-seek handle percentage) + (dbg-sound "ffmpeg-seek ~a" percentage) (let ((fmt (ffmpeg-handle-format handle))) (let ((total-samples (hash-ref fmt 'total-samples 0))) (unless (or @@ -149,6 +152,7 @@ (set-ffmpeg-handle-seek! handle sample)))))) (define (ffmpeg-stop handle) + (dbg-sound "ffmpeg-stop called") (set-ffmpeg-handle-stop! handle #t) (while (ffmpeg-handle-reading handle) (sleep 0.01))) diff --git a/ffmpeg-definitions.rkt b/ffmpeg-definitions.rkt index c447e0e..59a1b8a 100644 --- a/ffmpeg-definitions.rkt +++ b/ffmpeg-definitions.rkt @@ -898,51 +898,21 @@ ) ) -#| -(define (fill-audio-info! self) - (let* ((ctx (fmpg-instance-format-ctx self)) - (info (fmpg-instance-audio-info self))) - - (ais-clear! info) - (ais-stream-count! info (count-audio-streams ctx)) - - (let/assert - ((best (av_find_best_stream ctx AVMEDIA_TYPE_AUDIO -1 -1 #f 0) (a->=? 0) #f) - (stream (avformat_stream ctx best) a-!nullptr? #f) - (par (avstream-codec stream) a-!nullptr? #f) - (codec-type (avcodec-pars-codec_type par) (a-=? AVMEDIA_TYPE_AUDIO) #f) - (sample-rate (avcodec-pars-sample_rate par) (a->? 0) #f) - (channels (avcodec-pars-channels par) (a->? 0) #f) - (stream-seconds (stream_duration_seconds stream)) - (seconds (if (< stream-seconds 0.0) - (format_duration_seconds ctx) - stream-seconds)) - ) - (begin - (ais-stream-index! info best) - (ais-rate! info sample-rate) - (ais-channels! info channels) - (ais-duration-ms! info (milliseconds_from_seconds seconds)) - (ais-duration-samples! info (samples_from_seconds seconds sample-rate)) - #t - ) - ) - ) - ) -|# - (define (instance-ready? instance) - (and instance - (fmpg-instance-opened instance) - (fmpg-instance-format-ctx instance) - (let ((info (fmpg-instance-audio-info instance))) - (and info - (>= (ais-stream-index info) 0))) - (let ((dec (fmpg-instance-decoder instance))) - (and dec - (ds-codec-ctx dec) - (ds-swr-ctx dec))) - #t)) + (let ((ready (and instance + (fmpg-instance-opened instance) + (fmpg-instance-format-ctx instance) + (let ((info (fmpg-instance-audio-info instance))) + (and info + (>= (ais-stream-index info) 0))) + (let ((dec (fmpg-instance-decoder instance))) + (and dec + (ds-codec-ctx dec) + (ds-swr-ctx dec))) + #t))) + (unless ready + (err-sound "instance not ready!")) + ready)) @@ -973,31 +943,6 @@ #t) ) -#| -(define (init-codec-context! self) - (let/assert - ((dec (fmpg-instance-decoder self)) - (info (fmpg-instance-audio-info self)) - (ctx (fmpg-instance-format-ctx self)) - (stream-index (ais-stream-index info)) - (stream (avformat_stream ctx stream-index) a-!nullptr? #f) - (par (avstream-codec stream) a-!nullptr? #f) - (codec (let ((c (avcodec_find_decoder (avcodec-pars-codec_id par)))) - (ds-codec! dec c) - c) - a-!nullptr? #f) - (codec-ctx (let ((c (avcodec_alloc_context3 codec))) - (ds-codec-ctx! dec c) - c) - a-!nullptr? #f) - (ret-par (avcodec_parameters_to_context codec-ctx par) (a->=? 0) #f) - (ret-open (avcodec_open2 codec-ctx codec #f) (a->=? 0) #f) - (frame (let ((f (av_frame_alloc))) - (ds-frame! dec f) - f) - a-!nullptr? #f)) - #t)) -|# (define (init-resampler! self) (early-return @@ -1031,32 +976,6 @@ ) ) -#| -(define (init-resampler! self) - (let/assert - ((dec (fmpg-instance-decoder self)) - (codec-ctx (ds-codec-ctx dec) a-!nullptr? #f) - (par (avcodec_parameters_alloc) a-!nullptr? #f)) - (let ((result - (let/assert - ((ret-par (avcodec_parameters_from_context par codec-ctx) (a->=? 0) #f) - (layout (AVCodecParameters-ch_layout par)) - (channels (AVChannelLayout-nb_channels layout) (a->? 0) #f) - (rate (avcodec-pars-sample_rate par) (a->? 0) #f) - (fmt (avcodec-pars-format par)) - (ret-swr (let-values (((ret swr-ctx) - (swr_alloc_set_opts2 (ds-swr-ctx dec) - layout FMPG_OUTPUT_FMT rate - layout fmt rate - 0 #f))) - (ds-swr-ctx! dec swr-ctx) - ret) - (a->=? 0) #f) - (ret-init (swr_init (ds-swr-ctx dec)) (a->=? 0) #f)) - #t))) - (avcodec_parameters_free par) - result))) -|# (define (init-decoder! self) (let ((dec (fmpg-instance-decoder self))) @@ -1243,13 +1162,16 @@ (define (receive-available-frames! self) - (let ((dec (fmpg-instance-decoder self)) (produced 0)) + (let ((dec (fmpg-instance-decoder self)) + (produced 0)) (let loop () (let ((ret (avcodec_receive_frame (ds-codec-ctx dec) (ds-frame dec)))) (cond [(= ret AVERROR_EAGAIN) produced] [(= ret AVERROR_EOF) (ds-drained! dec #t) produced] - [(< ret 0) -1] + [(< ret 0) + (err-sound "Got retvalue ~a from avcodec_receive_frame" ret) + -1] [else (let ((ok? (append-converted-frame! self (ds-frame dec)))) (av_frame_unref (ds-frame dec)) @@ -1260,17 +1182,27 @@ -1))]))))) + (define (read-selected-audio-packet! self pkt) (let ((wanted-stream (ais-stream-index (fmpg-instance-audio-info self)))) (let loop () (let ((ret (av_read_frame (fmpg-instance-format-ctx self) pkt))) (cond - [(< ret 0) #f] - [(= (avpacket-stream-index pkt) wanted-stream) #t] + [(= ret AVERROR_EOF) + 'eof] + + [(< ret 0) + (err-sound "av_read_frame failed: ~a" ret) + 'error] + + [(= (avpacket-stream-index pkt) wanted-stream) + 'packet] + [else (av_packet_unref pkt) (loop)]))))) + (define (drain-resampler! self) (let* ((dec (fmpg-instance-decoder self)) (info (fmpg-instance-audio-info self)) @@ -1330,123 +1262,109 @@ ) ) - (define (fmpg-decode-next! instance) - ;; #f = continue, 0/1 = return value. + (define (r m r . e) + (when (or (eq? r #f) (< r 0)) + (err-sound "fmpg-decode-next! : ~a - ~a - ~a" m r e)) + r) + + ;; #f = continue, 1 = pcm available, negative = error. (define (receive-result! self dec) (let ((produced (receive-available-frames! self))) (cond - [(< produced 0) 0] + [(< produced 0) -1] [(produced-pcm? produced dec) 1] [else #f]))) + (define (send-packet-result! dec pkt) + (let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt))) + (av_packet_unref pkt) + ret)) + (early-return - ((? (not (instance-ready? instance)) => 0) + ((? (not (instance-ready? instance)) => (r "instance-ready" -1)) (dec (fmpg-instance-decoder instance)) (do (ds-clear-output! dec)) - - (received (receive-result! instance dec) ? received => received) - (pkt (av_packet_alloc) ? (eq? pkt #f) => 0) + + (received (receive-result! instance dec) + ? received => (r "receive-result!" received)) + + (pkt (av_packet_alloc) + ? (eq? pkt #f) => (r "av_packet_alloc" -1)) (packet-result (let loop () (cond [(ds-eof-seen dec) #f] - [(not (read-selected-audio-packet! instance pkt)) - (ds-eof-seen! dec #t) - (av_packet_unref pkt) - #f] - [else - (let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt))) - (av_packet_unref pkt) + (let ((packet-status (read-selected-audio-packet! instance pkt))) (cond - [(= ret AVERROR_EAGAIN) - (let ((received (receive-result! instance dec))) - (if received received (loop)))] - [(< ret 0) 0] + [(eq? packet-status 'eof) + (ds-eof-seen! dec #t) + (av_packet_unref pkt) + #f] + + [(eq? packet-status 'error) + (av_packet_unref pkt) + -1] + + [(eq? packet-status 'packet) + (let ((ret (send-packet-result! dec pkt))) + (cond + [(= ret AVERROR_EAGAIN) + (let ((received (receive-result! instance dec))) + (if received received (loop)))] + + [(< ret 0) + ret] + + [else + (let ((received (receive-result! instance dec))) + (if received received (loop)))]))] + [else - (let ((received (receive-result! instance dec))) - (if received received (loop)))]))])) - ? packet-result => packet-result - ~ (av_packet_free pkt)) - - (do - (av_packet_free pkt)) - - (drain-result - (and (not (ds-drained dec)) - (let ((ret (avcodec_send_packet (ds-codec-ctx dec) #f))) - (cond - [(and (< ret 0) (not (= ret AVERROR_EOF))) 0] - [else (receive-result! instance dec)]))) - ? drain-result => drain-result) - - (produced (drain-resampler! instance))) - - (if (produced-pcm? produced dec) 1 0) - ) - ) - -#| -(define (fmpg-decode-next! instance) - - ;; #f = continue, 0/1 = return value. - (define (receive-result! self dec) - (let ((produced (receive-available-frames! self))) - (cond - [(< produced 0) 0] - [(produced-pcm? produced dec) 1] - [else #f]))) - - (early-return - ((? (not (instance-ready? instance)) => 0) - (dec (fmpg-instance-decoder instance)) - (do (ds-clear-output! dec)) - (received (receive-result! instance dec) ? received => received) - (pkt (av_packet_alloc) ? (eq? pkt #f) => 0) - - (packet-result - (let loop () - (unless (ds-eof-seen dec) - (cond - [(not (read-selected-audio-packet! instance pkt)) - (ds-eof-seen! dec #t) - (av_packet_unref pkt) - #f] - [else - (let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt))) - (av_packet_unref pkt) - (cond - [(= ret AVERROR_EAGAIN) - (let ((r (receive-result! instance dec))) (if r r (loop)))] - [(< ret 0) 0] - [else - (let ((r (receive-result! instance dec))) - (if r r (loop)))]))]))) - ? packet-result => packet-result + (err-sound "read-selected-audio-packet!: unexpected result ~a" + packet-status) + -1]))])) + ? packet-result => (r "packet-result" packet-result) ~ (av_packet_free pkt)) (do (av_packet_free pkt)) + ;; If all packets have been read, flush the decoder. (drain-result (and (not (ds-drained dec)) (let ((ret (avcodec_send_packet (ds-codec-ctx dec) #f))) (cond - [(and (< ret 0) (not (= ret AVERROR_EOF))) 0] - [else (receive-result! instance dec)]))) - ? drain-result => drain-result) + [(= ret AVERROR_EOF) + (ds-drained! dec #t) + #f] + + [(= ret AVERROR_EAGAIN) + (receive-result! instance dec)] + + [(< ret 0) + ret] + + [else + (receive-result! instance dec)]))) + ? drain-result => (r "drain-result" drain-result)) + + ;; After decoder drain, flush any delayed samples from swresample. + (produced (drain-resampler! instance) + ? (< produced 0) => (r "drain-resampler!" produced))) + + (cond + [(produced-pcm? produced dec) 1] + [else + (dbg-sound "fmpg-decode-next!: eof/no more pcm") + 0]))) - (produced (drain-resampler! instance))) - (if (produced-pcm? produced dec) 1 0) - ) - ) -|# (define (fmpg-seek-ms! instance target-pos-ms) (early-return diff --git a/ffmpeg-ffi.rkt b/ffmpeg-ffi.rkt index 49a2dde..9c19bc2 100644 --- a/ffmpeg-ffi.rkt +++ b/ffmpeg-ffi.rkt @@ -16,8 +16,17 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (ok? r) - (not (= r 0))) + (> r 0)) + + (define (decode-ok? r) + (= r 1)) + (define (decode-eof? r) + (= r 0)) + + (define (decode-error? r) + (< r 0)) + (define (filename->string filename) (cond [(path? filename) (path->string filename)] @@ -149,18 +158,45 @@ (reset!) #t)) + #| (define (read cb format-cb) (when (= current-pcm-pos 0) (ffmpeg-format format-cb)) - (if (ok? (fmpg-decode-next! fh)) - (let-values ([(buffer size) (copy-current-buffer fh)]) - (cond - [(or (eq? buffer #f) (<= size 0)) (read cb format-cb)] - [else - (let ((pcm-pos (fmpg-buffer-start-sample fh))) - (set! current-pcm-pos (fmpg-buffer-end-sample fh)) - (cb 'data pcm-pos buffer size))])) - (cb 'done -1 #f 0)) + (let ((dec-val (fmpg-decode-next! fh))) + (unless (ok? dec-val) + (err-sound "return value of fmpg-decode-next = ~a" dec-val)) + (if (ok? dec-val) + (let-values ([(buffer size) (copy-current-buffer fh)]) + (cond + [(or (eq? buffer #f) (<= size 0)) (read cb format-cb)] + [else + (let ((pcm-pos (fmpg-buffer-start-sample fh))) + (set! current-pcm-pos (fmpg-buffer-end-sample fh)) + (cb 'data pcm-pos buffer size))])) + (cb 'done -1 #f 0)) + #t)) + |# + (define (read cb format-cb) + (when (= current-pcm-pos 0) + (ffmpeg-format format-cb)) + (let ((dec-val (fmpg-decode-next! fh))) + (cond + [(decode-ok? dec-val) + (let-values ([(buffer size) (copy-current-buffer fh)]) + (cond + [(or (eq? buffer #f) (<= size 0)) + (read cb format-cb)] + [else + (let ((pcm-pos (fmpg-buffer-start-sample fh))) + (set! current-pcm-pos (fmpg-buffer-end-sample fh)) + (cb 'data pcm-pos buffer size))]))] + + [(decode-eof? dec-val) + (cb 'done -1 #f 0)] + + [else + (err-sound "fmpg-decode-next failed: ~a" dec-val) + (cb 'done -1 #f 0)])) #t) (define (seek pcm-pos) diff --git a/libao-async-ffi-racket.rkt b/libao-async-ffi-racket.rkt index 8427ce7..3cc4cc6 100644 --- a/libao-async-ffi-racket.rkt +++ b/libao-async-ffi-racket.rkt @@ -225,12 +225,13 @@ ) -(define (needed-bytes h) +(define (needed-bytes h elem-buflen) (let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8)) (rate-s (ao-handle-dev-rate h)) (channels (ao-handle-dev-channels h)) ) - (/ (* req-bytes rate-s channels ao-buf-ms) 1000) + (let ((needed-for-ao (/ (* req-bytes rate-s channels ao-buf-ms) 1000))) + (max needed-for-ao elem-buflen)) ) ) @@ -256,7 +257,7 @@ (begin (set-ao-handle-current-elem! h elem) (set! cb elem) - (let* ((ns (needed-bytes h)) + (let* ((ns (needed-bytes h (queue-elem-buflen elem))) (new-buf (alloc-buf h ns))) (m-memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb)) (reuse-buf h (queue-elem-buf cb)) diff --git a/libao-async-ffi.rkt b/libao-async-ffi.rkt index 1a84993..e98d5c7 100644 --- a/libao-async-ffi.rkt +++ b/libao-async-ffi.rkt @@ -22,8 +22,23 @@ ao_volume_async make-BufferInfo_t ao_version + ao-playback-buf-ms + ao-set-playback-buf-ms! + ao_sample_queue_len ) + +(define pb 250) + +(define (ao-playback-buf-ms) + pb) + +(define (ao-set-playback-buf-ms! ms) + (set! pb ms)) + +(define (ao_sample_queue_len h) + 0) + (define _BufferType_t (_enum '(ao = 1 flac = 2 diff --git a/libmpg123-ffi.rkt b/libmpg123-ffi.rkt index a7b1da8..728e5d2 100644 --- a/libmpg123-ffi.rkt +++ b/libmpg123-ffi.rkt @@ -405,7 +405,7 @@ int main(int argc, char *argv[]) ) (define (init file) - (let ((r (mpg123_open mh file))) + (let ((r (mpg123_open mh (format "~a" file)))) (unless (eq? r 'MPG123_OK) (error (format "mpg123_open: ~a" (mpg123_plain_strerror r)))) ) diff --git a/play-test.rkt b/play-test.rkt index 633577e..6465549 100644 --- a/play-test.rkt +++ b/play-test.rkt @@ -6,15 +6,17 @@ racket/runtime-path racket/path early-return + "tests.rkt" ) -(define place-mode #t) +(define place-mode #f) + +(define run-queue #f) +(define (set-test a) + (set! run-queue a)) -(define-runtime-path tests "../racket-audio-test") -(define test-file2 (build-path tests "idyll.flac")) -(define test-file3 (build-path tests "mahler-1.mp3")) -(define test-file4 (build-path tests "mahler-2.mp3")) (define play-queue (list test-file2 test-file3 test-file4)) + (define current-sec -1) (define (to-time-str s*) @@ -53,19 +55,26 @@ ) (define (audio-player-eof h) - (if (null? play-queue) - (audio-quit! h) - (begin - (audio-play! h (car play-queue)) - (set! play-queue (cdr play-queue)) - ) - ) + (dbg-sound "audio-player-eof called") + (when (eq? run-queue 'queue) + (if (null? play-queue) + (audio-quit! h) + (begin + (audio-play! h (car play-queue)) + (set! play-queue (cdr play-queue)) + ) + )) + (when (eq? run-queue 'once) + (set! run-queue #f) + (audio-play! h test-file3)) ) (define h (make-audio-player audio-player-state audio-player-eof #:use-place place-mode)) +(sl-log-to-display) (audio-player-eof h) + diff --git a/private/utils.rkt b/private/utils.rkt index 3a9a678..e84d3b3 100644 --- a/private/utils.rkt +++ b/private/utils.rkt @@ -38,23 +38,51 @@ ;; Mutex definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (define (make-mutex) - (make-semaphore 1)) + (define-struct mutex + (thread count mut own) #:mutable) + + (define make-mutex-struct make-mutex) + + (set! make-mutex (λ () + (make-mutex-struct #f 0 (make-semaphore 1) (make-semaphore 1)))) (define (mutex-lock m) - (semaphore-wait m)) + (semaphore-wait (mutex-own m)) + (if (eq? (mutex-thread m) (current-thread)) + (begin + (set-mutex-count! m (+ (mutex-count m) 1)) + (semaphore-post (mutex-own m)) + ) + (begin + (semaphore-post (mutex-own m)) + (semaphore-wait (mutex-mut m)) + (set-mutex-count! m 1) + (set-mutex-thread! m (current-thread))) + ) + ) (define (mutex-unlock m) - (semaphore-post m)) + (semaphore-wait (mutex-own m)) + (let ((count (mutex-count m))) + (set! count (- count 1)) + (set-mutex-count! m count) + (if (= count 0) + (begin + (set-mutex-thread! m #f) + (semaphore-post (mutex-own m)) + (semaphore-post (mutex-mut m))) + (semaphore-post (mutex-own m))) + ) + ) (define-syntax with-mutex (syntax-rules () ((_ m b1 ...) (begin - (semaphore-wait m) - (let ((r (begin b1 ...))) - (semaphore-post m) - r))))) + (dynamic-wind + (λ () (mutex-lock m)) + (λ () b1 ...) + (λ () (mutex-unlock m))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/tests.rkt b/tests.rkt new file mode 100644 index 0000000..d7c4f74 --- /dev/null +++ b/tests.rkt @@ -0,0 +1,79 @@ +#lang racket/base + +(require racket/runtime-path + "private/utils.rkt" + "libmpg123-ffi.rkt" + "audio-decoder.rkt" + ) + +(provide mp3-ffi-read-test + decoder-read-test + test-file1 + test-file2 + test-file3 + test-file4 + test-file5) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; test audio +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-runtime-path tests "../racket-audio-test") + +(define test-file1 (build-path tests "idyll.mp3")) +(define test-file2 (build-path tests "idyll.flac")) +(define test-file3 (build-path tests "mahler-1.mp3")) +(define test-file4 (build-path tests "mahler-2.mp3")) +(define test-file5 (build-path tests "mahler-1.opus")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; test functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; mp3 read test ffi + +(define (mp3-ffi-read-test) + (let* ((file test-file1) + (state #f) + (audio '()) + (formats '()) + (h (mpg123-ffi-decoder-handler)) + ) + (h 'new) + (h 'init file) + (let loop () + (h 'read + (λ (kind pos buf done) + (set! state kind) + (set! audio (cons (list kind pos done) audio))) + (λ (pos rate channels sample-bits sample-bytes length) + (set! formats (cons (list rate channels sample-bits sample-bytes length) formats)))) + (unless (eq? state 'done) + (loop))) + (h 'close) + (h 'delete) + + (displayln (format "got ~a audio samples (~a)" (length audio) (car audio))) + (displayln (format "got ~a formats (~a)" (length formats) (car formats))) + )) + +;;; decoder read test + +(define (decoder-read-test file) + (let* ((state #f) + (audio '()) + (formats '()) + (h (audio-open file + (λ (reader-type ao-type handle meta) + (set! formats (cons (list reader-type ao-type meta) formats))) + (λ (reader-type ao-type handle buf-info audio-buffer buf-len) + (set! audio + (cons (list reader-type ao-type buf-info buf-len) audio))) + ))) + (audio-read h) + + (displayln (format "got ~a audio samples (~a)" (length audio) (car audio))) + (displayln (format "got ~a formats (~a)" (length formats) (car formats))) + ) + ) +