racket-sound/audio-decoder.rkt

(module audio-decoder racket/base

  (require "flac-decoder.rkt"
           racket/contract
           racket/string
           racket/path
           )

  (provide audio-open
           audio-read
           audio-stop
           audio-seek
           audio-kind
           audio-valid-ext?
           audio-file-valid?
           audio-known-exts?
           audio-register-reader!
           make-audio-reader
           audio-handle?
           )

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Audio readers
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (define-struct audio-reader
    (exts valid? open reader seeker stopper))

  ;; audiotype, audio-reader
  (define audio-readers (make-hash))
  
  (hash-set! audio-readers
             'flac
             (make-audio-reader '("flac")
                                flac-valid?
                                flac-open
                                flac-read
                                flac-seek
                                flac-stop))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Known extensions
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define known-extensions
    '("flac"))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Register audio reader
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define/contract (audio-register-reader! type reader)
    (-> symbol? audio-reader? void?)
    (set! known-extensions (append known-extensions (audio-reader-exts reader)))
    (hash-set! audio-readers type reader))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Generic audio reader
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define-struct audio-handle
    ((kind #:mutable)
     (cb-stream-info #:mutable)
     (cb-audio #:mutable)
     (driver #:mutable)
     (driver-handle #:mutable)
     )
    )

  (define (audio-known-exts?)
    known-extensions)

  (define/contract (audio-kind handle)
    (-> audio-handle? symbol?)
    (audio-handle-kind handle))

  (define (audio-valid-ext? ext)
    (set! ext (format "~a" ext))
    (when (string-prefix? ext ".")
      (set! ext (substring ext 1)))
    (not (null? (filter (λ (e) (string-ci=? ext e)) known-extensions)))
    )

  (define/contract (audio-file-valid? file)
    (-> (or/c string? path?) boolean?)
    (let ((f (build-path file)))
      (let ((e (format "~a" (path-get-extension f))))
        (if (audio-valid-ext? e)
            (let ((reader (find-reader file)))
              (if (eq? reader #f)
                  #f
                  (audio-reader-valid? file)))
            #f))))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ; cb-stream-info will be called with
  ;    - audio-type: symbol?
  ;    - handle: audio-handle?
  ;    - meta: hash?
  ;    Meta information must at least contain:
  ;        ('duration . seconds) - duration of the audio in seconds (or fractions): double
  ;        ('bits-per-sample . integer) - number of audio bits per sample
  ;        ('channels . integer) - number of audio channels
  ;        ('sample-rate . integer) - number of samples per second per channel
  ;        ('total-samples . integer) - total number of samples of the audio
  ;
  ; cb-audio will be called with
  ;    - audio-type: symbol?
  ;    - handle: audio-handle?
  ;    - buf-info: hash?
  ;    - buffer: cpointer?     - contains data to be fed to ao - must be owned / released by the driver
  ;                              the ao-async backend will copy the data
  ;    - buf-size: integer?    - contains the size of the data
  ;    buf-info must at least contain:
  ;        ('duration . seconds) - duration of the audio in seconds (or fractions): double
  ;        ('bits-per-sample . integer) - number of audio bits per sample
  ;        ('channels . integer) - number of audio channels
  ;        ('sample-rate . integer) - number of samples per second per channel
  ;        ('total-samples . integer) - total number of samples of the audio
  ;        (sample . integer) - the current sample the audio buffer applies to.
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define/contract (audio-open audio-file cb-stream-info cb-audio)
    (-> (or/c string? path?) procedure? procedure? audio-handle?)
    (let ((file (if (path? audio-file)
                    (path->string audio-file)
                    audio-file)))
      (unless (audio-file-valid? audio-file)
        (error (format "Not a valid audio file '~a'" audio-file)))
      (unless (file-exists? audio-file)
        (error (format "File '~a' does not exist" audio-file)))
      (let ((reader* (find-reader audio-file)))
        (when (eq? reader* #f)
          (error (format "Cannot find reader for '~a'" audio-file)))
        (let* ((reader-type (car reader*))
               (reader (cadr reader*))
               (handle (make-audio-handle reader-type cb-stream-info cb-audio reader #f))
               )
          (set-audio-handle-driver-handle!
           handle
           ((audio-reader-open reader)
                                file
                                (λ (meta)
                                  (cb-stream-info reader-type handle meta))
                                (λ (buf-info audio-buffer buf-len)
                                  (cb-audio reader-type handle buf-info audio-buffer buf-len)))
             )
          handle)
        )
      )
    )

  (define/contract (audio-read handle)
    (-> audio-handle? void?)
    (let ((reader (audio-reader-reader (audio-handle-driver handle))))
      (void? (reader (audio-handle-driver-handle handle)))))

  (define/contract (audio-seek handle percentage)
    (-> audio-handle? number? void?)
    (let ((seeker (audio-reader-seeker (audio-handle-driver handle))))
      (void (seeker (audio-handle-driver-handle handle) percentage))))

  (define/contract (audio-stop handle)
    (-> audio-handle? void?)
    (let ((stopper (audio-reader-stopper (audio-handle-driver handle))))
      (void (stopper (audio-handle-driver-handle handle)))))
      
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Utils
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (right-reader? reader ext)
    (not (null? (filter (λ (e) (string-ci=? ext e)) (audio-reader-exts reader)))))

  (define (find-reader audio-file)
    (let* ((f (build-path audio-file))
           (ext (substring (format "~a" (path-get-extension audio-file)) 1)))
      (letrec ((f (λ (keys)
                    (if (null? keys)
                        #f
                        (let ((reader (hash-ref audio-readers (car keys))))
                          (if (right-reader? reader ext)
                              (list (car keys) reader)
                              (f (cdr keys))))))))
        (f (hash-keys audio-readers))
        )
      )
    )
      
) ; end of module