small bugs.

ffmpeg-definitions.rkt

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

@@ -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)
+      (cond [(eq? st 'windows)
-             (displayln
+             (display-section "Windows native library directory:"
-              (format
+                              (list (format "  - ~a" (soundlibs-directory))))]
-               "\nLibraries for Windows should have been downloaded to\n\n  - ~a\n"
+            [(eq? st 'linux)
-               (soundlibs-directory))))
+             (display-command "Debian/Ubuntu runtime packages:" linux-runtime-package-lines)
-            ((eq? st 'linux)
+             (display-command "Debian/Ubuntu development packages, for local FFI rebuilding:" linux-dev-package-lines)]
-             (displayln
+            [(eq? st 'macosx)
-               (string-append
+             (display-command "Homebrew packages:" brew-package-lines)
-                "Make sure you have installed the following libraries,\n"
+             (displayln "If your local setup uses ffmpeg-full instead of ffmpeg, install that variant instead.")
-                "e.g. on a debian based system with apt:\n"
+             (newline)]
-                "\n"
+            [else
-                "  sudo apt install libflac12 libmpg123-0 libao4 \
+             (display-section "Required native libraries:"
-"
+                              '("  - xiph libao"
-                "                   libavcodec60 libavutil58 libswresample4 libavformat60 \
+                                "  - xiph libFLAC"
-"
+                                "  - ffmpeg"
-                "                   libogg0 libopus0 libopusenc0 libopusfile0 libsoxr0 libtag1v5
+                                "  - libmpg123"
-"
+                                "  - libopus/libopusenc/libopusfile"
-                "
+                                "  - libsoxr"
-"
+                                "  - taglib"))])
-                "For development from source or local FFI rebuilding, install the matching -dev packages,
+      (display-section "Supported FFmpeg ABI versions:"
-"
+                       (list (ffmpeg-version-line 'avcodec)
-                "for example libflac-dev, libmpg123-dev, libao-dev, libavcodec-dev,
+                             (ffmpeg-version-line 'avutil)
-"
+                             (ffmpeg-version-line 'swresample)
-                "libavutil-dev, libswresample-dev, libavformat-dev, libogg-dev,
+                             (ffmpeg-version-line 'avformat)))))
-"
-                "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"
-                      ))
-      )
-    )
 
   (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

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

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