racket-sound/play-test.rkt

#lang racket/base
(require "libao.rkt"
         "audio-decoder.rkt"
         simple-log
         "private/utils.rkt"
         racket-sprintf
         racket/runtime-path
         ;data/queue
         ;racket-sound
         )

(define-runtime-path tests "tests")

(define test-file3 #f)
(define test-file4 #f)
(define test-file3-id 3)
(define test-file4-id 4)
(let ((os (system-type 'os)))
  (when (eq? os 'unix)
    (set! test-file3 (build-path tests "idyll.mp3"))
    (set! test-file4 (build-path tests "idyll.flac"))
    )
  (when (eq? os 'windows)
    (set! test-file3 (build-path tests "idyll.mp3"))
    (set! test-file4 (build-path tests "idyll.flac"))
    )
  )

;(define fmt (ao-mk-format 24 48000 2 'big-endian))
;(define ao-h (ao-open-live #f fmt))

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

(define current-bits -1)
(define current-rate -1)
(define current-channels -1)

(sl-log-to-display)
(define wav-output-file #f)
(define seeked #f)

(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))
         (cond-seek (λ ()
                      (when (= (round current-seconds) 10)
                        (when (and (= current-file-id 3) (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))))))
         (cond-volume (λ ()
                        (when (= (round current-seconds) 20)
                          (ao-set-volume! ao-h 70.0))
                        (when (= (round current-seconds) 25)
                          (ao-set-volume! ao-h 30))
                        (when (= (round current-seconds) 30)
                          (ao-set-volume! ao-h 100))
                        (when (= (round current-seconds) 35)
                          (ao-set-volume! ao-h 150))
                        (when (= (round current-seconds) 40)
                          (ao-set-volume! ao-h 100))))
         )

    (when (not (eq? ao-h #f))
      (when (not (and
                  (= current-bits bits-per-sample)
                  (= current-rate rate)
                  (= current-channels channels)))
        (ao-close ao-h)
        (set! ao-h #f)))
    
    ;(displayln buf-info)
    (when (eq? ao-h #f)
      
      (info-sound "Opening ao handle")
      (info-sound "bits-per-sample: ~a" bits-per-sample)
      (info-sound "rate           : ~a" rate)
      (info-sound "channels       : ~a" channels)
      (info-sound "endian         : ~a" 'native-endian)
      (info-sound "(optional) file: ~a" wav-output-file)
      (sync-log-sound)
      
      (set! ao-h (ao-open-file bits-per-sample rate channels 'native-endian wav-output-file))

      (set! current-bits bits-per-sample)
      (set! current-rate rate)
      (set! current-channels channels)
      (info-sound "ao bits per sample: ~a" (ao-device-bits ao-h))
      (sync-log-sound)
      )
    
    ;(displayln 'ao-play)
    ;(dbg-sound "Playing audio at ~a" second)
    ;(sync-log-sound)
               
    (ao-play ao-h current-file-id second duration buffer buf-len ao-type)
    (set! duration (inexact->exact (round duration)))
    ;(displayln 'done)
    (let ((second-printer (λ (buf-seconds)
                            (let ((s (inexact->exact (round (ao-at-second ao-h)))))
                              (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 (ao-volume ao-h))
                                      )
                                (info-sound
                                 (sprintf "At time: %02d:%02d (%02d:%02d) - %d - volume: %d"
                                                   minutes seconds
                                                   tminutes tseconds
                                                   buf-seconds
                                                   volume
                                                   ))))))))
      (let* ((buf-size (ao-bufsize-async ao-h))
             (buf-seconds (exact->inexact (/ buf-size bytes-per-sample-all-channels rate))))
        (second-printer buf-seconds)
        (cond-seek)
        (cond-volume)
        (when (> buf-seconds 5)
          (letrec ((waiter (λ ()
                             (let ((buf-seconds-left (exact->inexact
                                                      (/ (ao-bufsize-async ao-h)
                                                         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)
                                     (cond-volume)
                                     (cond-seek)
                                     (waiter)))))
                             ))
            (waiter))))
      )
    )
  )

(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)
  (set! ao-h #f)
  (let ((audio-h (audio-open test-file3 audio-meta audio-play)))
    (set! current-file-id test-file3-id)
    (set! current-audio-h audio-h)
    (audio-read audio-h)
    )
  (info-sound "Opening next file: ~a" test-file4)
  (let ((audio-h (audio-open test-file4 audio-meta audio-play)))
    (set! current-file-id test-file4-id)
    (set! current-audio-h audio-h)
    (audio-read audio-h)
    )
  (ao-close ao-h)
  (set! ao-h #f))

(play)