127 lines
4.3 KiB
Racket
127 lines
4.3 KiB
Racket
(module utils racket/base
|
|
|
|
(require racket/path
|
|
racket/runtime-path
|
|
ffi/unsafe
|
|
setup/dirs
|
|
"downloader.rkt"
|
|
simple-log
|
|
)
|
|
|
|
(provide while
|
|
until
|
|
build-lib-path
|
|
get-lib
|
|
do-for
|
|
dbg-sound
|
|
info-sound
|
|
err-sound
|
|
warn-sound
|
|
fatal-sound
|
|
sync-log-sound
|
|
integer->int-bytes
|
|
int-bytes->integer
|
|
)
|
|
|
|
(sl-def-log racket-sound sound)
|
|
|
|
(define-syntax while
|
|
(syntax-rules ()
|
|
((_ cond body ...)
|
|
(letrec ((while-f (lambda (last-result)
|
|
(if cond
|
|
(let ((last-result (begin
|
|
body
|
|
...)))
|
|
(while-f last-result))
|
|
last-result))))
|
|
(while-f #f))
|
|
)
|
|
))
|
|
|
|
(define-syntax until
|
|
(syntax-rules ()
|
|
((_ cond body ...)
|
|
(letrec ((until-f (lambda (last-result)
|
|
(if cond
|
|
last-result
|
|
(let ((last-reult (begin
|
|
body
|
|
...)))
|
|
(until-f last-result))))))
|
|
(until-f #f)))))
|
|
|
|
(define-syntax do-for
|
|
(syntax-rules ()
|
|
((_ (init cond next) body ...)
|
|
(begin
|
|
init
|
|
(letrec ((do-for-f (lamba ()
|
|
(if cond
|
|
(begin
|
|
(begin
|
|
body
|
|
...)
|
|
next
|
|
(do-for-f))))))
|
|
(do-for-f))))))
|
|
|
|
|
|
(define (build-lib-path)
|
|
(soundlibs-directory))
|
|
|
|
(define (get-lib* libs-to-try orig-libs versions)
|
|
(let ((libs-path (cons (build-lib-path) (get-lib-search-dirs))))
|
|
(unless (soundlibs-available?)
|
|
(download-soundlibs))
|
|
(if (null? libs-to-try)
|
|
(begin
|
|
(displayln (format "Warning: Cannot find library, tried ~a in ~a" 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))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (get-lib libs-to-try versions)
|
|
(get-lib* libs-to-try libs-to-try versions))
|
|
|
|
(define-syntax-rule (integer->int-bytes v size signed? big? bs pos)
|
|
(if (= size 3)
|
|
(if big?
|
|
(begin
|
|
(bytes-set! bs pos (bitwise-and (arithmetic-shift v -16) #xff))
|
|
(bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8) #xff))
|
|
(bytes-set! bs (+ pos 2) (bitwise-and v #xff)))
|
|
(begin
|
|
(bytes-set! bs pos (bitwise-and v #xff))
|
|
(bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8) #xff))
|
|
(bytes-set! bs (+ pos 2) (bitwise-and (arithmetic-shift v -16) #xff))))
|
|
(integer->integer-bytes v size signed? big? bs pos)))
|
|
|
|
(define-syntax-rule (int-bytes->integer bs signed? big? start end)
|
|
(let ([size (- end start)])
|
|
(if (= size 3)
|
|
(let* ([b0 (bytes-ref bs start)]
|
|
[b1 (bytes-ref bs (+ start 1))]
|
|
[b2 (bytes-ref bs (+ start 2))]
|
|
[u (if big?
|
|
(bitwise-ior (arithmetic-shift b0 16)
|
|
(arithmetic-shift b1 8)
|
|
b2)
|
|
(bitwise-ior b0
|
|
(arithmetic-shift b1 8)
|
|
(arithmetic-shift b2 16)))])
|
|
(if (and signed? (not (zero? (bitwise-and u #x800000))))
|
|
(- u #x1000000)
|
|
u))
|
|
(integer-bytes->integer bs signed? big? start end))))
|
|
|
|
) ; end of module
|