gemigreerd-racket-audio/private/utils.rkt

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

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Create log definitions
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (sl-def-log racket-sound sound)

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