xiph opusfile support and taglib write support.

audio-placed-player.rkt

@@ -337,6 +337,32 @@
       (audio-read-worker ao-dec current-file-id)
       current-file-id)
 
+    (define (param! par val)
+      (cond
+        ((eq? par 'opus-bits)
+         (if (integer? val)
+             (cond
+               ((= val 16)
+                (current-opusfile-output-format 's16)
+                16
+                )
+               ((= val 24)
+                (current-opusfile-output-format 's24)
+                24)
+               (else 'error-unsupported-value)
+               )
+             'error-wrong-value-type)
+         )
+        (else 'error-unknown-param)))
+
+    (define (param par)
+      (cond
+        ((eq? par 'opus-bits)
+         (if (eq? (current-opusfile-output-format) 's16)
+             16
+             24))
+        (else 'error-unknown-param)))
+
     (define (pause paused)
       (when (or (eq? player-state 'paused)
                 (eq? player-state 'playing))
@@ -478,6 +504,15 @@
                    (do-rpc
                     (stop-and-cleanup)
                     '(ok)))
+                  ((eq? cmd 'param!)
+                   (do-rpc
+                    (let ((par (cadr data))
+                          (value (caddr data)))
+                      (list (param! par value)))))
+                  ((eq? cmd 'param)
+                   (do-rpc
+                    (let ((par (cadr data)))
+                      (list (param par)))))
                   ((eq? cmd 'state)
                    (do-rpc
                     (let ((st #f))

audio-player.rkt

@@ -33,6 +33,8 @@
          audio-ao-buf-ms!
          audio-ao-buf-ms
          audio-known-exts?
+         audio-param!
+         audio-param
          )
 
 (define-runtime-path placed-player-module "audio-placed-player.rkt")
@@ -52,6 +54,9 @@
 (define (percentage? p)
   (and (number? p) (>= p 0)))
 
+(define (any? x)
+  #t)
+
 (define (max-percentage? n)
   (λ (p) (and (percentage? p)
               (<= p n))))
@@ -281,6 +286,13 @@
   (-> audio-play? (or/c integer? boolean?))
   ((audio-play-rpc handle) 'ao-buf-ms))
 
+(define/contract (audio-param! handle param value)
+  (-> audio-play? symbol? any? any?)
+  ((audio-play-rpc handle) 'param! param value))
+
+(define/contract (audio-param handle param)
+  (-> audio-play? symbol? any?)
+  ((audio-play-rpc handle) 'param param))
   
     
     

opusfile-decoder.rkt

@@ -24,9 +24,21 @@
   ;; Opus decode output is always 48 kHz PCM.  The original input rate, if
   ;; present in metadata, is not the actual decoder output rate.
 
-  (define libopusfile
+
-    (with-handlers ([exn:fail? (lambda (_) #f)])
+  (define libogg (get-lib (case (system-type 'os)
-      (ffi-lib "libopusfile" '("0" #f))))
+                                 [(windows) '("ogg")]
+                                 [else      '("ogg" "libogg")])
+                               '(#f)))
+
+  (define libopus (get-lib (case (system-type 'os)
+                             [(windows) '("opus")]
+                             [else      '("opus" "libopus")])
+                           '(#f)))
+  
+  (define libopusfile (get-lib (case (system-type 'os)
+                                 [(windows) '("opusfile")]
+                                 [else      '("opusfile" "libopusfile")])
+                               '(#f)))
 
   (define _OggOpusFile _pointer)
 
@@ -36,12 +48,16 @@
   (define (opusfile-output-format? v)
     (or (eq? v 's16) (eq? v 's24)))
 
-  (define current-opusfile-output-format
+  (define cur-output-format 's16)
-    (make-parameter 's16
+
-      (lambda (v)
+  (define (current-opusfile-output-format . args)
-        (unless (opusfile-output-format? v)
+    (unless (null? args)
-          (raise-argument-error 'current-opusfile-output-format "(or/c 's16 's24)" v))
+      (if (or (> (length args) 1)
-        v)))
+              (not (opusfile-output-format? (car args))))
+          (raise-argument-error 'current-opusfile-output-format
+                                "(or/c 's16 's24)")
+          (set! cur-output-format (car args))))
+    cur-output-format)
 
   (define (opus-bits-per-sample)
     (case (current-opusfile-output-format)

play-test.rkt

@@ -9,7 +9,7 @@
          "tests.rkt"
          )
 
-(define place-mode #f)
+(define place-mode #t)
 
 (define run-queue #f)
 (define (set-test a)
@@ -26,7 +26,7 @@
          )
     (sprintf "%02d:%02d" minutes seconds)))
 
-(define (audio-player-state h st)
+(define (audio-player-state h s st)
   (early-return
    ((? (not (audio-play? h)) => 'done))
    (let* ((f (audio-file h))

taglib-ffi.rkt

@@ -3,8 +3,7 @@
 (require ffi/unsafe
          ffi/unsafe/define
          "private/utils.rkt"
-         "private/downloader.rkt"
+         "private/downloader.rkt")
-         )
 
 (provide TagLib_File_Type
          _TagLib_File-pointer
@@ -16,6 +15,7 @@
          taglib_file_new_type
          taglib_file_is_valid
          taglib_file_free
+         taglib_file_save
 
          taglib_file_tag
          taglib_file_audioproperties
@@ -29,6 +29,14 @@
          taglib_tag_year
          taglib_tag_track
 
+         taglib_tag_set_title
+         taglib_tag_set_artist
+         taglib_tag_set_album
+         taglib_tag_set_comment
+         taglib_tag_set_genre
+         taglib_tag_set_year
+         taglib_tag_set_track
+
          taglib_audioproperties_length
          taglib_audioproperties_bitrate
          taglib_audioproperties_samplerate
@@ -36,36 +44,19 @@
 
          taglib_property_keys
          taglib_property_key
-         
          taglib_property_get
          taglib_property_val
-         
+         taglib_property_set
+         taglib_property_set_append
          taglib_property_free
 
+         taglib_complex_property_set
+         taglib_complex_property_set_append
+
          taglib-get-picture
-         )
+         taglib-set-picture
-
+         taglib-append-picture
-
+         taglib-clear-picture)
-;(define-runtime-path lib-path "..");
-;
-;(define libs (let ((os-type (system-type 'os*)))
-;              (if (eq? os-type 'windows)
-;                  (list
-;                   (build-path lib-path "lib" "dll" "tag")
-;                   (build-path lib-path "lib" "dll" "tag_c"))
-;                  (let* ((arch (symbol->string (system-type 'arch)))
-;                         (subdir (string-append (symbol->string os-type) "-" arch)))
-;                    (list
-;                     (build-path lib-path "lib" subdir "libtag")
-;                     (build-path lib-path "lib" subdir "libtag_c"))))))
-
-;(define (get-lib l)
-;  (ffi-lib l '("2" #f)
-;           #:get-lib-dirs (λ ()
-;                            (cons (build-path ".") (get-lib-search-dirs)))
-;           #:fail (λ ()
-;                    (error (format "Cannot find library ~a" l)))
-;           ))
 
 (define zlib (get-lib '("zlib" "libz") '(#f)))
 (define libtag (get-lib '("tag" "libtag") '("2" #f)))
@@ -97,45 +88,39 @@
            dsf
            dsdiff
            shorten
-           )))
+           matroska)))
 
 (define _TagLib_File-pointer (_cpointer/null 'taglib-file))
 (define _TagLib_Tag-pointer (_cpointer/null 'taglib-tag))
 (define _TagLib_AudioProperties-pointer (_cpointer/null 'taglib-audioproperties))
 
-; TagLib_File *taglib_file_new(const char *filename);
 (define-tag-c-lib taglib_file_new
   (_fun _string/utf-8 -> _TagLib_File-pointer))
 
-; TAGLIB_C_EXPORT TagLib_File *taglib_file_new_wchar(const wchar_t *filename);
 (define-tag-c-lib taglib_file_new_wchar
   (_fun _string/utf-16 -> _TagLib_File-pointer))
 
-; TagLib_File *taglib_file_new_type(const char *filename, TagLib_File_Type type);
 (define-tag-c-lib taglib_file_new_type
   (_fun _string/utf-8 TagLib_File_Type -> _TagLib_File-pointer))
 
-; TagLib_File *taglib_file_new_type_wchar(const char *filename, TagLib_File_Type type);
 (define-tag-c-lib taglib_file_new_type_wchar
   (_fun _string/utf-16 TagLib_File_Type -> _TagLib_File-pointer))
 
-; void taglib_file_free(TagLib_File *file);
 (define-tag-c-lib taglib_file_free
   (_fun _TagLib_File-pointer -> _void))
 
-; BOOL taglib_file_is_valid(const TagLib_File *file);
 (define-tag-c-lib taglib_file_is_valid
   (_fun _TagLib_File-pointer -> _bool))
 
-; TagLib_Tag *taglib_file_tag(const TagLib_File *file);
+(define-tag-c-lib taglib_file_save
+  (_fun _TagLib_File-pointer -> _bool))
+
 (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))
 
@@ -150,12 +135,8 @@
        (_fun _TagLib_Tag-pointer -> _string/utf-8)))
     ((_ name ret-type)
      (define-tag-c-lib name
-       (_fun _TagLib_Tag-pointer -> ret-type)))
+       (_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)
@@ -164,6 +145,23 @@
 (tg taglib_tag_year _uint)
 (tg taglib_tag_track _uint)
 
+(define-syntax tgs
+  (syntax-rules ()
+    ((_ name)
+     (define-tag-c-lib name
+       (_fun _TagLib_Tag-pointer _string/utf-8 -> _void)))
+    ((_ name arg-type)
+     (define-tag-c-lib name
+       (_fun _TagLib_Tag-pointer arg-type -> _void)))))
+
+(tgs taglib_tag_set_title)
+(tgs taglib_tag_set_artist)
+(tgs taglib_tag_set_album)
+(tgs taglib_tag_set_comment)
+(tgs taglib_tag_set_genre)
+(tgs taglib_tag_set_year _uint)
+(tgs taglib_tag_set_track _uint)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; audio properties
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -172,11 +170,7 @@
   (syntax-rules ()
     ((_ name)
      (define-tag-c-lib name
-       (_fun _TagLib_AudioProperties-pointer -> _int)))
+       (_fun _TagLib_AudioProperties-pointer -> _int)))))
-    ))
-
-; int taglib_audioproperties_length(const TagLib_AudioProperties *audioProperties);
-; etc...
 
 (ap taglib_audioproperties_length)
 (ap taglib_audioproperties_bitrate)
@@ -184,24 +178,29 @@
 (ap taglib_audioproperties_channels)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; keys in the propertymap
+;; property map
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-; 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);
+;; value may be NULL to clear the property.
+(define-tag-c-lib taglib_property_set
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))
+
+;; value may be NULL to clear all values for the property.
+(define-tag-c-lib taglib_property_set_append
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))
+
 (define-tag-c-lib taglib_property_free
   (_fun _pointer -> _void))
 
@@ -209,40 +208,12 @@
 ;; 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]
-   [mimeType _string/utf-8]
    [description _string/utf-8]
    [pictureType _string/utf-8]
    [data _pointer]
-   [size _uint]
+   [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))
 
@@ -257,24 +228,87 @@
 (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)
+;; TagLib_Variant is { enum type; unsigned int size; union value; }.
-  (define (cp s) (string-append s ""))
+;; For writing pictures we only use pointer-valued union members: stringValue
-  (define (to-bytestring data size)
+;; and byteVectorValue. A pointer-sized field has the same size/alignment as
+;; the union on the supported ABIs.
+(define TagLib_Variant_ByteVector 9)
+(define TagLib_Variant_String 7)
 
-    (let* ((v (make-vector size 0))
+(define-cstruct _TagLib_Variant
-           (i 0))
+  ([type _int]
-      (while (< i size)
+   [size _uint]
-             (vector-set! v (ptr-ref data _byte i) i)
+   [value _pointer]))
-             (set! i (+ i 1)))
+
-      v))
+(define-cstruct _TagLib_Complex_Property_Attribute
+  ([key _pointer]
+   [value _TagLib_Variant]))
+
+(define-tag-c-lib taglib_complex_property_set
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))
+
+(define-tag-c-lib taglib_complex_property_set_append
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))
+
+(define (bytes->malloc-ptr bs [nul? #f])
+  (define len (bytes-length bs))
+  (define ptr (malloc _byte (+ len (if nul? 1 0)) 'atomic-interior))
+  (for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
+  (when nul? (ptr-set! ptr _byte len 0))
+  ptr)
+
+(define (string->malloc-cstring s)
+  (bytes->malloc-ptr (string->bytes/utf-8 s) #t))
+
+(define (picture->complex-property data size description mimetype picture-type)
+  (define data-ptr (bytes->malloc-ptr data #f))
+  (define data-key (string->malloc-cstring "data"))
+  (define mime-key (string->malloc-cstring "mimeType"))
+  (define desc-key (string->malloc-cstring "description"))
+  (define type-key (string->malloc-cstring "pictureType"))
+  (define mime-ptr (string->malloc-cstring mimetype))
+  (define desc-ptr (string->malloc-cstring description))
+  (define type-ptr (string->malloc-cstring picture-type))
+  (define data-attr (make-TagLib_Complex_Property_Attribute data-key (make-TagLib_Variant TagLib_Variant_ByteVector size data-ptr)))
+  (define mime-attr (make-TagLib_Complex_Property_Attribute mime-key (make-TagLib_Variant TagLib_Variant_String 0 mime-ptr)))
+  (define desc-attr (make-TagLib_Complex_Property_Attribute desc-key (make-TagLib_Variant TagLib_Variant_String 0 desc-ptr)))
+  (define type-attr (make-TagLib_Complex_Property_Attribute type-key (make-TagLib_Variant TagLib_Variant_String 0 type-ptr)))
+  (define propv (malloc _pointer 5 'atomic-interior))
+  (ptr-set! propv _pointer 0 data-attr)
+  (ptr-set! propv _pointer 1 mime-attr)
+  (ptr-set! propv _pointer 2 desc-attr)
+  (ptr-set! propv _pointer 3 type-attr)
+  (ptr-set! propv _pointer 4 #f)
+  ;; Return keepalive values as well as the pointer array. TagLib copies during
+  ;; taglib_complex_property_set(), but all buffers must remain live for the call.
+  (values propv (list data-ptr data-key mime-key desc-key type-key mime-ptr desc-ptr type-ptr
+                      data-attr mime-attr desc-attr type-attr propv)))
+
+(define (taglib-set-picture tag-file mimetype picture-type description data)
+  (define-values (props keepalive)
+    (picture->complex-property data (bytes-length data) description mimetype picture-type))
+  (define ok? (taglib_complex_property_set tag-file "PICTURE" props))
+  keepalive
+  ok?)
+
+(define (taglib-append-picture tag-file mimetype picture-type description data)
+  (define-values (props keepalive)
+    (picture->complex-property data (bytes-length data) description mimetype picture-type))
+  (define ok? (taglib_complex_property_set_append tag-file "PICTURE" props))
+  keepalive
+  ok?)
+
+(define (taglib-clear-picture tag-file)
+  (taglib_complex_property_set tag-file "PICTURE" #f))
+
+(define (taglib-get-picture tag-file)
+  (define (cp s) (if (eq? s #f) "" (string-append s "")))
   (let ((props (taglib_complex_property_get tag-file "PICTURE")))
     (if (eq? props #f)
         #f
@@ -284,11 +318,7 @@
                  (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)
+                 (data (cast (TagLib_Complex_Property_Picture_Data-data pd) _pointer (_bytes o size))))
-                               _pointer
-                               (_bytes o size)))
-                 )
             (let ((r (list mimetype description type size data)))
               (taglib_complex_property_free props)
-              r))))
+              r))))))
-    ))

taglib-tests.rkt

@@ -0,0 +1,278 @@
+#lang racket/base
+
+(require rackunit
+         racket/class
+         racket/draw
+         racket/file
+         racket/list
+         racket/path
+         racket/runtime-path
+         "taglib.rkt")
+
+(provide run-taglib-tests
+         run-taglib-tests/verbose
+         current-taglib-test-verbosity
+         test-audio-dir
+         taglib-read-files
+         taglib-write-files)
+
+;; These tests expect the repository hans/racket-audio-test next to this
+;; package checkout, matching the layout already used by tests.rkt:
+;;
+;;   parent/
+;;     racket-audio/
+;;     racket-audio-test/
+;;
+;; The tests are defensive: missing test files are skipped, but existing files
+;; are tested. Write tests always work on a temporary copy and never modify the
+;; original test audio files.
+
+
+(define current-taglib-test-verbosity (make-parameter 'normal))
+
+(define (taglib-test-verbose?)
+  (memq (current-taglib-test-verbosity) '(verbose very-verbose)))
+
+(define (taglib-test-note fmt . args)
+  (when (taglib-test-verbose?)
+    (apply printf fmt args)
+    (newline)
+    (flush-output)))
+
+(define-syntax-rule (taglib-test-case name body ...)
+  (test-case name
+    (taglib-test-note "[taglib] running: ~a" name)
+    body ...
+    (taglib-test-note "[taglib] ok: ~a" name)))
+
+(define-runtime-path test-audio-dir "../racket-audio-test")
+
+(define taglib-read-files
+  '("idyll.flac"
+    "idyll.m4a"
+    "idyll.mp3"
+    "idyll.ogg"
+    "idyll.opus"
+    "mahler-1.mp3"
+    "mahler-1.ogg"
+    "mahler-1.opus"
+    "mahler-2.mp3"
+    "mahler-2.ogg"
+    "mahler-2.opus"
+    "ff-16b-2c-44100hz.flac"
+    "ff-16b-2c-44100hz.m4a"
+    "ff-16b-2c-44100hz.mp3"
+    "ff-16b-2c-44100hz.ogg"
+    "ff-16b-2c-44100hz.opus"))
+
+;; Keep the write matrix deliberately small. These formats should cover the
+;; main TagLib backends used by the package without making the test suite slow.
+(define taglib-write-files
+  '("idyll.flac"
+    "idyll.mp3"
+    "idyll.m4a"
+    "idyll.ogg"
+    "idyll.opus"))
+
+(define (existing-test-files names)
+  (for/list ([name (in-list names)]
+             #:when (file-exists? (build-path test-audio-dir name)))
+    (build-path test-audio-dir name)))
+
+(define (taglib-usable?)
+  (with-handlers ([exn:fail? (lambda (_) #f)])
+    (define files (existing-test-files taglib-read-files))
+    (and (pair? files)
+         (let ([tags (id3-tags (car files))])
+           (and (tags-valid? tags) #t)))))
+
+(define (copy-test-file-to-temp src)
+  (define dst (make-temporary-file (format "racket-audio-taglib-~a-~~a~a"
+                                           (path->string (file-name-from-path src))
+                                           (or (path-get-extension src) #""))))
+  (copy-file src dst #t)
+  dst)
+
+(define (check-nonnegative/name name v)
+  (check-true (and (exact-integer? v) (>= v -1)) name))
+
+(define (check-readable-snapshot path)
+  (taglib-test-case (format "read-only snapshot: ~a" (file-name-from-path path))
+    (define tags (id3-tags path))
+    (check-true (tags-valid? tags))
+    (check-false (tags-read-write? tags))
+    (check-true (tags-closed? tags))
+    (check-pred string? (tags-title tags))
+    (check-pred string? (tags-album tags))
+    (check-pred string? (tags-artist tags))
+    (check-pred string? (tags-comment tags))
+    (check-pred string? (tags-genre tags))
+    (check-nonnegative/name "year" (tags-year tags))
+    (check-nonnegative/name "track" (tags-track tags))
+    (check-nonnegative/name "length" (tags-length tags))
+    (check-nonnegative/name "sample-rate" (tags-sample-rate tags))
+    (check-nonnegative/name "bit-rate" (tags-bit-rate tags))
+    (check-nonnegative/name "channels" (tags-channels tags))
+    (check-true (list? (tags-keys tags)))
+    ;; A read-only snapshot must still be usable after the native TagLib file
+    ;; has been closed. This protects the audio playback path from stale file
+    ;; handles/locks after metadata reading.
+    (check-pred hash? (tags->hash tags))
+    (check-exn exn:fail? (lambda () (tags-title! tags "must fail")))))
+
+(define (check-call-with-closes path)
+  (taglib-test-case (format "call-with-id3-tags closes read-write handle: ~a" (file-name-from-path path))
+    (define captured #f)
+    (with-handlers ([exn:fail? void])
+      (call-with-id3-tags path #:mode 'read-write
+        (lambda (tags)
+          (set! captured tags)
+          (check-true (tags-read-write? tags))
+          (check-false (tags-closed? tags))
+          (error 'expected-test-exception "force close path"))))
+    (check-true (tags-closed? captured))))
+
+(define (check-simple-write-roundtrip path)
+  (taglib-test-case (format "tag write/read/clear roundtrip: ~a" (file-name-from-path path))
+    (define tmp (copy-test-file-to-temp path))
+    (displayln (format "tmp = ~a" tmp))
+    (dynamic-wind
+      void
+      (lambda ()
+        (define title (format "Racket Audio TagLib Test ~a" (current-inexact-milliseconds)))
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (check-true (tags-valid? tags))
+            (check-true (tags-read-write? tags))
+            (check-false (tags-closed? tags))
+            (tags-title! tags title)
+            (tags-album! tags "Racket Audio Test Album")
+            (tags-artist! tags "Racket Audio Test Artist")
+            (tags-comment! tags "Written by racket-audio taglib-tests.rkt")
+            (tags-genre! tags "Test")
+            (tags-year! tags 2026)
+            (tags-track! tags 7)
+            (tags-composer! tags "Racket Composer")
+            (tags-album-artist! tags "Racket Album Artist")
+            (tags-disc-number! tags 2)
+            (tags-set-values! tags 'performer '("Performer One" "Performer Two"))
+            (check-true (tags-save! tags))))
+
+        (define reread (id3-tags tmp))
+        (check-true (tags-valid? reread))
+        (check-true (tags-closed? reread))
+        (check-equal? (tags-title reread) title)
+        (check-equal? (tags-album reread) "Racket Audio Test Album")
+        (check-equal? (tags-artist reread) "Racket Audio Test Artist")
+        (check-equal? (tags-comment reread) "Written by racket-audio taglib-tests.rkt")
+        (check-equal? (tags-genre reread) "Test")
+        (check-equal? (tags-year reread) 2026)
+        (check-equal? (tags-track reread) 7)
+        (check-equal? (tags-composer reread) "Racket Composer")
+        (check-equal? (tags-album-artist reread) "Racket Album Artist")
+        (check-equal? (tags-disc-number reread) 2)
+        (check-equal? (tags-ref reread 'performer) '("Performer One" "Performer Two"))
+
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (tags-title! tags 'clear)
+            (tags-year! tags 'clear)
+            (tags-track! tags 'clear)
+            (tags-clear! tags 'composer)
+            (tags-clear! tags 'performer)
+            (check-true (tags-save! tags))))
+
+        (define cleared (id3-tags tmp))
+        (check-equal? (tags-title cleared) "")
+        (check-equal? (tags-year cleared) -1)
+        (check-equal? (tags-track cleared) -1)
+        (check-equal? (tags-composer cleared) "")
+        (check-false (tags-ref cleared 'performer)))
+      (lambda ()
+        (when (file-exists? tmp) (delete-file tmp))))))
+
+(define (make-test-bitmap)
+  (define bm (make-object bitmap% 4 4))
+  (define dc (new bitmap-dc% [bitmap bm]))
+  (send dc set-pen "black" 1 'solid)
+  (send dc set-brush "white" 'solid)
+  (send dc draw-rectangle 0 0 4 4)
+  (send dc set-pen "black" 1 'solid)
+  (send dc draw-line 0 0 3 3)
+  (send dc set-bitmap #f)
+  bm)
+
+(define (check-picture-roundtrip path)
+  (taglib-test-case (format "picture write/read/clear roundtrip: ~a" (file-name-from-path path))
+    (define tmp (copy-test-file-to-temp path))
+    (dynamic-wind
+      void
+      (lambda ()
+        (define picture (make-tags-picture-from-bitmap (make-test-bitmap)
+                                                       "Front Cover"
+                                                       #:mimetype "image/png"
+                                                       #:description "Racket test cover"))
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (tags-picture! tags picture)
+            (check-true (tags-save! tags))))
+
+        (define reread (id3-tags tmp))
+        (define p (tags-picture reread))
+        (check-true (id3-picture? p))
+        (check-equal? (id3-picture-mimetype p) "image/png")
+        (check-equal? (id3-picture-kind p) "Front Cover")
+        (check-equal? (id3-picture-description p) "Racket test cover")
+        (check-true (> (id3-picture-size p) 0))
+        (check-true (is-a? (tags-picture->bitmap reread) bitmap%))
+
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (tags-clear-picture! tags)
+            (check-true (tags-save! tags))))
+        (check-false (tags-picture (id3-tags tmp)))
+        )
+      (lambda ()
+        (when (file-exists? tmp) (delete-file tmp))))))
+
+(define (run-taglib-tests [verbosity 'normal])
+  (unless (memq verbosity '(quiet normal verbose very-verbose))
+    (raise-argument-error 'run-taglib-tests "(or/c 'quiet 'normal 'verbose 'very-verbose)" verbosity))
+  (parameterize ([current-taglib-test-verbosity verbosity])
+    (cond
+      [(not (directory-exists? test-audio-dir))
+       (unless (eq? verbosity 'quiet)
+         (printf "Skipping TagLib tests: test audio directory not found: ~a\n" test-audio-dir))
+       (void)]
+      [(not (taglib-usable?))
+       (unless (eq? verbosity 'quiet)
+         (printf "Skipping TagLib tests: TagLib runtime is not available or no readable test file was found.\n"))
+       (void)]
+      [else
+       (define read-files (existing-test-files taglib-read-files))
+       (define write-files (existing-test-files taglib-write-files))
+       (taglib-test-note "[taglib] test audio directory: ~a" test-audio-dir)
+       (taglib-test-note "[taglib] read files: ~a" (length read-files))
+       (taglib-test-note "[taglib] write files: ~a" (length write-files))
+       (for ([path (in-list read-files)]) (check-readable-snapshot path))
+       (when (pair? write-files)
+         ;; call-with close behavior only needs one writable copy.
+         (define tmp (copy-test-file-to-temp (car write-files)))
+         (dynamic-wind void
+                       (lambda () (check-call-with-closes tmp))
+                       (lambda () (when (file-exists? tmp) (delete-file tmp)))))
+       (for ([path (in-list write-files)]) (check-simple-write-roundtrip path))
+       ;; Exercise picture writing on FLAC first, because it is the least
+       ;; ambiguous container for embedded cover-art roundtrips with TagLib.
+       (define flac (build-path test-audio-dir "idyll.flac"))
+       (when (file-exists? flac) (check-picture-roundtrip flac))
+       (taglib-test-note "[taglib] done")])))
+
+(define (run-taglib-tests/verbose)
+  (run-taglib-tests 'verbose))
+
+(module+ test
+  (run-taglib-tests))
+
+(module+ main
+  (run-taglib-tests))

taglib.rkt

@@ -2,12 +2,19 @@
 
   (require "taglib-ffi.rkt"
            "private/utils.rkt"
-           racket/string
+           ffi/unsafe
-           racket/draw)
+           racket/class
+           racket/draw
+           racket/string)
 
   (provide id3-tags
+           call-with-id3-tags
 
            tags-valid?
+           tags-read-write?
+           tags-closed?
+           tags-close!
+           tags-save!
 
            tags-title
            tags-album
@@ -20,6 +27,17 @@
            tags-disc-number
            tags-album-artist
 
+           tags-title!
+           tags-album!
+           tags-artist!
+           tags-comment!
+           tags-year!
+           tags-genre!
+           tags-track!
+           tags-composer!
+           tags-disc-number!
+           tags-album-artist!
+
            tags-length
            tags-sample-rate
            tags-bit-rate
@@ -27,138 +45,336 @@
 
            tags-keys
            tags-ref
+           tags-set!
+           tags-set-values!
+           tags-append!
+           tags-clear!
 
            tags-picture
+           tags-picture!
+           tags-append-picture!
+           tags-clear-picture!
            tags-picture->bitmap
            tags-picture->file
            tags-picture->kind
            tags-picture->mimetype
+           tags-picture->description
            tags-picture->size
            tags-picture->ext
 
            tags->hash
 
+           make-tags-picture
+           make-tags-picture-from-bitmap
+           id3-picture?
            id3-picture-mimetype
            id3-picture-kind
            id3-picture-size
            id3-picture-bytes
-           )
+           id3-picture-description)
 
-  (define-struct id3-tag-struct
+  (define-struct id3-tag-struct (handle))
-    (handle))
+  (define-struct id3-picture (mimetype kind size bytes description))
 
-  (define-struct id3-picture
+  (define clear-tag-value 'clear)
-    (mimetype kind size bytes))
 
-  (define (id3-tags file*)
+  (define (normal-mode mode)
-    (let ((file (if (path? file*) (path->string file*) file*))
+    (cond
-          (valid? #f)
+      [(or (eq? mode 'read) (eq? mode 'read-only)) 'read]
-          (title "")
+      [(or (eq? mode 'write) (eq? mode 'read-write)) 'read-write]
-          (album "")
+      [else (raise-argument-error 'id3-tags "(or/c 'read 'read-only 'read-write 'write)" mode)]))
-          (artist "")
+
-          (comment "")
+  (define (file->string file*)
-          (year -1)
+    (if (path? file*) (path->string file*) file*))
-          (genre "")
+
-          (track -1)
+  (define (copy-string s)
-          (length -1)
+    (if (eq? s #f) "" (string-append s "")))
-          (sample-rate -1)
+
-          (bit-rate -1)
+  (define (property-name k)
-          (channels -1)
+    (cond
-          (key-store (make-hash))
+      [(symbol? k) (string-upcase (symbol->string k))]
-          (composer "")
+      [(string? k) k]
-          (album-artist "")
+      [else (raise-argument-error 'tag-property "(or/c symbol? string?)" k)]))
-          (disc-number -1)
+
-          (picture #f))
+  (define (property-symbol k)
+    (string->symbol (string-downcase (property-name k))))
+
+  (define (first-property h key [default ""])
+    (let ((v (hash-ref h key #f)))
+      (cond
+        [(and (pair? v) (string? (car v))) (car v)]
+        [(string? v) v]
+        [else default])))
+
+  (define (first-property-number h key [default -1])
+    (let ((n (string->number (first-property h key (number->string default)))))
+      (if n n default)))
+
+  (define (string-list? v)
+    (and (list? v) (andmap string? v)))
+
+  (define (bitmap->encoded-bytes bm mimetype)
+    (define kind
+      (cond
+        [(or (string-ci=? mimetype "image/jpeg") (string-ci=? mimetype "image/jpg")) 'jpeg]
+        [(string-ci=? mimetype "image/png") 'png]
+        [else (error 'make-tags-picture-from-bitmap
+                     "unsupported bitmap mimetype: ~a; use image/png or image/jpeg" mimetype)]))
+    (define out (open-output-bytes))
+    (unless (send bm save-file out kind)
+      (error 'make-tags-picture-from-bitmap "could not encode bitmap as ~a" mimetype))
+    (get-output-bytes out))
+
+  (define (make-tags-picture mimetype kind data #:description [description ""])
+    (define bytes
+      (cond
+        [(bytes? data) data]
+        [(is-a? data bitmap%) (bitmap->encoded-bytes data mimetype)]
+        [else (raise-argument-error 'make-tags-picture "(or/c bytes? (is-a?/c bitmap%))" data)]))
+    (make-id3-picture mimetype kind (bytes-length bytes) bytes description))
+
+  (define (make-tags-picture-from-bitmap bm kind #:mimetype [mimetype "image/png"] #:description [description ""])
+    (make-tags-picture mimetype kind bm #:description description))
+
+  (define (open-tag-file file)
     (let ((tag-file (taglib_file_new file)))
-        (if (eq? tag-file #f)
+      (if (and tag-file (taglib_file_is_valid tag-file))
-            (set! valid? #f)
+          tag-file
-            (set! valid? (taglib_file_is_valid tag-file)))
+          (begin
-        
+            (when (and tag-file (not (eq? tag-file #f))) (taglib_file_free tag-file))
-        (unless valid?
+            (if (eq? (system-type 'os) 'windows)
-          (when (eq? (system-type 'os) 'windows)
+                (begin
                   (dbg-sound "Could not open file ~a, trying wchar version on windows" file)
-            (unless (eq? tag-file #f)
+                  (let ((wtag-file (taglib_file_new_wchar file)))
-              (taglib_file_free tag-file))
+                    (if (and wtag-file (taglib_file_is_valid wtag-file)) wtag-file
-            (set! tag-file (taglib_file_new_wchar file))
+                        (begin
+                          (when (and wtag-file (not (eq? wtag-file #f))) (taglib_file_free wtag-file))
+                          #f))))
+                #f)))))
+
+  (define (read-property-map tag-file)
+    (define key-store (make-hash))
+    (let* ((keys (taglib_property_keys tag-file))
+           (i 0)
+           (key (and keys (taglib_property_key keys i)))
+           (key-list '()))
+      (while (not (eq? key #f))
+             (set! key-list (append key-list (list (copy-string 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 (and props (taglib_property_val props i))))
+             (while (not (eq? val #f))
+                    (set! vals (append vals (list (copy-string val))))
+                    (set! i (+ i 1))
+                    (set! val (taglib_property_val props i)))
+             (when props (taglib_property_free props))
+             (hash-set! key-store (string->symbol (string-downcase key)) vals))))
+       key-list))
+    key-store)
+
+  (define (read-picture tag-file)
+    (let ((p (taglib-get-picture tag-file)))
+      (if (eq? p #f)
+          #f
+          (let ((mimetype (car p))
+                (description (cadr p))
+                (kind (caddr p))
+                (size (cadddr p))
+                (bytes (car (cddddr p))))
+            (make-id3-picture mimetype kind size bytes description)))))
+
+  (define (id3-tags file* #:mode [mode 'read])
+    (define file (file->string file*))
+    (define actual-mode (normal-mode mode))
+    (define read-write? (eq? actual-mode 'read-write))
+    (define valid? #f)
+    (define closed? #t)
+    (define tag-file #f)
+    (define tag #f)
+    (define title "")
+    (define album "")
+    (define artist "")
+    (define comment "")
+    (define year -1)
+    (define genre "")
+    (define track -1)
+    (define length -1)
+    (define sample-rate -1)
+    (define bit-rate -1)
+    (define channels -1)
+    (define key-store (make-hash))
+    (define composer "")
+    (define album-artist "")
+    (define disc-number -1)
+    (define picture #f)
+
+    (define (refresh-derived!)
+      (set! composer (first-property key-store 'composer ""))
+      (set! album-artist (first-property key-store 'albumartist ""))
+      (set! disc-number (first-property-number key-store 'discnumber -1)))
+
+    (define (open-and-read!)
+      (set! tag-file (open-tag-file file))
       (if (eq? tag-file #f)
+          (begin
             (set! valid? #f)
-                (set! valid? (taglib_file_is_valid tag-file)))))
+            (warn-sound "Could not open file ~a" file))
-
+          (begin
-        (unless valid?
+            (set! valid? #t)
-          (warn-sound "Could not open file ~a" file)
+            (set! closed? #f)
-          (unless (eq? tag-file #f)
+            (set! tag (taglib_file_tag tag-file))
-            (taglib_file_free tag-file)
+            (let ((ap (taglib_file_audioproperties tag-file)))
-            (set! tag-file #f)))
+              (set! title (copy-string (taglib_tag_title tag)))
-        
+              (set! album (copy-string (taglib_tag_album tag)))
-        (when valid?
+              (set! artist (copy-string (taglib_tag_artist tag)))
-          (let ((tag (taglib_file_tag tag-file))
+              (set! comment (copy-string (taglib_tag_comment tag)))
-                (ap (taglib_file_audioproperties tag-file))
+              (set! genre (copy-string (taglib_tag_genre tag)))
-                (cp (lambda (s) (string-append s "")))
+              (set! year (let ((v (taglib_tag_year tag))) (if (zero? v) -1 v)))
-                )
+              (set! track (let ((v (taglib_tag_track tag))) (if (zero? v) -1 v)))
-            (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))
-
+              (set! key-store (read-property-map tag-file))
-            (let* ((keys (taglib_property_keys tag-file))
+              (refresh-derived!)
-                   (i 0)
+              (set! picture (read-picture tag-file))
-                   (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)
+              (unless read-write? (close!))))))
+
+    (define (close!)
+      (unless closed?
         (taglib_file_free tag-file)
-            )
+        (set! tag-file #f)
-          )
+        (set! tag #f)
-        (let ((handle 
+        (set! closed? #t))
-          (lambda (v . args)
+      (void))
+
+    (define (ensure-open! who)
+      (unless valid? (error who "tag handle is invalid: ~a" file))
+      (unless read-write?
+        (error who "tag handle is read-only for ~a; open with #:mode 'read-write" file))
+      (when closed? (error who "tag handle is closed: ~a" file)))
+
+    (define (set-property-cache! key vals)
+      (define sym (property-symbol key))
+      (if (null? vals) (hash-remove! key-store sym) (hash-set! key-store sym vals))
+      (refresh-derived!))
+
+    (define (string->cptr s)
+      (define bs (string->bytes/utf-8 s))
+      (define len (bytes-length bs))
+      (define ptr (malloc _byte (+ len 1) 'atomic-interior))
+      (for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
+      (ptr-set! ptr _byte len 0)
+      ptr)
+
+    (define (apply-string! who value setter cache!)
+      (ensure-open! who)
+      (cond
+        [(eq? value clear-tag-value) (setter tag "") (cache! "")]
+        [(string? value) (setter tag value) (cache! value)]
+        [else (raise-argument-error who "(or/c string? 'clear)" value)]))
+
+    (define (apply-uint! who value setter cache!)
+      (ensure-open! who)
+      (cond
+        [(eq? value clear-tag-value) (setter tag 0) (cache! -1)]
+        [(and (exact-nonnegative-integer? value) (<= value #xffffffff))
+         (setter tag value) (cache! value)]
+        [else (raise-argument-error who "(or/c exact-nonnegative-integer? 'clear)" value)]))
+
+    (define (set-one-property! who key value #:append? [append? #f])
+      (ensure-open! who)
+      (cond
+        [(eq? value clear-tag-value)
+         (if append?
+             (taglib_property_set_append tag-file (property-name key) #f)
+             (taglib_property_set tag-file (property-name key) #f))
+         (set-property-cache! key '())]
+        [(string? value)
+         (if append?
+             (taglib_property_set_append tag-file (property-name key) (string->cptr value))
+             (taglib_property_set tag-file (property-name key) (string->cptr value)))
+         (if append?
+             (set-property-cache! key (append (hash-ref key-store (property-symbol key) '()) (list value)))
+             (set-property-cache! key (list value)))]
+        [else (raise-argument-error who "(or/c string? 'clear)" value)]))
+
+    (define (set-values-property! key values)
+      (ensure-open! 'tags-set-values!)
+      (cond
+        [(eq? values clear-tag-value)
+         (taglib_property_set tag-file (property-name key) #f)
+         (set-property-cache! key '())]
+        [(string-list? values)
+         (taglib_property_set tag-file (property-name key) #f)
+         (for ([v values]) (taglib_property_set_append tag-file (property-name key) (string->cptr v)))
+         (set-property-cache! key values)]
+        [else (raise-argument-error 'tags-set-values! "(or/c (listof string?) 'clear)" values)]))
+
+    (define (set-picture! value #:append? [append? #f])
+      (ensure-open! (if append? 'tags-append-picture! 'tags-picture!))
+      (cond
+        [(eq? value clear-tag-value)
+         (unless (taglib-clear-picture tag-file)
+           (error 'tags-picture! "could not clear picture for file: ~a" file))
+         (set! picture #f)]
+        [(id3-picture? value)
+         (define ok?
+           (if append?
+               (taglib-append-picture tag-file
+                                      (id3-picture-mimetype value)
+                                      (id3-picture-kind value)
+                                      (id3-picture-description value)
+                                      (id3-picture-bytes value))
+               (taglib-set-picture tag-file
+                                   (id3-picture-mimetype value)
+                                   (id3-picture-kind value)
+                                   (id3-picture-description value)
+                                   (id3-picture-bytes value))))
+         (unless ok? (error (if append? 'tags-append-picture! 'tags-picture!)
+                            "could not set picture for file: ~a" file))
+         (unless append? (set! picture value))]
+        [else (raise-argument-error (if append? 'tags-append-picture! 'tags-picture!)
+                                    "(or/c id3-picture? 'clear)" value)]))
+
+    (define (save!)
+      (ensure-open! 'tags-save!)
+      (taglib_file_save tag-file))
+
+    (define (to-hash)
+      (let ((h (make-hash)))
+        (hash-set! h 'valid? valid?)
+        (hash-set! h 'read-write? read-write?)
+        (hash-set! h 'closed? closed?)
+        (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))
+
+    (define (handle v . args)
       (cond
         [(eq? v 'valid?) valid?]
+        [(eq? v 'read-write?) read-write?]
+        [(eq? v 'closed?) closed?]
+        [(eq? v 'close!) (close!)]
+        [(eq? v 'save!) (save!)]
         [(eq? v 'title) title]
         [(eq? v 'album) album]
         [(eq? v 'artist) artist]
@@ -174,55 +390,62 @@
         [(eq? v 'keys) (hash-keys key-store)]
         [(eq? v 'album-artist) album-artist]
         [(eq? v 'disc-number) disc-number]
-              [(eq? v 'val)
+        [(eq? v 'val) (if (null? args) #f (hash-ref key-store (property-symbol (car args)) #f))]
-               (if (null? args)
-                   #f
-                   (hash-ref key-store (car args) #f))]
         [(eq? v 'picture) picture]
-              [(eq? v 'to-hash)
+        [(eq? v 'to-hash) (to-hash)]
-               (let ((h (make-hash)))
+        [(eq? v 'set-title!) (apply-string! 'tags-title! (car args) taglib_tag_set_title (lambda (x) (set! title x)))]
-                 (hash-set! h 'valid? valid?)
+        [(eq? v 'set-album!) (apply-string! 'tags-album! (car args) taglib_tag_set_album (lambda (x) (set! album x)))]
-                 (hash-set! h 'title title)
+        [(eq? v 'set-artist!) (apply-string! 'tags-artist! (car args) taglib_tag_set_artist (lambda (x) (set! artist x)))]
-                 (hash-set! h 'album album)
+        [(eq? v 'set-comment!) (apply-string! 'tags-comment! (car args) taglib_tag_set_comment (lambda (x) (set! comment x)))]
-                 (hash-set! h 'artist artist)
+        [(eq? v 'set-genre!) (apply-string! 'tags-genre! (car args) taglib_tag_set_genre (lambda (x) (set! genre x)))]
-                 (hash-set! h 'comment comment)
+        [(eq? v 'set-year!) (apply-uint! 'tags-year! (car args) taglib_tag_set_year (lambda (x) (set! year x)))]
-                 (hash-set! h 'composer composer)
+        [(eq? v 'set-track!) (apply-uint! 'tags-track! (car args) taglib_tag_set_track (lambda (x) (set! track x)))]
-                 (hash-set! h 'genre genre)
+        [(eq? v 'set-composer!) (set-one-property! 'tags-composer! 'composer (car args))]
-                 (hash-set! h 'year year)
+        [(eq? v 'set-album-artist!) (set-one-property! 'tags-album-artist! 'albumartist (car args))]
-                 (hash-set! h 'track track)
+        [(eq? v 'set-disc-number!)
-                 (hash-set! h 'length length)
+         (let ((x (car args)))
-                 (hash-set! h 'sample-rate sample-rate)
+           (cond
-                 (hash-set! h 'bit-rate bit-rate)
+             [(eq? x clear-tag-value) (set-one-property! 'tags-disc-number! 'discnumber clear-tag-value)]
-                 (hash-set! h 'channels channels)
+             [(and (exact-nonnegative-integer? x) (<= x #xffffffff)) (set-one-property! 'tags-disc-number! 'discnumber (number->string x))]
-                 (hash-set! h 'picture picture)
+             [(string? x) (set-one-property! 'tags-disc-number! 'discnumber x)]
-                 (hash-set! h 'keys (hash-keys key-store))
+             [else (raise-argument-error 'tags-disc-number! "(or/c exact-nonnegative-integer? string? 'clear)" x)]))]
-                 h)]
+        [(eq? v 'set!) (set-one-property! 'tags-set! (car args) (cadr args))]
-              [else (error (format "Unknown tag-cmd '~a'" v))]
+        [(eq? v 'set-values!) (set-values-property! (car args) (cadr args))]
-              ))))
+        [(eq? v 'append!) (set-one-property! 'tags-append! (car args) (cadr args) #:append? #t)]
-          (make-id3-tag-struct handle))
+        [(eq? v 'clear!) (set-one-property! 'tags-clear! (car args) clear-tag-value)]
-          )))
+        [(eq? v 'set-picture!) (set-picture! (car args))]
+        [(eq? v 'append-picture!) (set-picture! (car args) #:append? #t)]
+        [(eq? v 'clear-picture!) (set-picture! clear-tag-value)]
+        [else (error (format "Unknown tag-cmd '~a'" v))]))
 
+    (open-and-read!)
+    (make-id3-tag-struct handle))
+
+  (define (call-with-id3-tags file proc #:mode [mode 'read])
+    (define tags (id3-tags file #:mode mode))
+    (dynamic-wind
+      void
+      (lambda () (proc tags))
+      (lambda () (tags-close! tags))))
 
   (define-syntax def
     (syntax-rules ()
       ((_ (fun v))
        (define (fun tags . args)
-         (apply (id3-tag-struct-handle tags) (cons v args)))
+         (apply (id3-tag-struct-handle tags) (cons v args))))))
-       )))
 
   (define-syntax defs
     (syntax-rules ()
-      ((_ f1)
+      ((_ f1) (def f1))
-       (def f1))
+      ((_ f1 f2 ...) (begin (def f1) (def f2) ...))))
-      ((_ f1 f2 ...)
-       (begin
-         (def f1)
-         (def f2)
-         ...))
-      ))
 
   (defs
     (tags-valid? 'valid?)
+    (tags-read-write? 'read-write?)
+    (tags-closed? 'closed?)
+    (tags-close! 'close!)
+    (tags-save! 'save!)
+
     (tags-title 'title)
     (tags-album 'album)
     (tags-artist 'artist)
@@ -234,6 +457,17 @@
     (tags-year 'year)
     (tags-track 'track)
 
+    (tags-title! 'set-title!)
+    (tags-album! 'set-album!)
+    (tags-artist! 'set-artist!)
+    (tags-comment! 'set-comment!)
+    (tags-genre! 'set-genre!)
+    (tags-composer! 'set-composer!)
+    (tags-album-artist! 'set-album-artist!)
+    (tags-disc-number! 'set-disc-number!)
+    (tags-year! 'set-year!)
+    (tags-track! 'set-track!)
+
     (tags-length 'length)
     (tags-sample-rate 'sample-rate)
     (tags-bit-rate 'bit-rate)
@@ -241,10 +475,16 @@
 
     (tags-keys 'keys)
     (tags-ref 'val)
+    (tags-set! 'set!)
+    (tags-set-values! 'set-values!)
+    (tags-append! 'append!)
+    (tags-clear! 'clear!)
 
     (tags-picture 'picture)
-    (tags->hash 'to-hash)
+    (tags-picture! 'set-picture!)
-    )
+    (tags-append-picture! 'append-picture!)
+    (tags-clear-picture! 'clear-picture!)
+    (tags->hash 'to-hash))
 
   (define (tags-picture->bitmap tags)
     (let ((p (tags-picture tags)))
@@ -257,34 +497,27 @@
 
   (define (tags-picture->kind tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
+      (if (eq? p #f) #f (id3-picture-kind p))))
-          #f
-          (id3-picture-kind p))))
 
   (define (tags-picture->mimetype tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
+      (if (eq? p #f) #f (id3-picture-mimetype p))))
-          #f
+
-          (id3-picture-mimetype p))))
+  (define (tags-picture->description tags)
+    (let ((p (tags-picture tags)))
+      (if (eq? p #f) #f (id3-picture-description p))))
 
   (define (tags-picture->ext tags)
     (let ((mt (tags-picture->mimetype tags)))
       (cond
-        ((eq? mt #f)
+        [(eq? mt #f) #f]
-         #f)
+        [(or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg")) 'jpg]
-        ((or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg"))
+        [(string-suffix? mt "/png") 'png]
-         'jpg)
+        [else #f])))
-        ((string-suffix? mt "/png")
-         'png)
-        (else #f)
-        )
-      ))
 
   (define (tags-picture->size tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
+      (if (eq? p #f) #f (id3-picture-size p))))
-          #f
-          (id3-picture-size p))))
 
   (define (tags-picture->file tags path)
     (let ((p (tags-picture tags)))
@@ -300,6 +533,4 @@
             (close-input-port in)
             #t))))
 
-
+  )
-  ); end of module
-

tests.rkt

@@ -21,7 +21,7 @@
 (define-runtime-path tests "../racket-audio-test")
 
 (define test-file1 (build-path tests "idyll.mp3"))
-(define test-file2 (build-path tests "idyll.flac"))
+(define test-file2 (build-path tests "idyll.opus"))
 (define test-file3 (build-path tests "mahler-1.mp3"))
 (define test-file4 (build-path tests "mahler-2.mp3"))
 (define test-file5 (build-path tests "mahler-1.opus"))