(module utils racket/base

  (require racket/path
           racket/file
           racket/runtime-path
           racket/system
           ffi/unsafe
           setup/dirs
           "downloader.rkt"
           simple-log
           )
  
  (provide while
           until
           build-lib-path
           get-lib
           get-lib/quiet
           linux-lib-versions
           ffmpeg-lib-versions
           do-for
           dbg-sound
           info-sound
           err-sound
           warn-sound
           fatal-sound
           sync-log-sound
           racket-sound-cache-directory
           racket-sound-log-file
           open-racket-sound-log-file
           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)



  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Standard cache/log paths
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (racket-sound-cache-directory)
    (build-path (find-system-path 'cache-dir) "racket-audio"))

  (define (racket-sound-log-file name)
    (define filename
      (cond [(symbol? name) (format "~a.log" name)]
            [(string? name) name]
            [else (raise-argument-error 'racket-sound-log-file "(or/c symbol? string?)" name)]))
    (build-path (racket-sound-cache-directory) filename))

  (define (open-racket-sound-log-file path #:exists [exists 'append])
    (define parent (path-only (path->complete-path path)))
    (when parent (make-directory* parent))
    (open-output-file path #:exists exists))




  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Mutex definitions
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define-struct mutex
    (thread count mut own) #:mutable)

  (define make-mutex-struct make-mutex)
  
  (set! make-mutex (λ ()
                     (make-mutex-struct #f 0 (make-semaphore 1) (make-semaphore 1))))

  (define (mutex-lock m)
    (semaphore-wait (mutex-own m))
    (if (eq? (mutex-thread m) (current-thread))
        (begin
          (set-mutex-count! m (+ (mutex-count m) 1))
          (semaphore-post (mutex-own m))
          )
        (begin
          (semaphore-post (mutex-own m))
          (semaphore-wait (mutex-mut m))
          (set-mutex-count! m 1)
          (set-mutex-thread! m (current-thread)))
        )
    )

  (define (mutex-unlock m)
    (semaphore-wait (mutex-own m))
    (let ((count (mutex-count m)))
      (set! count (- count 1))
      (set-mutex-count! m count)
      (if (= count 0)
          (begin
            (set-mutex-thread! m #f)
            (semaphore-post (mutex-own m))
            (semaphore-post (mutex-mut m)))
          (semaphore-post (mutex-own m)))
      )
    )

  (define-syntax with-mutex
    (syntax-rules ()
      ((_ m b1 ...)
       (begin
         (dynamic-wind
          (λ () (mutex-lock m))
          (λ () b1 ...)
          (λ () (mutex-unlock m)))))))


  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; 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 "libavutil")
                     (list 'avcodec 60 62 "libavcodec")
                     (list 'avformat 60 62 "libavformat")
                     (list 'swresample 4 6 "libswresample"))))

  (define (versions-high-to-low from until)
    (let loop ((n from) (acc '(#f)))
      (if (> n until)
          acc
          (loop (+ n 1) (cons (number->string n) acc)))))

  (define (ffmpeg-lib-versions kind)
    (case (system-type 'os*)
      [(linux)
       (let ((v (hash-ref valid-ffmpeg-versions kind)))
         (versions-high-to-low (car v) (cadr v)))]
      [else '(#f)]))

  (define (linux-lib-versions versions [default '(#f)])
    (case (system-type 'os*)
      [(linux) versions]
      [else default]))

  (define (ffmpeg-version-line kind)
    (let ((v (hash-ref valid-ffmpeg-versions kind)))
      (format "  ~a: ~a .. ~a" (caddr v) (car v) (cadr v))))

  (define (display-section title lines)
    (displayln title)
    (for ([line (in-list lines)]) (displayln line))
    (newline))

  (define (display-command title chunks)
    (displayln title)
    (displayln "  sudo apt install \\")
    (let loop ((xs chunks))
      (cond [(null? xs) (newline)]
            [(null? (cdr xs))
             (displayln (format "    ~a" (car xs)))
             (newline)]
            [else
             (displayln (format "    ~a \\" (car xs)))
             (loop (cdr xs))])))

  (define linux-runtime-package-lines
    '("libflac12 libmpg123-0 libao4"
      "libavcodec60 libavutil58 libswresample4 libavformat60"
      "libogg0 libopus0 libopusenc0 libopusfile0"
      "libsoxr0 libtag1v5"))

  (define linux-dev-package-lines
    '("libflac-dev libmpg123-dev libao-dev"
      "libavcodec-dev libavutil-dev libswresample-dev libavformat-dev"
      "libogg-dev libopus-dev libopusenc-dev libopusfile-dev"
      "libsoxr-dev libtag1-dev"))

  (define brew-package-lines
    '("ffmpeg libao mpg123 flac opus"
      "libopusenc libsoxr taglib"))

  (define (lib-not-found-message orig-libs libs-path)
    (newline)
    (displayln "Warning: native library not found")
    (newline)
    (display-section "Tried library names:"
                     (for/list ([lib (in-list orig-libs)]) (format "  - ~a" lib)))
    (display-section "Search paths:"
                     (for/list ([path (in-list libs-path)]) (format "  - ~a" path)))
    (let ((st (system-type 'os*)))
      (cond [(eq? st 'windows)
             (display-section "Windows native library directory:"
                              (list (format "  - ~a" (soundlibs-directory))))]
            [(eq? st 'linux)
             (display-command "Debian/Ubuntu runtime packages:" linux-runtime-package-lines)
             (display-command "Debian/Ubuntu development packages, for local FFI rebuilding:" linux-dev-package-lines)]
            [(eq? st 'macosx)
             (display-command "Homebrew packages:" brew-package-lines)
             (displayln "If your local setup uses ffmpeg-full instead of ffmpeg, install that variant instead.")
             (newline)]
            [else
             (display-section "Required native libraries:"
                              '("  - xiph libao"
                                "  - xiph libFLAC"
                                "  - ffmpeg"
                                "  - libmpg123"
                                "  - libopus/libopusenc/libopusfile"
                                "  - libsoxr"
                                "  - taglib"))])
      (display-section "Supported FFmpeg ABI versions:"
                       (list (ffmpeg-version-line 'avcodec)
                             (ffmpeg-version-line 'avutil)
                             (ffmpeg-version-line 'swresample)
                             (ffmpeg-version-line 'avformat)))))

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

    (unless (soundlibs-available?)
      (download-soundlibs))

    (let ((libs-path (build-lib-path (get-lib-search-dirs))))
      (if (null? libs-to-try)
          (begin
            (when warn? (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 warn?))))
                   )
          )
      )
    )

  (define (get-lib libs-to-try versions)
    (get-lib* libs-to-try libs-to-try versions #t))

  (define (get-lib/quiet libs-to-try versions)
    (get-lib* libs-to-try libs-to-try versions #f))


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