gemigreerd-racket-audio/test-player-2.rkt

#lang racket/base

(require "ao-player.rkt"
         "audio-decoder.rkt"
         simple-log
         "private/utils.rkt"
         racket-sprintf
         racket/runtime-path)

(define-runtime-path tests "../racket-audio-test")

(define test-file3 (build-path tests "idyll.flac"))
(define test-file4 (build-path tests "mahler-2.mp3"))
(define test-file3-id 3)
(define test-file4-id 4)

(define current-seconds 0)
(define current-file-id -1)
(define current-audio-h #f)
(define player #f)

(sl-log-to-display)

(define wav-output-file #f)
(define seeked #f)

(define (player-status)
  (if player
      (ao-player-status player)
      (hash 'open? #f
            'at-second 0.0
            'duration 0.0
            'buf-size 0
            'volume 100.0
            'reuse-buf-len 0
            'sample-queue-len 0
            'device-bits 0)))

(define (player-at-second)
  (hash-ref (player-status) 'at-second 0.0))

(define (player-volume)
  (hash-ref (player-status) 'volume 100.0))

(define (player-bufsize)
  (hash-ref (player-status) 'buf-size 0))

(define (player-reuse-buf-len)
  (hash-ref (player-status) 'reuse-buf-len 0))

(define (player-sample-queue-len)
  (hash-ref (player-status) 'sample-queue-len 0))

(define (cond-seek duration)
  (when (>= (round current-seconds) 10)
    (when (and (= current-file-id test-file3-id) (not seeked))
      (set! seeked #t)
      (let ((perc (exact->inexact (* (/ (- duration 15) duration) 100.0))))
        (info-sound "Seeking to ~a%" perc)
        (audio-seek current-audio-h perc)))))

(define (cond-volume)
  (when (= (round current-seconds) 20)
    (ao-player-set-volume! player 70.0))
  (when (= (round current-seconds) 25)
    (ao-player-set-volume! player 30))
  (when (= (round current-seconds) 30)
    (ao-player-set-volume! player 100))
  (when (= (round current-seconds) 35)
    (ao-player-set-volume! player 150))
  (when (= (round current-seconds) 40)
    (ao-player-set-volume! player 100)))

(define (audio-play type ao-type handle buf-info buffer buf-len)
  ;(dbg-sound "~a ~a ~a ~a ~a" type ao-type handle buf-info buf-len)

  (let* ((sample (hash-ref buf-info 'sample))
         (rate (hash-ref buf-info 'sample-rate))
         (second (/ (* sample 1.0) (* rate 1.0)))
         (bits-per-sample (hash-ref buf-info 'bits-per-sample))
         (bytes-per-sample (/ bits-per-sample 8))
         (channels (hash-ref buf-info 'channels))
         (bytes-per-sample-all-channels (* channels bytes-per-sample))
         (duration (hash-ref buf-info 'duration)))

    ;; Fire-and-forget naar de player-place.  De player opent/sluit intern
    ;; opnieuw wanneer bits/rate/channels wijzigen.
    ;(dbg-sound "Playing ~a" buf-info)
    ;(sync-log-sound)
    (ao-player-play! player
                     current-file-id
                     second
                     duration
                     buf-info
                     buffer
                     buf-len
                     ao-type)
    ;(dbg-sound "played")
    ;(sync-log-sound)

    (let ((duration* (inexact->exact (round duration))))
      (define (second-printer buf-seconds)
        (let* ((st (player-status))
               (s (inexact->exact (round (hash-ref st 'at-second 0.0)))))
          (unless (= s current-seconds)
            (set! current-seconds s)
            (let ((minutes (quotient s 60))
                  (seconds (remainder s 60))
                  (tminutes (quotient duration* 60))
                  (tseconds (remainder duration* 60))
                  (volume (hash-ref st 'volume 100.0)))
              (info-sound
               (sprintf "At time: %02d:%02d (%02d:%02d) - %d - volume: %d"
                        minutes seconds
                        tminutes tseconds
                        buf-seconds
                        volume))))))

      (let* ((st (player-status))
             (buf-size (hash-ref st 'buf-size 0))
             (buf-seconds
              (exact->inexact
               (/ buf-size bytes-per-sample-all-channels rate))))
        (second-printer buf-seconds)
        (cond-seek duration)
        (cond-volume)

        (when (> buf-seconds 10)
          (info-sound "Reuse buf/Sample queue: ~a/~a"
                      (hash-ref st 'reuse-buf-len 0)
                      (hash-ref st 'sample-queue-len 0))

          (letrec ((waiter
                    (lambda ()
                      (let* ((st (player-status))
                             (buf-size-left (hash-ref st 'buf-size 0))
                             (buf-seconds-left
                              (exact->inexact
                               (/ buf-size-left
                                  bytes-per-sample-all-channels
                                  rate))))
                        (if (< buf-seconds-left 3.0)
                            (info-sound "Seconds in buffer left: ~a"
                                        buf-seconds-left)
                            (begin
                              (sleep 0.5)
                              (second-printer buf-seconds-left)
                              (cond-volume)
                              (cond-seek duration)
                              (waiter)))))))
            (waiter)
            (let ((st (player-status)))
              (info-sound "Reuse buf/Sample queue: ~a/~a"
                          (hash-ref st 'reuse-buf-len 0)
                          (hash-ref st 'sample-queue-len 0)))))))))

(define (audio-meta type ao-type handle meta)
  (dbg-sound "type:    ~a" type)
  (dbg-sound "ao-type: ~a" ao-type)
  (dbg-sound "meta:    ~a" meta))

(define (play-one file file-id)
  (let ((audio-h (audio-open file audio-meta audio-play)))
    (set! current-file-id file-id)
    (set! current-audio-h audio-h)
    (audio-read audio-h)))

(define (play)
  (set! player (make-ao-player #:wav-output-file wav-output-file))
  (set! current-seconds 0)
  (set! seeked #f)

  (displayln (player-status))

  (play-one test-file3 test-file3-id)

  ;; Bij overgang naar volgend bestand: queue leegmaken, zodat oude buffers
  ;; niet doorlopen in de volgende track.
  (ao-player-clear! player)

  (info-sound "Opening next file: ~a" test-file4)
  (set! current-seconds 0)
  (play-one test-file4 test-file4-id)

  (ao-player-close! player)
  (set! player #f))

(play)