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

* flac support

Browse Source 
* taglib support
It is possible to play some music already.
This commit is contained in:
Hans Dijkema
2025-08-13 14:13:35 +02:00
parent 820c68a1aa
commit ad7f1345ad
16 changed files with 1522 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

273
libtag/taglib-ffi.rkt Normal file
View File

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

228
libtag/taglib.rkt Normal file
View File

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