racket-audio/ffmpeg-decoder.rkt

(module ffmpeg_decoder racket/base

  (require ffi/unsafe
           "ffmpeg-ffi.rkt"
           "private/utils.rkt"
           (prefix-in fin: finalizer)
           )

  (provide ffmpeg-open
           ffmpeg-valid?
           ffmpeg-read
           ffmpeg-stop
           ffmpeg-seek
           )

  (define-struct ffmpeg-handle
    (if cb-info cb-audio
        (stop #:mutable)
        (seek #:mutable)
        (reading #:mutable)
        (format #:mutable)
        )
    #:transparent
    )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to do the good stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (ffmpeg-valid? audio-file)
    ;; Keep this deliberately weak, just like mp3-valid?.  Existence and
    ;; extension checks can be done by the generic audio-decoder layer.  The
    ;; real validation happens when the FFmpeg shim opens the file.
    #t)

  (define audio-type 'ffmpeg)

  (define last-rate 44100)    ; An assumption for if we've got nothing
  (define last-channels 2)    ; An assumption for if we've got nothing
  (define last-bits 32)       ; FFmpeg shim output is always S32
  (define last-bytes 4)       ; One S32 sample is four bytes

  (define (correct-format-hash h)
    (let ((rate (hash-ref h 'sample-rate #f)))
      (when (eq? rate #f)
        (hash-set! h 'sample-rate last-rate)))
    (let ((channels (hash-ref h 'channels #f)))
      (when (eq? channels #f)
        (hash-set! h 'channels last-channels)))
    (let ((bits (hash-ref h 'bits-per-sample #f)))
      (when (eq? bits #f)
        (hash-set! h 'bits-per-sample last-bits)))
    (let ((bytes (hash-ref h 'bytes-per-sample #f)))
      (when (eq? bytes #f)
        (hash-set! h 'bytes-per-sample last-bytes)))
    (let ((total-samples (hash-ref h 'total-samples #f)))
      (when (eq? total-samples #f)
        (hash-set! h 'total-samples 0)
        (hash-set! h 'duration 0))))

  (define (report-format handle current-pcm-pos)
    (dbg-sound "Reporting ffmpeg format at pcm-pos: ~a" current-pcm-pos)
    (let ((h (ffmpeg-handle-format handle)))
      (set! last-rate (hash-ref h 'sample-rate))
      (set! last-channels (hash-ref h 'channels))
      (set! last-bits (hash-ref h 'bits-per-sample))
      (set! last-bytes (hash-ref h 'bytes-per-sample last-bytes)))
    ((ffmpeg-handle-cb-info handle) (ffmpeg-handle-format handle)))

  (define (give-audio handle info pos buffer size)
    (let ((h (ffmpeg-handle-format handle)))
      (correct-format-hash h)
      (hash-set! h 'sample pos)
      (let ((sample-rate (hash-ref h 'sample-rate last-rate)))
        (hash-set! h 'current-time (exact->inexact (/ pos sample-rate))))
      ((ffmpeg-handle-cb-audio handle) h buffer size)))

  (define (ffmpeg-open audio-file* cb-stream-info cb-audio)
    (let ((audio-file (if (path? audio-file*)
                          (path->string audio-file*)
                          audio-file*)))
      (if (file-exists? audio-file)
          (let ((handler (fmpg-ffi-decoder-handler)))
            (handler 'new)
            (handler 'init audio-file)
            (let ((h (make-ffmpeg-handle handler
                                         cb-stream-info
                                         cb-audio
                                         #f
                                         #f
                                         #f
                                         (make-hash))))
              h))
          #f)))

  (define (handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length)
    (let ((f (make-hash)))
      (hash-set! f 'duration (if (and (integer? pcm-length)
                                      (>= pcm-length 0)
                                      (integer? rate)
                                      (> rate 0))
                                 (exact->inexact (/ pcm-length rate))
                                 0.0))
      (hash-set! f 'sample-rate rate)
      (hash-set! f 'channels channels)
      (hash-set! f 'bits-per-sample sample-bits)
      (hash-set! f 'bytes-per-sample sample-bytes)
      (hash-set! f 'total-samples pcm-length)
      (set-ffmpeg-handle-format! handle f))
    (report-format handle pcm-pos))

  (define (ffmpeg-read handle)
    (let* ((ffi-handler (ffmpeg-handle-if handle))
           (cb-info (ffmpeg-handle-cb-info handle))
           (cb-audio (ffmpeg-handle-cb-audio handle)))
      (set-ffmpeg-handle-reading! handle #t)
      (let loop ()
        (if (eq? (ffmpeg-handle-stop handle) #t)
            (begin
              (dbg-sound "Stopping ffmpeg decoding")
              (set-ffmpeg-handle-reading! handle #f)
              'stopped-reading)
            (begin
              (unless (eq? (ffmpeg-handle-seek handle) #f)
                (dbg-sound "Seeking to ~a" (ffmpeg-handle-seek handle))
                (ffi-handler 'seek (ffmpeg-handle-seek handle))
                (set-ffmpeg-handle-seek! handle #f))
              (ffi-handler 'read
                           (lambda (info pos buffer size)
                             (if (eq? info 'done)
                                 (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)))
              (loop)))))
    (let ((ffi-handler (ffmpeg-handle-if handle)))
      (ffi-handler 'close)
      (ffi-handler 'delete)))

  (define (ffmpeg-seek handle percentage)
    (let ((fmt (ffmpeg-handle-format handle)))
      (let ((total-samples (hash-ref fmt 'total-samples 0)))
        (unless (or
                 (eq? total-samples #f)
                 (= total-samples -1))
          (let ((sample (inexact->exact
                         (round (* (exact->inexact (/ percentage 100.0))
                                   total-samples)))))
            (set-ffmpeg-handle-seek! handle sample))))))

  (define (ffmpeg-stop handle)
    (set-ffmpeg-handle-stop! handle #t)
    (while (ffmpeg-handle-reading handle)
           (sleep 0.01)))

  ); end of module