325 lines
11 KiB
Racket
325 lines
11 KiB
Racket
#lang racket/base
|
|
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
"private/utils.rkt"
|
|
"private/downloader.rkt")
|
|
|
|
(provide TagLib_File_Type
|
|
_TagLib_File-pointer
|
|
_TagLib_Tag-pointer
|
|
_TagLib_AudioProperties-pointer
|
|
|
|
taglib_file_new
|
|
taglib_file_new_wchar
|
|
taglib_file_new_type
|
|
taglib_file_is_valid
|
|
taglib_file_free
|
|
taglib_file_save
|
|
|
|
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_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
|
|
taglib_audioproperties_channels
|
|
|
|
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 zlib (get-lib '("zlib" "libz") '(#f)))
|
|
(define libtag (get-lib '("tag" "libtag") '("2" #f)))
|
|
(define libtag_c (get-lib '("tag_c" "libtag_c") '("#2" #f)))
|
|
|
|
(define-ffi-definer define-tag-c-lib libtag_c
|
|
#:default-make-fail make-not-available)
|
|
|
|
(define TagLib_File_Type
|
|
(_enum '(
|
|
mpeg
|
|
ogg-vorbis
|
|
flac
|
|
mpc
|
|
ogg-flac
|
|
wavpack
|
|
speex
|
|
true-audio
|
|
mp4
|
|
asf
|
|
aiff
|
|
wav
|
|
ape
|
|
it
|
|
mod
|
|
s3m
|
|
xm
|
|
opus
|
|
dsf
|
|
dsdiff
|
|
shorten
|
|
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))
|
|
|
|
(define-tag-c-lib taglib_file_new
|
|
(_fun _string/utf-8 -> _TagLib_File-pointer))
|
|
|
|
(define-tag-c-lib taglib_file_new_wchar
|
|
(_fun _string/utf-16 -> _TagLib_File-pointer))
|
|
|
|
(define-tag-c-lib taglib_file_new_type
|
|
(_fun _string/utf-8 TagLib_File_Type -> _TagLib_File-pointer))
|
|
|
|
(define-tag-c-lib taglib_file_new_type_wchar
|
|
(_fun _string/utf-16 TagLib_File_Type -> _TagLib_File-pointer))
|
|
|
|
(define-tag-c-lib taglib_file_free
|
|
(_fun _TagLib_File-pointer -> _void))
|
|
|
|
(define-tag-c-lib taglib_file_is_valid
|
|
(_fun _TagLib_File-pointer -> _bool))
|
|
|
|
(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))
|
|
|
|
(define-tag-c-lib taglib_file_audioproperties
|
|
(_fun _TagLib_File-pointer -> _TagLib_AudioProperties-pointer))
|
|
|
|
(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)))))
|
|
|
|
(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)
|
|
|
|
(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
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax ap
|
|
(syntax-rules ()
|
|
((_ name)
|
|
(define-tag-c-lib name
|
|
(_fun _TagLib_AudioProperties-pointer -> _int)))))
|
|
|
|
(ap taglib_audioproperties_length)
|
|
(ap taglib_audioproperties_bitrate)
|
|
(ap taglib_audioproperties_samplerate)
|
|
(ap taglib_audioproperties_channels)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; property map
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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))
|
|
|
|
(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))
|
|
|
|
;; 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))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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]))
|
|
|
|
(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))
|
|
|
|
(define-tag-c-lib taglib_complex_property_keys
|
|
(_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))
|
|
|
|
(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) (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)))
|
|
(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))))))
|