Prefetching
This commit is contained in:
+113
-30
@@ -126,10 +126,13 @@
|
||||
(define temporary-media #f)
|
||||
(define current-media-key #f)
|
||||
(define cached-media (make-hash))
|
||||
(define prefetched-track #f)
|
||||
(define auto-started-key #f)
|
||||
(define pending-auto-music-id #f)
|
||||
(define music-tracks (make-hash))
|
||||
(define current-track #f)
|
||||
(define acknowledged-command 0)
|
||||
(define ended-counter 0)
|
||||
(define eof-pending? #f)
|
||||
(define logical-volume 50)
|
||||
(define agent-state
|
||||
(hasheq 'state "stopped"
|
||||
@@ -164,10 +167,11 @@
|
||||
(define (update-from-audio! state full-state)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(define normalized (normal-state state))
|
||||
(define audible-music-id
|
||||
(hash-ref full-state 'at-music-id #f))
|
||||
(set! agent-state
|
||||
(hasheq
|
||||
'state normalized
|
||||
'state (normal-state state)
|
||||
'position
|
||||
(state-value (hash-ref full-state 'at-second #f) 0)
|
||||
'duration
|
||||
@@ -183,10 +187,16 @@
|
||||
(if decoder (format "~a" decoder) ""))
|
||||
'volume logical-volume
|
||||
'error 'null))
|
||||
;; racket-audio reports decoder EOF before its output buffer has
|
||||
;; drained. Advance only when playback itself has actually stopped.
|
||||
(when (and eof-pending? (string=? normalized "stopped"))
|
||||
(set! eof-pending? #f)
|
||||
(when (and pending-auto-music-id
|
||||
(number? audible-music-id)
|
||||
(= pending-auto-music-id audible-music-id))
|
||||
(let ((audible-track
|
||||
(hash-ref music-tracks audible-music-id #f)))
|
||||
(when audible-track
|
||||
(set! current-track audible-track)
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks audible-music-id audible-track)))
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! ended-counter (+ ended-counter 1))))))
|
||||
|
||||
(define (set-agent-error! message)
|
||||
@@ -211,10 +221,8 @@
|
||||
(make-audio-player
|
||||
(λ (_handle state full-state)
|
||||
(update-from-audio! state full-state))
|
||||
(λ (_handle)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! eof-pending? #t))))))
|
||||
(λ (handle)
|
||||
(advance-at-decoder-eof! handle))))
|
||||
(audio-ao-buf-ms! audio 500)
|
||||
(audio-buf-seconds! audio 4 10)
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
@@ -266,33 +274,104 @@
|
||||
(safe-delete-file (cdr entry))
|
||||
(hash-remove! cached-media (car entry)))))
|
||||
|
||||
;; Decoder EOF is intentionally earlier than audible EOF: racket-audio may
|
||||
;; still have several seconds buffered in libao. Starting the prepared file
|
||||
;; here appends it to that same output queue, which is the gapless transition
|
||||
;; used by rktplayer as well.
|
||||
(define (advance-at-decoder-eof! handle)
|
||||
(define prepared
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((value prefetched-track))
|
||||
(set! prefetched-track #f)
|
||||
value))))
|
||||
(cond
|
||||
(prepared
|
||||
(let* ((data (car prepared))
|
||||
(path (cdr prepared))
|
||||
(key (command-cache-key data)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent
|
||||
"Could not start prefetched track: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! ended-counter (+ ended-counter 1)))))))
|
||||
(define music-id (audio-play! handle path))
|
||||
(info-player-agent
|
||||
"Queued prefetched track ~a as music id ~a"
|
||||
(hash-ref data 'filename "track")
|
||||
music-id)
|
||||
(set! current-media-key key)
|
||||
(set! temporary-media path)
|
||||
(discard-unused-media! key)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(hash-set! music-tracks music-id data)
|
||||
(set! auto-started-key key)
|
||||
;; Inform the server only when libao reports this id as audible,
|
||||
;; not while the preceding track is still draining.
|
||||
(set! pending-auto-music-id music-id))))))
|
||||
(else
|
||||
;; The server-driven fallback remains available when prefetching did
|
||||
;; not complete before EOF.
|
||||
(warn-player-agent
|
||||
"Decoder reached EOF before the next track was prefetched")
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! ended-counter (+ ended-counter 1)))))))
|
||||
|
||||
(define (execute-command! command)
|
||||
(let* ((action (hash-ref command 'action ""))
|
||||
(data (hash-ref command 'data (hasheq))))
|
||||
(info-player-agent "Executing command ~a" action)
|
||||
(cond
|
||||
((string=? action "play")
|
||||
(with-agent-state (λ () (set! eof-pending? #f)))
|
||||
(set! current-track data)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state
|
||||
(hash-set
|
||||
(hash-set agent-state 'state "starting")
|
||||
'error
|
||||
'null))))
|
||||
(let* ((next-key (command-cache-key data))
|
||||
(next-media (ensure-media-cached! data)))
|
||||
;; audio-play! already interrupts and closes the previous decoder.
|
||||
;; Calling audio-stop! first can delete a finished FLAC decoder a
|
||||
;; second time in racket-audio.
|
||||
(audio-play! (ensure-audio!) next-media)
|
||||
(set! current-media-key next-key)
|
||||
(set! temporary-media next-media)
|
||||
(discard-unused-media! next-key)))
|
||||
(already-started?
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((matches?
|
||||
(and auto-started-key
|
||||
(equal? auto-started-key next-key))))
|
||||
(when matches? (set! auto-started-key #f))
|
||||
matches?)))))
|
||||
(set! current-track data)
|
||||
(unless already-started?
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! prefetched-track #f)
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! agent-state
|
||||
(hash-set
|
||||
(hash-set agent-state 'state "starting")
|
||||
'error
|
||||
'null))))
|
||||
(let ((next-media (ensure-media-cached! data)))
|
||||
;; audio-play! already interrupts and closes the previous
|
||||
;; decoder; an extra audio-stop! can double-delete FLAC.
|
||||
(define music-id
|
||||
(audio-play! (ensure-audio!) next-media))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks music-id data)))
|
||||
(set! current-media-key next-key)
|
||||
(set! temporary-media next-media)
|
||||
(discard-unused-media! next-key)))))
|
||||
((string=? action "prefetch")
|
||||
(let ((key (command-cache-key data)))
|
||||
(ensure-media-cached! data)
|
||||
(let ((path (ensure-media-cached! data)))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! prefetched-track (cons data path))))
|
||||
(info-player-agent
|
||||
"Prefetched ~a"
|
||||
(hash-ref data 'filename "track")))
|
||||
;; Retain the playing file and the one prepared for playback.
|
||||
(for ((entry (in-list (hash->list cached-media))))
|
||||
(unless (or (equal? (car entry) current-media-key)
|
||||
@@ -304,7 +383,11 @@
|
||||
((string=? action "resume")
|
||||
(audio-pause! (ensure-audio!) #f))
|
||||
((string=? action "stop")
|
||||
(with-agent-state (λ () (set! eof-pending? #f)))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! prefetched-track #f)
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)))
|
||||
(when audio (audio-stop! audio)))
|
||||
((string=? action "seek")
|
||||
(audio-seek! (ensure-audio!)
|
||||
|
||||
+31
-8
@@ -70,6 +70,7 @@
|
||||
[closed? #:mutable]
|
||||
state-lock
|
||||
command-lock
|
||||
local-music-indexes
|
||||
dlna-port)
|
||||
#:transparent)
|
||||
|
||||
@@ -226,6 +227,14 @@
|
||||
value
|
||||
(λ ()
|
||||
(when (eq? handle (player-backend value))
|
||||
(let* ((music-id (hash-ref full-state 'at-music-id #f))
|
||||
(audible-index
|
||||
(and (number? music-id)
|
||||
(hash-ref (player-local-music-indexes value)
|
||||
music-id
|
||||
#f))))
|
||||
(when (exact-nonnegative-integer? audible-index)
|
||||
(set-player-current-index! value audible-index)))
|
||||
(set-player-state! value (normalize-state state))
|
||||
(set-player-position!
|
||||
value
|
||||
@@ -248,7 +257,14 @@
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(set-error! value (exn-message exception)))))
|
||||
(player-command! value "next" (hasheq)))))
|
||||
(call-with-semaphore
|
||||
(player-command-lock value)
|
||||
(λ ()
|
||||
(let ((index (next-index value 1)))
|
||||
;; Queue immediately at decoder EOF, but keep the old track selected
|
||||
;; until libao reports the new music id as actually audible.
|
||||
(when index
|
||||
(play-index! value index #t))))))))
|
||||
|
||||
(define (make-local-backend value)
|
||||
(let ((backend
|
||||
@@ -351,7 +367,7 @@
|
||||
(and (exact-nonnegative-integer? index)
|
||||
(< index (length (player-tracks value)))))
|
||||
|
||||
(define (play-index! value index)
|
||||
(define (play-index! value index [defer-current-index? #f])
|
||||
(unless (valid-track-index? value index)
|
||||
(raise-arguments-error
|
||||
'player-command!
|
||||
@@ -363,20 +379,26 @@
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(set-player-current-index! value index)
|
||||
(set-player-state! value 'starting)
|
||||
(set-player-position! value 0)
|
||||
(set-player-duration! value (track-duration item))))
|
||||
(unless defer-current-index?
|
||||
(set-player-current-index! value index)
|
||||
(set-player-state! value 'starting)
|
||||
(set-player-position! value 0)
|
||||
(set-player-duration! value (track-duration item)))))
|
||||
(cond
|
||||
((eq? kind 'local)
|
||||
(audio-play! backend (track-file item)))
|
||||
(let ((music-id (audio-play! backend (track-file item))))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(hash-set! (player-local-music-indexes value)
|
||||
music-id
|
||||
index)))))
|
||||
((eq? kind 'agent)
|
||||
(let* ((token (fresh-media-token))
|
||||
(data (agent-track-data item index token))
|
||||
(following-index (next-index value 1))
|
||||
(following-item
|
||||
(and following-index
|
||||
(not (= following-index index))
|
||||
(list-ref (player-tracks value) following-index)))
|
||||
(following-token
|
||||
(and following-item (fresh-media-token)))
|
||||
@@ -1027,6 +1049,7 @@
|
||||
#f
|
||||
(make-semaphore 1)
|
||||
(make-semaphore 1)
|
||||
(make-hash)
|
||||
dlna-port)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
Reference in New Issue
Block a user