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

small bugs.

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-10 02:30:23 +02:00
parent 0b5d8a21b4
commit 815f39a8cc
4 changed files with 121 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ffmpeg-definitions.rkt
+4 -4
View File
@@ -77,23 +77,23 @@
;; FFmpeg DLL names often contain the major version; on Unix-like systems
;; the dynamic linker can usually find the generic soname.
(define libavutil (get-lib (case (system-type 'os)
(define libavutil (get-lib/quiet (case (system-type 'os)
[(windows) '("avutil-60")]
[else '("avutil" "libavutil")])
(ffmpeg-lib-versions 'avutil)))
(define libswresample (get-lib (case (system-type 'os)
(define libswresample (get-lib/quiet (case (system-type 'os)
[(windows) '("swresample-6")]
[else '("swresample" "libswresample")])
(ffmpeg-lib-versions 'swresample)))
(define libavcodec (get-lib (case (system-type 'os)
(define libavcodec (get-lib/quiet (case (system-type 'os)
[(windows) '("avcodec-62")]
[else '("avcodec" "libavcodec")])
(ffmpeg-lib-versions 'avcodec)))
(define libavformat (get-lib (case (system-type 'os)
(define libavformat (get-lib/quiet (case (system-type 'os)
[(windows) '("avformat-62")]
[else '("avformat" "libavformat")])
(ffmpeg-lib-versions 'avformat)))
private/utils.rkt
+74 -92
View File
@@ -14,6 +14,7 @@
until
build-lib-path
get-lib
get-lib/quiet
linux-lib-versions
ffmpeg-lib-versions
do-for
@@ -189,98 +190,76 @@
[(linux) versions]
[else default]))
(define (version-str kind)
(define (ffmpeg-version-line kind)
(let ((v (hash-ref valid-ffmpeg-versions kind)))
(format " - ~a.so.~a - ~a.so.~a\n" (caddr v) (car v) (caddr v) (cadr v))
)
)
(format " ~a: ~a .. ~a" (caddr v) (car v) (cadr v))))
(define (display-section title lines)
(displayln title)
(for ([line (in-list lines)]) (displayln line))
(newline))
(define (display-command title chunks)
(displayln title)
(displayln " sudo apt install \\")
(let loop ((xs chunks))
(cond [(null? xs) (newline)]
[(null? (cdr xs))
(displayln (format " ~a" (car xs)))
(newline)]
[else
(displayln (format " ~a \\" (car xs)))
(loop (cdr xs))])))
(define linux-runtime-package-lines
'("libflac12 libmpg123-0 libao4"
"libavcodec60 libavutil58 libswresample4 libavformat60"
"libogg0 libopus0 libopusenc0 libopusfile0"
"libsoxr0 libtag1v5"))
(define linux-dev-package-lines
'("libflac-dev libmpg123-dev libao-dev"
"libavcodec-dev libavutil-dev libswresample-dev libavformat-dev"
"libogg-dev libopus-dev libopusenc-dev libopusfile-dev"
"libsoxr-dev libtag1-dev"))
(define brew-package-lines
'("ffmpeg libao mpg123 flac opus"
"libopusenc libsoxr taglib"))
(define (lib-not-found-message orig-libs libs-path)
(displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs libs-path))
(newline)
(displayln "Warning: native library not found")
(newline)
(display-section "Tried library names:"
(for/list ([lib (in-list orig-libs)]) (format " - ~a" lib)))
(display-section "Search paths:"
(for/list ([path (in-list libs-path)]) (format " - ~a" path)))
(let ((st (system-type 'os*)))
(cond ((eq? st 'windows)
(displayln
(format
"\nLibraries for Windows should have been downloaded to\n\n - ~a\n"
(soundlibs-directory))))
((eq? st 'linux)
(displayln
(string-append
"Make sure you have installed the following libraries,\n"
"e.g. on a debian based system with apt:\n"
"\n"
" sudo apt install libflac12 libmpg123-0 libao4 \
"
" libavcodec60 libavutil58 libswresample4 libavformat60 \
"
" libogg0 libopus0 libopusenc0 libopusfile0 libsoxr0 libtag1v5
"
"
"
"For development from source or local FFI rebuilding, install the matching -dev packages,
"
"for example libflac-dev, libmpg123-dev, libao-dev, libavcodec-dev,
"
"libavutil-dev, libswresample-dev, libavformat-dev, libogg-dev,
"
"libopus-dev, libopusenc-dev, libopusfile-dev, libsoxr-dev and libtag1-dev.
"
"
"
)))
((eq? st 'macosx)
(displayln
(string-append
"Make sure you have the right libraries installed, using 'homebrew', see https://brew.sh/\n"
"\n"
" brew install ffmpeg
"
" brew install libao
"
" brew install mpg123
"
" brew install flac
"
" brew install opus
"
" brew install libopusenc
"
" brew install libsoxr
"
" brew install taglib
"
"
"
"If your local setup uses ffmpeg-full instead of ffmpeg, install that variant instead.
"
"
"
)))
(else
(displayln
(string-append
"Make sure you have the right libraries installed on your system and reachable by racket\n"
"\n"
"You need following libraries:\n"
"\n"
"- xiph libao (https://xiph.org).\n"
"- xiph libFLAC (https://xiph.org).\n"
"- ffmpeg of the right version (https://ffmpeg.org).\n"
"- libmpg123 (https://mpg123.org).\n"
"\n")
))
)
(displayln
(string-append "NB. currently supported major versions for the ffmpeg libraries are:\n"
"\n"
(version-str 'avcodec)
(version-str 'avutil)
(version-str 'swresample)
(version-str 'avformat)
"\n"
))
)
)
(cond [(eq? st 'windows)
(display-section "Windows native library directory:"
(list (format " - ~a" (soundlibs-directory))))]
[(eq? st 'linux)
(display-command "Debian/Ubuntu runtime packages:" linux-runtime-package-lines)
(display-command "Debian/Ubuntu development packages, for local FFI rebuilding:" linux-dev-package-lines)]
[(eq? st 'macosx)
(display-command "Homebrew packages:" brew-package-lines)
(displayln "If your local setup uses ffmpeg-full instead of ffmpeg, install that variant instead.")
(newline)]
[else
(display-section "Required native libraries:"
'(" - xiph libao"
" - xiph libFLAC"
" - ffmpeg"
" - libmpg123"
" - libopus/libopusenc/libopusfile"
" - libsoxr"
" - taglib"))])
(display-section "Supported FFmpeg ABI versions:"
(list (ffmpeg-version-line 'avcodec)
(ffmpeg-version-line 'avutil)
(ffmpeg-version-line 'swresample)
(ffmpeg-version-line 'avformat)))))
(define (build-lib-path p)
(if (eq? (system-type 'os) 'macosx)
@@ -288,7 +267,7 @@
(cons (soundlibs-directory) (cons brew-lib p)))
(cons (soundlibs-directory) p)))
(define (get-lib* libs-to-try orig-libs versions)
(define (get-lib* libs-to-try orig-libs versions warn?)
(unless (soundlibs-available?)
(download-soundlibs))
@@ -296,21 +275,24 @@
(let ((libs-path (build-lib-path (get-lib-search-dirs))))
(if (null? libs-to-try)
(begin
(lib-not-found-message orig-libs libs-path)
(when warn? (lib-not-found-message orig-libs libs-path))
#f)
(ffi-lib (car libs-to-try) versions
#:get-lib-dirs (λ () libs-path)
#:fail (λ ()
(ffi-lib (car libs-to-try) versions
#:fail (λ ()
(get-lib* (cdr libs-to-try) orig-libs versions))))
(get-lib* (cdr libs-to-try) orig-libs versions warn?))))
)
)
)
)
(define (get-lib libs-to-try versions)
(get-lib* libs-to-try libs-to-try versions))
(get-lib* libs-to-try libs-to-try versions #t))
(define (get-lib/quiet libs-to-try versions)
(get-lib* libs-to-try libs-to-try versions #f))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
taglib-ffi.rkt
+11 -1
View File
@@ -263,8 +263,18 @@
(when nul? (ptr-set! ptr _byte len 0))
ptr)
(define (string/bytes->malloc-cstring who v)
(define bs
(cond
[(bytes? v) v]
[(string? v) (string->bytes/utf-8 v)]
[(symbol? v) (string->bytes/utf-8 (symbol->string v))]
[(number? v) (string->bytes/utf-8 (number->string v))]
[else (raise-argument-error who "(or/c string? bytes? symbol? number?)" v)]))
(bytes->malloc-ptr bs #t))
(define (string->malloc-cstring s)
(bytes->malloc-ptr (string->bytes/utf-8 s) #t))
(string/bytes->malloc-cstring 'string->malloc-cstring s))
(define (picture->complex-property data size description mimetype picture-type)
(define data-ptr (bytes->malloc-ptr data #f))
taglib.rkt
+32 -1
View File
@@ -125,13 +125,44 @@
(error 'make-tags-picture-from-bitmap "could not encode bitmap as ~a" mimetype))
(get-output-bytes out))
(define picture-type-names
(hash 0 "Other"
1 "File Icon"
2 "Other File Icon"
3 "Front Cover"
4 "Back Cover"
5 "Leaflet Page"
6 "Media"
7 "Lead Artist"
8 "Artist"
9 "Conductor"
10 "Band"
11 "Composer"
12 "Lyricist"
13 "Recording Location"
14 "During Recording"
15 "During Performance"
16 "Movie Screen Capture"
17 "Coloured Fish"
18 "Illustration"
19 "Band Logo"
20 "Publisher Logo"))
(define (picture-kind->string kind)
(cond
[(string? kind) kind]
[(symbol? kind) (string-titlecase (regexp-replace* #rx"-" (symbol->string kind) " "))]
[(integer? kind) (hash-ref picture-type-names kind (number->string kind))]
[else (raise-argument-error 'make-tags-picture "(or/c string? symbol? integer?)" kind)]))
(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))
(make-id3-picture mimetype (picture-kind->string 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))