From e1390a205b5b2258fe6dda58d41cbd8f9f6c3f4d Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Tue, 7 Apr 2026 13:46:34 +0200 Subject: [PATCH] - --- play-test.rkt | 4 +- private/downloader.rkt | 165 +++++++++++++++++++++++++++++++++++++++++ private/utils.rkt | 15 ++-- taglib-ffi.rkt | 3 +- 4 files changed, 174 insertions(+), 13 deletions(-) create mode 100644 private/downloader.rkt diff --git a/play-test.rkt b/play-test.rkt index 04a0c92..aa7e7f7 100644 --- a/play-test.rkt +++ b/play-test.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require "libao/libao.rkt" - "libflac/flac-decoder.rkt" +(require "libao.rkt" + "flac-decoder.rkt" ;data/queue ;racket-sound ) diff --git a/private/downloader.rkt b/private/downloader.rkt new file mode 100644 index 0000000..45e5d65 --- /dev/null +++ b/private/downloader.rkt @@ -0,0 +1,165 @@ +#lang racket/base + +(require setup/dirs + net/sendurl + net/url + net/url-connect + net/dns + racket/file + racket/system + racket/string + file/unzip + ) + +(provide download-soundlibs + soundlibs-version + soundlibs-directory + soundlibs-available? + soundlibs-downloadable? + soundlibs-resolves? + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Version info of the version to download +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define version-major 0) +(define version-minor 1) +(define version-patch 0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Internal functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define download-version (format "~a-~a-~a" + version-major + version-minor + version-patch + )) + +(define download-site "git.dijkewijk.nl") +(define base-path "hans/racket-sound-lib/releases/download") +(define os (system-type 'os*)) +(define arch (system-type 'arch)) + +(define download-url (format "https://~a/~a/~a/~a-~a.zip" + download-site + base-path + download-version + os + arch)) + +(define install-path (build-path (find-system-path 'addon-dir) "racket-sound-lib")) +(define version-file (build-path install-path "version.txt")) +(define ffi-path (build-path install-path (format "~a-~a" os arch))) + +(define (download-port link) + (let ((current-https-prot (current-https-protocol))) + (current-https-protocol 'secure) + (let* ((url (string->url link)) + (port-in (get-pure-port url #:redirections 10))) + (current-https-protocol current-https-prot) + port-in))) + + +(define (do-download port-in port-out) + (letrec ((downloader-func (λ (count next-c len) + (let ((bytes (read-bytes 16384 port-in))) + (if (eof-object? bytes) + count + (let ((read-len (bytes-length bytes))) + (when (> read-len 0) + (set! count (+ count read-len)) + (when (> count next-c) + (display (format "~a..." count)) + (set! next-c (+ count len))) + (write-bytes bytes port-out) + ) + (downloader-func count next-c len))))) + )) + (let ((count (downloader-func 0 100000 100000))) + (displayln (format "~a downloaded" count)) + (close-input-port port-in) + (close-output-port port-out) + count) + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Provided functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (soundlibs-available?) + (if (file-exists? version-file) + (with-handlers ([exn:fail? (λ (e) #f)]) + (let ((v (file->value version-file))) + (and + (= (car v) version-major) + (= (cadr v) version-minor) + (= (caddr v) version-patch))) + ) + #f)) + +(define (soundlibs-directory) + (if (soundlibs-available?) + (build-path install-path (format "~a-~a" os arch)) + #f)) + +(define (soundlibs-resolves?) + (if (eq? (dns-find-nameserver) #f) + #f + (with-handlers ([exn:fail? (λ (e) #f)]) + (dns-get-address (dns-find-nameserver) download-site) + #t) + ) + ) + +(define (soundlibs-version) + (if (soundlibs-available?) + (file->value version-file) + #f)) + +(define (soundlibs-downloadable?) + (with-handlers ([exn:fail? (λ (e) #f)]) + (let ((in (download-port download-url))) + (let ((d (input-port? in))) + (when d + (close-input-port in)) + d)))) + +(define (download-soundlibs) + (let ((in (download-port download-url))) + (unless (input-port? in) + (error (format "Cannot get a download port for '~a'" download-url))) + (unless (directory-exists? install-path) + (make-directory* install-path)) + (let* ((file (build-path install-path "archive.zip")) + (out (open-output-file file #:exists 'replace)) + ) + (displayln (format "Downloading racket-webview-qt (~a)..." download-url)) + (do-download in out) + (displayln (format "downloaded '~a'" file)) + (when (directory-exists? ffi-path) + (displayln (format "Removing existing directory '~a'" ffi-path)) + (delete-directory/files ffi-path)) + (displayln "Unzipping...") + (let ((cd (current-directory))) + (current-directory install-path) + (unzip file #:preserve-attributes? #t #:preserve-timestamps? #t) + (current-directory cd)) + (displayln "Removing zip archive") + (delete-file file) + (displayln "Writing version") + (let ((version (list version-major + version-minor + version-patch + ))) + (let ((out (open-output-file version-file #:exists 'replace))) + (write version out) + (close-output-port out))) + (displayln "Version file written; ready for FFI integration") + #t + ) + ) + ) diff --git a/private/utils.rkt b/private/utils.rkt index 67b1b1e..dbe2955 100644 --- a/private/utils.rkt +++ b/private/utils.rkt @@ -4,6 +4,7 @@ racket/runtime-path ffi/unsafe setup/dirs + "downloader.rkt" ) (provide while @@ -55,18 +56,12 @@ (do-for-f)))))) - (define-runtime-path lib-path "..") - (define (build-lib-path) - (let ((os-type (system-type 'os*))) - (if (eq? os-type 'windows) - (build-path lib-path "lib" "dll") - (let* ((arch (symbol->string (system-type 'arch))) - (subdir (string-append (symbol->string os-type) "-" arch))) - (let ((path (build-path lib-path "lib" subdir))) - path))))) + (soundlibs-directory)) (define (get-lib* libs-to-try orig-libs versions) + (unless (soundlibs-available?) + (download-soundlibs)) (if (null? libs-to-try) (error (format "Cannot find library, tried ~a" orig-libs)) (ffi-lib (car libs-to-try) versions @@ -77,4 +72,4 @@ (define (get-lib libs-to-try versions) (get-lib* libs-to-try libs-to-try versions)) - ) ; end of module +) ; end of module diff --git a/taglib-ffi.rkt b/taglib-ffi.rkt index 81be431..ba9bd7f 100644 --- a/taglib-ffi.rkt +++ b/taglib-ffi.rkt @@ -3,6 +3,7 @@ (require ffi/unsafe ffi/unsafe/define "private/utils.rkt" + "private/downloader.rkt" ) (provide TagLib_File_Type @@ -64,7 +65,7 @@ ; #:fail (λ () ; (error (format "Cannot find library ~a" l))) ; )) - + (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)