diff --git a/lib/dll/libFLAC.dll b/lib/dll/libFLAC.dll new file mode 100644 index 0000000..484b6e9 Binary files /dev/null and b/lib/dll/libFLAC.dll differ diff --git a/lib/dll/libao-4.dll b/lib/dll/libao-4.dll new file mode 100644 index 0000000..803f1c7 Binary files /dev/null and b/lib/dll/libao-4.dll differ diff --git a/lib/dll/tag.dll b/lib/dll/tag.dll new file mode 100644 index 0000000..ce08641 Binary files /dev/null and b/lib/dll/tag.dll differ diff --git a/lib/dll/tag_c.dll b/lib/dll/tag_c.dll new file mode 100644 index 0000000..e02f45c Binary files /dev/null and b/lib/dll/tag_c.dll differ diff --git a/libao/libao-ffi.rkt b/libao/libao-ffi.rkt index 650a98a..d4e3bc4 100644 --- a/libao/libao-ffi.rkt +++ b/libao/libao-ffi.rkt @@ -2,6 +2,7 @@ (require ffi/unsafe ffi/unsafe/define + setup/dirs ) (provide ;_libao_pointer @@ -15,10 +16,22 @@ ao_shutdown ao_append_option make-ao_sample_format + ao_sample_format-bits + ao_sample_format-rate + ao_sample_format-channels + ao_sample_format-byte_format + ao_sample_format-matrix (all-from-out ffi/unsafe) ) -(define-ffi-definer define-libao (ffi-lib "libao" '("3" "4" "5" #f))) + +(define-ffi-definer define-libao + (ffi-lib "libao" '("3" "4" "5" #f) + #:get-lib-dirs (lambda () + (cons (build-path ".") (get-lib-search-dirs))) + #:fail (lambda () + (ffi-lib (get-lib-path "libao-4.dll"))) + )) (define _libao-pointer (_cpointer 'ao_device)) @@ -50,7 +63,7 @@ (define-libao ao_open_live (_fun _int _pointer _pointer -> _libao-pointer)) ; int ao_play(ao_device *device, char *output_samples, uint_32 num_bytes); -(define-libao ao_play (_fun _libao-pointer _pointer _ulong -> _int)) +(define-libao ao_play (_fun _libao-pointer _pointer _uint32 -> _int)) ; int ao_close(ao_device *device); (define-libao ao_close (_fun _libao-pointer -> _int)) diff --git a/libao/libao.rkt b/libao/libao.rkt index e0fdfd0..8136aed 100644 --- a/libao/libao.rkt +++ b/libao/libao.rkt @@ -1,7 +1,8 @@ #lang racket/base -(require "libao-ffi.rkt") -;(require finalizer) +(require "libao-ffi.rkt" + (prefix-in fin: finalizer) + ffi/unsafe) (provide ao-open-live ao-play @@ -10,9 +11,34 @@ ao-default-driver-id ) -(define currently-open 0) -(define ao-device-handle 0) -(define ao-devices (make-hash)) +(define devices (make-hash)) +(define device-number 1) + + +(define-struct ao-handle (handle-num + [bits #:auto #:mutable] + [bytes-per-sample #:auto #:mutable] + [byte-format #:auto #:mutable] + [channels #:auto #:mutable] + [rate #:auto #:mutable] + ) + #:auto-value #f + ) + +(ao_initialize) + +(define libao-plumber-flus-handle + (plumber-add-flush! (current-plumber) + (lambda (my-handle) + (hash-for-each devices + (lambda (handle-num device) + (ao-close handle-num))) + (set! devices (make-hash)) + (ao_shutdown) + (plumber-flush-handle-remove! my-handle) + ))) + + (define (ao-mk-format bits rate channels byte-format . matrix) (let ((bf (if (eq? byte-format 'little-endian) @@ -23,39 +49,114 @@ (let ((format (make-ao_sample_format bits rate channels bf #f))) format))) +(define (ao-endianness->symbol e) + (if (= e AO-FMT-LITTLE) + 'little-endian + (if (= e AO-FMT-BIG) + 'big-endian + 'native))) + (define (ao-default-driver-id) (ao_default_driver_id)) - (define (ao-open-live driver-id sample-format . options) - (when (= currently-open 0) - (ao_initialize)) - (let ((ao-device (ao_open_live driver-id sample-format #f))) - (set! currently-open (+ currently-open 1)) - (when (eq? ao-device _cpointer/null) - (set! currently-open (- currently-open 1)) - (when (= currently-open 0) - (ao_shutdown))) - (if (eq? ao-device _cpointer/null) - #f - (begin - (set! ao-device-handle (+ ao-device-handle 1)) - (hash-set! ao-devices ao-device-handle ao-device) - ao-device-handle)))) + (let ((id (if (eq? driver-id #f) (ao-default-driver-id) driver-id))) + (let ((ao-device (ao_open_live id sample-format #f))) + (if (eq? ao-device #f) + (let ((handle (ao-handle -1))) + handle) + (let ((handle-num device-number)) + (set! device-number (+ device-number 1)) + (let ((handle (ao-handle handle-num))) + (let* ((bits (ao_sample_format-bits sample-format)) + (bytes-per-sample (inexact->exact (round (/ bits 8)))) + (channels (ao_sample_format-channels sample-format)) + (endianness (ao-endianness->symbol + (ao_sample_format-byte_format sample-format))) + (rate (ao_sample_format-rate sample-format)) + ) + (set-ao-handle-bits! handle bits) + (set-ao-handle-bytes-per-sample! handle bytes-per-sample) + (set-ao-handle-byte-format! handle endianness) + (set-ao-handle-rate! handle rate) + (set-ao-handle-channels! handle channels) + (hash-set! devices handle-num ao-device) + (fin:register-finalizer handle + (lambda (handle) + (ao-close handle))) + handle)) + )) + ))) + +(define (ao-close handle) + (if (number? handle) + (let ((ao-device (hash-ref devices handle #f))) + (unless (eq? ao-device #f) + (let ((r (ao_close ao-device))) + (when (= r 0) + (printf "Unexpected: cannot close ao-device")))) + 'internally-closed) + (let ((handle-num (ao-handle-handle-num handle))) + (let ((ao-device (hash-ref devices handle-num #f))) + (if (eq? ao-device #f) + 'error-ao-device-non-existent + (let ((r (ao_close ao-device))) + (hash-remove! devices handle-num) + (if (= r 0) + 'error-closing-ao-device + 'ok))))))) -(define (ao-close ao-handle) - (let ((ao-device (hash-ref ao-devices ao-handle #f))) - (when (eq? ao-device #f) - (error (format "Not a valid ao-handle ~a" ao-handle))) - (hash-remove! ao-devices ao-handle) - (let ((r (ao_close ao-device))) - (set! currently-open (- currently-open 1)) - (when (= currently-open 0) - (ao_shutdown)) - r))) -(define (ao-play) - #t) +(define count 0) +(define (abs x) (if (>= x 0) x (* x -1))) + +(define (make-sample-bytes sample bytes-per-sample endianess) + (letrec ((mk (lambda (i d) + (if (< i bytes-per-sample) + (cons (bitwise-and d 255) + (mk (+ i 1) (arithmetic-shift d -8))) + '())))) + (let ((bytes (mk 0 sample))) + (if (eq? endianess 'big-endian) + (reverse bytes) + bytes)))) + +(define (ao-play handle buffer) + (let* ((bytes-per-sample (ao-handle-bytes-per-sample handle)) + (bits (ao-handle-bits handle)) + (channels (ao-handle-channels handle)) + (endianess (ao-handle-byte-format handle)) + (buf-len (vector-length (car buffer))) + (audio-buf-len (* channels bytes-per-sample buf-len)) + (audio (malloc 'atomic audio-buf-len)) + (get-sample (lambda (k channel) + (let ((chan-buf (list-ref buffer channel))) + (vector-ref chan-buf k)))) + ) + ;(displayln (format "bps: ~a, buf-len: ~a, endianess: ~a, channels: ~a, bits ~a" + ; bytes-per-sample buf-len endianess channels bits)) + (letrec ((i 0) + (fill (lambda (k channel) + (if (< k buf-len) + (if (< channel channels) + (let* ((sample (get-sample k channel)) + (bytes (make-sample-bytes sample bytes-per-sample endianess)) + ) + (for-each (lambda (byte) + (ptr-set! audio _byte i byte) + (set! i (+ i 1))) + bytes) + ;; process sample + (fill k (+ channel 1))) + (fill (+ k 1) 0)) + 'filled)) + )) + (fill 0 0) + (let* ((handle-num (ao-handle-handle-num handle)) + (ao-device (hash-ref devices handle-num #f))) + (if (eq? ao-device #f) + (error "No device for this handle") + (ao_play ao-device audio audio-buf-len)))))) diff --git a/libflac/capr24.flac b/libflac/capr24.flac new file mode 100644 index 0000000..fd856e1 Binary files /dev/null and b/libflac/capr24.flac differ diff --git a/libflac/flac-decoder.rkt b/libflac/flac-decoder.rkt new file mode 100644 index 0000000..cd3a13e --- /dev/null +++ b/libflac/flac-decoder.rkt @@ -0,0 +1,131 @@ +(module flac-decoder racket/base + + (require ffi/unsafe + "libflac-ffi.rkt" + "flac-definitions.rkt" + "../utils/utils.rkt") + + (provide flac-open + flac-read + flac-read-meta + flac-stream-state + (all-from-out "flac-definitions.rkt") + test-file test-file2 test-file3 + kinds + last-buffer last-buf-len + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions to do the good stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (flac-open flac-file cb-stream-info cb-audio) + (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 (process-frame handle frame buffer) + (let* ((h (flac-ffi-frame-header frame)) + (cb-audio (flac-handle-cb-audio handle)) + (ffi (flac-handle-ffi-decoder-handler handle)) + (type (hash-ref h 'number-type)) + (channels (hash-ref h 'channels)) + (block-size (hash-ref h 'blocksize))) + (let ((buffers (ffi 'get-buffers buffer channels block-size))) + (set! last-buffer buffers) + (set! last-buf-len (hash-ref h 'blocksize)) + (hash-set! kinds type #t) + (when (procedure? cb-audio) + (cb-audio h buffers)) + )) + ;(displayln "Processing frame")) + #t + ) + + (define (process-meta handle meta) + (let ((type (FLAC__StreamMetadata-type meta))) + (display (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) + (hash-ref mh 'bits-per-sample) + (hash-ref mh 'total-samples)))) + (set-flac-handle-stream-info! handle si) + (let ((cb (flac-handle-cb-stream-info handle))) + (when (procedure? cb) + (cb si)))))) + ) + )) + + (define (flac-read handle) + (let* ((ffi-handler (flac-handle-ffi-decoder-handler handle)) + (state (ffi-handler 'state))) + (letrec ((reader (lambda (frame-nr) + (let* ((st (ffi-handler 'state))) + (ffi-handler 'process-single) + (unless (eq? state st) + (set! state st) + (displayln + (format "Now in state ~a (frame-nr = ~a) (int-state = ~a)" + st frame-nr (ffi-handler 'int-state))) + ) + (when (ffi-handler 'has-errno?) + (displayln + (format "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) + 'end-of-stream + (reader (+ frame-nr 1))))) + )) + (reader 0)))) + + (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 test-file "C:/devel/racket/racket-sound/libflac/capr24.flac") + (define test-file2 "C:/Muziek/Klassiek-Kamermuziek/Beethoven/Rachel Podger/01 Violin Sonata No. 1 in D Major, Op. 12 No. 1- I. Allegro con brio.flac") + (define test-file3 "c:/Muziek/Pop/Radiohead/The Best of Radiohead (2008)/02. Paranoid Android.flac") + + ); end of module diff --git a/libflac/flac-definitions.rkt b/libflac/flac-definitions.rkt new file mode 100644 index 0000000..f0dfa73 --- /dev/null +++ b/libflac/flac-definitions.rkt @@ -0,0 +1,99 @@ +(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->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 + )) + + (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] + ) + #:auto-value #f + ) + + ); end of module diff --git a/libflac/flac.exe b/libflac/flac.exe new file mode 100644 index 0000000..f79f639 Binary files /dev/null and b/libflac/flac.exe differ diff --git a/libflac/libflac-ffi.rkt b/libflac/libflac-ffi.rkt index 7bc35af..ffb3688 100644 --- a/libflac/libflac-ffi.rkt +++ b/libflac/libflac-ffi.rkt @@ -1 +1,591 @@ -#lang racket/base +;#lang racket/base +(module libflac-ffi racket/base + +(require ffi/unsafe + ffi/unsafe/define + setup/dirs + "../utils/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-ffi-definer define-libflac + (ffi-lib "libFLAC" '(#f) + #:get-lib-dirs (lambda () + (cons (build-path ".") (get-lib-search-dirs))) + #:fail (lambda () + (ffi-lib (get-lib-path "libFLAC.dll"))) + )) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 'flac-client-data)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 + -> _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)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 (write-callback fl frame buffer data) + (set! write-data (append write-data (list (cons frame buffer)))) + 0) + + (define (meta-callback fl meta data) + (set! meta-data (append meta-data (list meta)))) + + (define (error-callback fl errno data) + (set! error-no errno) + ) + + (define (new) + (set! fl (FLAC__stream_decoder_new)) + fl) + + (define (init file) + (let ((r (FLAC__stream_decoder_init_file + fl + file + write-callback + meta-callback + error-callback))) + (set! flac-file file) + r)) + + (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 cb 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 '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/libflac/metaflac.exe b/libflac/metaflac.exe new file mode 100644 index 0000000..54dba80 Binary files /dev/null and b/libflac/metaflac.exe differ diff --git a/libtag/taglib-ffi.rkt b/libtag/taglib-ffi.rkt new file mode 100644 index 0000000..03e749e --- /dev/null +++ b/libtag/taglib-ffi.rkt @@ -0,0 +1,273 @@ +#lang racket/base + +(require ffi/unsafe + ffi/unsafe/define + setup/dirs + "../utils/utils.rkt" + ) + +(provide TagLib_File_Type + _TagLib_File-pointer + _TagLib_Tag-pointer + _TagLib_AudioProperties-pointer + + taglib_file_new + 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-ffi-definer define-tag-lib + (ffi-lib "tag" '("0" #f) + #:get-lib-dirs (lambda () + (cons (build-path ".") (get-lib-search-dirs))) + #:fail (lambda () + (ffi-lib (get-lib-path "tag.dll"))) + )) + +(define-ffi-definer define-tag-c-lib + (ffi-lib "tag_c" '("0" "1" "2" #f) + #:get-lib-dirs (lambda () + (cons (build-path ".") (get-lib-search-dirs))) + #:fail (lambda () + (ffi-lib (get-lib-path "tag_c.dll"))) + )) + +(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_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)) + +; 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/libtag/taglib.rkt b/libtag/taglib.rkt new file mode 100644 index 0000000..357fa63 --- /dev/null +++ b/libtag/taglib.rkt @@ -0,0 +1,228 @@ +(module taglib racket/base + + (require "taglib-ffi.rkt" + "../utils/utils.rkt" + racket/draw) + + (provide id3-tags + + tags-valid? + + tags-title + tags-album + tags-artist + tags-comment + tags-year + tags-genre + tags-track + + tags-length + tags-sample-rate + tags-bit-rate + tags-channels + + tags-keys + tags-ref + + tags-picture + tags-picture->bitmap + + 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 ((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))) + (set! valid? (taglib_file_is_valid tag-file)) + (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 '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-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)))) + + + + ); end of module + diff --git a/play-test.rkt b/play-test.rkt new file mode 100644 index 0000000..a0f730d --- /dev/null +++ b/play-test.rkt @@ -0,0 +1,20 @@ +#lang racket/base +(require "libao/libao.rkt" + "libflac/flac-decoder.rkt" + ) + + + +(define fmt (ao-mk-format 16 44100 2 'big-endian)) +(define ao-h (ao-open-live #f fmt)) + +(define (flac-play frame buffer) + (ao-play ao-h buffer)) + +(define (flac-meta meta) + (displayln meta)) + +(define flac-h (flac-open test-file3 flac-meta flac-play)) + +(flac-read flac-h) + diff --git a/utils/utils.rkt b/utils/utils.rkt new file mode 100644 index 0000000..fa2202c --- /dev/null +++ b/utils/utils.rkt @@ -0,0 +1,32 @@ +(module utils racket/base + + (provide while + get-lib-path + ) + + (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 (get-lib-path lib) + (let ((platform (system-type))) + (cond + [(eq? platform 'windows) + (build-path (current-directory) ".." "lib" "dll" lib)] + [else + (error (format "Install the shared library: ~a" lib))] + ))) + + + ) ; end of module