hans/gemigreerd-racket-audio
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

xiph opusfile support and taglib write support.

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-07 23:49:38 +02:00
parent cf87fa7ed8
commit 4b6adc404e
8 changed files with 905 additions and 303 deletions
Download Patch File Download Diff File Expand all files Collapse all files
taglib-ffi.rkt
+132 -102
View File
@@ -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,11 +15,12 @@
taglib_file_new_type
taglib_file_is_valid
taglib_file_free
taglib_file_save
taglib_file_tag
taglib_file_audioproperties
taglib_tag_free_strings
taglib_tag_title
taglib_tag_artist
taglib_tag_album
@@ -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
)
;(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)))
; ))
taglib-set-picture
taglib-append-picture
taglib-clear-picture)
(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 ))
(_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 ))
(_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)))
))
; int taglib_audioproperties_length(const TagLib_AudioProperties *audioProperties);
; etc...
(_fun _TagLib_AudioProperties-pointer -> _int)))))
(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]
))
; 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);
[size _uint]))
(define _Complex_Property_Attribute-pointer (_cpointer/null 'taglib-complex-property-attribute))
@@ -257,38 +228,97 @@
(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))
;; TagLib_Variant is { enum type; unsigned int size; union value; }.
;; For writing pictures we only use pointer-valued union members: stringValue
;; 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)
(define-cstruct _TagLib_Variant
([type _int]
[size _uint]
[value _pointer]))
(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) (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))
(define (cp s) (if (eq? s #f) "" (string-append s "")))
(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)))
(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)))
)
(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))))
))
r))))))