-
This commit is contained in:
@@ -1,6 +1,6 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require "libao/libao.rkt"
|
(require "libao.rkt"
|
||||||
"libflac/flac-decoder.rkt"
|
"flac-decoder.rkt"
|
||||||
;data/queue
|
;data/queue
|
||||||
;racket-sound
|
;racket-sound
|
||||||
)
|
)
|
||||||
|
|||||||
165
private/downloader.rkt
Normal file
165
private/downloader.rkt
Normal file
@@ -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
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
@@ -4,6 +4,7 @@
|
|||||||
racket/runtime-path
|
racket/runtime-path
|
||||||
ffi/unsafe
|
ffi/unsafe
|
||||||
setup/dirs
|
setup/dirs
|
||||||
|
"downloader.rkt"
|
||||||
)
|
)
|
||||||
|
|
||||||
(provide while
|
(provide while
|
||||||
@@ -55,18 +56,12 @@
|
|||||||
(do-for-f))))))
|
(do-for-f))))))
|
||||||
|
|
||||||
|
|
||||||
(define-runtime-path lib-path "..")
|
|
||||||
|
|
||||||
(define (build-lib-path)
|
(define (build-lib-path)
|
||||||
(let ((os-type (system-type 'os*)))
|
(soundlibs-directory))
|
||||||
(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)))))
|
|
||||||
|
|
||||||
(define (get-lib* libs-to-try orig-libs versions)
|
(define (get-lib* libs-to-try orig-libs versions)
|
||||||
|
(unless (soundlibs-available?)
|
||||||
|
(download-soundlibs))
|
||||||
(if (null? libs-to-try)
|
(if (null? libs-to-try)
|
||||||
(error (format "Cannot find library, tried ~a" orig-libs))
|
(error (format "Cannot find library, tried ~a" orig-libs))
|
||||||
(ffi-lib (car libs-to-try) versions
|
(ffi-lib (car libs-to-try) versions
|
||||||
|
|||||||
@@ -3,6 +3,7 @@
|
|||||||
(require ffi/unsafe
|
(require ffi/unsafe
|
||||||
ffi/unsafe/define
|
ffi/unsafe/define
|
||||||
"private/utils.rkt"
|
"private/utils.rkt"
|
||||||
|
"private/downloader.rkt"
|
||||||
)
|
)
|
||||||
|
|
||||||
(provide TagLib_File_Type
|
(provide TagLib_File_Type
|
||||||
|
|||||||
Reference in New Issue
Block a user