* flac support

* taglib support
It is possible to play some music already.

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))

libao/libao.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
-(require "libao-ffi.rkt")
+(require "libao-ffi.rkt"
-;(require finalizer)
+         (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 devices (make-hash))
-(define ao-device-handle 0)
+(define device-number 1)
-(define ao-devices (make-hash))
+
+
+(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)
+  (let ((id (if (eq? driver-id #f) (ao-default-driver-id) driver-id)))
-    (ao_initialize))
+    (let ((ao-device (ao_open_live id sample-format #f)))
-  (let ((ao-device (ao_open_live driver-id sample-format #f)))
+      (if (eq? ao-device #f)
-    (set! currently-open (+ currently-open 1))
+          (let ((handle (ao-handle -1)))
-    (when (eq? ao-device _cpointer/null)
+            handle)
-      (set! currently-open (- currently-open 1))
+          (let ((handle-num device-number))
-      (when (= currently-open 0)
+            (set! device-number (+ device-number 1))
-        (ao_shutdown)))
+            (let ((handle (ao-handle handle-num)))
-    (if (eq? ao-device _cpointer/null)
+              (let* ((bits (ao_sample_format-bits sample-format))
-        #f
+                     (bytes-per-sample (inexact->exact (round (/ bits 8))))
-        (begin
+                     (channels (ao_sample_format-channels sample-format))
-          (set! ao-device-handle (+ ao-device-handle 1))
+                     (endianness (ao-endianness->symbol
-          (hash-set! ao-devices ao-device-handle ao-device)
+                                  (ao_sample_format-byte_format sample-format)))
-          ao-device-handle))))
+                     (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)
+(define count 0)
-  #t)
+(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))))))
 
 
 

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

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

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

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))))
+    ))

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
+

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)
+

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