175 lines
6.5 KiB
Racket
175 lines
6.5 KiB
Racket
#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 "../racket-audio-test")
|
|
|
|
(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)
|
|
|