much work on the player and hunting for a bug, which first seemed to be in ffmpeg-decoder, but eventually was found in a race condition in audio-placed-player.rkt and an allocation problem in libao-async-ffi-racket.rkt
This commit is contained in:
@@ -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)))))
|
||||
|
||||
|
||||
+166
-63
@@ -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,12 +64,25 @@
|
||||
(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)
|
||||
(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)
|
||||
@@ -82,16 +93,24 @@
|
||||
(let ((nbfs (with-ao-h 'done
|
||||
(ao-bufsize-async ao-h))))
|
||||
(if (eq? nbfs 'done)
|
||||
'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 (set! bufsize nbfs) (sleep 0.1) (loop)))
|
||||
(else
|
||||
(check-paused)
|
||||
(set! bufsize nbfs)
|
||||
(sleep 0.1)
|
||||
(loop)))
|
||||
)
|
||||
)
|
||||
)
|
||||
(when (= bufsize 0)
|
||||
;; 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))
|
||||
)
|
||||
@@ -101,6 +120,7 @@
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define (check-volume)
|
||||
(unless (= req-volume current-volume)
|
||||
@@ -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)
|
||||
; 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 "check-paused: player-stat = playing" evt)
|
||||
)
|
||||
(state (format "check-paused: player-state = ~a" player-state) evt)
|
||||
#t)
|
||||
#f))
|
||||
|
||||
@@ -138,36 +160,55 @@
|
||||
(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)))
|
||||
; 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)))))
|
||||
)
|
||||
|
||||
(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)
|
||||
@@ -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)))
|
||||
(cmd (car data))
|
||||
(in-rpc #f))
|
||||
|
||||
(early-return
|
||||
((? (eq? cmd 'quit) => (stop-and-cleanup)
|
||||
~ (begin
|
||||
(state "quit" evt 'force)
|
||||
(put '(quit)))))
|
||||
(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)
|
||||
(evt (list 'exception e))))])
|
||||
(if (eq? cmd 'init)
|
||||
(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))
|
||||
(put '(initialized)))
|
||||
(begin
|
||||
'(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)
|
||||
(set! min-buf-secs (if (< (cadr data) 2) 2 (cadr data)))
|
||||
(set! max-buf-secs (if (> (caddr data) 30) 30 (caddr data)))
|
||||
(put '(ok))
|
||||
)
|
||||
(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))
|
||||
))
|
||||
'(ok))))
|
||||
((eq? cmd 'seek)
|
||||
(do-rpc
|
||||
(let ((percentage (cadr data)))
|
||||
(seek percentage)
|
||||
(put '(ok))))
|
||||
'(ok))))
|
||||
((eq? cmd 'pause)
|
||||
(do-rpc
|
||||
(let ((paused (cadr data)))
|
||||
(pause paused)
|
||||
(put '(ok))))
|
||||
'(ok))))
|
||||
((eq? cmd 'paused)
|
||||
(put (list (eq? player-state 'paused))))
|
||||
(do-rpc
|
||||
(list (eq? player-state 'paused))))
|
||||
((eq? cmd 'volume)
|
||||
(do-rpc
|
||||
(let ((percentage (cadr data)))
|
||||
(volume percentage)
|
||||
(put '(ok))))
|
||||
(volume (exact->inexact percentage))
|
||||
'(ok))))
|
||||
((eq? cmd 'get-volume)
|
||||
(put (list current-volume)))
|
||||
(do-rpc
|
||||
(list current-volume)))
|
||||
((eq? cmd 'stop)
|
||||
(do-rpc
|
||||
(stop-and-cleanup)
|
||||
(put '(ok)))
|
||||
'(ok)))
|
||||
((eq? cmd 'state)
|
||||
(state "'state command" put))
|
||||
(do-rpc
|
||||
(let ((st #f))
|
||||
(state "'state command" (λ (s) (set! st s)) 'force)
|
||||
st)))
|
||||
(else
|
||||
(error (format "Unknown command ~a" cmd)))
|
||||
(do-rpc
|
||||
(list 'error (format "Unknown command ~a" cmd))))
|
||||
)
|
||||
(loop)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(loop)))
|
||||
)
|
||||
)
|
||||
)
|
||||
+5
-1
@@ -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)))
|
||||
|
||||
+82
-164
@@ -898,41 +898,8 @@
|
||||
)
|
||||
)
|
||||
|
||||
#|
|
||||
(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
|
||||
(let ((ready (and instance
|
||||
(fmpg-instance-opened instance)
|
||||
(fmpg-instance-format-ctx instance)
|
||||
(let ((info (fmpg-instance-audio-info instance)))
|
||||
@@ -942,7 +909,10 @@
|
||||
(and dec
|
||||
(ds-codec-ctx dec)
|
||||
(ds-swr-ctx dec)))
|
||||
#t))
|
||||
#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))
|
||||
[else
|
||||
(let ((packet-status (read-selected-audio-packet! instance pkt)))
|
||||
(cond
|
||||
[(eq? packet-status 'eof)
|
||||
(ds-eof-seen! dec #t)
|
||||
(av_packet_unref pkt)
|
||||
#f]
|
||||
|
||||
[else
|
||||
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
|
||||
[(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) 0]
|
||||
|
||||
[(< ret 0)
|
||||
ret]
|
||||
|
||||
[else
|
||||
(let ((received (receive-result! instance dec)))
|
||||
(if received received (loop)))]))]))
|
||||
? packet-result => packet-result
|
||||
~ (av_packet_free pkt))
|
||||
(if received received (loop)))]))]
|
||||
|
||||
(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
|
||||
|
||||
+38
-2
@@ -16,7 +16,16 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(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
|
||||
@@ -149,10 +158,14 @@
|
||||
(reset!)
|
||||
#t))
|
||||
|
||||
#|
|
||||
(define (read cb format-cb)
|
||||
(when (= current-pcm-pos 0)
|
||||
(ffmpeg-format format-cb))
|
||||
(if (ok? (fmpg-decode-next! fh))
|
||||
(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)]
|
||||
@@ -161,6 +174,29 @@
|
||||
(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)
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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
|
||||
|
||||
+1
-1
@@ -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))))
|
||||
)
|
||||
|
||||
+15
-6
@@ -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)
|
||||
(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)
|
||||
|
||||
|
||||
|
||||
|
||||
+36
-8
@@ -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)))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
@@ -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)))
|
||||
)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user