(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 valid-ffmpeg-versions make-mutex mutex-lock mutex-unlock with-mutex ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Create log definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (sl-def-log racket-sound sound) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mutex definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (make-mutex) (make-semaphore 1)) (define (mutex-lock m) (semaphore-wait m)) (define (mutex-unlock m) (semaphore-post m)) (define-syntax with-mutex (syntax-rules () ((_ m b1 ...) (begin (semaphore-wait m) (let ((r (begin b1 ...))) (semaphore-post m) r))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Provide some loop constructions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Loading libraries ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define valid-ffmpeg-versions (make-hash (list (list 'avutil 58 60 "libavcodec") (list 'avcodec 60 62 "libavutil") (list 'avformat 60 62 "libswresample") (list 'swresample 4 6 "libavformat") )) ) (define (version-str kind) (let ((v (hash-ref valid-ffmpeg-versions kind))) (format " - ~a~a - ~a~a\n" (caddr v) (car v) (caddr v) (cadr v)) ) ) (define (lib-not-found-message orig-libs libs-path) (displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs libs-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" " FLAC : sudo apt install libflac12\n" " mpg123 : libmpg123-0\n" " libao : libao4\n" " ffmpeg : libavcodec60 libavutil58 libswresample4 libavformat60\n" "\n" ))) ((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-full\n" " brew install libao\n" " brew install mpg123\n" " brew install flac\n" "\n" ))) (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) (let ((brew-lib "/opt/homebrew/lib")) (cons (soundlibs-directory) (cons brew-lib p))) (cons (soundlibs-directory) p))) (define (get-lib* libs-to-try orig-libs versions) (unless (soundlibs-available?) (download-soundlibs)) (let ((libs-path (build-lib-path (get-lib-search-dirs)))) (if (null? libs-to-try) (begin (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)))) ) ) ) ) (define (get-lib libs-to-try versions) (get-lib* libs-to-try libs-to-try versions)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; integer->int-bytes and vise versa. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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