diff --git a/.gitignore b/.gitignore index 39a4f9c..6d257d5 100644 --- a/.gitignore +++ b/.gitignore @@ -1,17 +1,9 @@ -# ---> Racket -# gitignore template for the Racket language -# website: http://www.racket-lang.org/ - -# DrRacket autosave files -*.rkt~ -*.rkt.bak -\#*.rkt# -\#*.rkt#*# - -# Compiled racket bytecode +.DS_Store compiled/ -*.zo - -# Dependency tracking files -*.dep - +/doc/ +*~ +*.bak +\#* +.\#* +libao/c/build +libao/c/ao-play-async/build diff --git a/audio-decoder.rkt b/audio-decoder.rkt new file mode 100644 index 0000000..4d18839 --- /dev/null +++ b/audio-decoder.rkt @@ -0,0 +1,263 @@ +(module audio-decoder racket/base + + (require "flac-decoder.rkt" + "mp3-decoder.rkt" + "ffmpeg-decoder.rkt" + "audio-sniffer.rkt" + "private/utils.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-supported-extensions + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Audio readers + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define-struct audio-reader + (exts valid? open reader seeker stopper ao-type)) + + ;; audiotype, audio-reader + (define audio-readers (make-hash)) + + ;; FLAC + (hash-set! audio-readers + 'flac + (make-audio-reader '("flac") + flac-valid? + flac-open + flac-read + flac-seek + flac-stop + 'ao)) + + ;; MP3 + (hash-set! audio-readers + 'ffmpeg + (make-audio-reader '("mp3") + mp3-valid? + mp3-open + mp3-read + mp3-seek + mp3-stop + 'ao)) + + ;; FFmpeg decodere + (hash-set! audio-readers + 'ffmpeg + (make-audio-reader '("ogg" "oga" "opus" + "m4a" "mp4" "m4b" + "aac" + "wav" + "aiff" "aif" "aifc" + "wma" + "webm" "mkv" "mka") + ffmpeg-valid? + ffmpeg-open + ffmpeg-read + ffmpeg-seek + ffmpeg-stop + 'ao)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Known extensions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define known-extensions + '("flac" ; FLAC decoder + "mp3" ; mp3 decoder + "ogg" "oga" "opus" + "m4a" "mp4" "m4b" + "aac" + "wav" + "aiff" "aif" "aifc" + "wma" + "webm" "mkv" "mka" ; FFMPEG decoder + )) + + (define (audio-supported-extensions) + known-extensions) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; 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))) + (if (not (null? (filter (λ (e) (string-ci=? ext e)) known-extensions))) + #t + (begin + (warn-sound "extension '~a' not in known-extensions '~a'" ext known-extensions) + #f)) + ) + + (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? (cadr reader)) file))) + #f)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ; cb-stream-info will be called with + ; - audio-type: symbol? (e.g. 'flac, 'mp3) + ; - ao-type: symbol? - e.g. 'flac, 'ao (ao means the buffer can be used directly by aolib). + ; - 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? + ; - ao-type: symbol? - e.g. 'flac, 'ao (ao means the buffer can be used directly by aolib). + ; - 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*)) + (ao-type (audio-reader-ao-type 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 ao-type handle meta)) + (λ (buf-info audio-buffer buf-len) + (cb-audio reader-type ao-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 reader-for-kind + (make-hash '((mp3 . mp3) ; ffmpeg does a better job on gapless playback... + (flac . flac) + (ogg . ffmpeg) + (vorbis . ffmpeg) + (opus . ffmpeg) + (wav . ffmpeg) + (aiff . ffmpeg) + (mp4 . ffmpeg) + (aac . ffmpeg) + (alac . ffmpeg) + (ac3 . ffmpeg) + (ape . ffmpeg) + (wavpack . ffmpeg) + (wma . ffmpeg) + (matroska . ffmpeg)))) + + + (define (find-reader audio-file) + ; First try to sniff the format + (let ((format (audio-sniff-format/extension audio-file))) + (let ((reader-kind (hash-ref reader-for-kind format #f))) + (if (eq? reader-kind #f) + #f + (let ((reader (hash-ref audio-readers reader-kind))) + (list reader-kind reader)) + ) + ) + ) + ) + +) ; end of module + + + \ No newline at end of file diff --git a/audio-sniffer.rkt b/audio-sniffer.rkt new file mode 100644 index 0000000..589c424 --- /dev/null +++ b/audio-sniffer.rkt @@ -0,0 +1,358 @@ +#lang racket/base + +(require racket/contract + racket/path + racket/string + racket/runtime-path + ) + +(provide audio-format? + audio-sniff-format + audio-sniff-format/extension + audio-sniff-extension + audio-format-matches? + audio-format-known?) + +(define audio-formats + '(mp3 flac ogg vorbis opus wav aiff + mp4 aac alac encrypted-audio + ac3 ape wavpack wma matroska)) + +(define audio-status-formats + '(unknown file-not-found file-not-readable not-a-file)) + +(define known-formats + (append audio-formats audio-status-formats)) + +(define (audio-format? v) + (not (eq? (memq v known-formats) #f))) + +(define sniff-bytes 4096) + +(define mp4-head-peek-sizes + '(4096 8192 16384 32768 65536 131072 153600)) + +(define mp4-tail-peek-blocks + '(4096 8192 16384 32768 65536 65536)) + +(define (audio-sniff-extension* file) + (let ([ext (path-get-extension (build-path file))]) + (cond + [(not ext) #f] + [else + (let ([s (string-downcase (bytes->string/utf-8 ext #\?))]) + (if (and (> (string-length s) 0) + (char=? (string-ref s 0) #\.)) + (substring s 1) + s))]))) + +(define (file-readable-status file) + (cond + [(not (file-exists? file)) 'file-not-found] + [else + (let ([typ (file-or-directory-type file #f)]) + (cond + [(not typ) 'file-not-found] + [(not (eq? typ 'file)) 'not-a-file] + [else #t]))])) + +(define (read-prefix/status file [n sniff-bytes]) + (with-handlers ([exn:fail:filesystem? + (lambda (_) 'file-not-readable)]) + (call-with-input-file file + (lambda (in) + (let ([b (read-bytes n in)]) + (if (eof-object? b) #"" b))) + #:mode 'binary))) + +(define (read-block/status file start size) + (with-handlers ([exn:fail:filesystem? + (lambda (_) 'file-not-readable)]) + (call-with-input-file file + (lambda (in) + (file-position in start) + (let ([b (read-bytes size in)]) + (if (eof-object? b) #"" b))) + #:mode 'binary))) + +(define (u8 b i) + (bytes-ref b i)) + +(define (bytes-prefix? b prefix) + (and (>= (bytes-length b) (bytes-length prefix)) + (bytes=? (subbytes b 0 (bytes-length prefix)) prefix))) + +(define (bytes-at? b pos marker) + (and (>= (bytes-length b) (+ pos (bytes-length marker))) + (bytes=? (subbytes b pos (+ pos (bytes-length marker))) + marker))) + +(define (bytes-contains? b marker) + (let ([blen (bytes-length b)] + [mlen (bytes-length marker)]) + (cond + [(zero? mlen) #t] + [(< blen mlen) #f] + [else + (let loop ([i 0]) + (cond + [(> (+ i mlen) blen) #f] + [(bytes=? (subbytes b i (+ i mlen)) marker) #t] + [else (loop (add1 i))]))]))) + +(define asf-guid + (bytes #x30 #x26 #xb2 #x75 #x8e #x66 #xcf #x11 + #xa6 #xd9 #x00 #xaa #x00 #x62 #xce #x6c)) + +(define (riff-wave? b) + (and (bytes-at? b 0 #"RIFF") + (bytes-at? b 8 #"WAVE"))) + +(define (aiff? b) + (and (bytes-at? b 0 #"FORM") + (or (bytes-at? b 8 #"AIFF") + (bytes-at? b 8 #"AIFC")))) + +(define (iso-bmff? b) + (bytes-at? b 4 #"ftyp")) + +(define (matroska-or-webm? b) + (bytes-prefix? b #"\x1a\x45\xdf\xa3")) + +(define (ac3? b) + (bytes-prefix? b #"\x0b\x77")) + +(define (ape? b) + (bytes-prefix? b #"MAC ")) + +(define (wavpack? b) + (bytes-prefix? b #"wvpk")) + +(define (sniff-ogg-subtype b) + (cond + [(bytes-contains? b #"OpusHead") 'opus] + [(bytes-contains? b #"\x01vorbis") 'vorbis] + [(bytes-contains? b #"vorbis") 'vorbis] + [(bytes-contains? b #"fLaC") 'flac] + [else 'ogg])) + +(define (mp4-codec-peek b) + (cond + [(bytes-contains? b #"enca") 'encrypted-audio] + [(bytes-contains? b #"alac") 'alac] + [(bytes-contains? b #"mp4a") 'aac] + [else #f])) + +(define (mp4-codec-peek/tail file) + (with-handlers ([exn:fail:filesystem? + (lambda (_) 'file-not-readable)]) + (let ([file-len (file-size file)]) + (let loop ([blocks mp4-tail-peek-blocks] + [end file-len]) + (cond + [(null? blocks) #f] + [(<= end 0) #f] + [else + (let* ([block-size (car blocks)] + [start (max 0 (- end block-size))] + [size (- end start)] + [b (read-block/status file start size)]) + (cond + [(not (bytes? b)) b] + [else + (let ([r (mp4-codec-peek b)]) + (if r + r + (loop (cdr blocks) start)))]))]))))) + +(define (mp4-codec-peek/head file) + (let loop ([sizes (cdr mp4-head-peek-sizes)]) + (cond + [(null? sizes) #f] + [else + (let ([b (read-prefix/status file (car sizes))]) + (cond + [(not (bytes? b)) b] + [else + (let ([r (mp4-codec-peek b)]) + (if r + r + (loop (cdr sizes))))]))]))) + +(define (mp4-codec-peek/file file head) + (let ([r0 (mp4-codec-peek head)]) + (cond + [r0 r0] + [else + (let ([rtail (mp4-codec-peek/tail file)]) + (cond + [rtail rtail] + [else + (let ([rhead (mp4-codec-peek/head file)]) + (if rhead rhead #f))]))]))) + +(define (id3? b) + (and (bytes-at? b 0 #"ID3") + (>= (bytes-length b) 10) + (not (= (u8 b 3) #xff)) + (not (= (u8 b 4) #xff)) + (zero? (bitwise-and (u8 b 6) #x80)) + (zero? (bitwise-and (u8 b 7) #x80)) + (zero? (bitwise-and (u8 b 8) #x80)) + (zero? (bitwise-and (u8 b 9) #x80)))) + +(define (synchsafe-size b0 b1 b2 b3) + (+ (arithmetic-shift b0 21) + (arithmetic-shift b1 14) + (arithmetic-shift b2 7) + b3)) + +(define (id3-total-size b) + (and (id3? b) + (+ 10 + (synchsafe-size (u8 b 6) + (u8 b 7) + (u8 b 8) + (u8 b 9))))) + +(define (valid-mp3-frame-at? b i) + (and (>= (bytes-length b) (+ i 4)) + (let* ([b0 (u8 b i)] + [b1 (u8 b (+ i 1))] + [b2 (u8 b (+ i 2))] + [b3 (u8 b (+ i 3))] + [version (bitwise-and (arithmetic-shift b1 -3) #x03)] + [layer (bitwise-and (arithmetic-shift b1 -1) #x03)] + [bitrate (bitwise-and (arithmetic-shift b2 -4) #x0f)] + [sample-rate (bitwise-and (arithmetic-shift b2 -2) + #x03)] + [emphasis (bitwise-and b3 #x03)]) + (and (= b0 #xff) + (= (bitwise-and b1 #xe0) #xe0) + (not (= version #b01)) + (not (= layer #b00)) + (not (= bitrate #b0000)) + (not (= bitrate #b1111)) + (not (= sample-rate #b11)) + (not (= emphasis #b10)))))) + +(define (mp3-frame-sync? b) + (or (valid-mp3-frame-at? b 0) + (let ([id3-size (id3-total-size b)]) + (and id3-size + (< id3-size (bytes-length b)) + (valid-mp3-frame-at? b id3-size))))) + +(define (mp3? b) + (or (id3? b) + (mp3-frame-sync? b))) + +(define (aac-adts-sync? b) + (and (>= (bytes-length b) 7) + (= (u8 b 0) #xff) + (= (bitwise-and (u8 b 1) #xf6) #xf0) + (= (bitwise-and (u8 b 1) #x06) #x00) + (not (= (bitwise-and (arithmetic-shift (u8 b 2) -2) + #x0f) + #x0f)))) + +(define (audio-sniff-format* file) + (let ([status (file-readable-status file)]) + (cond + [(not (eq? status #t)) status] + [else + (let ([b (read-prefix/status file)]) + (cond + [(symbol? b) b] + + ;; Hard signatures + [(bytes-prefix? b #"fLaC") 'flac] + [(bytes-prefix? b #"OggS") (sniff-ogg-subtype b)] + [(riff-wave? b) 'wav] + [(aiff? b) 'aiff] + [(iso-bmff? b) + (let ([codec (mp4-codec-peek/file file b)]) + (if codec codec 'mp4))] + [(bytes-prefix? b asf-guid) 'wma] + [(matroska-or-webm? b) 'matroska] + [(ac3? b) 'ac3] + [(ape? b) 'ape] + [(wavpack? b) 'wavpack] + + ;; Heuristics + [(mp3? b) 'mp3] + [(aac-adts-sync? b) 'aac] + + [else 'unknown]))]))) + +(define (audio-sniff-format/extension* file) + (let ([fmt (audio-sniff-format* file)]) + (cond + [(not (eq? (memq fmt + '(file-not-found file-not-readable not-a-file)) + #f)) + fmt] + [(not (eq? fmt 'unknown)) fmt] + [else + (case (string->symbol (or (audio-sniff-extension* file) "")) + [(mp3 mp2 mp1) 'mp3] + [(flac) 'flac] + [(ogg oga) 'ogg] + [(opus) 'opus] + [(wav wave) 'wav] + [(aif aiff aifc) 'aiff] + [(m4a mp4 m4b m4p) 'mp4] + [(aac) 'aac] + [(alac) 'alac] + [(ac3) 'ac3] + [(ape) 'ape] + [(wv wvp wvpk wavpack) 'wavpack] + [(wma asf) 'wma] + [(webm mka mkv) 'matroska] + [else 'unknown])]))) + +(define (audio-format-known?* fmt) + (not (eq? (memq fmt audio-formats) #f))) + +(define (audio-format-matches?* file formats) + (not (eq? (memq (audio-sniff-format/extension* file) formats) #f))) + +(define/contract (audio-sniff-extension file) + (-> path-string? (or/c string? #f)) + (audio-sniff-extension* file)) + +(define/contract (audio-sniff-format file) + (-> path-string? audio-format?) + (audio-sniff-format* file)) + +(define/contract (audio-sniff-format/extension file) + (-> path-string? audio-format?) + (audio-sniff-format/extension* file)) + +(define/contract (audio-format-known? fmt) + (-> symbol? boolean?) + (audio-format-known?* fmt)) + +(define/contract (audio-format-matches? file formats) + (-> path-string? (listof symbol?) boolean?) + (audio-format-matches?* file formats)) + +(define-runtime-path audio-tests "tests") + +(define (sniff-test) + (for-each (λ (ext) + (let* ((dir (build-path audio-tests)) + (ext* (format ".~a" ext)) + (files (map (λ (f) + (build-path audio-tests f)) + (filter (λ (f) + (string-suffix? (format "~a" f) ext*)) + (directory-list dir)))) + ) + (for-each (λ (f) + (displayln (format "~a: ~a" f (audio-sniff-format/extension f)))) + files) + ) + ) + '(aac adts flac mp3 ogg ts ac3 aiff m4a mp4 ogx wav wv mp2)) + ) diff --git a/ffmpeg-decoder.rkt b/ffmpeg-decoder.rkt new file mode 100644 index 0000000..b0229e0 --- /dev/null +++ b/ffmpeg-decoder.rkt @@ -0,0 +1,156 @@ +(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 diff --git a/ffmpeg-ffi.rkt b/ffmpeg-ffi.rkt new file mode 100644 index 0000000..df6131c --- /dev/null +++ b/ffmpeg-ffi.rkt @@ -0,0 +1,347 @@ +(module ffmpeg_ffi racket/base + + (require ffi/unsafe + ffi/unsafe/define + ffi/unsafe/alloc + "private/utils.rkt" + ) + + (provide fmpg-ffi-decoder-handler + ) + + ;; The native shim is the new instance-only FFmpeg audio API. It exposes a + ;; single opaque fmpg_instance pointer and keeps stream-index, packets, + ;; decoder state and file metadata inside that instance. The public C header + ;; says that output is always signed 32-bit interleaved PCM and that the + ;; current buffer pointer is valid until the next decode/seek/close/free call. + + ;; Adjust the names below if your shared library has another basename. + ;; get-lib is used in the same style as libmpg123-ffi.rkt. + (when (eq? (system-type 'os) 'windows) + ; preload ffmpeg dlls. + (void + (begin + (get-lib '("avutil-60.dll") '(#f)) + (get-lib '("swresample-6.dll") '(#f)) + (get-lib '("avcodec-62") '(#f)) + (get-lib '("avformat-62.dll") '(#f)) + ) + ) + ) + + (define lib (get-lib '("ffmpeg_audio" "libffmpeg_audio") '(#f))) + + (define-ffi-definer define-ffmpeg-audio lib + #:default-make-fail make-not-available) + + (define _fmpg_instance _pointer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Native bindings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define-ffmpeg-audio fmpg_init + (_fun -> _fmpg_instance)) + + (define-ffmpeg-audio fmpg_free + (_fun _fmpg_instance -> _void)) + + (define-ffmpeg-audio fmpg_open_file + (_fun _fmpg_instance _string/utf-8 -> _int)) + + (define-ffmpeg-audio fmpg_close + (_fun _fmpg_instance -> _void)) + + (define-ffmpeg-audio fmpg_is_open + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_stream_count + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_sample_rate + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_channels + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_bits_per_sample + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_bytes_per_sample + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_duration_ms + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_duration_samples + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_file_title + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_author + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_album + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_genre + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_comment + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_copyright + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_year + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_file_track + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_file_bitrate + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_decode_next + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_seek_ms + (_fun _fmpg_instance _int64 -> _int)) + + (define-ffmpeg-audio fmpg_buffer + (_fun _fmpg_instance -> _pointer)) + + (define-ffmpeg-audio fmpg_buffer_size + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_buffer_samples + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_buffer_start_sample + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_buffer_end_sample + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_sample_position + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_timecode + (_fun _fmpg_instance -> _double)) + + (define-ffmpeg-audio fmpg_ffmpeg_version + (_fun -> _string*/utf-8)) + + (define-ffmpeg-audio fmpg_int_version2string + (_fun _int -> _string*/utf-8)) + + (define-ffmpeg-audio fmpg_compatible_ffmpeg + (_fun -> _int)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Our interface for decoding to racket +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (ok? r) + (not (= r 0))) + + (define (str v) + (if (string? v) v "")) + + (define (known-int64? v) + (and (integer? v) (not (= v -1)))) + + (define (copy-current-buffer fh) + (let ((size (fmpg_buffer_size fh))) + (cond + ((<= size 0) (values #f 0)) + (else + (let ((src (fmpg_buffer fh))) + (if (eq? src #f) + (error (format "fmpg_buffer: got NULL for ~a bytes" size)) + ;(let ((dst (malloc size 'nonatomic))) + (let ((dst (make-bytes size))) + (memcpy dst src size) + (values dst size)))))))) + + (define (fmpg-ffi-decoder-handler) + + (define fh #f) + + (define rate -1) + (define channels -1) + (define sample-bits -1) + (define sample-bytes -1) + (define pcm-length -1) + (define duration-ms -1) + (define audio-streams -1) + (define ffmpeg-file "") + (define current-pcm-pos 0) + + (define title "") + (define author "") + (define album "") + (define genre "") + (define comment "") + (define copyright "") + (define year -1) + (define track -1) + (define bitrate -1) + + (define (new) + (if (eq? fh #f) + (begin + (set! fh (fmpg_init)) + (when (eq? fh #f) + (error "fmpg_init: could not allocate ffmpeg instance")) + #t) + (error "ffmpeg handle already initialized, delete it first"))) + + (define (delete) + (if (eq? fh #f) + (error "ffmpeg handle has already been deleted") + (begin + (fmpg_free fh) + (set! fh #f) + (set! rate -1) + (set! channels -1) + (set! sample-bits -1) + (set! sample-bytes -1) + (set! pcm-length -1) + (set! duration-ms -1) + (set! audio-streams -1) + (set! ffmpeg-file "") + (set! current-pcm-pos 0) + #t))) + + (define (fetch-info) + (set! rate (fmpg_audio_sample_rate fh)) + (set! channels (fmpg_audio_channels fh)) + (set! sample-bits (fmpg_audio_bits_per_sample fh)) + (set! sample-bytes (fmpg_audio_bytes_per_sample fh)) + (set! pcm-length (fmpg_duration_samples fh)) + (set! duration-ms (fmpg_duration_ms fh)) + (set! audio-streams (fmpg_audio_stream_count fh)) + (set! title (str (fmpg_file_title fh))) + (set! author (str (fmpg_file_author fh))) + (set! album (str (fmpg_file_album fh))) + (set! genre (str (fmpg_file_genre fh))) + (set! comment (str (fmpg_file_comment fh))) + (set! copyright (str (fmpg_file_copyright fh))) + (set! year (fmpg_file_year fh)) + (set! track (fmpg_file_track fh)) + (set! bitrate (fmpg_file_bitrate fh))) + + (define (init file) + (unless (ok? (fmpg_open_file fh file)) + (error (format "fmpg_open_file: could not open ~a" file))) + (set! ffmpeg-file (format "~a" file)) + (set! current-pcm-pos 0) + (fetch-info) + #t) + + (define (ffmpeg-format cb) + (cb current-pcm-pos rate channels sample-bits sample-bytes pcm-length)) + + (define (info) + (info-sound "file : ~a" ffmpeg-file) + (info-sound "audio-streams : ~a" audio-streams) + (info-sound "channels : ~a" channels) + (info-sound "sample-bits : ~a" sample-bits) + (info-sound "sample-bytes : ~a" sample-bytes) + (info-sound "rate : ~a" rate) + (info-sound "pcm-length : ~a" pcm-length) + (info-sound "duration-ms : ~a" duration-ms) + (info-sound "title : ~a" title) + (info-sound "author : ~a" author) + (info-sound "album : ~a" album) + (info-sound "genre : ~a" genre) + (info-sound "year : ~a" year) + (info-sound "track : ~a" track) + (info-sound "bitrate : ~a" bitrate) + #t) + + (define (close) + (unless (eq? fh #f) + (when (ok? (fmpg_is_open fh)) + (fmpg_close fh)) + (set! channels -1) + (set! pcm-length -1) + (set! duration-ms -1) + (set! rate -1) + (set! sample-bits -1) + (set! sample-bytes -1) + (set! audio-streams -1) + (set! ffmpeg-file "") + #t)) + + (define (read cb format-cb) + ;; Unlike mpg123, this shim already has a fixed output format after + ;; fmpg_open_file. Still report the format lazily on the first read so + ;; the decoder layer can keep exactly the same structure as mp3-decoder. + (when (= current-pcm-pos 0) + (ffmpeg-format format-cb)) + (if (ok? (fmpg_decode_next fh)) + (let-values ([(buffer size) (copy-current-buffer fh)]) + (cond + ((or (eq? buffer #f) (<= size 0)) + ;; Defensive: fmpg_decode_next should only return 1 when there + ;; is PCM data, but if the native side ever returns an empty + ;; block, simply read again. + (read cb format-cb)) + (else + ;; The start sample is the absolute music position of the first + ;; sample frame in this buffer. This is more useful than the + ;; end position for UI and progress reporting. + (let ((pcm-pos (fmpg_buffer_start_sample fh))) + (set! current-pcm-pos (fmpg_buffer_end_sample fh)) + (cb 'data pcm-pos buffer size))))) + (cb 'done -1 #f 0)) + #t) + + (define (seek pcm-pos) + (let* ((r (if (and (integer? rate) (> rate 0)) rate 44100)) + (ms (inexact->exact + (round (* 1000.0 (/ pcm-pos r)))))) + (unless (ok? (fmpg_seek_ms fh ms)) + (error (format "fmpg_seek_ms: could not seek to sample ~a (~a ms)" + pcm-pos ms))) + (set! current-pcm-pos (fmpg_sample_position fh)) + #t)) + + (define (tell) + (if (eq? fh #f) 0 (fmpg_sample_position fh))) + + (define (metadata) + (let ((h (make-hash))) + (hash-set! h 'title title) + (hash-set! h 'author author) + (hash-set! h 'album album) + (hash-set! h 'genre genre) + (hash-set! h 'comment comment) + (hash-set! h 'copyright copyright) + (hash-set! h 'year year) + (hash-set! h 'track track) + (hash-set! h 'bitrate bitrate) + (hash-set! h 'duration-ms duration-ms) + (hash-set! h 'audio-streams audio-streams) + h)) + + (lambda (cmd . args) + (cond + [(eq? cmd 'new) (new)] + [(eq? cmd 'delete) (delete)] + [(eq? cmd 'init) (init (car args))] + [(eq? cmd 'close) (close)] + [(eq? cmd 'format) (ffmpeg-format (car args))] + [(eq? cmd 'info) (info)] + [(eq? cmd 'read) (read (car args) (cadr args))] + [(eq? cmd 'seek) (seek (car args))] + [(eq? cmd 'tell) (tell)] + [(eq? cmd 'file) ffmpeg-file] + [(eq? cmd 'metadata) (metadata)] + [else (error (format "Unknown command: ~a" cmd))]))) + + ); end of module diff --git a/flac-decoder.rkt b/flac-decoder.rkt new file mode 100644 index 0000000..010e172 --- /dev/null +++ b/flac-decoder.rkt @@ -0,0 +1,248 @@ +(module flac-decoder racket/base + + (require ffi/unsafe + "libflac-ffi.rkt" + "flac-definitions.rkt" + "private/utils.rkt") + + (provide flac-open + flac-valid? + flac-read + flac-read-meta + flac-stream-state + flac-stop + flac-seek + (all-from-out "flac-definitions.rkt") + kinds + last-buffer last-buf-len + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions to do the good stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (flac-valid? flac-file*) + #t) + + (define (flac-open flac-file* cb-stream-info cb-audio) + (let ((flac-file (if (path? flac-file*) (path->string flac-file*) flac-file*))) + (if (file-exists? flac-file) + (let ((handler (flac-ffi-decoder-handler))) + (handler 'new) + (handler 'init flac-file) + (let ((h (make-flac-handle handler))) + (set-flac-handle-cb-stream-info! h cb-stream-info) + (set-flac-handle-cb-audio! h cb-audio) + h)) + #f))) + + (define (flac-stream-state handle) + ((flac-handle-ffi-decoder-handler handle) 'state)) + + + (define kinds (make-hash)) + (define last-buffer #f) + (define last-buf-len #f) + + (define (endian-little? e) + (cond [(eq? e 'little-endian) #t] + [(eq? e 'big-endian) #f] + [(eq? e 'native-endian) (not (system-big-endian?))] + [else (error (format "unknown endian value: ~a" e))])) + + #| + (define (flac-channels->interleaved-buffer buffer block-size channels bits endianness) + (let* ([bytes (quotient bits 8)] + [little? (endian-little? endianness)] + [buf-size (* block-size channels bytes)] + [mem-out (malloc buf-size 'atomic)] + [out-pos 0]) + + (for ([k (in-range block-size)]) + (for ([channel (in-range channels)]) + (let* ([channel-ptr (ptr-ref buffer _pointer channel)] + [sample (ptr-ref channel-ptr _int32 k)]) + + (if little? + (for ([j (in-range bytes)]) + (ptr-set! mem-out _uint8 (+ out-pos j) + (bitwise-and + (arithmetic-shift sample (* -8 j)) + #xff))) + (for ([j (in-range bytes)]) + (ptr-set! mem-out _uint8 (+ out-pos j) + (bitwise-and + (arithmetic-shift sample + (* -8 (- bytes j 1))) + #xff)))) + + (set! out-pos (+ out-pos bytes))))) + + (list mem-out buf-size))) +|# + +(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness) + ;; buffer = FLAC__int32 * const buffer[] + ;; block-size = samples per channel + + (let* ([bytes (quotient bits 8)] + [big? (not (endian-little? endianness))] + [buf-size (* block-size channels bytes)] + [bs (make-bytes buf-size)] + ;[out (malloc buf-size 'atomic-interior)] + [out-pos 0]) + + (for ([k (in-range block-size)]) + (for ([channel (in-range channels)]) + (let* ([chan (ptr-ref buffer _pointer channel)] + [sample (ptr-ref chan _int32 k)]) + (integer->int-bytes sample bytes #t big? bs out-pos) + (set! out-pos (+ out-pos bytes))))) + + ;(memcpy out bs buf-size) + ;(list out buf-size) + (list bs buf-size) + )) + + (define (process-frame handle frame buffer) + (let* ([h (flac-ffi-frame-header frame)] + [cb-audio (flac-handle-cb-audio handle)] + [type (hash-ref h 'number-type)] + [channels (hash-ref h 'channels)] + [block-size (hash-ref h 'blocksize)] + [bits (hash-ref h 'bits-per-sample)] + [endianness 'native-endian] + [result (flac-channels->interleaved-buffer + buffer block-size channels bits endianness)] + [mem-out (car result)] + [buf-size (cadr result)]) + + (hash-set! h 'duration (flac-duration handle)) + (hash-set! h 'sample (hash-ref h 'number)) + (hash-set! h 'type 'interleaved) + (hash-set! h 'endianness endianness) + (hash-set! h 'bits-per-sample bits) + + (set! last-buffer mem-out) + (set! last-buf-len buf-size) + + (hash-set! kinds type #t) + + (when (procedure? cb-audio) + (cb-audio h mem-out buf-size)) + + #t)) + + (define (process-meta handle meta) + (let ((type (FLAC__StreamMetadata-type meta))) + (dbg-sound (format " Got metadata type: ~a\n" type)) + (cond + ([eq? type 'streaminfo] + (let ((mh (flac-ffi-meta meta))) + (let ((si (make-flac-stream-info + (hash-ref mh 'min-blocksize) (hash-ref mh 'max-blocksize) + (hash-ref mh 'min-framesize) (hash-ref mh 'max-framesize) + (hash-ref mh 'sample-rate) + (hash-ref mh 'channels) + 32 ; (hash-ref mh 'bits-per-sample) + (hash-ref mh 'total-samples)))) + (let ((duration (exact->inexact + (/ (hash-ref mh 'total-samples) + (hash-ref mh 'sample-rate))))) + (hash-set! mh 'duration duration)) + (set-flac-handle-stream-info! handle si) + (hash-set! mh 'bits-per-sample 32) ; Flac works internally 32 bits. + (let ((cb (flac-handle-cb-stream-info handle))) + (when (procedure? cb) + (cb mh)))))) + ) + ) + ) + + (define (flac-read handle) + (let* ((ffi-handler (flac-handle-ffi-decoder-handler handle)) + (state (ffi-handler 'state))) + (set-flac-handle-stop-reading! handle #f) + (set-flac-handle-reading! handle #t) + (letrec ((reader (lambda (frame-nr) + (if (flac-handle-stop-reading handle) + (begin + (dbg-sound "handling stop at: ~a" (current-milliseconds)) + (set-flac-handle-reading! handle #f) + 'stopped-reading) + (let* ((st (ffi-handler 'state))) + (ffi-handler 'process-single) + (unless (eq? state st) + (set! state st) + (dbg-sound "Now in state ~a (frame-nr = ~a) (int-state = ~a)" + st frame-nr (ffi-handler 'int-state)) + ) + (when (ffi-handler 'has-errno?) + (err-sound "Error in stream: ~a" (ffi-handler 'errno)) + ) + (when (ffi-handler 'has-meta-data?) + (ffi-handler 'process-meta-data + (lambda (meta) (process-meta handle meta))) + ) + (when (ffi-handler 'has-write-data?) + (ffi-handler 'process-write-data + (lambda (frame buffer) + (process-frame handle frame buffer))) + ) + (if (eq? st 'end-of-stream) + (begin + (set-flac-handle-reading! handle #f) + st) + (reader (+ frame-nr 1)))))) + )) + (reader 0) + ; done reading, delete flac encoder + (ffi-handler 'delete) + ) + ) + ) + + (define (flac-read-meta handle) + (let* ((ffi-handler (flac-handle-ffi-decoder-handler handle)) + (state (ffi-handler 'state))) + (while (not (or (eq? state 'read-metadata) + (eq? state 'end-of-stream) + (eq? state 'aborted) + (eq? state 'memory-allocation-error) + (eq? state 'uninitialized))) + (ffi-handler 'process-single) + (set! state (ffi-handler 'state)) + state) + (if (eq? state 'read-metadata) + (begin + (ffi-handler 'process-meta-data + (lambda (meta) (process-meta handle meta))) + (flac-handle-stream-info handle)) + #f))) + + (define (flac-seek handle percentage) + (dbg-sound "seek to percentage ~a" percentage) + (let ((ffi-handler (flac-handle-ffi-decoder-handler handle))) + (let ((total-samples (flac-total-samples handle))) + (unless (eq? total-samples #f) + (let ((sample (inexact->exact (round (* (exact->inexact (/ percentage 100.0)) total-samples))))) + (ffi-handler 'seek-to-sample sample)) + ) + ) + ) + ) + + + (define (flac-stop handle) + (let ((ct (current-milliseconds))) + (dbg-sound "requesting stop at: ~a" ct) + (set-flac-handle-stop-reading! handle #t) + (while (flac-handle-reading handle) + (sleep 0.01)) + (let ((ct* (current-milliseconds))) + (dbg-sound "stop came back at: ~a" ct*) + (dbg-sound "flac-stop took: ~a ms" (- ct* ct))) + ) + ) + + ); end of module diff --git a/flac-definitions.rkt b/flac-definitions.rkt new file mode 100644 index 0000000..e4ac81a --- /dev/null +++ b/flac-definitions.rkt @@ -0,0 +1,108 @@ +(module flac-definitions racket/base + + (provide flac-stream-info + make-flac-stream-info + flac-stream-info->string + + flac-handle + make-flac-handle + flac-handle-ffi-decoder-handler + flac-handle-stream-info + set-flac-handle-stream-info! + flac-handle-cb-stream-info + set-flac-handle-cb-stream-info! + flac-handle-cb-audio + set-flac-handle-cb-audio! + flac-handle-stop-reading + set-flac-handle-stop-reading! + flac-handle-reading + set-flac-handle-reading! + + flac-handle->string + + flac-sample-rate + flac-channels + flac-bits-per-sample + flac-total-samples + flac-duration + ) + + (define-struct flac-stream-info + (min-blocksize max-blocksize + min-framesize max-framesize + sample-rate + channels + bits-per-sample + total-samples + ) + #:transparent + ) + + (define (flac-stream-info->string si) + (format "sample-rate: ~a, channels: ~a, bits-per-sample: ~a, total-samples: ~a" + (flac-stream-info-sample-rate si) + (flac-stream-info-channels si) + (flac-stream-info-bits-per-sample si) + (flac-stream-info-total-samples si))) + + (define (flac-sample-rate h) + (let ((si (flac-handle-stream-info h))) + (if (eq? si #f) + #f + (flac-stream-info-sample-rate si)))) + + (define (flac-channels h) + (let ((si (flac-handle-stream-info h))) + (if (eq? si #f) + #f + (flac-stream-info-channels si)))) + + (define (flac-bits-per-sample h) + (let ((si (flac-handle-stream-info h))) + (if (eq? si #f) + #f + (flac-stream-info-bits-per-sample si)))) + + (define (flac-total-samples h) + (let ((si (flac-handle-stream-info h))) + (if (eq? si #f) + #f + (flac-stream-info-total-samples si)))) + + (define (flac-handle->string h) + (let* ((si (flac-handle-stream-info h)) + (ffi (flac-handle-ffi-decoder-handler h)) + (ff (ffi 'file))) + (string-append + (if (eq? ff #f) + "no flac file available\n" + (format "Flac File: ~a\n" ff)) + (if (eq? si #f) + "no stream info available\n" + (string-append + (format "Stream Info: ~a\n" (flac-stream-info->string si)) + (format "Duration in seconds: ~a\n" (flac-duration h)))) + ))) + + (define (flac-duration h) + (let* ((si (flac-handle-stream-info h))) + (if (eq? si #f) + #f + (let* ((total-samples (flac-stream-info-total-samples si)) + (sample-rate (flac-stream-info-sample-rate si))) + (inexact->exact (round (/ total-samples sample-rate))))))) + + (define-struct flac-handle + ( + ffi-decoder-handler + [cb-stream-info #:auto #:mutable] + [cb-audio #:auto #:mutable] + [stream-info #:auto #:mutable] + [stop-reading #:auto #:mutable] + [reading #:auto #:mutable] + ) + #:auto-value #f + ;#:transparent + ) + + ); end of module diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..4579ae9 --- /dev/null +++ b/info.rkt @@ -0,0 +1,34 @@ +#lang info + +(define pkg-authors '(hnmdijkema)) +(define version "0.1.5") +(define license 'GPL-2.0-or-later) ; The liboa library has this license +(define collection "racket-sound") +(define pkg-desc "racket-sound - Integration of popular music/sound related libraries in racket") + +(define scribblings + '( + ("scrbl/libao.scrbl" () (library)) + ("scrbl/audio-decoder.scrbl" () (library)) + ("scrbl/flac-decoder.scrbl" () (library)) + ("scrbl/mp3-decoder.scrbl" () (library)) + ("scrbl/audio-sniffer.scrbl" () (library)) + ("scrbl/ffmpeg-ffi.scrbl" () (library)) + ("scrbl/ffmpeg-decoder.scrbl" () (library)) + ("scrbl/ffmpeg-c-backend.scrbl" () (library)) + ) + ) + +(define deps + '("racket/gui" "racket/base" "racket" "finalizer" "draw-lib" "net-lib" "simple-log" "racket-sprintf") + ) + +(define build-deps + '("racket-doc" + "draw-doc" + "rackunit-lib" + "scribble-lib" + )) + +(define test-omit-paths 'all) + diff --git a/libao-async-ffi-racket.rkt b/libao-async-ffi-racket.rkt new file mode 100644 index 0000000..9c4360b --- /dev/null +++ b/libao-async-ffi-racket.rkt @@ -0,0 +1,562 @@ +#lang racket/base + +;; Pure Racket replacement for ao_playasync.c as used by libao.rkt. +;; +;; This module exports the same Racket API as libao-async-ffi.rkt, but it +;; calls Xiph libao directly and uses a Racket worker thread instead of the +;; C queue/thread backend. + +(define AO-ASYNC-VERSION 3) + +(require ffi/unsafe + ffi/unsafe/define + ffi/unsafe/custodian + racket/async-channel + data/queue + "private/utils.rkt") + +(provide ao_version_async + ao_create_async + ao_real_output_bits_async + ao_stop_async + ao_play_async + ao_is_at_music_id_async + ao_is_at_second_async + ao_music_duration_async + ao_bufsize_async + ao_clear_async + ao_pause_async + ao_set_volume_async + ao_volume_async + make-buffer-info + make-BufferInfo_t + ) + +;; ------------------------------------------------------------------------- +;; Public structs and enums: keep these equal to the old FFI module. + +(define _Endian_t + (_enum '(little-endian = 1 + big-endian = 2 + native-endian = 4))) + +(define-struct buffer-info + (type ; 'interleaved (old: 'ao) or 'planar (old: 'flac) + sample-bits + sample-rate + channels + endianness + ) + #:mutable + #:transparent + ) + +(define make-BufferInfo_t make-buffer-info) + +;; ------------------------------------------------------------------------- +;; Direct libao FFI. + +(define libao + (get-lib (list (case (system-type 'os) + [(windows) "libao-1.2.2"] + [else "libao"])) '(#f))) + +(define-ffi-definer define-ao libao) + +(define _ao-device (_cpointer/null 'ao-device)) +(define _ao-option (_cpointer/null 'ao-option)) + +(define-cstruct _ao_sample_format + ([bits _int] + [rate _int] + [channels _int] + [byte_format _Endian_t] + [matrix _string*/utf-8])) + +(define-ao ao_initialize (_fun -> _void)) +(define-ao ao_shutdown (_fun -> _void)) +(define-ao ao_default_driver_id (_fun -> _int)) +(define-ao ao_driver_id (_fun _string/utf-8 -> _int)) +(define-ao ao_open_live (_fun _int _ao_sample_format-pointer _ao-option -> _ao-device)) +(define-ao ao_open_file (_fun _int _string/utf-8 _int _ao_sample_format-pointer _ao-option -> _ao-device)) +(define-ao ao_close (_fun _ao-device -> _int)) + +;; ao_play can block until the device accepts more data. Mark it as blocking +;; so other Racket places/threads are not needlessly held up by the foreign +;; call. This is the important part that makes the C backend much less useful. +(define-ao ao_play + ;(_fun #:blocking? #t _ao-device _pointer _uint32 -> _int)) + ;(_fun _ao-device _pointer _uint32 -> _int)) + (_fun #:blocking? #t _ao-device _bytes _uint32 -> _int)) + +;; ------------------------------------------------------------------------- +;; Mutex stuff +;; ------------------------------------------------------------------------- + +(define (make-mutex) + (let ((sem (make-semaphore))) + (semaphore-post sem) + sem)) + +(define (mutex-lock sem) + (semaphore-wait sem)) + +(define (mutex-unlock sem) + (semaphore-post sem)) + +;; ------------------------------------------------------------------------- +;; Async handle etc. +;; ------------------------------------------------------------------------- + +(define (command? x) + (or (eq? x 'play) (eq? x 'stop))) + +(define-struct queue-elem + (command + buf + buflen + at-second + music-duration + music-id + )) + + +(define-struct ao-handle + (queue + paused + + ao-device + requested-bits-per-sample + dev-bits-per-sample + dev-endianness + dev-channels + dev-rate + + mutex + pause-mutex + clear-mutex + play-thread + + at-second + music-duration + music-id + buf-size + volume-in-10000 + + valid + ) + #:mutable + ) + +(define (get h ms-wait) + (let ((el (if (<= ms-wait 0) + (sync/timeout 0 (ao-handle-queue h)) + (sync/timeout (/ ms-wait 1000.0) (ao-handle-queue h) )))) + (unless (eq? el #f) + (set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el)))) + el)) + +(define (add h elem) + (set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem))) + (async-channel-put (ao-handle-queue h) elem) + ) + +(define (new-elem command music-id at-second music-duration buflen buf) + ;(let ((new-buf (make-bytes buflen))) ;((new-buf (malloc buflen 'atomic))) + ; (memcpy new-buf buf buflen) + ;(make-queue-elem command new-buf buflen at-second music-duration music-id))) + (make-queue-elem command buf buflen at-second music-duration music-id)) + +(define (del-elem elem) + ; does nothing + #t) + +(define (clear h) + (let ((count 0) + (el (get h 0))) + (mutex-lock (ao-handle-clear-mutex h)) + (while (not (eq? el #f)) + (del-elem el) + (set! count (+ count 1)) + (set! el (get h 0))) + (mutex-unlock (ao-handle-clear-mutex h)) + (dbg-sound "~a elements cleared" count) + ) + ) + +(define-syntax system-little-endian? + (syntax-rules () + ((_) (not (system-big-endian?))))) + +(define (is-little-endian? e) + (cond [(eq? e 'little-endian) #t] + [(eq? e 'big-endian) #f] + [(eq? e 'native-endian) (system-little-endian?)] + [else (error 'convert-bits "unknown endian value: ~a" e)])) + +(define (is-big-endian? e) + (not (is-little-endian? e))) + + +(define (endian-eq? a b) + (let ((le-a (is-little-endian? a)) + (le-b (is-little-endian? b))) + (eq? le-a le-b))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Converters +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Volume + + + +(define (adjust-volume h bs buf-size volume-in-10000) + ;; bs: bytes + ;; buf-size: aantal geldige bytes in bs + + (let* ([bits (ao-handle-dev-bits-per-sample h)] + [bytes-per-sample (arithmetic-shift bits -3)] + [big? (is-big-endian? (ao-handle-dev-endianness h))]) + + (unless (= volume-in-10000 10000) + (for ([i (in-range 0 buf-size bytes-per-sample)]) + (let* ([sample (int-bytes->integer bs #t big? + i + (+ i bytes-per-sample))] + [scaled (quotient (* sample volume-in-10000) 10000)]) + (integer->int-bytes scaled + bytes-per-sample + #t + big? + bs + i)))) + + #t)) + +;;; planar -> intereleaved + + +(define (planar-to-interleaved mem buf-size info) + ;; mem: bytes + ;; result: (list bytes output-size) + + (let* ([type (buffer-info-type info)] + [bits (buffer-info-sample-bits info)] + [channels (buffer-info-channels info)] + [bytes (arithmetic-shift bits -3)] + [out-size buf-size] + [out (make-bytes out-size)]) + + (unless (or (eq? type 'planar) (eq? type 'flac)) + (error (format "expected planar buffer, got: ~a" type))) + + (unless (zero? (remainder buf-size (* channels bytes))) + (error (format "buffer size ~a is not aligned to ~a channels of ~a-bit samples" + buf-size channels bits))) + + (let* ([samples-total (quotient buf-size bytes)] + [samples-per-channel (quotient samples-total channels)] + [plane-size (* samples-per-channel bytes)]) + + (for ([sample-index (in-range samples-per-channel)]) + (for ([channel (in-range channels)]) + (let* ([in-pos (+ (* channel plane-size) + (* sample-index bytes))] + [out-pos (* (+ (* sample-index channels) channel) + bytes)]) + (bytes-copy! out out-pos mem in-pos (+ in-pos bytes))))) + + (list out out-size)))) + +;;; requested bits to device bits + + +(define (convert-bits buf buf-size in-bits in-endianness out-bits out-endianness) + ;; buf: bytes + ;; returns: (list out-bytes out-size) + + (let* ([in-bytes (arithmetic-shift in-bits -3)] + [out-bytes (arithmetic-shift out-bits -3)] + [samples (quotient buf-size in-bytes)] + [out-size (* samples out-bytes)] + [out (make-bytes out-size)] + [shift (- out-bits in-bits)] + [in-big? (is-big-endian? in-endianness)] + [out-big? (is-big-endian? out-endianness)]) + + (for ([n (in-range samples)]) + (let* ([in-pos (* n in-bytes)] + [out-pos (* n out-bytes)] + [sample (int-bytes->integer buf #t in-big? in-pos (+ in-pos in-bytes))] + [converted (arithmetic-shift sample shift)]) + (integer->int-bytes converted out-bytes #t out-big? out out-pos))) + + (list out out-size))) + +(define (convert-req-bits-to-dev-bits h mem buf-size info) + (if (and (= (buffer-info-sample-bits info) (ao-handle-dev-bits-per-sample h)) + (endian-eq? (buffer-info-endianness info) (ao-handle-dev-endianness h))) + (list mem buf-size) + (convert-bits mem buf-size + (buffer-info-sample-bits info) + (buffer-info-endianness info) + (ao-handle-dev-bits-per-sample h) + (ao-handle-dev-endianness h) + ) + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ASync player +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (run h) + (thread + (λ () + (let ((go-on #t)) + (while go-on + (mutex-lock (ao-handle-pause-mutex h)) + (mutex-unlock (ao-handle-pause-mutex h)) + (mutex-lock (ao-handle-clear-mutex h)) + (let ((elem (get h 250))) + (mutex-unlock (ao-handle-clear-mutex h)) + (if (eq? elem #f) + (sleep 0.005) + (begin + (set-ao-handle-at-second! h (queue-elem-at-second elem)) + (set-ao-handle-music-duration! h (queue-elem-music-duration elem)) + (set-ao-handle-music-id! h (queue-elem-music-id elem)) + + (unless (= (ao-handle-volume-in-10000 h) 10000) + (adjust-volume h (queue-elem-buf elem) (queue-elem-buflen elem) + (ao-handle-volume-in-10000 h))) + + (if (eq? (queue-elem-command elem) 'stop) + (set! go-on #f) + (ao_play (ao-handle-ao-device h) + (queue-elem-buf elem) (queue-elem-buflen elem))) + + (del-elem elem) + )) + ) + ) + ) + ) + #:pool 'own + ) + ) + + +(define init #f) +(define (init-ao) + (when (eq? init #f) + (set! init #t) + (ao_initialize) + (register-finalizer-and-custodian-shutdown + init + (λ (v) + (ao_shutdown)) + #:at-exit? #t + ) + ) + ) + + +(define (try-open-device bits rate channels byte-format wav-output-file) + (let ((candidates (make-vector 3 bits)) + (n 1) + (result #f)) + + (when (> bits 24) + (vector-set! candidates n 24) + (set! n (+ n 1))) + + (when (> bits 16) + (vector-set! candidates n 16) + (set! n (+ n 1))) + + (let ((i 0)) + (while (< i n) + (let* ((fmt (make-ao_sample_format (vector-ref candidates i) + rate + channels + byte-format + #f)) + (driver-id (if (eq? wav-output-file #f) + (ao_default_driver_id) + (ao_driver_id "wav"))) + (dev (if (eq? wav-output-file #f) + (ao_open_live driver-id fmt #f) + (ao_open_file driver-id wav-output-file 1 fmt #f))) + ) + + (unless (eq? dev #f) + (set! result (list dev (vector-ref candidates i))) + (set! i n) + ) + ) + (set! i (+ i 1)) + ) + ) + + (if (eq? result #f) + (list #f 0) + result) + ) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (ao_version_async) + AO-ASYNC-VERSION) + +(define (ao_create_async bits rate channels byte-format wav-output-file) + (init-ao) + + (let ((handle (make-ao-handle + (make-async-channel) ; queue + #f ; paused + + #f ; ao-device + bits ; requested-bits-per-sample + 0 ; device bits per sample + 'little-endian ; dev-endianness + channels ; dev-channels + rate ; dev-rate + + (make-mutex) ; mutex + (make-mutex) ; pause-mutex + (make-mutex) ; clear-mutex + + #f ; play-thread + + 0.0 ; at-second + 0.0 ; music-duration + 0 ; music-id + + 0 ; total buf size + 10000 ; volume-in-10000 + + #t ; valid handle + ))) + + (let ((ao-dev-bits (try-open-device bits rate channels byte-format wav-output-file))) + (set-ao-handle-ao-device! handle (car ao-dev-bits)) + (set-ao-handle-dev-bits-per-sample! handle (cadr ao-dev-bits)) + + (if (eq? (car ao-dev-bits) #f) + (begin + (err-sound "Cannot open ao-device") + #f) + (begin + (set-ao-handle-play-thread! handle (run handle)) + handle) + ) + ) + ) + ) + +(define (ao_stop_async h) + (unless (ao-handle-valid h) + (error "Not a valid ao handle")) + + (dbg-sound "Stopping ao-async, calling clear") + (clear h) + (dbg-sound "Queue cleared") + + (when (ao-handle-paused h) + (mutex-unlock (ao-handle-pause-mutex h))) + + (let ((elem (new-elem 'stop 0 0.0 0.0 0 #f))) + (add h elem)) + + (dbg-sound "Stop command queued") + + (thread-wait (ao-handle-play-thread h)) + (dbg-sound "Play thread stopped") + + (ao_close (ao-handle-ao-device h)) + (dbg-sound "AO Device closed") + + (set-ao-handle-valid! h #f) + h + ) + +(define (ao_play_async h music-id at-second music-duration buf-size mem info) + (let ((type (buffer-info-type info))) + + (unless (bytes? mem) + (error "ao_play_async: paramater mem must be of type bytes")) + + (when (or (eq? type 'planar) (eq? type 'flac)) + (dbg-sound "Converting from planar to interleaved") + (let ((m (planar-to-interleaved mem buf-size info))) + (set! mem (car m)) + (set! buf-size (cadr m))) + ) + + (let ((ao-size buf-size) + (ao-mem mem)) + (let ((m (convert-req-bits-to-dev-bits h mem buf-size info))) + (set! ao-mem (car m)) + (set! ao-size (cadr m))) + + (unless (bytes? ao-mem) + (error "Hey! this was unexpected!")) + + + (let ((elem (new-elem 'play music-id at-second music-duration ao-size ao-mem))) + (add h elem)) + ) + ) + ) + +(define (ao_clear_async h) + (clear h)) + +(define (ao_is_at_second_async h) + (ao-handle-at-second h)) + +(define (ao_is_at_music_id_async h) + (ao-handle-music-id h)) + +(define (ao_music_duration_async h) + (ao-handle-music-duration h)) + +(define (ao_bufsize_async h) + (ao-handle-buf-size h)) + +(define (ao_set_volume_async h percentage) + (let ((volume-10000 (inexact->exact (round (* percentage 100.0))))) + (when (and (> volume-10000 9990) (< volume-10000 10010)) + (set! volume-10000 10000)) + (set-ao-handle-volume-in-10000! h volume-10000) + ) + ) + +(define (ao_volume_async h) + (let ((volume-10000 (ao-handle-volume-in-10000 h))) + (/ volume-10000 100.0) + ) + ) + +(define (ao_pause_async h paused) + (if (ao-handle-paused h) + (when (eq? paused #f) + (mutex-unlock (ao-handle-pause-mutex h)) + (set-ao-handle-paused! h #f) + ) + (when (eq? paused #t) + (mutex-lock (ao-handle-pause-mutex h)) + (set-ao-handle-paused! h #t) + ) + ) + ) + +(define (ao_real_output_bits_async h) + (ao-handle-dev-bits-per-sample h)) + diff --git a/libao-async-ffi.rkt b/libao-async-ffi.rkt new file mode 100644 index 0000000..543e49c --- /dev/null +++ b/libao-async-ffi.rkt @@ -0,0 +1,102 @@ +#lang racket/base + + +(require ffi/unsafe + ffi/unsafe/define + "private/utils.rkt" + ;"libao-ffi.rkt" + ) + +(provide ao_create_async + ao_real_output_bits_async + ao_stop_async + ao_play_async + ao_is_at_music_id_async + ao_is_at_second_async + ao_music_duration_async + ao_bufsize_async + ao_clear_async + ao_pause_async + ao_set_volume_async + ao_volume_async + make-BufferInfo_t + ) + +(define _BufferType_t + (_enum '(ao = 1 + flac = 2 + mp3 = 3 + ogg = 4 + ))) + +;#define AO_FMT_LITTLE 1 +;#define AO_FMT_BIG 2 +;#define AO_FMT_NATIVE 4 + +(define _Endian_t + (_enum '(little-endian = 1 + big-endian = 2 + native-endian = 4 + ) + ) + ) + +(define-cstruct _BufferInfo_t + ( + [type _BufferType_t] + [sample_bits _int] + [sample_rate _int] + [channels _int] + [endiannes _Endian_t] + )) + + +(when (eq? (system-type 'os) 'windows) + (void (get-lib '("libao-1.2.2") '(#f)))) + +(define lib (get-lib '("ao-play-async" "libao-play-async") '(#f))) +;(define lib (ffi-lib "/home/hans/src/racket/racket-sound-lib/lib/linux-x86_64/libao-play-async.so")) +(define-ffi-definer define-libao-async lib + #:default-make-fail make-not-available) + +(define _libao-async-handle-pointer (_cpointer 'ao-async-handle)) + +;extern int ao_async_version() +(define-libao-async ao_async_version (_fun -> _int)) + +;extern void *ao_create_async(int bits, int rate, int channel, int byte_format); +(define-libao-async ao_create_async(_fun _int _int _int _Endian_t _string/utf-8 -> _libao-async-handle-pointer)) + +;extern int ao_real_output_bits(void *handle) +(define-libao-async ao_real_output_bits_async + (_fun _libao-async-handle-pointer -> _int)) + +;extern void ao_stop_async(void *handle); +(define-libao-async ao_stop_async(_fun _libao-async-handle-pointer -> _void)) + +;extern void ao_play_async(void *handle, int music_id, double at_second, double music_duration, int buf_size, void *mem, BufferInfo_t info); +(define-libao-async ao_play_async(_fun _libao-async-handle-pointer _int _double _double _uint32 _pointer _BufferInfo_t -> _void)) + +;extern double ao_is_at_second_async(void *handle); +(define-libao-async ao_is_at_second_async(_fun _libao-async-handle-pointer -> _double)) + +;extern int ao_is_at_music_id_async(void *handle); +(define-libao-async ao_is_at_music_id_async (_fun _libao-async-handle-pointer -> _int)) + +;extern double ao_music_duration_async(void *handle); +(define-libao-async ao_music_duration_async(_fun _libao-async-handle-pointer -> _double)) + +;extern int ao_bufsize_async(void *handle); +(define-libao-async ao_bufsize_async(_fun _libao-async-handle-pointer -> _int)) + +;extern void ao_clear_async(void *handle); +(define-libao-async ao_clear_async(_fun _libao-async-handle-pointer -> _void)) + +;extern void ao_pause_async(void *handle, int pause); +(define-libao-async ao_pause_async(_fun _libao-async-handle-pointer _int -> _void)) + +;extern void ao_set_volume_async(void *handle, double percentage) +(define-libao-async ao_set_volume_async (_fun _libao-async-handle-pointer _double -> _void)) + +;extern double ao_volume_async(void *handle) +(define-libao-async ao_volume_async (_fun _libao-async-handle-pointer -> _double)) diff --git a/libao.rkt b/libao.rkt new file mode 100644 index 0000000..e5cc1ca --- /dev/null +++ b/libao.rkt @@ -0,0 +1,221 @@ +#lang racket/base + +(require (prefix-in fin: finalizer) + (prefix-in ffi: "libao-async-ffi.rkt") + ffi/unsafe + ffi/unsafe/custodian + data/queue + "private/utils.rkt" + (prefix-in rc: racket/contract) + ) + +(provide ao-open-live + ao-device-bits + ao-open-file + ao-play + ao-close + ao-at-second + ao-music-duration + ao-at-music-id + ao-bufsize-async + ao-clear-async + ao-pause + ao-set-volume! + ao-volume + ao-valid? + ao-valid-bits? + ao-valid-rate? + ao-valid-channels? + ao-valid-format? + ao-handle? + ao-supported-music-format? + ) + +(define device-number 1) + +(define-struct ao-handle (handle-num + [bits #:auto #:mutable] + [bytes-per-sample #:auto #:mutable] + [dev-bits #:auto #:mutable] + [dev-bytes-per-sample #:auto #:mutable] + [byte-format #:auto #:mutable] + [channels #:auto #:mutable] + [rate #:auto #:mutable] + [async-player #:auto #:mutable] + [closed #:auto #:mutable] + ) + #:auto-value #f + ) + + +(define (ao-supported-music-format? f) + (and (symbol? f) + (or (eq? f 'flac) + (eq? f 'ao)))) + + +(define (bytes-for-bits bits) + (/ bits 8)) + +(define (ao-valid-bits? bits) + (and (integer? bits) (or + (= bits 8) + (= bits 16) + (= bits 24) + (= bits 32)) + ) + ) + +(define (ao-valid-rate? rate) + (and (integer? rate) + (> rate 0) + (not (eq? (memq rate '(8000 11025 16000 22050 44100 + 48000 88200 96000 176400 + 192000 352800 384000)) #f)))) + +(define (ao-valid-channels? c) + (and (integer? c) + (>= c 1))) + +(define (ao-valid-format? f) + (or (eq? f 'little-endian) + (eq? f 'big-endian) + (eq? f 'native-endian))) + +(rc:define/contract (ao-open-live bits rate channels byte-format) + (rc:-> ao-valid-bits? ao-valid-rate? ao-valid-channels? ao-valid-format? ao-handle?) + (ao-open-file bits rate channels byte-format #f)) + +(define (valid-file-kind? f) + (or (string? f) (path? f) (eq? f #f))) + +(rc:define/contract (ao-open-file bits rate channels byte-format filename) + (rc:-> ao-valid-bits? ao-valid-rate? ao-valid-channels? ao-valid-format? valid-file-kind? ao-handle?) + (let* ((handle (make-ao-handle device-number)) + (file (if (eq? filename #f) + #f + (format "~a" filename))) + ) + (fin:register-finalizer handle + (lambda (handle) + (ao-close handle))) + + (set-ao-handle-bits! handle bits) + (set-ao-handle-bytes-per-sample! handle (bytes-for-bits bits)) + (set-ao-handle-byte-format! handle byte-format) + (set-ao-handle-channels! handle channels) + (set-ao-handle-rate! handle rate) + + (info-sound "ao-open-live ~a ~a ~a ~a ~a" bits rate channels byte-format file) + + (let ((player (ffi:ao_create_async bits rate channels byte-format file))) + (set-ao-handle-async-player! handle player) + (if (eq? player #f) + (begin + (err-sound "ao-open-live - cannote create player") + (set-ao-handle-closed! handle #t) + handle) + (let ((out-bits (ffi:ao_real_output_bits_async player))) + (info-sound "ao-open-live - created player at ~a bits" out-bits) + (set-ao-handle-dev-bits! handle out-bits) + (set-ao-handle-dev-bytes-per-sample! handle (/ out-bits 8)) + (set-ao-handle-closed! handle #f) + handle + ) + ) + ) + ) + ) + + +(rc:define/contract (ao-close handle) + (rc:-> ao-handle? void?) + (void + (unless (eq? (ao-handle-async-player handle) #f) + (info-sound "ao-close - closing handle") + (ffi:ao_stop_async (ao-handle-async-player handle)) + (set-ao-handle-async-player! handle #f) + ) + ) + ) + +(define (ao-valid? handle) + (and (ao-handle? handle) + (not (eq? (ao-handle-async-player handle) #f))) + ) + +(define (any? x) + #t) + +(rc:define/contract (ao-device-bits handle) + (rc:-> ao-handle? integer?) + (ao-handle-dev-bits handle)) + +(rc:define/contract (ao-play handle music-id at-time-in-s music-duration-s buffer buf-len buf-type) + (rc:-> ao-handle? integer? number? number? any? integer? ao-supported-music-format? void?) + (let* ((bytes-per-sample (ao-handle-bytes-per-sample handle)) + (bits (ao-handle-bits handle)) + (rate (ao-handle-rate handle)) + (channels (ao-handle-channels handle)) + (endianess (ao-handle-byte-format handle)) + (buf-info (ffi:make-BufferInfo_t buf-type bits rate channels endianess)) + ) + (unless (ao-valid? handle) + (err-sound "Cannot play on an invalid ao-device") + (error "Cannot play on an invalid ao-device")) + (ffi:ao_play_async (ao-handle-async-player handle) + music-id + (exact->inexact at-time-in-s) + (exact->inexact music-duration-s) + buf-len + buffer + buf-info) + + ) + ) + +(rc:define/contract (ao-pause handle pause) + (rc:-> ao-handle? boolean? void?) + (dbg-sound "ao-pause ~a" pause) + (ffi:ao_pause_async (ao-handle-async-player handle) (if (eq? pause #f) 0 1)) + ) + +(rc:define/contract (ao-at-second handle) + (rc:-> ao-handle? number?) + (ffi:ao_is_at_second_async (ao-handle-async-player handle)) + ) + +(rc:define/contract (ao-at-music-id handle) + (rc:-> ao-handle? integer?) + (ffi:ao_is_at_music_id_async (ao-handle-async-player handle)) + ) + +(rc:define/contract (ao-music-duration handle) + (rc:-> ao-handle? number?) + (ffi:ao_music_duration_async (ao-handle-async-player handle)) + ) + +(rc:define/contract (ao-bufsize-async handle) + (rc:-> ao-handle? integer?) + (ffi:ao_bufsize_async (ao-handle-async-player handle)) + ) + +(rc:define/contract (ao-set-volume! handle percentage) + (rc:-> ao-handle? number? void?) + (ffi:ao_set_volume_async (ao-handle-async-player handle) + (if (integer? percentage) + (exact->inexact percentage) + percentage)) + ) + +(rc:define/contract (ao-volume handle) + (rc:-> ao-handle? number?) + (ffi:ao_volume_async (ao-handle-async-player handle)) + ) + +(rc:define/contract (ao-clear-async handle) + (rc:-> ao-handle? void?) + (ffi:ao_clear_async (ao-handle-async-player handle)) + ) + + diff --git a/libflac-ffi.rkt b/libflac-ffi.rkt new file mode 100644 index 0000000..fa7b4e3 --- /dev/null +++ b/libflac-ffi.rkt @@ -0,0 +1,621 @@ +(module libflac-ffi racket/base + +(require ffi/unsafe + ffi/unsafe/define + "private/utils.rkt" + ) + +(provide flac-ffi-decoder-handler + _FLAC__StreamMetadata + FLAC__StreamMetadata-type + flac-ffi-meta + flac-ffi-frame-header + FLAC__uint32-pointer + FLAC__int32** + ) + + +(define lib (get-lib '("libFLAC") '(#f))) +(define-ffi-definer define-libflac lib + #:default-make-fail make-not-available) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Some FLAC Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define FLAC__MAX_CHANNELS 8) +(define FLAC__MAX_FIXED_ORDER 4) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; FLAC Integer types +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define _uint32_t _uint32) +(define _uint64_t _uint64) +(define FLAC__uint8 _uint8) +(define FLAC__uint16 _uint16) +(define FLAC__int64 _int64) +(define FLAC__uint64 _uint64) +(define FLAC__uint32 _uint32) +(define FLAC__int32-pointer (_ptr i _int32)) +(define FLAC__int32** (_ptr i (_ptr i _int32))) +(define FLAC__uint32-pointer (_ptr i _uint32)) +(define FLAC__int64-pointer (_ptr i _int64)) +(define FLAC__uint64-pointer (_ptr i _uint64)) +(define FLAC__bool _int) +(define FLAC__byte _uint8) +(define FLAC__byte-pointer (_ptr i FLAC__byte)) +(define _uint32_1bit_t _uint32) +(define _char _int8) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; FLAC enumerations +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define _FLAC__ChannelAssignment + (_enum '(independent = 0 + left-side = 1 + right-side = 2 + mid-side = 3 + ))) + +(define _FLAC__FrameNumberType + (_enum '(frame-number + sample-number + ))) + +(define _FLAC__SubframeType + (_enum '(constant = 0 + verbatim = 1 + fixed = 2 + lpc = 3 + ))) + +(define _FLAC__MetadataType + (_enum '(streaminfo = 0 + padding = 1 + application = 2 + seektable = 3 + vorbis-comment = 4 + cuesheet = 5 + picture = 6 + undefined = 7 + max--metadata-type-code = 126 + ))) + +(define _FLAC_StreamMetadata_Picture_Type + (_enum '(other = 0 + file-icon-standard = 1 + file-icon = 2 + front-cover = 3 + back-cover = 4 + leaflet-page = 5 + media = 6 + lead-artist = 7 + artist = 8 + conductor = 9 + band = 10 + composer = 11 + lyricist = 12 + recording-location = 13 + during-recording = 14 + during-performance = 15 + video-screen-capture = 16 + fish = 17 + illustration = 18 + band-logotype = 19 + publisher-logotype = 20 + undefined + ))) + + +;typedef enum { +; FLAC__STREAM_DECODER_SEARCH_FOR_METADATA = 0, +; FLAC__STREAM_DECODER_READ_METADATA, +; FLAC__STREAM_DECODER_SEARCH_FOR_FRAME_SYNC, +; FLAC__STREAM_DECODER_READ_FRAME, +; FLAC__STREAM_DECODER_END_OF_STREAM, +; FLAC__STREAM_DECODER_OGG_ERROR, +; FLAC__STREAM_DECODER_SEEK_ERROR, +; FLAC__STREAM_DECODER_ABORTED, +; FLAC__STREAM_DECODER_MEMORY_ALLOCATION_ERROR, +; FLAC__STREAM_DECODER_UNINITIALIZED, +; FLAC__STREAM_DECODER_END_OF_LINK +;} FLAC__StreamDecoderState; + +(define _FLAC_StreamDecoderState + (_enum '(search-for-metadata = 0 + read-metadata + search-for-frame-sync + read-frames + end-of-stream + ogg-error + seek-error + aborted + memory-allocation-error + uninitialized + end-of-link + ))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; FLAC Frames +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-cstruct _FLAC__FrameHeader ( + [blocksize _uint32_t] + [sample_rate _uint32_t] + [channels _uint32_t] + [channel_assignment _FLAC__ChannelAssignment] + [bits_per_sample _uint32_t] + [number_type _FLAC__FrameNumberType] + [number (_union _uint32_t _uint64_t)] + [crc FLAC__uint8] + )) + +(define (flac-ffi-frame-header frame) + (let* ((hdr (FLAC__Frame-header frame)) + (h (make-hash))) + (for-each + (lambda (e) + (hash-set! h (car e) (cdr e))) + (list + (cons 'blocksize (FLAC__FrameHeader-blocksize hdr)) + (cons 'sample-rate (FLAC__FrameHeader-sample_rate hdr)) + (cons 'channels (FLAC__FrameHeader-channels hdr)) + (cons 'channel-assignment (FLAC__FrameHeader-channel_assignment hdr)) + (cons 'bits-per-sample (FLAC__FrameHeader-bits_per_sample hdr)) + (cons 'number-type (FLAC__FrameHeader-number_type hdr)) + (cons 'number (if (eq? (FLAC__FrameHeader-number_type hdr) 'frame-number) + (union-ref (FLAC__FrameHeader-number hdr) 0) + (union-ref (FLAC__FrameHeader-number hdr) 1))) + (cons 'crc (FLAC__FrameHeader-crc hdr))) + ) + h)) + +(define-cstruct _FLAC__FrameFooter ( + [crc FLAC__uint16] + )) + +(define-cstruct _FLAC__Subframe_Constant ( + [value FLAC__int64] + )) + +(define _FLAC__VerbatimSubframeDataType + (_enum '(int32 + int64))) + +(define-cstruct _FLAC__Subframe_Verbatim ( + [data (_union + FLAC__int32-pointer + FLAC__int64-pointer + )] + [data_type _FLAC__VerbatimSubframeDataType] + )) + + +(define FLAC__EntropyCodingMethodType + (_enum '(partitioned-rice = 0 + partitioned-rice2 = 1))) + +(define-cstruct _FLAC__EntropyCodingMethod_PartitionedRiceContents + ( + [parameters FLAC__uint32-pointer] + [raw_bits FLAC__uint32-pointer] + [capacity_by_order FLAC__uint32-pointer] + )) + +(define-cstruct _FLAC__EntropyCodingMethod_PartitionedRice + ( + [order _uint32_t] + [contents _FLAC__EntropyCodingMethod_PartitionedRiceContents-pointer] + )) + +(define-cstruct _FLAC__EntropyCodingMethod + ( + [type FLAC__EntropyCodingMethodType] + [data (_union _FLAC__EntropyCodingMethod_PartitionedRice)] + )) + +(define-cstruct _FLAC__Subframe_Fixed ( + [entropy_coding_method _FLAC__EntropyCodingMethod] + [order _uint32_t] + [warmup (_array FLAC__int64 FLAC__MAX_FIXED_ORDER)] + [residual FLAC__int32-pointer] + )) + +(define-cstruct _FLAC__Subframe_LPC ( + [jaja _int] + )) + +(define-cstruct _FLAC__Subframe ( + [type _FLAC__SubframeType] + [data (_union + _FLAC__Subframe_Constant + _FLAC__Subframe_Fixed + _FLAC__Subframe_LPC + _FLAC__Subframe_Verbatim + )] + [wated_bits _uint32_t] + )) + +(define-cstruct _FLAC__Frame ( + [header _FLAC__FrameHeader] + [subframes (_array _FLAC__Subframe FLAC__MAX_CHANNELS)] + [footer _FLAC__FrameFooter] + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; FLAC Metadata +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;typedef struct FLAC__StreamMetadata { +; FLAC__MetadataType type; +; FLAC__bool is_last; +; uint32_t length; +; union { +; FLAC__StreamMetadata_StreamInfo stream_info; +; FLAC__StreamMetadata_Padding padding; +; FLAC__StreamMetadata_Application application; +; FLAC__StreamMetadata_SeekTable seek_table; +; FLAC__StreamMetadata_VorbisComment vorbis_comment; +; FLAC__StreamMetadata_CueSheet cue_sheet; +; FLAC__StreamMetadata_Picture picture; +; FLAC__StreamMetadata_Unknown unknown; +; } data; +;} FLAC__StreamMetadata; + + +(define-cstruct _FLAC__StreamMetadata_StreamInfo + ( + [min_blocksize _uint32_t] + [max_blocksize _uint32_t] + [min_framesize _uint32_t] + [max_framesize _uint32_t] + [sample_rate _uint32_t] + [channels _uint32_t] + [bits_per_sample _uint32_t] + [total_samples FLAC__uint64] + [md5sum (_array FLAC__byte 16)] + )) + +(define (meta-stream-info si . hash) + (let ((h (if (null? hash) (make-hash) (car hash)))) + (hash-set! h 'min-blocksize (FLAC__StreamMetadata_StreamInfo-min_blocksize si)) + (hash-set! h 'max-blocksize (FLAC__StreamMetadata_StreamInfo-max_blocksize si)) + (hash-set! h 'min-framesize (FLAC__StreamMetadata_StreamInfo-min_framesize si)) + (hash-set! h 'max-framesize (FLAC__StreamMetadata_StreamInfo-max_framesize si)) + (hash-set! h 'sample-rate (FLAC__StreamMetadata_StreamInfo-sample_rate si)) + (hash-set! h 'channels (FLAC__StreamMetadata_StreamInfo-channels si)) + (hash-set! h 'bits-per-sample (FLAC__StreamMetadata_StreamInfo-bits_per_sample si)) + (hash-set! h 'total-samples (FLAC__StreamMetadata_StreamInfo-total_samples si)) + h)) + +(define-cstruct _FLAC__StreamMetadata_Padding + ( + [dummy _int] + )) + +(define-cstruct _FLAC__StreamMetadata_Application + ( + [id (_array FLAC__byte 4)] + [data FLAC__byte-pointer] + )) + +(define-cstruct _FLAC__StreamMetadata_SeekPoint + ( + [sample_number FLAC__uint64] + [stream_offset FLAC__uint64] + [frame_samples _uint32_t] + )) + +(define-cstruct _FLAC__StreamMetadata_SeekTable + ( + [num_points _uint32_t] + [points _FLAC__StreamMetadata_SeekPoint-pointer] + )) + +(define-cstruct _FLAC__StreamMetadata_VorbisComment_Entry + ( + [length FLAC__uint32] + [entry FLAC__byte-pointer] + )) + +(define-cstruct _FLAC__StreamMetadata_VorbisComment + ( + [vendor_string _FLAC__StreamMetadata_VorbisComment_Entry] + [num_comments FLAC__uint32] + [comments _FLAC__StreamMetadata_VorbisComment_Entry-pointer] + )) + +(define-cstruct _FLAC__StreamMetadata_CueSheet_Index + ( + [offset FLAC__uint64] + [number FLAC__byte] + )) + +(define-cstruct _FLAC__StreamMetadata_CueSheet_Track + ( + [offset FLAC__uint64] + [number FLAC__byte] + [isrc (_array _char 13)] + [type _uint32_1bit_t] + [pre_emphasis _uint32_1bit_t] + [num_indices FLAC__byte] + [indices _FLAC__StreamMetadata_CueSheet_Index-pointer] + )) + +(define-cstruct _FLAC__StreamMetadata_CueSheet + ( + [media_catalog_number (_array _char 129)] + [lead_in FLAC__uint64] + [is_cd FLAC__bool] + [num_tracks _uint32_t] + [tracks _FLAC__StreamMetadata_CueSheet_Track-pointer] + )) + +(define-cstruct _FLAC__StreamMetadata_Picture + ( + [type _FLAC_StreamMetadata_Picture_Type] + [mime_type _string/utf-8] + [description FLAC__byte-pointer] + [width FLAC__uint32] + [height FLAC__uint32] + [depth FLAC__uint32] + [colors FLAC__uint32] + [data_length FLAC__uint32] + [date FLAC__byte-pointer] + )) + +(define-cstruct _FLAC__StreamMetadata_Unknown + ( + [data FLAC__byte-pointer] + )) + + +(define-cstruct _FLAC__StreamMetadata + ( + [type _FLAC__MetadataType] + [is_last FLAC__bool] + [length _uint32_t] + [data (_union + _FLAC__StreamMetadata_StreamInfo + _FLAC__StreamMetadata_Padding + _FLAC__StreamMetadata_Application + _FLAC__StreamMetadata_SeekTable + _FLAC__StreamMetadata_VorbisComment + _FLAC__StreamMetadata_CueSheet + _FLAC__StreamMetadata_Picture + _FLAC__StreamMetadata_Unknown + )] + )) + + (define (flac-ffi-meta meta) + (let ((type (FLAC__StreamMetadata-type meta)) + (h (make-hash))) + (cond + ([eq? type 'streaminfo] + (meta-stream-info (union-ref (FLAC__StreamMetadata-data meta) 0) h)) + (else (error (format "Cannot process metadata: ~a" type))) + ) + h)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; FLAC Generic Pointer Definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define _FLAC__StreamDecoder-pointer (_cpointer 'flac-streamdecoder)) +(define _FLAC__Data-pointer (_cpointer/null 'flac-client-data)) +;(define _FLAC__StreamMetadata-pointer (_cpointer/null 'flac-stream-metadata)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; FLAC Callback function definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;typedef FLAC__StreamDecoderWriteStatus(* FLAC__StreamDecoderWriteCallback) (const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, const FLAC__int32 *const buffer[], void *client_data) +(define _FLAC__StreamDecoderWriteCallback + (_fun _FLAC__StreamDecoder-pointer + _FLAC__Frame-pointer + FLAC__int32** + _FLAC__Data-pointer + -> _int)) + +;typedef void(* FLAC__StreamDecoderMetadataCallback) (const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data) +(define _FLAC__StreamDecoderMetadataCallback + (_fun _FLAC__StreamDecoder-pointer + _FLAC__StreamMetadata-pointer + _FLAC__Data-pointer + -> _void)) + +(define _FLAC__StreamDecoderErrorCallback + (_fun _FLAC__StreamDecoder-pointer + _int + _FLAC__Data-pointer + -> _void)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Exported FLAC functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-libflac FLAC__stream_decoder_new + (_fun -> _FLAC__StreamDecoder-pointer)) + +(define-libflac FLAC__stream_decoder_delete + (_fun _FLAC__StreamDecoder-pointer -> _void)) + +(define-libflac FLAC__stream_decoder_get_state + (_fun _FLAC__StreamDecoder-pointer -> _int)) + +(define states (make-hash)) + (hash-set! states 0 'search-for-metadata) + (hash-set! states 1 'read-metadata) + (hash-set! states 2 'search-for-frame-sync) + (hash-set! states 3 'read-frames) + (hash-set! states 4 'end-of-stream) + (hash-set! states 5 'ogg-error) + (hash-set! states 6 'seek-error) + (hash-set! states 7 'aborted) + (hash-set! states 8 'memory-allocation-error) + (hash-set! states 9 'uninitialized) + (hash-set! states 10 'end-of-link) + +(define (decoder-state int-st) + (hash-ref states int-st #f)) + + +(define-libflac FLAC__stream_decoder_init_file + (_fun _FLAC__StreamDecoder-pointer + _string/utf-8 + _FLAC__StreamDecoderWriteCallback + _FLAC__StreamDecoderMetadataCallback + _FLAC__StreamDecoderErrorCallback + _FLAC__Data-pointer ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3 + -> _int)) + +(define-libflac FLAC__stream_decoder_process_single + (_fun _FLAC__StreamDecoder-pointer + -> _bool)) + +(define-libflac FLAC__stream_decoder_process_until_end_of_metadata + (_fun _FLAC__StreamDecoder-pointer + -> _bool)) + +(define-libflac FLAC__stream_decoder_seek_absolute + (_fun _FLAC__StreamDecoder-pointer FLAC__uint64 + -> _bool)) + +;FLAC_API FLAC__StreamMetadata *FLAC__metadata_object_clone(const FLAC__StreamMetadata *object); +(define-libflac FLAC__metadata_object_clone + (_fun _FLAC__StreamMetadata-pointer + -> _FLAC__StreamMetadata-pointer)) + +;FLAC_API void FLAC__metadata_object_delete(FLAC__StreamMetadata *object); +(define-libflac FLAC__metadata_object_delete + (_fun _FLAC__StreamMetadata-pointer + -> _void)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Our interface for decoding to racket +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (flac-ffi-decoder-handler) + (define write-data '()) + (define meta-data '()) + (define error-no -1) + (define fl #f) + (define flac-file #f) + (define client-data #f) + + (define (write-callback fl frame buffer client-data) + (set! write-data (append write-data (list (cons frame buffer)))) + 0) + + (define (meta-callback fl meta client-data) + (let ((meta-clone (FLAC__metadata_object_clone meta))) + (unless (eq? meta-clone #f) + (set! meta-data (append meta-data (list meta-clone)))))) + + (define (error-callback fl errno client-data) + (set! error-no errno) + ) + + (define (new) + (dbg-sound "flac-ffi 'new") + (if (eq? fl #f) + (set! fl (FLAC__stream_decoder_new)) + (error "flac handler already initialized (new)")) + fl) + + (define (init file) + (dbg-sound "flac-ffi 'init") + (let ((r (FLAC__stream_decoder_init_file + fl + file + write-callback + meta-callback + error-callback + client-data))) + (set! flac-file file) + r)) + + (define (delete) + (dbg-sound "flac-ffi 'delete") + (if (eq? fl #f) + (error "flac handler has already been deleted") + (begin + (FLAC__stream_decoder_delete fl) + (set! fl #f))) + ) + + (define (process-single) + (FLAC__stream_decoder_process_single fl)) + + (define (int-state) + (FLAC__stream_decoder_get_state fl)) + + (define (state) + (decoder-state (int-state))) + + (define (process-meta-data cb) + (for-each (λ (meta-entry) + (cb meta-entry) + (FLAC__metadata_object_delete meta-entry)) + meta-data) + (set! meta-data '())) + + (define (process-write-data cb) + (for-each (lambda (d) + (cb (car d) (cdr d))) + write-data) + (set! write-data '())) + + (define (buffer->vectorlist buffer channels size) + (letrec ((for-channels + (lambda (channel) + (if (< channel channels) + (letrec ((v (make-vector size 0)) + (p (ptr-ref buffer FLAC__int32-pointer channel)) + (to-vec (lambda (i) + (when (< i size) + (vector-set! v i (ptr-ref p _int32 i)) + (to-vec (+ i 1))))) + ) + (to-vec 0) + (cons v (for-channels (+ channel 1)))) + '()))) + ) + (for-channels 0))) + + (define (seek-to-sample sample) + (FLAC__stream_decoder_seek_absolute fl sample)) + + (lambda (cmd . args) + (cond + [(eq? cmd 'write-data) write-data] + [(eq? cmd 'meta-data) meta-data] + + [(eq? cmd 'new) (new)] + [(eq? cmd 'init) (init (car args))] + [(eq? cmd 'delete) (delete)] + [(eq? cmd 'process-single) (process-single)] + [(eq? cmd 'get-buffers) (buffer->vectorlist (car args) (cadr args) (caddr args))] + + [(eq? cmd 'int-state) (int-state)] + [(eq? cmd 'state) (state)] + + [(eq? cmd 'has-write-data?) (not (null? write-data))] + [(eq? cmd 'has-meta-data?) (not (null? meta-data))] + [(eq? cmd 'has-errno?) (not (= error-no -1))] + + [(eq? cmd 'process-meta-data) (process-meta-data (car args))] + [(eq? cmd 'process-write-data) (process-write-data (car args))] + [(eq? cmd 'errno) error-no] + + [(eq? cmd 'seek-to-sample) (seek-to-sample (car args))] + [(eq? cmd 'file) flac-file] + + [else (error (format "unknown command ~a" cmd))] + )) + ) + +); end of module \ No newline at end of file diff --git a/libmpg123-ffi.rkt b/libmpg123-ffi.rkt new file mode 100644 index 0000000..a7b1da8 --- /dev/null +++ b/libmpg123-ffi.rkt @@ -0,0 +1,486 @@ +(module libmpg123-ffi racket/base + + (require ffi/unsafe + ffi/unsafe/define + "private/utils.rkt" + ) + + (provide mpg123-ffi-decoder-handler + ) + + + ;(define lib (ffi-lib "/home/hans/tmp/lib/libmpg123.so")) ;(get-lib '("libmpg123") '("0" #f))) + (define lib (get-lib '("libmpg123") '("0" #f))) + (define-ffi-definer define-libmpg123 lib + #:default-make-fail make-not-available) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Some MPG123 Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define _size_t _size) + + (define SEEK_SET 0) + (define SEEK_CUR 1) + (define SEEK_END 2) + + (define _Seek_t + (_enum '(seek-set = 0 + seek-cur = 1 + seek-end = 2 + ) + ) + ) + + + (define _MPG123_Result + (_enum '(MPG123_DONE = -12 ;/**< Message: Track ended. Stop decoding. */ + MPG123_NEW_FORMAT = -11 ;/**< Message: Output format will be different on next call. + ; Note that some libmpg123 versions between 1.4.3 and 1.8.0 + ; insist on you calling mpg123_getformat() after getting this + ; message code. Newer verisons behave like advertised: + ; You have the chance to call mpg123_getformat(), but you can + ; also just continue decoding and get your data. */ + MPG123_NEED_MORE = -10 ;/**< Message: For feed reader: "Feed me more!" (call + ; mpg123_feed() or mpg123_decode() with some new input data). */ + MPG123_ERR = -1 ;/**< Generic Error */ + MPG123_OK = 0 ;/**< Success */ + MPG123_BAD_OUTFORMAT ;/**< Unable to set up output format! */ + MPG123_BAD_CHANNEL ;/**< Invalid channel number specified. */ + MPG123_BAD_RATE ;/**< Invalid sample rate specified. */ + MPG123_ERR_16TO8TABLE ;/**< Unable to allocate memory for 16 to 8 converter table! */ + MPG123_BAD_PARAM ;/**< Bad parameter id! */ + MPG123_BAD_BUFFER ;/**< Bad buffer given -- invalid pointer or too small size. */ + MPG123_OUT_OF_MEM ;/**< Out of memory -- some malloc() failed. */ + MPG123_NOT_INITIALIZED ;/**< You didn't initialize the library! */ + MPG123_BAD_DECODER ;/**< Invalid decoder choice. */ + MPG123_BAD_HANDLE ;/**< Invalid mpg123 handle. */ + MPG123_NO_BUFFERS ;/**< Unable to initialize frame buffers (out of memory?). */ + MPG123_BAD_RVA ;/**< Invalid RVA mode. */ + MPG123_NO_GAPLESS ;/**< This build doesn't support gapless decoding. */ + MPG123_NO_SPACE ;/**< Not enough buffer space. */ + MPG123_BAD_TYPES ;/**< Incompatible numeric data types. */ + MPG123_BAD_BAND ;/**< Bad equalizer band. */ + MPG123_ERR_NULL ;/**< Null pointer given where valid storage address needed. */ + MPG123_ERR_READER ;/**< Error reading the stream. */ + MPG123_NO_SEEK_FROM_END ;/**< Cannot seek from end (end is not known). */ + MPG123_BAD_WHENCE ;/**< Invalid 'whence' for seek function.*/ + MPG123_NO_TIMEOUT ;/**< Build does not support stream timeouts. */ + MPG123_BAD_FILE ;/**< File access error. */ + MPG123_NO_SEEK ;/**< Seek not supported by stream. */ + MPG123_NO_READER ;/**< No stream opened or no reader callback setup. */ + MPG123_BAD_PARS ;/**< Bad parameter handle. */ + MPG123_BAD_INDEX_PAR ;/**< Bad parameters to MPG123_index() and MPG123_set_index() */ + MPG123_OUT_OF_SYNC ;/**< Lost track in bytestream and did not try to resync. */ + MPG123_RESYNC_FAIL ;/**< Resync failed to find valid MPEG data. */ + MPG123_NO_8BIT ;/**< No 8bit encoding possible. */ + MPG123_BAD_ALIGN ;/**< Stack aligmnent error */ + MPG123_NULL_BUFFER ;/**< NULL input buffer with non-zero size... */ + MPG123_NO_RELSEEK ;/**< Relative seek not possible (screwed up file offset) */ + MPG123_NULL_POINTER ;/**< You gave a null pointer somewhere where you shouldn't have. */ + MPG123_BAD_KEY ;/**< Bad key value given. */ + MPG123_NO_INDEX ;/**< No frame index in this build. */ + MPG123_INDEX_FAIL ;/**< Something with frame index went wrong. */ + MPG123_BAD_DECODER_SETUP ;/**< Something prevents a proper decoder setup */ + MPG123_MISSING_FEATURE ;/**< This feature has not been built into libmpg123. */ + MPG123_BAD_VALUE ;/**< A bad value has been given somewhere. */ + MPG123_LSEEK_FAILED ;/**< Low-level seek failed. */ + MPG123_BAD_CUSTOM_IO ;/**< Custom I/O not prepared. */ + MPG123_LFS_OVERFLOW ;/**< Offset value overflow during translation + ; of large file API calls -- your client program + ; cannot handle that large file. */ + MPG123_INT_OVERFLOW ;/**< Some integer overflow. */ + MPG123_BAD_FLOAT ;/**< Floating-point computations work not as expected. */ + ) + _int + ) + ) + + (define _mpg123_param + (_enum '(force-mono = #x7 + mono-left = #x1 + mono-right = #x2 + mono-mix = #x4 + force-stereo = #x8 + force-8bit = #x10 + quiet = #x20 + gapless = #x40 + no-resync = #x80 + seekbuffer = #x100 + fuzzy = #x200 + force-float = #x400 + plain-id3text = #x800 + ignore-streamlength = #x1000 + skip-id3v2 = #x2000 + ignore-infoframe = #x4000 + auto-resample = #x8000 + ) + _int + ) + ) + + + #| + /** Flag bits for MPG123_FLAGS, use the usual binary or to combine. */ + enum mpg123_param_flags + + MPG123_FORCE_MONO = 0x7 /**< 0111 Force some mono mode: This is a test bitmask for seeing if any mono forcing is active. */ + ,MPG123_MONO_LEFT = 0x1 /**< 0001 Force playback of left channel only. */ + ,MPG123_MONO_RIGHT = 0x2 /**< 0010 Force playback of right channel only. */ + ,MPG123_MONO_MIX = 0x4 /**< 0100 Force playback of mixed mono. */ + ,MPG123_FORCE_STEREO = 0x8 /**< 1000 Force stereo output. */ + ,MPG123_FORCE_8BIT = 0x10 /**< 00010000 Force 8bit formats. */ + ,MPG123_QUIET = 0x20 /**< 00100000 Suppress any printouts (overrules verbose). */ + ,MPG123_GAPLESS = 0x40 /**< 01000000 Enable gapless decoding (default on if libmpg123 has support). */ + ,MPG123_NO_RESYNC = 0x80 /**< 10000000 Disable resync stream after error. */ + ,MPG123_SEEKBUFFER = 0x100 /**< 000100000000 Enable small buffer on non-seekable streams to allow some peek-ahead (for better MPEG sync). */ + ,MPG123_FUZZY = 0x200 /**< 001000000000 Enable fuzzy seeks (guessing byte offsets or using approximate seek points from Xing TOC) */ + ,MPG123_FORCE_FLOAT = 0x400 /**< 010000000000 Force floating point output (32 or 64 bits depends on mpg123 internal precision). */ + ,MPG123_PLAIN_ID3TEXT = 0x800 /**< 100000000000 Do not translate ID3 text data to UTF-8. ID3 strings will contain the raw text data, with the first byte containing the ID3 encoding code. */ + ,MPG123_IGNORE_STREAMLENGTH = 0x1000 /**< 1000000000000 Ignore any stream length information contained in the stream, which can be contained in a 'TLEN' frame of an ID3v2 tag or a Xing tag */ + ,MPG123_SKIP_ID3V2 = 0x2000 /**< 10 0000 0000 0000 Do not parse ID3v2 tags, just skip them. */ + ,MPG123_IGNORE_INFOFRAME = 0x4000 /**< 100 0000 0000 0000 Do not parse the LAME/Xing info frame, treat it as normal MPEG data. */ + ,MPG123_AUTO_RESAMPLE = 0x8000 /**< 1000 0000 0000 0000 Allow automatic internal resampling of any kind (default on if supported). Especially when going lowlevel with replacing output buffer, you might want to unset this flag. Setting MPG123_DOWNSAMPLE or MPG123_FORCE_RATE will override this. */ + |# + + (define _mpg123_handle _pointer) + + + ; MPG123_EXPORT int mpg123_init (void) + ; Not relevant anymore + (define-libmpg123 mpg123_init + (_fun -> _MPG123_Result)) + + ; MPG123_EXPORT mpg123_handle *mpg123_new (const char *decoder, int *error) + (define-libmpg123 mpg123_new + (_fun _string/utf-8 (err : (_ptr o _int)) + -> (h : _mpg123_handle) + -> (values h err))) + + ; MPG123_EXPORT size_t mpg123_outblock ( mpg123_handle * mh ) + (define-libmpg123 mpg123_outblock + (_fun _mpg123_handle -> _size_t)) + + ; MPG123_EXPORT int mpg123_open (mpg123_handle *mh, const char *path) + (define-libmpg123 mpg123_open + (_fun _mpg123_handle _string/utf-8 -> _MPG123_Result)) + + ; MPG123_EXPORT int mpg123_close (mpg123_handle *mh) + (define-libmpg123 mpg123_close + (_fun _mpg123_handle -> _MPG123_Result)) + + ; MPG123_EXPORT int mpg123_getformat (mpg123_handle *mh, long *rate, int *channels, int *encoding) + (define-libmpg123 mpg123_getformat + (_fun _mpg123_handle + (rate : (_ptr o _long)) + (channels : (_ptr o _int)) + (encoding : (_ptr o _int)) + -> (r : _MPG123_Result) + -> (values r rate channels encoding))) + + ; MPG123_EXPORT int mpg123_encsize ( int encoding ) + (define-libmpg123 mpg123_encsize + (_fun _int -> _int)) + + ; MPG123_EXPORT int mpg123_read (mpg123_handle *mh, void *outmemory, size_t outmemsize, size_t *done) + (define-libmpg123 mpg123_read + (_fun _mpg123_handle + _pointer + _size_t + (done : (_ptr o _size_t)) + -> (r : _MPG123_Result) + -> (values r done))) + + ; MPG123_EXPORT int64_t mpg123_tell64 ( mpg123_handle * mh ) + (define-libmpg123 mpg123_tell64 + (_fun _mpg123_handle -> _int64)) + + ; MPG123_EXPORT int64_t mpg123_seek64(mpg123_handle * mh, int64_t sampleoff, int whence ) + (define-libmpg123 mpg123_seek64 + (_fun _mpg123_handle _int64 _Seek_t -> _int64)) + + ; MPG123_EXPORT int mpg123_scan ( mpg123_handle * mh ) + (define-libmpg123 mpg123_scan + (_fun _mpg123_handle -> _MPG123_Result)) + + ; MPG123_EXPORT off_t mpg123_length ( mpg123_handle * mh ) + (define-libmpg123 mpg123_length64 + (_fun _mpg123_handle -> _int64)) + + ; MPG123_EXPORT void mpg123_delete (mpg123_handle *mh) + (define-libmpg123 mpg123_delete + (_fun _mpg123_handle -> _void)) + + ; MPG123_EXPORT void mpg123_exit (void) + ; Not relevant anymore + (define-libmpg123 mpg123_exit + (_fun -> _void)) + + ; MPG123_EXPORT const char* mpg123_plain_strerror ( int errcode ) + (define-libmpg123 mpg123_plain_strerror + (_fun _MPG123_Result -> _string*/utf-8)) + + (define mpg123_int_strerror + (get-ffi-obj "mpg123_plain_strerror" + lib + (_fun _int -> _string*/utf-8))) + + + ;MPG123_EXPORT int mpg123_getparam ( mpg123_handle * mh,; + ; enum mpg123_parms type, + ; long * value, + ; double * fvalue + ; ) + (define-libmpg123 mpg123_getparam2 + (_fun _mpg123_handle _mpg123_param + (value : (_ptr io _long )) + (fvalue : (_ptr io _double )) + -> (r : _MPG123_Result) + -> (values r value fvalue))) + + ;MPG123_EXPORT int mpg123_param2 ( mpg123_handle * mh, + ; int type, + ; long value, + ; double fvalue + ; ) + (define-libmpg123 mpg123_param2 + (_fun _mpg123_handle _mpg123_param + _long _double + -> _int)) + + +#| +#include +#include + +#define BITS 8 + +int main(int argc, char *argv[]) +{ + mpg123_handle *mh; + unsigned char *buffer; + size_t buffer_size; + size_t done; + int err; + + int driver; + ao_device *dev; + + ao_sample_format format; + int channels, encoding; + long rate; + + if(argc < 2) + exit(0); + + /* initializations */ + ao_initialize(); + driver = ao_default_driver_id(); + mpg123_init(); + mh = mpg123_new(NULL, &err); + buffer_size = mpg123_outblock(mh); + buffer = (unsigned char*) malloc(buffer_size * sizeof(unsigned char)); + + /* open the file and get the decoding format */ + mpg123_open(mh, argv[1]); + mpg123_getformat(mh, &rate, &channels, &encoding); + + /* set the output format and open the output device */ + format.bits = mpg123_encsize(encoding) * BITS; + format.rate = rate; + format.channels = channels; + format.byte_format = AO_FMT_NATIVE; + format.matrix = 0; + dev = ao_open_live(driver, &format, NULL); + + /* decode and play */ + while (mpg123_read(mh, buffer, buffer_size, &done) == MPG123_OK) + ao_play(dev, buffer, done); + + /* clean up */ + free(buffer); + ao_close(dev); + mpg123_close(mh); + mpg123_delete(mh); + mpg123_exit(); + ao_shutdown(); + + return 0; +} +|# + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Our interface for decoding to racket +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define BITS 8) + + (define (mpg123-ffi-decoder-handler) + + (define mh #f) + + (define buf-size -1) + (define buffer #f) + + (define rate -1) + (define channels -1) + (define sample-bits -1) + (define sample-bytes -1) + (define pcm-length -1) + (define encoding -1) + (define mp3-file "") + (define current-pcm-pos 0) + + (define (new) + (if (eq? mh #f) + (let-values ([(h err) (mpg123_new #f)]) + (when (eq? h #f) + (error (format "mpg123_new: ~a" (mpg123_int_strerror err)))) + (set! mh h) + (set! buf-size (mpg123_outblock mh)) + (set! buffer (malloc buf-size 'atomic-interior )) + ) + (error "mpg123 handle already initialized, delete it first")) + #t) + + (define (delete) + (if (eq? mh #f) + (error "mpg123 has already been deleted") + (begin + (mpg123_delete mh) + (set! mh #f) + (set! buf-size -1) + (set! buffer #f) + )) + #t) + + (define (info) + (info-sound "file : ~a" mp3-file) + (info-sound "buf-size : ~a" buf-size) + (info-sound "channels : ~a" channels) + (info-sound "sample-bits: ~a" sample-bits) + (info-sound "rate : ~a" rate) + (info-sound "encoding : ~a" encoding) + (info-sound "pcm-length : ~a" pcm-length) + (info-sound "duration : ~a" (if (= rate -1) + 0 + (exact->inexact + (/ pcm-length rate)))) + #t + ) + + (define (params) + (for-each + (λ (p) + (let-values ([(r v fv) (mpg123_getparam2 mh p 0 0.0)]) + (info-sound "~a: ~a - ~a - ~a" p r v fv))) + '(force-mono mono-left mono-right mono-mix + force-stereo force-8bit + quiet + gapless + no-resync seekbuffer fuzzy + force-float + plain-id3text ignore-streamlength skip-id3v2 ignore-infoframe + auto-resample + ))) + + (define (set-param p val) + (mpg123_param2 mh p val (exact->inexact val))) + + (define (do-format) + (dbg-sound "do-format called, got an MPG123_NEW_FORMAT message") + (let-values ([(fr rate* channels* encoding*) (mpg123_getformat mh)]) + (unless (eq? fr 'MPG123_OK) + (error (format "mpg123_format: ~a" (mpg123_plain_strerror fr)))) + (set! rate rate*) + (set! channels channels*) + (set! encoding encoding*) + (dbg-sound "mpg123_format: ~a ~a ~a" rate channels encoding) + (set! sample-bits (* (mpg123_encsize encoding) BITS)) + (set! sample-bytes (/ sample-bits 8))) + (let ((sr (mpg123_scan mh))) + (unless (eq? sr 'MPG123_OK) + (error (format "mpg123_scan: ~a" (mpg123_plain_strerror sr)))) + (set! pcm-length (mpg123_length64 mh))) + ) + + (define (init file) + (let ((r (mpg123_open mh file))) + (unless (eq? r 'MPG123_OK) + (error (format "mpg123_open: ~a" (mpg123_plain_strerror r)))) + ) + (set! mp3-file (format "~a" file)) + (set! current-pcm-pos 0) + #t) + + (define (mp3-format cb) + (cb current-pcm-pos rate channels sample-bits sample-bytes pcm-length)) + + (define (close) + (let ((r (mpg123_close mh))) + (unless (eq? r 'MPG123_OK) + (error (format "mpg123_close: ~a" (mpg123_plain_strerror r)))) + (set! channels -1) + (set! pcm-length -1) + (set! rate -1) + (set! sample-bits -1) + (set! sample-bytes -1) + (set! encoding -1) + (set! mp3-file "") + #t)) + + (define (copy-buffer buf size) + (cond + ((> size 0) + (let ((out (make-bytes size))) + (memcpy out buf size) + out)) + ((= size 0) + (make-bytes 0)) + (else + #f))) + + (define (read cb format-cb) + (let-values ([(r done) (mpg123_read mh buffer buf-size)]) + (cond + ((eq? r 'MPG123_DONE) (cb 'done -1 (copy-buffer buffer done) done)) + ((eq? r 'MPG123_NEW_FORMAT) (do-format) + (mp3-format format-cb) + (read cb format-cb)) + ((eq? r 'MPG123_OK) (let ((pcm-pos (mpg123_tell64 mh))) + (set! current-pcm-pos pcm-pos) + (cb 'data pcm-pos (copy-buffer buffer done) done))) + (else (error (format "mpg123_read: ~a" (mpg123_plain_strerror r)))) + ) + ) + #t) + + (define (seek pcm-pos) + (let ((r (mpg123_seek64 mh pcm-pos 'seek-set))) + (unless (>= r 0) + (error (format "mpg123_seek64: ~a" (mpg123_int_strerror r)))) + #t)) + + (define (tell) + (mpg123_tell64 mh)) + + (λ (cmd . args) + (cond + [(eq? cmd 'new) (new)] + [(eq? cmd 'delete) (delete)] + [(eq? cmd 'init) (init (car args))] + [(eq? cmd 'close) (close)] + [(eq? cmd 'format) (mp3-format (car args))] + [(eq? cmd 'info) (info)] + [(eq? cmd 'read) (read (car args) (cadr args))] + [(eq? cmd 'seek) (seek (car args))] + [(eq? cmd 'tell) (tell)] + [(eq? cmd 'file) mp3-file] + [(eq? cmd 'params) (params)] + [(eq? cmd 'set-param) (set-param (car args) (cadr args))] + [else (error (format "Unknown command: ~a" cmd))] + ) + ) + ) + +); end of module \ No newline at end of file diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..24b3f27 --- /dev/null +++ b/main.rkt @@ -0,0 +1,14 @@ +#lang racket/base + +(require "libao.rkt" + "audio-decoder.rkt" + "taglib.rkt" + "audio-sniffer.rkt" + ) + +(provide (all-from-out "libao.rkt") + (all-from-out "audio-decoder.rkt") + (all-from-out "taglib.rkt") + (all-from-out "audio-sniffer.rkt") + ) + diff --git a/mp3-decoder.rkt b/mp3-decoder.rkt new file mode 100644 index 0000000..fce0859 --- /dev/null +++ b/mp3-decoder.rkt @@ -0,0 +1,157 @@ +(module mp3-decoder racket/base + + (require ffi/unsafe + "libmpg123-ffi.rkt" + "private/utils.rkt" + (prefix-in fin: finalizer) + ) + + (provide mp3-open + mp3-valid? + mp3-read + mp3-stop + mp3-seek + ) + + + (define-struct mp3-handle + (if cb-info cb-audio + (stop #:mutable) + (seek #:mutable) + (reading #:mutable) + (format #:mutable) + ) + #:transparent + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions to do the good stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (mp3-valid? mp3-file) + #t) + + (define audio-type 'mp3) + + (define last-rate 44200) ; An assumption for if we've got nothing + (define last-channels 2) ; An assumption for if we've got nothing + (define last-bits 16) ; An assumption for if we've got nothing + + (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 ((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 format at pcm-pos: ~a" current-pcm-pos) + (let ((h (mp3-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))) + ((mp3-handle-cb-info handle) (mp3-handle-format handle))) + + (define (give-audio handle info pos buffer size) + (let ((h (mp3-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)))) + ((mp3-handle-cb-audio handle) h buffer size))) + + (define (mp3-open mp3-file* cb-stream-info cb-audio) + (let ((mp3-file (if (path? mp3-file*) (path->string mp3-file*) mp3-file*))) + (if (file-exists? mp3-file) + (let ((handler (mpg123-ffi-decoder-handler))) + (handler 'new) + (handler 'init mp3-file) + (let ((h (make-mp3-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 (exact->inexact (/ pcm-length rate))) + (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-mp3-handle-format! handle f) + ) + (report-format handle pcm-pos) + ) + + (define (mp3-read handle) + (let* ((ffi-handler (mp3-handle-if handle)) + (cb-info (mp3-handle-cb-info handle)) + (cb-audio (mp3-handle-cb-audio handle)) + ) + (set-mp3-handle-reading! handle #t) + (let loop () + (if (eq? (mp3-handle-stop handle) #t) + (begin + (dbg-sound "Stopping mp3 decoding") + (set-mp3-handle-reading! handle #f) + 'stopped-reading + ) + (begin + (unless (eq? (mp3-handle-seek handle) #f) + (dbg-sound "Seeking to ~a" (mp3-handle-seek handle)) + (ffi-handler 'seek (mp3-handle-seek handle)) + (set-mp3-handle-seek! handle #f)) + (ffi-handler 'read + (λ (info pos buffer size) + (if (eq? info 'done) + (set-mp3-handle-stop! handle #t) + (give-audio handle info pos buffer size) + )) + (λ (pcm-pos rate channels sample-bits sample-bytes pcm-length) + (handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length)) + ) + (loop) + ) + )) + (ffi-handler 'close) + (ffi-handler 'delete) + ) + ) + + (define (mp3-seek handle percentage) + (let ((fmt (mp3-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-mp3-handle-seek! handle sample)) + ) + ) + ) + ) + + (define (mp3-stop handle) + (set-mp3-handle-stop! handle #t) + (while (mp3-handle-reading handle) + (sleep 0.01)) + ) + + ); end of module diff --git a/play-test.rkt b/play-test.rkt new file mode 100644 index 0000000..4118e58 --- /dev/null +++ b/play-test.rkt @@ -0,0 +1,174 @@ +#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) + diff --git a/private/downloader.rkt b/private/downloader.rkt new file mode 100644 index 0000000..855f867 --- /dev/null +++ b/private/downloader.rkt @@ -0,0 +1,170 @@ +#lang racket/base + +(require setup/dirs + net/sendurl + net/url + net/url-connect + net/dns + racket/file + racket/system + racket/string + file/unzip + ) + +(provide download-soundlibs + soundlibs-clear-download! + soundlibs-version + soundlibs-directory + soundlibs-available? + soundlibs-downloadable? + soundlibs-resolves? + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Version info of the version to download +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define version-major 1) +(define version-minor 0) +(define version-patch 0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Internal functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define download-version (format "~a-~a-~a" + version-major + version-minor + version-patch + )) + +(define download-site "git.dijkewijk.nl") +(define base-path "hans/racket-sound-lib/releases/download") +(define os (system-type 'os*)) +(define arch (system-type 'arch)) + +(define download-url (format "https://~a/~a/~a/~a-~a.zip" + download-site + base-path + download-version + os + arch)) + +(define install-path (build-path (find-system-path 'addon-dir) "racket-sound-lib")) +(define version-file (build-path install-path "version.txt")) +(define ffi-path (build-path install-path (format "~a-~a" os arch))) + +(define (download-port link) + (let ((current-https-prot (current-https-protocol))) + (current-https-protocol 'secure) + (let* ((url (string->url link)) + (port-in (get-pure-port url #:redirections 10))) + (current-https-protocol current-https-prot) + port-in))) + + +(define (do-download port-in port-out) + (letrec ((downloader-func (λ (count next-c len) + (let ((bytes (read-bytes 16384 port-in))) + (if (eof-object? bytes) + count + (let ((read-len (bytes-length bytes))) + (when (> read-len 0) + (set! count (+ count read-len)) + (when (> count next-c) + (display (format "~a..." count)) + (set! next-c (+ count len))) + (write-bytes bytes port-out) + ) + (downloader-func count next-c len))))) + )) + (let ((count (downloader-func 0 100000 100000))) + (displayln (format "~a downloaded" count)) + (close-input-port port-in) + (close-output-port port-out) + count) + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Provided functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (soundlibs-available?) + (if (file-exists? version-file) + (with-handlers ([exn:fail? (λ (e) #f)]) + (let ((v (file->value version-file))) + (and + (= (car v) version-major) + (= (cadr v) version-minor) + (= (caddr v) version-patch))) + ) + #f)) + +(define (soundlibs-directory) + (if (soundlibs-available?) + (build-path install-path (format "~a-~a" os arch)) + #f)) + +(define (soundlibs-resolves?) + (if (eq? (dns-find-nameserver) #f) + #f + (with-handlers ([exn:fail? (λ (e) #f)]) + (dns-get-address (dns-find-nameserver) download-site) + #t) + ) + ) + +(define (soundlibs-version) + (if (soundlibs-available?) + (file->value version-file) + #f)) + +(define (soundlibs-downloadable?) + (with-handlers ([exn:fail? (λ (e) #f)]) + (let ((in (download-port download-url))) + (let ((d (input-port? in))) + (when d + (close-input-port in)) + d)))) + +(define (soundlibs-clear-download!) + (when (file-exists? version-file) + (delete-file version-file))) + +(define (download-soundlibs) + (let ((in (download-port download-url))) + (unless (input-port? in) + (error (format "Cannot get a download port for '~a'" download-url))) + (unless (directory-exists? install-path) + (make-directory* install-path)) + (let* ((file (build-path install-path "archive.zip")) + (out (open-output-file file #:exists 'replace)) + ) + (displayln (format "Downloading racket-webview-qt (~a)..." download-url)) + (do-download in out) + (displayln (format "downloaded '~a'" file)) + (when (directory-exists? ffi-path) + (displayln (format "Removing existing directory '~a'" ffi-path)) + (delete-directory/files ffi-path)) + (displayln "Unzipping...") + (let ((cd (current-directory))) + (current-directory install-path) + (unzip file #:preserve-attributes? #t #:preserve-timestamps? #t) + (current-directory cd)) + (displayln "Removing zip archive") + (delete-file file) + (displayln "Writing version") + (let ((version (list version-major + version-minor + version-patch + ))) + (let ((out (open-output-file version-file #:exists 'replace))) + (write version out) + (close-output-port out))) + (displayln "Version file written; ready for FFI integration") + #t + ) + ) + ) diff --git a/private/utils.rkt b/private/utils.rkt new file mode 100644 index 0000000..113bd0e --- /dev/null +++ b/private/utils.rkt @@ -0,0 +1,126 @@ +(module utils racket/base + + (require racket/path + racket/runtime-path + ffi/unsafe + setup/dirs + "downloader.rkt" + simple-log + ) + + (provide while + until + build-lib-path + get-lib + do-for + dbg-sound + info-sound + err-sound + warn-sound + fatal-sound + sync-log-sound + integer->int-bytes + int-bytes->integer + ) + + (sl-def-log racket-sound sound) + + (define-syntax while + (syntax-rules () + ((_ cond body ...) + (letrec ((while-f (lambda (last-result) + (if cond + (let ((last-result (begin + body + ...))) + (while-f last-result)) + last-result)))) + (while-f #f)) + ) + )) + + (define-syntax until + (syntax-rules () + ((_ cond body ...) + (letrec ((until-f (lambda (last-result) + (if cond + last-result + (let ((last-reult (begin + body + ...))) + (until-f last-result)))))) + (until-f #f))))) + + (define-syntax do-for + (syntax-rules () + ((_ (init cond next) body ...) + (begin + init + (letrec ((do-for-f (lamba () + (if cond + (begin + (begin + body + ...) + next + (do-for-f)))))) + (do-for-f)))))) + + + (define (build-lib-path) + (soundlibs-directory)) + + (define (get-lib* libs-to-try orig-libs versions) + (let ((libs-path (cons (build-lib-path) (get-lib-search-dirs)))) + (unless (soundlibs-available?) + (download-soundlibs)) + (if (null? libs-to-try) + (begin + (displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs libs-path)) + #f) + (ffi-lib (car libs-to-try) versions + #:get-lib-dirs (λ () libs-path) + #:fail (λ () + (ffi-lib (car libs-to-try) versions + #:fail (λ () + (get-lib* (cdr libs-to-try) orig-libs versions)))) + ) + ) + ) + ) + + (define (get-lib libs-to-try versions) + (get-lib* libs-to-try libs-to-try versions)) + + (define-syntax-rule (integer->int-bytes v size signed? big? bs pos) + (if (= size 3) + (if big? + (begin + (bytes-set! bs pos (bitwise-and (arithmetic-shift v -16) #xff)) + (bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8) #xff)) + (bytes-set! bs (+ pos 2) (bitwise-and v #xff))) + (begin + (bytes-set! bs pos (bitwise-and v #xff)) + (bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8) #xff)) + (bytes-set! bs (+ pos 2) (bitwise-and (arithmetic-shift v -16) #xff)))) + (integer->integer-bytes v size signed? big? bs pos))) + + (define-syntax-rule (int-bytes->integer bs signed? big? start end) + (let ([size (- end start)]) + (if (= size 3) + (let* ([b0 (bytes-ref bs start)] + [b1 (bytes-ref bs (+ start 1))] + [b2 (bytes-ref bs (+ start 2))] + [u (if big? + (bitwise-ior (arithmetic-shift b0 16) + (arithmetic-shift b1 8) + b2) + (bitwise-ior b0 + (arithmetic-shift b1 8) + (arithmetic-shift b2 16)))]) + (if (and signed? (not (zero? (bitwise-and u #x800000)))) + (- u #x1000000) + u)) + (integer-bytes->integer bs signed? big? start end)))) + +) ; end of module diff --git a/scrbl/audio-decoder.scrbl b/scrbl/audio-decoder.scrbl new file mode 100644 index 0000000..f84e528 --- /dev/null +++ b/scrbl/audio-decoder.scrbl @@ -0,0 +1,259 @@ +#lang scribble/manual + +@(require racket/base + (for-label racket/base + racket/path + "../audio-decoder.rkt")) + +@title{audio-decoder} +@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] + +@defmodule[(file "../audio-decoder.rkt")] + +This module provides a small abstraction layer over concrete audio +decoders. A backend is selected from the filename extension and is then +used through a uniform interface for opening, reading, seeking, and +stopping. + +The module includes built-in readers for FLAC and MP3, and it allows +additional backends to be registered with +@racket[audio-register-reader!]. + +@section{Reader registration} + +A reader descriptor stores the extensions handled by a backend together +with the procedures used to validate, open, read, seek, and stop that +backend, plus an audio-output type. + +@defproc[(make-audio-reader [exts (listof string?)] + [valid? procedure?] + [open procedure?] + [reader procedure?] + [seeker procedure?] + [stopper procedure?] + [ao-type symbol?]) + struct?]{ + +Creates a reader descriptor. + +The @racket[exts] list contains the filename extensions handled by the +reader, without a leading dot. Matching is case-insensitive. + +The procedures are used as follows: + +@itemlist[#:style 'compact + @item{@racket[valid?] checks whether a file is valid for this reader;} + @item{@racket[open] opens a decoder for a file;} + @item{@racket[reader] reads or continues decoding;} + @item{@racket[seeker] seeks within the audio stream;} + @item{@racket[stopper] stops an active decode loop.}] + +The @racket[ao-type] value describes the buffer format exposed to the +audio output layer. The source comments mention values such as +@racket['flac] and @racket['ao]. The value @racket['ao] means that the +buffer can be used directly by the audio-output backend. +} + +@defproc[(audio-register-reader! [type symbol?] + [reader struct?]) + void?]{ + +Registers @racket[reader] under @racket[type]. + +The extensions declared in @racket[reader] are appended to the list +returned by @racket[audio-known-exts?], and the reader becomes +available to @racket[audio-open]. + +This procedure is the extension point for custom audio decoders. +} + +@section{Audio handles} + +@defproc[(audio-handle? [v any/c]) boolean?]{ + +Returns @racket[#t] if @racket[v] is an audio handle, and @racket[#f] +otherwise. +} + +@defproc[(audio-kind [handle audio-handle?]) symbol?]{ + +Returns the reader type stored in @racket[handle]. + +For the built-in readers this is either @racket['flac] or +@racket['mp3]. +} + +@section{Known extensions and validation} + +@defproc[(audio-known-exts?) (listof string?)]{ + +Returns the list of known filename extensions. + +The initial list contains @racket["flac"] and @racket["mp3"]. +Additional extensions are added when readers are registered with +@racket[audio-register-reader!]. +} + +@defproc[(audio-valid-ext? [ext any/c]) boolean?]{ + +Returns @racket[#t] if @racket[ext] denotes a known filename +extension, and @racket[#f] otherwise. + +The argument is converted to a string. If it starts with a dot, that +dot is removed. Matching is case-insensitive. +} + +@defproc[(audio-file-valid? [file (or/c string? path?)]) boolean?]{ + +Returns @racket[#t] if @racket[file] has a known extension and the +matching registered reader reports the file as valid. + +This procedure first derives the filename extension and checks it with +@racket[audio-valid-ext?]. If the extension is known, it then looks up +the matching reader and calls that reader's validity procedure. +} + +@section{Opening and callbacks} + +@defproc[(audio-open [audio-file (or/c string? path?)] + [cb-stream-info procedure?] + [cb-audio procedure?]) + audio-handle?]{ + +Opens an audio decoder for @racket[audio-file]. + +If @racket[audio-file] is a path, it is converted to a string before it +is passed to the backend open procedure. + +This procedure raises an exception if the file is not considered a +valid audio file, if the file does not exist, or if no registered +reader can be found for the file. + +The returned handle stores the selected reader type, the two callback +procedures, the reader descriptor, and the driver-specific handle +returned by the backend open procedure. + +The callback procedures are wrapped before they are passed to the +backend. + +The stream-info callback is called as: + +@racketblock[ +(cb-stream-info audio-type ao-type handle meta) +] + +where: + +@itemlist[#:style 'compact + @item{@racket[audio-type] is the registered reader type, such as + @racket['flac] or @racket['mp3];} + @item{@racket[ao-type] is the audio-output type stored in the reader, + such as @racket['flac] or @racket['ao];} + @item{@racket[handle] is the generic @racket[audio-handle];} + @item{@racket[meta] is a hash table with stream metadata.}] + +According to the source comments, @racket[meta] must contain at least: + +@itemlist[#:style 'compact + @item{@racket['duration] --- duration of the audio in seconds, possibly + fractional;} + @item{@racket['bits-per-sample] --- number of audio bits per sample;} + @item{@racket['channels] --- number of audio channels;} + @item{@racket['sample-rate] --- number of samples per second per + channel;} + @item{@racket['total-samples] --- total number of samples in the + audio.}] + +The audio callback is called as: + +@racketblock[ +(cb-audio audio-type ao-type handle buf-info buffer buf-size) +] + +where: + +@itemlist[#:style 'compact + @item{@racket[audio-type] is the registered reader type;} + @item{@racket[ao-type] is the audio-output type stored in the reader;} + @item{@racket[handle] is the generic @racket[audio-handle];} + @item{@racket[buf-info] is a hash table describing the audio buffer;} + @item{@racket[buffer] is a native buffer containing audio data;} + @item{@racket[buf-size] is the size of that buffer in bytes.}] + +According to the source comments, the buffer is to be owned and +released by the decoder driver. The comments also note that the +@tt{ao-async} backend copies the data. + +According to the source comments, @racket[buf-info] must contain at +least: + +@itemlist[#:style 'compact + @item{@racket['duration] --- duration of the audio in seconds, possibly + fractional;} + @item{@racket['bits-per-sample] --- number of audio bits per sample;} + @item{@racket['channels] --- number of audio channels;} + @item{@racket['sample-rate] --- number of samples per second per + channel;} + @item{@racket['total-samples] --- total number of samples in the + audio;} + @item{@racket['sample] --- the current sample to which the audio + buffer applies.}] +} + +@section{Reading, seeking, and stopping} + +@defproc[(audio-read [handle audio-handle?]) void?]{ + +Calls the registered reader procedure for @racket[handle]. + +The concrete reader procedure receives the driver-specific handle +stored in the generic audio handle. Any result value produced by the +backend is discarded. +} + +@defproc[(audio-seek [handle audio-handle?] + [percentage number?]) + void?]{ + +Calls the registered seek procedure for @racket[handle]. + +The @racket[percentage] argument is passed unchanged to the backend +seek procedure. + +In this abstraction layer, the parameter represents a relative +position in the full audio stream. A backend registered through +@racket[audio-register-reader!] is expected to follow that +interpretation. +} + +@defproc[(audio-stop [handle audio-handle?]) void?]{ + +Calls the registered stop procedure for @racket[handle]. + +The concrete stop procedure receives the driver-specific handle stored +in the generic audio handle. +} + +@section{Using custom decoders} + +Custom audio decoders can be integrated by constructing a reader +descriptor with @racket[make-audio-reader] and registering it with +@racket[audio-register-reader!]. + +A backend integrated through this interface should provide: + +@itemlist[#:style 'compact + @item{a list of handled filename extensions;} + @item{a file-validity procedure;} + @item{an open procedure that accepts a file path, a stream-info + callback, and an audio callback;} + @item{a read procedure that accepts the driver-specific handle;} + @item{a seek procedure that accepts the driver-specific handle and a + numeric relative position;} + @item{a stop procedure that accepts the driver-specific handle;} + @item{an audio-output type symbol describing the kind of buffers the + backend produces.}] + +Once registered, files with matching extensions can be opened through +@racket[audio-open] in the same way as the built-in FLAC and MP3 +backends. \ No newline at end of file diff --git a/scrbl/audio-sniffer.scrbl b/scrbl/audio-sniffer.scrbl new file mode 100644 index 0000000..83c0dad --- /dev/null +++ b/scrbl/audio-sniffer.scrbl @@ -0,0 +1,173 @@ +#lang scribble/manual + +@(require (for-label racket/base + racket/contract + "../audio-sniffer.rkt")) + +@title{audio-sniffer} +@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] + +@defmodule[(file "../audio-sniffer.rkt")] + +This module provides functionality to detect audio file formats based on +file contents (signature sniffing) and, optionally, file extensions. + +The sniffer prefers binary inspection over extensions and only falls back +to extensions when detection is inconclusive. + +@section{Overview} + +The detection strategy is as follows: + +@itemlist[ + #:style 'compact + @item{Read a prefix of the file (default 4096 bytes)} + @item{Match known binary signatures ("magic numbers")} + @item{Apply format-specific heuristics (e.g. MP3 frame sync, AAC ADTS)} + @item{For ISO-BMFF (MP4/M4A), scan both head and tail for codec markers} + @item{If still unknown, optionally fall back to file extension} +] + +The result is always a symbol describing the detected format or a status. + +@section{Formats} + +Known audio formats: + +@racketblock[ +'(mp3 flac ogg vorbis opus wav aiff + mp4 aac alac encrypted-audio + ac3 ape wavpack wma matroska) +] + +Status values: + +@racketblock[ +'(unknown file-not-found file-not-readable not-a-file) +] + +@section{API} + +@defproc[(audio-format? [v any/c]) boolean?]{ +Returns @racket[#t] if @racket[v] is a known audio format or status symbol. +} + +@defproc[(audio-sniff-format [file path-string?]) audio-format?]{ + +Detects the audio format of @racket[file] using binary inspection only. + +Returns one of: + +@itemlist[ + #:style 'compact + @item{A format symbol such as @racket['mp3], @racket['flac], etc.} + @item{A status symbol such as @racket['file-not-found]} +] + +This function does not use the file extension. +} + +@defproc[(audio-sniff-format/extension [file path-string?]) audio-format?]{ + +Like @racket[audio-sniff-format], but falls back to the file extension +if content-based detection returns @racket['unknown]. + +This is typically the preferred entry point in user-facing code. +} + +@defproc[(audio-sniff-extension [file path-string?]) (or/c string? #f)]{ + +Returns the lowercase file extension (without dot), or @racket[#f] +if no extension is present. +} + +@defproc[(audio-format-known? [fmt symbol?]) boolean?]{ + +Returns @racket[#t] if @racket[fmt] is a known audio format +(excludes status symbols). +} + +@defproc[(audio-format-matches? [file path-string?] + [formats (listof symbol?)]) + boolean?]{ + +Returns @racket[#t] if the detected format of @racket[file] matches +one of @racket[formats]. + +Detection uses @racket[audio-sniff-format/extension]. +} + +@section{Architecture} + +The sniffer is structured as a layered pipeline: + +@itemlist[ + #:style 'compact + @item{@bold{I/O layer} -- reads byte ranges from the file (head and tail)} + @item{@bold{Signature layer} -- matches fixed binary identifiers} + @item{@bold{Heuristic layer} -- validates formats without fixed headers} + @item{@bold{Container layer} -- inspects structured containers (MP4, Ogg)} + @item{@bold{Fallback layer} -- maps file extensions to formats} +] + +Detection proceeds from cheap and deterministic checks to more +expensive or heuristic ones. + +MP4/M4A detection is handled separately because codec identifiers may +appear outside the initial header. For this reason both the beginning +and the end of the file are scanned. + +The sniffer is deliberately stateless; each call operates only on the +given file and does not cache results. + +@section{Detection Details} + +Binary signatures are used where possible: + +@itemlist[ + #:style 'compact + @item{@bold{FLAC}: @"fLaC"} + @item{@bold{Ogg}: @"OggS" + subtype detection (Opus/Vorbis/FLAC)} + @item{@bold{WAV}: RIFF/WAVE} + @item{@bold{AIFF}: FORM/AIFF or AIFC} + @item{@bold{ASF/WMA}: GUID header} + @item{@bold{Matroska}: EBML header} + @item{@bold{AC3}: 0x0B77 sync word} + @item{@bold{APE}: @"MAC "} + @item{@bold{WavPack}: @"wvpk"} +] + +Heuristics are applied for: + +@itemlist[ + #:style 'compact + @item{MP3 (ID3 header or frame sync validation)} + @item{AAC (ADTS sync pattern)} +] + +MP4/M4A detection: + +@itemlist[ + #:style 'compact + @item{Detect ISO-BMFF via @"ftyp"} + @item{Scan for codec markers: @"mp4a", @"alac", @"enca"} + @item{Perform additional scanning near the end of the file} +] + +@section{Why not use FFmpeg?} + +The primary reason for implementing a custom sniffer is performance. + +Format detection in this module is intentionally lightweight: it reads +only small portions of the file and applies simple, deterministic checks. +In most cases, detection completes after inspecting just a few kilobytes. + +Using a library such as FFmpeg would significantly increase the cost of +this operation: + +@itemlist[ + #:style 'compact + @item{@bold{Startup overhead} -- initialization of codec infrastructure} + @item{@bold{I/O overhead} -- more data is typically read than necessary} + @item{@bold{Processing overhead} -- partial parsing of streams or containers} +] diff --git a/scrbl/ffmpeg-c-backend.scrbl b/scrbl/ffmpeg-c-backend.scrbl new file mode 100644 index 0000000..838f16a --- /dev/null +++ b/scrbl/ffmpeg-c-backend.scrbl @@ -0,0 +1,218 @@ +#lang scribble/manual + +@title{FFmpeg Audio Backend} +@author{@author+email["Hans Dijkema" "hans@dijkewijk.nl"]} + +@section{Overview} + +The FFmpeg audio backend is a small C++ wrapper with a plain C ABI. It hides +the FFmpeg data structures from the caller and exposes a simple +audio-only decoder interface. + +The caller does not handle FFmpeg streams, packets, frames, codec +contexts or resampler objects. A file is opened, the best audio stream is +selected, and decoding is performed by repeatedly calling +@tt{fmpg_decode_next}. + +The output format is fixed: signed 32-bit integer PCM, interleaved, in +native endian format. + +A sample frame means one sample moment across all channels. For stereo +S32, one sample frame contains two @tt{int32_t} values and therefore +takes 8 bytes. + +@section{Opaque Instance} + +@verbatim|{ +typedef struct fmpg_instance fmpg_instance; +}| + +The decoder instance is opaque. The caller only receives and passes +around a pointer to this type. All FFmpeg state is stored internally. + +@section{Lifecycle} + +@verbatim|{ +fmpg_instance *fmpg_init(void); +}| + +Creates a new decoder instance. + +Before allocating the instance, the backend checks whether the FFmpeg major +versions used at compile time match the FFmpeg major versions available +at runtime. If they do not match, @tt{NULL} is returned. + +Returns a pointer to a new @tt{fmpg_instance}, or @tt{NULL} on failure. + +@verbatim|{ +void fmpg_free(fmpg_instance *instance); +}| + +Frees the decoder instance. If the instance still has an open input, it +is closed as part of destruction. + +@verbatim|{ +int fmpg_open_file(fmpg_instance *instance, const char *filename); +}| + +Opens a media file, selects the best audio stream, initializes the +decoder and initializes the resampler. + +After a successful call, stream information, duration and metadata can be +read using the getter functions. + +Returns @tt{1} on success and @tt{0} on failure. The call fails if the +instance is @tt{NULL}, if a file is already open, if @tt{filename} is +@tt{NULL}, if no usable audio stream is found, or if FFmpeg cannot open +or initialize the file. + +@verbatim|{ +void fmpg_close(fmpg_instance *instance); +}| + +Closes the current file and releases all FFmpeg state owned by the +instance. The instance itself remains valid and may be reused. + +@verbatim|{ +int fmpg_is_open(fmpg_instance *instance); +}| + +Returns @tt{1} if the instance is open and ready to decode. Otherwise +returns @tt{0}. + +@section{Audio Information} + +@verbatim|{ +int fmpg_audio_stream_count(fmpg_instance *instance); +int fmpg_audio_sample_rate(fmpg_instance *instance); +int fmpg_audio_channels(fmpg_instance *instance); +int fmpg_audio_bits_per_sample(fmpg_instance *instance); +int fmpg_audio_bytes_per_sample(fmpg_instance *instance); +int64_t fmpg_duration_ms(fmpg_instance *instance); +int64_t fmpg_duration_samples(fmpg_instance *instance); +}| + +These functions return information about the selected audio stream. + +@itemlist[ + #:style 'compact + @item{@tt{fmpg_audio_stream_count} returns the number of audio streams found in the opened file, or @tt{0}.} + @item{@tt{fmpg_audio_sample_rate} returns the selected stream's sample rate, or @tt{0}.} + @item{@tt{fmpg_audio_channels} returns the selected stream's channel count, or @tt{0}.} + @item{@tt{fmpg_audio_bits_per_sample} always returns @tt{32}.} + @item{@tt{fmpg_audio_bytes_per_sample} always returns @tt{4}.} + @item{@tt{fmpg_duration_ms} returns the duration in milliseconds, or @tt{-1}.} + @item{@tt{fmpg_duration_samples} returns the duration in output sample frames, or @tt{-1}.} +] + +@section{Metadata} + +@verbatim|{ +const char *fmpg_file_title(fmpg_instance *instance); +const char *fmpg_file_author(fmpg_instance *instance); +const char *fmpg_file_album(fmpg_instance *instance); +const char *fmpg_file_genre(fmpg_instance *instance); +const char *fmpg_file_comment(fmpg_instance *instance); +const char *fmpg_file_copyright(fmpg_instance *instance); +int fmpg_file_year(fmpg_instance *instance); +int fmpg_file_track(fmpg_instance *instance); +int64_t fmpg_file_bitrate(fmpg_instance *instance); +}| + +The metadata getters return values read from the container metadata. A +missing string value is returned as an empty string. A missing numeric +value is returned as @tt{-1}. @tt{fmpg_file_author} returns the +@tt{artist} metadata field. + +@section{Decoding} + +@verbatim|{ +int fmpg_decode_next(fmpg_instance *instance); +}| + +Decodes the next block of audio. + +Internally, the backend reads packets from the selected audio stream, feeds +them to the FFmpeg decoder, receives all available decoded frames, +converts them to signed 32-bit interleaved PCM, and concatenates the +result in the instance output buffer. + +Packets from non-selected streams are skipped internally. + +Returns @tt{1} if decoded PCM data is available through +@tt{fmpg_buffer} and @tt{fmpg_buffer_size}. Returns @tt{0} at EOF or on +error. + +@verbatim|{ +int fmpg_seek_ms(fmpg_instance *instance, int64_t target_pos_ms); +}| + +Seeks to an absolute position in milliseconds. + +FFmpeg may seek to a packet before the requested timestamp. After +seeking, this backend discards decoded pre-roll samples until the requested +output sample position is reached, when timestamps are available. + +Returns @tt{1} on success and @tt{0} on failure. + +@section{Output Buffer and Sample Positions} + +@verbatim|{ +const uint8_t *fmpg_buffer(fmpg_instance *instance); +int fmpg_buffer_size(fmpg_instance *instance); +int64_t fmpg_buffer_samples(fmpg_instance *instance); +int64_t fmpg_buffer_start_sample(fmpg_instance *instance); +int64_t fmpg_buffer_end_sample(fmpg_instance *instance); +int64_t fmpg_sample_position(fmpg_instance *instance); +double fmpg_timecode(fmpg_instance *instance); +}| + +@tt{fmpg_buffer} returns a pointer to the current decoded PCM buffer, or +@tt{NULL} if there is no current buffer. The pointer remains valid only +until the next API call that decodes, seeks, closes or frees the +instance. + +@tt{fmpg_buffer_size} returns the size of the current buffer in bytes. +@tt{fmpg_buffer_samples} returns the number of sample frames in the +current buffer. @tt{fmpg_buffer_start_sample} returns the absolute +sample-frame index of the first sample frame in the buffer, and +@tt{fmpg_buffer_end_sample} returns the absolute sample-frame index just +after the current buffer. + +@tt{fmpg_sample_position} returns the current absolute sample position in +the music stream. After a successful @tt{fmpg_decode_next}, this is the +same value as @tt{fmpg_buffer_end_sample}. + +@tt{fmpg_timecode} returns the approximate start time of the current +decoded block in seconds. + +@section{FFmpeg Version Checks} + +@verbatim|{ +const char *fmpg_ffmpeg_version(void); +const char *fmpg_int_version2string(unsigned version); +int fmpg_compatible_ffmpeg(void); +}| + +@tt{fmpg_ffmpeg_version} returns a string describing the FFmpeg versions +used when the backend was compiled. The string includes avformat, avcodec, +swresample and avutil. + +@tt{fmpg_int_version2string} converts an FFmpeg integer version value to +a string of the form @tt{major.minor.micro}. + +@tt{fmpg_compatible_ffmpeg} checks whether the FFmpeg major versions used +at compile time match the FFmpeg major versions available at runtime. +It returns @tt{1} when the versions are compatible and @tt{0} otherwise. + +@section{Decoder Model} + +The backend uses the modern FFmpeg send/receive decoding model. Packets are +sent with @tt{avcodec_send_packet}, decoded frames are received with +@tt{avcodec_receive_frame}, and conversion to the fixed output format is +done with libswresample. + +The public API intentionally avoids exposing these details. From the +caller perspective, decoding is a sequence of calls to +@tt{fmpg_decode_next} followed by reading the current output buffer and +its sample-position metadata. \ No newline at end of file diff --git a/scrbl/ffmpeg-decoder.scrbl b/scrbl/ffmpeg-decoder.scrbl new file mode 100644 index 0000000..a84c7d3 --- /dev/null +++ b/scrbl/ffmpeg-decoder.scrbl @@ -0,0 +1,128 @@ +#lang scribble/manual + +@(require racket/base + (for-label racket/base + racket/contract + racket/path + "../ffmpeg-decoder.rkt")) + +@title{FFmpeg Decoder} +@author{@author+email["Hans Dijkema" "hans@dijkewijk.nl"]} + +@defmodule[(file "../ffmpeg-decoder.rkt")] + +This module provides an audio decoder based on the FFmpeg audio shim. It +uses the lower-level @racketmodname[racket-sound/ffmpeg-ffi] module and presents a +callback-based decoder interface comparable to the other audio decoders. + +The native FFmpeg layer decodes audio to signed 32-bit interleaved PCM. +The decoder therefore reports 32 bits per sample and 4 bytes per sample +when no more specific information is available. + +@defproc[(ffmpeg-valid? [audio-file any/c]) boolean?]{ +Returns @racket[#t]. + +This predicate is deliberately weak. Existence and extension checks are +expected to be performed by the generic audio-decoder layer. Actual file +validation is done when the FFmpeg shim opens the file. +} + +@defproc[(ffmpeg-open [audio-file (or/c path? string?)] + [cb-stream-info procedure?] + [cb-audio procedure?]) + (or/c any/c #f)]{ +Opens @racket[audio-file] and returns an opaque decoder handle, or +@racket[#f] if the file does not exist. + +If @racket[audio-file] is a path, it is converted to a string before it +is passed to the native layer. + +The @racket[cb-stream-info] callback is called with a mutable hash that +describes the stream. The @racket[cb-audio] callback is called with the +same kind of hash, a PCM buffer pointer and the buffer size in bytes. +} + +@defproc[(ffmpeg-read [handle any/c]) any/c]{ +Starts reading and decoding audio from @racket[handle]. + +This function loops until decoding reaches the end of the stream or +until @racket[ffmpeg-stop] requests termination. During the read loop, +pending seek requests made with @racket[ffmpeg-seek] are applied before +the next native read. + +The stream-info callback is called when format information becomes +available. The audio callback is called as: + +@racketblock[ +(cb-audio info buffer size) +] + +where @racket[info] is a mutable hash, @racket[buffer] is a pointer to +interleaved signed 32-bit PCM data, and @racket[size] is the size of the +buffer in bytes. + +When reading stops, the native FFmpeg instance is closed and deleted. +} + +@defproc[(ffmpeg-seek [handle any/c] + [percentage real?]) + void?]{ +Requests a seek operation. + +The @racket[percentage] argument is interpreted as a percentage of the +total number of samples in the stream. Fractional percentages are +allowed. The actual seek is performed by @racket[ffmpeg-read] before the +next native read call. + +If the total sample count is unknown or invalid, no seek request is made. +} + +@defproc[(ffmpeg-stop [handle any/c]) void?]{ +Requests the read loop to stop. + +This function waits until @racket[ffmpeg-read] has left its read loop. +It polls the internal reading flag with a short sleep interval. +} + +@section{Stream Information} + +The stream-info and audio callbacks receive a mutable hash. The decoder +stores at least the following keys: + +@itemlist[ + #:style 'compact + @item{@racket['sample-rate]} + @item{@racket['channels]} + @item{@racket['bits-per-sample]} + @item{@racket['bytes-per-sample]} + @item{@racket['total-samples]} + @item{@racket['duration]} +] + +For audio callbacks, the hash is also updated with: + +@itemlist[ + #:style 'compact + @item{@racket['sample], the current sample position} + @item{@racket['current-time], the current time in seconds} +] + +If the native layer omits format values, the decoder fills in the most +recent known values. Initial defaults are 44100 Hz, 2 channels, 32 bits +per sample and 4 bytes per sample. + +@section{Decoding Model} + +The decoder keeps a small Racket handle around the native FFmpeg handler. +The handle stores the callbacks, stop and seek state, the current reading +state and the current format hash. + +Seeking is asynchronous with respect to @racket[ffmpeg-seek]: the +function only records the requested target sample. The read loop applies +the pending seek request before decoding the next block. + +@section{Notes} + +The FFmpeg shim output is expected to be signed 32-bit interleaved PCM. +This keeps the decoder interface suitable for a playback pipeline that +feeds decoded audio to libao. \ No newline at end of file diff --git a/scrbl/ffmpeg-ffi.scrbl b/scrbl/ffmpeg-ffi.scrbl new file mode 100644 index 0000000..fca3886 --- /dev/null +++ b/scrbl/ffmpeg-ffi.scrbl @@ -0,0 +1,166 @@ +#lang scribble/manual + +@(require racket/base + (for-label racket/base + racket/contract + racket/path + "../ffmpeg-ffi.rkt")) + +@title{FFmpeg FFI} +@author{@author+email["Hans Dijkema" "hans@dijkewijk.nl"]} + +@defmodule[(file "../ffmpeg-ffi.rkt")] + +This module provides the low-level Racket FFI binding for the native +FFmpeg audio shim. The native shim exposes an opaque FFmpeg instance and +keeps all decoder state inside that instance. + +The output format of the native shim is signed 32-bit interleaved PCM. +The buffer returned by the native layer is copied into Racket-managed +memory before it is passed to higher layers. + +@defproc[(fmpg-ffi-decoder-handler) procedure?]{ +Creates a new FFmpeg decoder command handler. + +The returned procedure manages one native FFmpeg instance. Commands are +sent as a symbol followed by command-specific arguments. + +@itemlist[ + #:style 'compact + @item{@racket['new] creates the native FFmpeg instance and returns @racket[#t].} + @item{@racket['delete] frees the native FFmpeg instance and returns @racket[#t].} + @item{@racket['init] opens a file and fetches stream and metadata information.} + @item{@racket['close] closes the currently opened file.} + @item{@racket['format] calls a format callback with the current stream format.} + @item{@racket['info] writes stream information to the sound logger.} + @item{@racket['read] decodes the next audio block.} + @item{@racket['seek] seeks to an absolute PCM sample position.} + @item{@racket['tell] returns the current PCM sample position.} + @item{@racket['file] returns the currently opened filename.} + @item{@racket['metadata] returns a hash with file metadata.} +] +} + +@section{Command Interface} + +The command handler is used as follows: + +@racketblock[ +(define h (fmpg-ffi-decoder-handler)) + +(h 'new) +(h 'init filename) +(h 'read audio-callback format-callback) +(h 'close) +(h 'delete) +] + +The @racket['new] command must be called before @racket['init]. A +handler owns at most one native FFmpeg instance. Calling @racket['new] +twice without @racket['delete] raises an error. + +@section{Format Callback} + +The @racket['format] command and the first @racket['read] call report +the stream format by calling the supplied callback as follows: + +@racketblock[ +(format-callback pcm-pos + sample-rate + channels + bits-per-sample + bytes-per-sample + pcm-length) +] + +The @racket[pcm-pos] argument is the current PCM sample position. +The @racket[pcm-length] argument is the total number of PCM samples, or +@racket[-1] when this is not known. + +@section{Reading Audio} + +The @racket['read] command decodes one audio block. It expects an audio +callback and a format callback: + +@racketblock[ +(h 'read audio-callback format-callback) +] + +On the first read, the format callback is called before audio data is +returned. If decoding produces data, the audio callback is called as: + +@racketblock[ +(audio-callback 'data pcm-pos buffer size) +] + +The @racket[pcm-pos] argument is the absolute sample position of the +first sample frame in the buffer. The @racket[buffer] argument points to +a copied PCM buffer, and @racket[size] is the buffer size in bytes. + +When the stream ends, the callback is called as: + +@racketblock[ +(audio-callback 'done -1 #f 0) +] + +The command returns @racket[#t]. + +@section{Seeking} + +The @racket['seek] command takes an absolute PCM sample position: + +@racketblock[ +(h 'seek pcm-pos) +] + +The sample position is converted to milliseconds using the current +sample rate and is then passed to the native FFmpeg shim. After seeking, +the current PCM position is updated from the native decoder. + +@section{Metadata} + +The @racket['metadata] command returns a mutable hash with the following +keys: + +@itemlist[ + #:style 'compact + @item{@racket['title]} + @item{@racket['author]} + @item{@racket['album]} + @item{@racket['genre]} + @item{@racket['comment]} + @item{@racket['copyright]} + @item{@racket['year]} + @item{@racket['track]} + @item{@racket['bitrate]} + @item{@racket['duration-ms]} + @item{@racket['audio-streams]} +] + +Missing string fields are returned as empty strings. Missing numeric +fields are returned as @racket[-1]. + +@section{Native Library} + +The module loads a shared library named @racket["ffmpeg_audio"] or +@racket["libffmpeg_audio"] using @racket[get-lib]. + +The native layer is expected to provide an instance-only FFmpeg API. +The relevant C-side properties are: + +@itemlist[ + #:style 'compact + @item{decoder state is stored in an opaque @tt{fmpg_instance};} + @item{output is signed 32-bit interleaved PCM;} + @item{the native buffer remains valid only until the next decode, seek, + close or free call;} + @item{Racket copies the buffer before passing it upward.} +] + +@section{Errors} + +Native failures are reported as Racket errors. Examples include failure +to allocate the native instance, failure to open a file and failure to +seek to a requested sample position. + +Unknown commands also raise an error. \ No newline at end of file diff --git a/scrbl/flac-decoder.scrbl b/scrbl/flac-decoder.scrbl new file mode 100644 index 0000000..ee69eaf --- /dev/null +++ b/scrbl/flac-decoder.scrbl @@ -0,0 +1,155 @@ +#lang scribble/manual + +@(require racket/base + (for-label racket/base + racket/path + "../flac-decoder.rkt" + "../flac-definitions.rkt")) + +@title{flac-decoder} +@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] + +@defmodule[(file "../flac-decoder.rkt")] + +This module provides a small decoder interface on top of the FLAC +FFI layer. It opens a decoder for a file, reads stream metadata, +reads audio frames, exposes the current decoder state, and allows +an active read loop to be stopped. It also re-exports the bindings +from @racketmodname["flac-definitions.rkt"]. + +A decoder handle stores the native decoder handler together with +optional callbacks for stream metadata and decoded audio. + +@section{Procedures} + +@defproc[(flac-open [flac-file* (or/c path? string?)] + [cb-stream-info (or/c procedure? #f)] + [cb-audio (or/c procedure? #f)]) + (or/c flac-handle? #f)]{ + +Opens a FLAC decoder for @racket[flac-file*]. If a path is given, +it is converted with @racket[path->string]. If the file does not +exist, the result is @racket[#f]. + +Otherwise a native decoder handler is created with +@racket[flac-ffi-decoder-handler], initialized with the file, and +wrapped in a @racket[flac-handle]. The given callbacks are stored +in the handle. + +When metadata of type @racket['streaminfo] is processed and +@racket[cb-stream-info] is a procedure, it is called with a +@racket[flac-stream-info] value. + +When decoded audio data is processed and @racket[cb-audio] is a +procedure, it is called as +@racket[(cb-audio header buffers)], where @racket[header] is a +mutable hash containing the frame header fields plus +@racket['duration], and @racket[buffers] is the decoded channel +data returned by the FFI layer. +} + +@defproc[(flac-stream-state [handle flac-handle?]) + (or/c 'search-for-metadata + 'read-metadata + 'search-for-frame-sync + 'read-frames + 'end-of-stream + 'ogg-error + 'seek-error + 'aborted + 'memory-allocation-error + 'uninitialized + 'end-of-link)]{ + +Returns the current decoder state reported by the native decoder +handler. +} + +@defproc[(flac-read [handle flac-handle?]) + (or/c 'stopped-reading + 'end-of-stream)]{ + +Reads the stream by repeatedly calling the native decoder with +@racket['process-single]. + +Before reading starts, the handle fields @racket[stop-reading] +and @racket[reading] are set to @racket[#f] and @racket[#t]. If a +stop has been requested with @racket[flac-stop], reading ends +with @racket['stopped-reading] and @racket[reading] is reset to +@racket[#f]. + +Whenever pending metadata is available, it is processed with +@racket[process-meta]. For metadata of type +@racket['streaminfo], a @racket[flac-stream-info] value is +constructed, stored in the handle, and passed to the +stream-info callback. + +Whenever pending frame data is available, it is processed with +@racket[process-frame]. The frame header is converted to a +mutable hash, extended with a @racket['duration] entry taken +from @racket[flac-duration], and passed together with the +decoded buffers to the audio callback. + +For each processed frame, the module also updates +@racket[last-buffer], @racket[last-buf-len], and @racket[kinds]. + +The procedure prints diagnostic messages for state changes, +metadata, stream errors, and stop handling. +} + +@defproc[(flac-read-meta [handle flac-handle?]) + (or/c flac-stream-info? #f)]{ + +Advances the decoder until the state becomes one of +@racket['read-metadata], @racket['end-of-stream], +@racket['aborted], @racket['memory-allocation-error], or +@racket['uninitialized]. + +If the resulting state is @racket['read-metadata], pending +metadata is processed and the stored stream info is returned. +Otherwise the result is @racket[#f]. + +Only metadata of type @racket['streaminfo] is converted into a +@racket[flac-stream-info] value by this module. +} + +@defproc[(flac-stop [handle flac-handle?]) void?]{ + +Requests termination of an active @racket[flac-read] loop by +setting the handle field @racket[stop-reading] to @racket[#t]. +The procedure then waits until the handle field +@racket[reading] becomes @racket[#f], sleeping for 10 ms between +checks. + +The procedure prints timing information before and after the +wait. +} + +@section{Diagnostic bindings} + +@defthing[kinds hash?]{ + +A mutable hash used to record the frame number kinds encountered +during decoding. The keys are the values found in the +frame-header field @racket['number-type]. +} + +@defthing[last-buffer (or/c #f list?)]{ + +The most recently decoded buffer set produced by frame +processing. +} + +@defthing[last-buf-len (or/c #f exact-integer?)]{ + +The block size of the most recently processed frame. +} + +@section{Notes} + +The frame-header hash passed to the audio callback is produced +by @racket[flac-ffi-frame-header]. In this module it is extended +with a @racket['duration] field before the callback is called. + +All bindings from @racketmodname["flac-definitions.rkt"] are +re-exported. \ No newline at end of file diff --git a/scrbl/libao.scrbl b/scrbl/libao.scrbl new file mode 100644 index 0000000..f3293cb --- /dev/null +++ b/scrbl/libao.scrbl @@ -0,0 +1,280 @@ +#lang scribble/manual + +@(require racket/base + (for-label racket/base + racket/contract + racket/path + "../libao.rkt")) + +@title{libao} +@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] + +@defmodule[(file "../libao.rkt")] + +This module provides a small high-level interface to an asynchronous +audio output backend. It opens a live output device or a file output, +queues audio buffers for playback, reports playback position, supports +pause and buffer clearing, and exposes a small set of validation +predicates. + +The central value is an @tt{ao-handle}, created by +@racket[ao-open-live] or @racket[ao-open-file]. An @tt{ao-handle} +stores the requested playback configuration together with a native +asynchronous player handle. It also records the real bit depth accepted +by the selected libao output device. + +@section{Audio handles} + +@defproc[(ao-handle? [v any/c]) boolean?]{ + +Returns @racket[#t] if @racket[v] is an @tt{ao-handle} value, and +@racket[#f] otherwise. +} + +@defproc[(ao-valid? [handle ao-handle?]) boolean?]{ + +Returns @racket[#t] if @racket[handle] still has a native asynchronous +player, and @racket[#f] otherwise. + +A handle becomes invalid after @racket[ao-close], or when opening the +native player failed. +} + +@defproc[(ao-device-bits [handle ao-handle?]) integer?]{ + +Returns the real bit depth of the opened output device. + +This can differ from the bit depth requested with @racket[ao-open-live] +or @racket[ao-open-file]. For example, when 32-bit output is requested +but the libao driver only accepts 24-bit output, this function returns +@racket[24]. +} + +@section{Validation predicates} + +@defproc[(ao-valid-bits? [bits any/c]) boolean?]{ + +Returns @racket[#t] if @racket[bits] is one of @racket[8], +@racket[16], @racket[24], or @racket[32], and @racket[#f] otherwise. +} + +@defproc[(ao-valid-rate? [rate any/c]) boolean?]{ + +Returns @racket[#t] if @racket[rate] is one of the sample rates +accepted by this module, and @racket[#f] otherwise. + +The accepted rates are: + +@itemlist[ + #:style 'compact + @item{@racket[8000], @racket[11025], @racket[16000], @racket[22050]} + @item{@racket[44100], @racket[48000], @racket[88200], @racket[96000]} + @item{@racket[176400], @racket[192000], @racket[352800], @racket[384000]} +] +} + +@defproc[(ao-valid-channels? [channels any/c]) boolean?]{ + +Returns @racket[#t] if @racket[channels] is an integer greater than or +equal to @racket[1], and @racket[#f] otherwise. +} + +@defproc[(ao-valid-format? [format any/c]) boolean?]{ + +Returns @racket[#t] if @racket[format] is one of +@racket['little-endian], @racket['big-endian], or +@racket['native-endian], and @racket[#f] otherwise. +} + +@defproc[(ao-supported-music-format? [format any/c]) boolean?]{ + +Returns @racket[#t] if @racket[format] is one of @racket['ao] or +@racket['flac], and @racket[#f] otherwise. + +The symbol does not describe an encoded audio format. It describes the +in-memory layout of the PCM buffer passed to @racket[ao-play]. +@racket['ao] means interleaved PCM samples. @racket['flac] means +channel-oriented PCM samples, as produced by the FLAC decoder, which +must be converted to interleaved PCM before playback. +} + +@section{Opening and closing} + +@defproc[(ao-open-live [bits ao-valid-bits?] + [rate ao-valid-rate?] + [channels ao-valid-channels?] + [byte-format ao-valid-format?]) + ao-handle?]{ + +Creates an audio output handle for live playback. + +This is equivalent to calling @racket[ao-open-file] with +@racket[#f] as the filename. + +The handle stores the requested sample size, sample rate, channel count, +and byte format. The native backend first tries to open the device with +the requested bit depth. If that fails, it may fall back to a lower bit +depth accepted by the selected libao driver. + +The requested bit depth describes the buffers supplied by the Racket +side. The real device bit depth describes the format accepted by libao +and can be inspected with @racket[ao-device-bits]. + +If the native player is created successfully, the returned handle is +valid. If player creation fails, the function still returns an +@tt{ao-handle}, but that handle is marked closed and is not valid +for playback. + +A finalizer is registered for the handle and calls @racket[ao-close] +when the handle is reclaimed. +} + +@defproc[(ao-open-file [bits ao-valid-bits?] + [rate ao-valid-rate?] + [channels ao-valid-channels?] + [byte-format ao-valid-format?] + [filename (or/c path? string? #f)]) + ao-handle?]{ + +Creates an audio output handle. + +If @racket[filename] is @racket[#f], the default live libao output +device is opened. Otherwise the native backend opens a file output +target using the given filename. + +The requested bit depth is stored in the handle and describes the input +buffers that will be queued with @racket[ao-play]. The native backend +also records the real bit depth accepted by the output device or file +backend. Use @racket[ao-device-bits] to inspect that value. +} + +@defproc[(ao-close [handle ao-handle?]) void?]{ + +Stops playback for @racket[handle] and releases the native player +reference stored in the handle. + +If the handle already has no native player, this procedure has no +effect. +} + +@section{Playback} + +@defproc[(ao-play [handle ao-handle?] + [music-id integer?] + [at-time-in-s number?] + [music-duration-s number?] + [buffer any/c] + [buf-len integer?] + [buf-type ao-supported-music-format?]) + void?]{ + +Queues audio data for asynchronous playback. + +The @racket[music-id] argument identifies the music stream associated +with the buffer. The arguments @racket[at-time-in-s] and +@racket[music-duration-s] describe the position and duration, in +seconds, associated with the buffer. The arguments @racket[buffer] and +@racket[buf-len] provide the audio data and its length. The +@racket[buf-type] argument specifies the in-memory PCM layout. + +The buffer description passed to the native layer is completed with the +requested sample size, sample rate, channel count, and byte format +stored in @racket[handle]. + +Two buffer layouts are supported: + +@itemlist[ + #:style 'compact + @item{@racket['ao]: interleaved PCM samples, for example @tt{L0 R0 L1 R1}.} + @item{@racket['flac]: channel-oriented PCM samples, for example one channel buffer for left samples and one channel buffer for right samples.} +] + +The native backend converts @racket['flac] buffers to interleaved PCM +before playback. It also converts between the requested bit depth and the +real device bit depth when needed. This makes it possible to keep decoder +output at 32-bit signed integer PCM while still playing on devices that +only accept 24-bit or 16-bit integer samples. + +The queued buffer is copied by the native backend, so the caller does +not need to keep the original buffer alive after @racket[ao-play] +returns. + +If @racket[handle] is not valid, this procedure raises an exception. +} + +@defproc[(ao-pause [handle ao-handle?] + [pause boolean?]) + void?]{ + +Pauses or resumes asynchronous playback for @racket[handle]. + +A true value pauses playback. @racket[#f] resumes playback. +} + +@defproc[(ao-clear-async [handle ao-handle?]) void?]{ + +Clears buffered asynchronous playback data for @racket[handle]. +} + +@section{Playback state} + +@defproc[(ao-at-second [handle ao-handle?]) number?]{ + +Returns the current playback position, in seconds, as reported by the +native asynchronous player. +} + +@defproc[(ao-at-music-id [handle ao-handle?]) integer?]{ + +Returns the music identifier currently reported by the native +asynchronous player. +} + +@defproc[(ao-music-duration [handle ao-handle?]) number?]{ + +Returns the duration of the current music stream, in seconds, as +reported by the native asynchronous player. +} + +@defproc[(ao-bufsize-async [handle ao-handle?]) integer?]{ + +Returns the current buffered size in bytes for the asynchronous player. +} + +@section{Volume control} + +@defproc[(ao-set-volume! [handle ao-handle?] + [percentage number?]) + void?]{ + +Sets the playback volume for @racket[handle]. + +If @racket[percentage] is an exact integer, it is converted to an +inexact number before it is passed to the native layer. +} + +@defproc[(ao-volume [handle ao-handle?]) number?]{ + +Returns the current playback volume as reported by the native +asynchronous player. +} + +@section{Notes} + +This module is a higher-level wrapper around the asynchronous FFI layer. +It stores the playback configuration in the handle, and reuses that +configuration for each call to @racket[ao-play]. + +The requested bit depth and the real device bit depth are deliberately +kept separate. The requested value describes the buffers supplied by the +Racket side. The real value describes the format accepted by libao. + +The module does not expose the handle fields directly. The public API +is intentionally small: create a handle, queue buffers, inspect +position and buffer state, pause or clear playback, adjust volume, and +close the handle. + +A typical usage pattern is to open one live handle for a given stream +format, queue decoded buffers with @racket[ao-play], and query the +playback position with @racket[ao-at-second] while playback proceeds +asynchronously. \ No newline at end of file diff --git a/scrbl/mp3-decoder.scrbl b/scrbl/mp3-decoder.scrbl new file mode 100644 index 0000000..9d9af49 --- /dev/null +++ b/scrbl/mp3-decoder.scrbl @@ -0,0 +1,149 @@ +#lang scribble/manual + +@(require racket/base + (for-label racket/base + racket/path + racket/contract + "../mp3-decoder.rkt")) + +@title{mp3-decoder} +@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]] + +@defmodule[(file "../mp3-decoder.rkt")] + +This module provides an MP3 decoder backend. It opens an MP3 file, +reports stream information through a callback, streams decoded PCM +buffers, and supports stopping and seeking. + +The module is intended to be used through +@racketmodname[racket-sound/audio-decoder], but its procedures can also +be used directly. + +@section{Validation} + +@defproc[(mp3-valid? [mp3-file any/c]) boolean?]{ + +Returns #t. + +The current implementation does not inspect mp3-file. This procedure +exists to satisfy the reader interface used by +@racketmodname[racket-sound/audio-decoder]. + +Basic validation such as file existence and extension matching is +performed in the higher-level module. This procedure therefore acts as +an additional hook and currently accepts all inputs. +} + +@section{Opening} + +@defproc[(mp3-open [mp3-file* (or/c path? string?)] + [cb-stream-info procedure?] + [cb-audio procedure?]) + (or/c struct? #f)]{ + +Opens an MP3 decoder for mp3-file*. + +If mp3-file* is a path, it is converted with path->string. If the file +does not exist, the result is #f. + +Otherwise a decoder handle is created and initialized. During +initialization, stream information is collected and stored in a mutable +hash in the handle. + +The stream-info callback is invoked once, immediately after +initialization: + +@racketblock[ +(cb-stream-info info) +] + +where info is a mutable hash containing at least: + +@itemlist[#:style 'compact + @item{'duration} + @item{'sample-rate} + @item{'channels} + @item{'bits-per-sample} + @item{'bytes-per-sample} + @item{'total-samples}] +} + +@section{Reading} + +@defproc[(mp3-read [handle struct?]) any/c]{ + +Starts the decode loop for handle. + +The loop repeatedly decodes audio chunks and invokes the audio +callback: + +@racketblock[ +(cb-audio info buffer size) +] + +Before each callback, the info hash is updated in place with: + +@itemlist[#:style 'compact + @item{'sample} + @item{'current-time}] + +The loop also checks for a pending seek request. If a seek has been +requested, the stored target sample position is forwarded to the +decoder backend and the request is cleared. + +The loop terminates when either: + +@itemlist[#:style 'compact + @item{the backend reports end-of-stream} + @item{a stop has been requested via mp3-stop}] + +If a stop is detected, the procedure returns 'stopped-reading. + +After termination, the underlying decoder is closed and released. + +The return value is otherwise unspecified. +} + +@section{Seeking} + +@defproc[(mp3-seek [handle struct?] + [percentage number?]) + void?]{ + +Requests a seek within the stream. + +The percentage argument represents a position relative to the full +audio stream, where 0 is the start and 100 is the end. The value may be +fractional. + +If the total number of samples is available in the handle, the +procedure computes an absolute target sample and stores it in the +handle as a pending seek request. + +The actual seek operation is performed later by mp3-read in its decode +loop. + +If the total number of samples is unavailable or equal to -1, this +procedure has no effect. +} + +@section{Stopping} + +@defproc[(mp3-stop [handle struct?]) void?]{ + +Requests termination of an active mp3-read loop. + +The procedure sets an internal stop flag and waits until the read loop +has terminated, sleeping briefly between checks. +} + +@section{Notes} + +The stream-info hash is shared between initialization and decoding and +is updated in place during playback. + +The audio buffer passed to the callback is managed by the decoder and +should be treated as transient data. + +Seeking is implemented as a request stored in the handle and executed +by the decode loop, not directly by mp3-seek. \ No newline at end of file diff --git a/taglib-ffi.rkt b/taglib-ffi.rkt new file mode 100644 index 0000000..0e80a44 --- /dev/null +++ b/taglib-ffi.rkt @@ -0,0 +1,294 @@ +#lang racket/base + +(require ffi/unsafe + ffi/unsafe/define + "private/utils.rkt" + "private/downloader.rkt" + ) + +(provide TagLib_File_Type + _TagLib_File-pointer + _TagLib_Tag-pointer + _TagLib_AudioProperties-pointer + + taglib_file_new + taglib_file_new_wchar + taglib_file_new_type + taglib_file_is_valid + taglib_file_free + + taglib_file_tag + taglib_file_audioproperties + taglib_tag_free_strings + + taglib_tag_title + taglib_tag_artist + taglib_tag_album + taglib_tag_comment + taglib_tag_genre + taglib_tag_year + taglib_tag_track + + taglib_audioproperties_length + taglib_audioproperties_bitrate + taglib_audioproperties_samplerate + taglib_audioproperties_channels + + taglib_property_keys + taglib_property_key + + taglib_property_get + taglib_property_val + + taglib_property_free + + taglib-get-picture + ) + + +;(define-runtime-path lib-path ".."); +; +;(define libs (let ((os-type (system-type 'os*))) +; (if (eq? os-type 'windows) +; (list +; (build-path lib-path "lib" "dll" "tag") +; (build-path lib-path "lib" "dll" "tag_c")) +; (let* ((arch (symbol->string (system-type 'arch))) +; (subdir (string-append (symbol->string os-type) "-" arch))) +; (list +; (build-path lib-path "lib" subdir "libtag") +; (build-path lib-path "lib" subdir "libtag_c")))))) + +;(define (get-lib l) +; (ffi-lib l '("2" #f) +; #:get-lib-dirs (λ () +; (cons (build-path ".") (get-lib-search-dirs))) +; #:fail (λ () +; (error (format "Cannot find library ~a" l))) +; )) + +(define zlib (get-lib '("zlib" "libz") '(#f))) +(define libtag (get-lib '("tag" "libtag") '("2" #f))) +(define libtag_c (get-lib '("tag_c" "libtag_c") '("#2" #f))) + +(define-ffi-definer define-tag-c-lib libtag_c + #:default-make-fail make-not-available) + +(define TagLib_File_Type + (_enum '( + mpeg + ogg-vorbis + flac + mpc + ogg-flac + wavpack + speex + true-audio + mp4 + asf + aiff + wav + ape + it + mod + s3m + xm + opus + dsf + dsdiff + shorten + ))) + +(define _TagLib_File-pointer (_cpointer/null 'taglib-file)) +(define _TagLib_Tag-pointer (_cpointer/null 'taglib-tag)) +(define _TagLib_AudioProperties-pointer (_cpointer/null 'taglib-audioproperties)) + +; TagLib_File *taglib_file_new(const char *filename); +(define-tag-c-lib taglib_file_new + (_fun _string/utf-8 -> _TagLib_File-pointer )) + +; TAGLIB_C_EXPORT TagLib_File *taglib_file_new_wchar(const wchar_t *filename); +(define-tag-c-lib taglib_file_new_wchar + (_fun _string/utf-16 -> _TagLib_File-pointer )) + +; TagLib_File *taglib_file_new_type(const char *filename, TagLib_File_Type type); +(define-tag-c-lib taglib_file_new_type + (_fun _string/utf-8 TagLib_File_Type -> _TagLib_File-pointer)) + +; TagLib_File *taglib_file_new_type_wchar(const char *filename, TagLib_File_Type type); +(define-tag-c-lib taglib_file_new_type_wchar + (_fun _string/utf-16 TagLib_File_Type -> _TagLib_File-pointer)) + +; void taglib_file_free(TagLib_File *file); +(define-tag-c-lib taglib_file_free + (_fun _TagLib_File-pointer -> _void)) + +; BOOL taglib_file_is_valid(const TagLib_File *file); +(define-tag-c-lib taglib_file_is_valid + (_fun _TagLib_File-pointer -> _bool)) + +; TagLib_Tag *taglib_file_tag(const TagLib_File *file); +(define-tag-c-lib taglib_file_tag + (_fun _TagLib_File-pointer -> _TagLib_Tag-pointer)) + +; const TagLib_AudioProperties *taglib_file_audioproperties(const TagLib_File *file); +(define-tag-c-lib taglib_file_audioproperties + (_fun _TagLib_File-pointer -> _TagLib_AudioProperties-pointer)) + +; void taglib_tag_free_strings(void); +(define-tag-c-lib taglib_tag_free_strings + (_fun -> _void)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; tags +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-syntax tg + (syntax-rules () + ((_ name) + (define-tag-c-lib name + (_fun _TagLib_Tag-pointer -> _string/utf-8))) + ((_ name ret-type) + (define-tag-c-lib name + (_fun _TagLib_Tag-pointer -> ret-type))) + )) + + +; char *taglib_tag_title(const TagLib_Tag *tag); +; etc.. +(tg taglib_tag_title) +(tg taglib_tag_artist) +(tg taglib_tag_album) +(tg taglib_tag_comment) +(tg taglib_tag_genre) +(tg taglib_tag_year _uint) +(tg taglib_tag_track _uint) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; audio properties +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-syntax ap + (syntax-rules () + ((_ name) + (define-tag-c-lib name + (_fun _TagLib_AudioProperties-pointer -> _int))) + )) + +; int taglib_audioproperties_length(const TagLib_AudioProperties *audioProperties); +; etc... + +(ap taglib_audioproperties_length) +(ap taglib_audioproperties_bitrate) +(ap taglib_audioproperties_samplerate) +(ap taglib_audioproperties_channels) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; keys in the propertymap +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; char** taglib_property_keys(const TagLib_File *file); +(define-tag-c-lib taglib_property_keys + (_fun _TagLib_File-pointer -> (_ptr i _string/utf-8))) + +(define (taglib_property_key keys i) + (ptr-ref keys _string/utf-8 i)) + +;char** taglib_property_get(const TagLib_File *file, const char *prop); +(define-tag-c-lib taglib_property_get + (_fun _TagLib_File-pointer _string/utf-8 -> (_ptr i _string/utf-8))) + +(define (taglib_property_val prop i) + (ptr-ref prop _string/utf-8 i)) + +; void taglib_property_free(char **props); +(define-tag-c-lib taglib_property_free + (_fun _pointer -> _void)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Picture data +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;typedef struct { +; char *mimeType; +; char *description; +; char *pictureType; +; char *data; +; unsigned int size; +;} TagLib_Complex_Property_Picture_Data; + +(define-cstruct _TagLib_Complex_Property_Picture_Data + ( + [mimeType _string/utf-8] + [description _string/utf-8] + [pictureType _string/utf-8] + [data _pointer] + [size _uint] + )) + + + +; TagLib_Complex_Property_Attribute*** properties = * taglib_complex_property_get(file, "PICTURE"); +; * TagLib_File *file = taglib_file_new("myfile.mp3"); +; * TagLib_Complex_Property_Attribute*** properties = +; * taglib_complex_property_get(file, "PICTURE"); +; * TagLib_Complex_Property_Picture_Data picture; +; * taglib_picture_from_complex_property(properties, &picture); +; * // Do something with picture.mimeType, picture.description, +; * // picture.pictureType, picture.data, picture.size, e.g. extract it. +; * FILE *fh = fopen("mypicture.jpg", "wb"); +; * if(fh) { +; * fwrite(picture.data, picture.size, 1, fh); +; * fclose(fh); +; * } +; * taglib_complex_property_free(properties); + +(define _Complex_Property_Attribute-pointer (_cpointer/null 'taglib-complex-property-attribute)) + +(define-tag-c-lib taglib_complex_property_get + (_fun _TagLib_File-pointer _string/utf-8 -> _Complex_Property_Attribute-pointer)) + +(define-tag-c-lib taglib_picture_from_complex_property + (_fun _Complex_Property_Attribute-pointer + _TagLib_Complex_Property_Picture_Data-pointer + -> _void)) + +(define-tag-c-lib taglib_complex_property_free + (_fun _Complex_Property_Attribute-pointer -> _void)) + +;TAGLIB_C_EXPORT char** taglib_complex_property_keys(const TagLib_File *file); +(define-tag-c-lib taglib_complex_property_keys + (_fun _TagLib_File-pointer -> (_ptr i _string/utf-8))) + +; void taglib_complex_property_free_keys(char **keys); +(define-tag-c-lib taglib_complex_property_free_keys + (_fun _pointer -> _void)) + +(define (taglib-get-picture tag-file) + (define (cp s) (string-append s "")) + (define (to-bytestring data size) + + (let* ((v (make-vector size 0)) + (i 0)) + (while (< i size) + (vector-set! v (ptr-ref data _byte i) i) + (set! i (+ i 1))) + v)) + (let ((props (taglib_complex_property_get tag-file "PICTURE"))) + (if (eq? props #f) + #f + (let ((pd (make-TagLib_Complex_Property_Picture_Data #f #f #f #f 0))) + (taglib_picture_from_complex_property props pd) + (let* ((mimetype (cp (TagLib_Complex_Property_Picture_Data-mimeType pd))) + (description (cp (TagLib_Complex_Property_Picture_Data-description pd))) + (type (cp (TagLib_Complex_Property_Picture_Data-pictureType pd))) + (size (TagLib_Complex_Property_Picture_Data-size pd)) + (data (cast (TagLib_Complex_Property_Picture_Data-data pd) + _pointer + (_bytes o size))) + ) + (let ((r (list mimetype description type size data))) + (taglib_complex_property_free props) + r)))) + )) \ No newline at end of file diff --git a/taglib.rkt b/taglib.rkt new file mode 100644 index 0000000..f2f52d2 --- /dev/null +++ b/taglib.rkt @@ -0,0 +1,305 @@ +(module taglib racket/base + + (require "taglib-ffi.rkt" + "private/utils.rkt" + racket/string + racket/draw) + + (provide id3-tags + + tags-valid? + + tags-title + tags-album + tags-artist + tags-comment + tags-year + tags-genre + tags-track + tags-composer + tags-disc-number + tags-album-artist + + tags-length + tags-sample-rate + tags-bit-rate + tags-channels + + tags-keys + tags-ref + + tags-picture + tags-picture->bitmap + tags-picture->file + tags-picture->kind + tags-picture->mimetype + tags-picture->size + tags-picture->ext + + tags->hash + + id3-picture-mimetype + id3-picture-kind + id3-picture-size + id3-picture-bytes + ) + + (define-struct id3-tag-struct + (handle)) + + (define-struct id3-picture + (mimetype kind size bytes)) + + (define (id3-tags file*) + (let ((file (if (path? file*) (path->string file*) file*)) + (valid? #f) + (title "") + (album "") + (artist "") + (comment "") + (year -1) + (genre "") + (track -1) + (length -1) + (sample-rate -1) + (bit-rate -1) + (channels -1) + (key-store (make-hash)) + (composer "") + (album-artist "") + (disc-number -1) + (picture #f)) + (let ((tag-file (taglib_file_new file))) + (if (eq? tag-file #f) + (set! valid? #f) + (set! valid? (taglib_file_is_valid tag-file))) + + (unless valid? + (when (eq? (system-type 'os) 'windows) + (dbg-sound "Could not open file ~a, trying wchar version on windows" file) + (unless (eq? tag-file #f) + (taglib_file_free tag-file)) + (set! tag-file (taglib_file_new_wchar file)) + (if (eq? tag-file #f) + (set! valid? #f) + (set! valid? (taglib_file_is_valid tag-file))))) + + (unless valid? + (warn-sound "Could not open file ~a" file) + (unless (eq? tag-file #f) + (taglib_file_free tag-file) + (set! tag-file #f))) + + (when valid? + (let ((tag (taglib_file_tag tag-file)) + (ap (taglib_file_audioproperties tag-file)) + (cp (lambda (s) (string-append s ""))) + ) + (set! title (cp (taglib_tag_title tag))) + (set! album (cp (taglib_tag_album tag))) + (set! artist (cp (taglib_tag_artist tag))) + (set! comment (cp (taglib_tag_comment tag))) + (set! genre (cp (taglib_tag_genre tag))) + (set! year (taglib_tag_year tag)) + (set! track (taglib_tag_track tag)) + + (set! length (taglib_audioproperties_length ap)) + (set! sample-rate (taglib_audioproperties_samplerate ap)) + (set! bit-rate (taglib_audioproperties_bitrate ap)) + (set! channels (taglib_audioproperties_channels ap)) + + (let* ((keys (taglib_property_keys tag-file)) + (i 0) + (key (taglib_property_key keys i)) + (key-list '()) + ) + (while (not (eq? key #f)) + (set! key-list (append key-list (list (cp key)))) + (set! i (+ i 1)) + (set! key (taglib_property_key keys i))) + (for-each (lambda (key) + (let ((props (taglib_property_get tag-file key))) + (let* ((vals '()) + (i 0) + (val (taglib_property_val props i))) + (while (not (eq? val #f)) + (set! vals (append vals (list (cp val)))) + (set! i (+ i 1)) + (set! val (taglib_property_val props i))) + (taglib_property_free props) + (hash-set! key-store + (string->symbol + (string-downcase key)) vals) + ))) + key-list) + (set! composer (hash-ref key-store 'composer "")) + (set! album-artist (hash-ref key-store 'albumartist "")) + (set! disc-number (string->number + (car + (hash-ref key-store 'discnumber (list "-1"))))) + ) + + ; picture + (let ((p (taglib-get-picture tag-file))) + (if (eq? p #f) + (set! picture #f) + (let ((mimetype (car p)) + (kind (caddr p)) + (size (cadddr p)) + (bytes (car (cddddr p)))) + (set! picture (make-id3-picture mimetype kind size bytes)) + ))) + + ; cleaning up + (taglib_tag_free_strings) + (taglib_file_free tag-file) + ) + ) + (let ((handle + (lambda (v . args) + (cond + [(eq? v 'valid?) valid?] + [(eq? v 'title) title] + [(eq? v 'album) album] + [(eq? v 'artist) artist] + [(eq? v 'comment) comment] + [(eq? v 'composer) composer] + [(eq? v 'genre) genre] + [(eq? v 'year) year] + [(eq? v 'track) track] + [(eq? v 'length) length] + [(eq? v 'sample-rate) sample-rate] + [(eq? v 'bit-rate) bit-rate] + [(eq? v 'channels) channels] + [(eq? v 'keys) (hash-keys key-store)] + [(eq? v 'album-artist) album-artist] + [(eq? v 'disc-number) disc-number] + [(eq? v 'val) + (if (null? args) + #f + (hash-ref key-store (car args) #f))] + [(eq? v 'picture) picture] + [(eq? v 'to-hash) + (let ((h (make-hash))) + (hash-set! h 'valid? valid?) + (hash-set! h 'title title) + (hash-set! h 'album album) + (hash-set! h 'artist artist) + (hash-set! h 'comment comment) + (hash-set! h 'composer composer) + (hash-set! h 'genre genre) + (hash-set! h 'year year) + (hash-set! h 'track track) + (hash-set! h 'length length) + (hash-set! h 'sample-rate sample-rate) + (hash-set! h 'bit-rate bit-rate) + (hash-set! h 'channels channels) + (hash-set! h 'picture picture) + (hash-set! h 'keys (hash-keys key-store)) + h)] + [else (error (format "Unknown tag-cmd '~a'" v))] + )))) + (make-id3-tag-struct handle)) + ))) + + + (define-syntax def + (syntax-rules () + ((_ (fun v)) + (define (fun tags . args) + (apply (id3-tag-struct-handle tags) (cons v args))) + ))) + + (define-syntax defs + (syntax-rules () + ((_ f1) + (def f1)) + ((_ f1 f2 ...) + (begin + (def f1) + (def f2) + ...)) + )) + + (defs + (tags-valid? 'valid?) + (tags-title 'title) + (tags-album 'album) + (tags-artist 'artist) + (tags-comment 'comment) + (tags-genre 'genre) + (tags-composer 'composer) + (tags-album-artist 'album-artist) + (tags-disc-number 'disc-number) + (tags-year 'year) + (tags-track 'track) + + (tags-length 'length) + (tags-sample-rate 'sample-rate) + (tags-bit-rate 'bit-rate) + (tags-channels 'channels) + + (tags-keys 'keys) + (tags-ref 'val) + + (tags-picture 'picture) + (tags->hash 'to-hash) + ) + + (define (tags-picture->bitmap tags) + (let ((p (tags-picture tags))) + (if (eq? p #f) + #f + (let* ((in (open-input-bytes (id3-picture-bytes p))) + (btm (read-bitmap in))) + (close-input-port in) + btm)))) + + (define (tags-picture->kind tags) + (let ((p (tags-picture tags))) + (if (eq? p #f) + #f + (id3-picture-kind p)))) + + (define (tags-picture->mimetype tags) + (let ((p (tags-picture tags))) + (if (eq? p #f) + #f + (id3-picture-mimetype p)))) + + (define (tags-picture->ext tags) + (let ((mt (tags-picture->mimetype tags))) + (cond + ((eq? mt #f) + #f) + ((or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg")) + 'jpg) + ((string-suffix? mt "/png") + 'png) + (else #f) + ) + )) + + (define (tags-picture->size tags) + (let ((p (tags-picture tags))) + (if (eq? p #f) + #f + (id3-picture-size p)))) + + (define (tags-picture->file tags path) + (let ((p (tags-picture tags))) + (if (eq? p #f) + #f + (let* ((in (open-input-bytes (id3-picture-bytes p))) + (fh (open-output-file path #:mode 'binary #:exists 'replace))) + (let ((bytes (read-bytes 16384 in))) + (while (and (not (eof-object? bytes)) (> (bytes-length bytes) 0)) + (write-bytes bytes fh) + (set! bytes (read-bytes 16384 in)))) + (close-output-port fh) + (close-input-port in) + #t)))) + + + ); end of module +