#lang racket/base

(require "audio-encoder.rkt"
         "tests.rkt"
         simple-log
         racket/cmdline
         racket/file
         racket/path
         racket/string)

(provide encoder-test
         encoder-test-opus
         encoder-test-flac)

(define (setting-value v)
  (cond ((or (eq? v #f) (eq? v 'source)) 'source)
        ((string? v)
         (let ((s (string-downcase v)))
           (if (string=? s "source")
               'source
               (let ((n (string->number v)))
                 (if n n (raise-argument-error 'encoder-test "number or source" v))))))
        (else v)))

(define (encoder-symbol v)
  (cond ((symbol? v) v)
        ((string? v) (string->symbol (string-downcase v)))
        (else (raise-argument-error 'encoder-test "encoder name" v))))

(define (default-output-file encoder)
  (build-path (find-system-path 'temp-dir)
              (format "racket-audio-encoder-test.~a"
                      (case encoder
                        ((opus) "opus")
                        ((flac) "flac")
                        (else (raise-argument-error 'encoder-test "opus or flac" encoder))))))

(define (opus-settings bitrate-kbps sample-rate)
  (if (eq? sample-rate 'source)
      (hash 'bitrate (* bitrate-kbps 1000)
            'vbr? #t
            'complexity 10)
      (hash 'bitrate (* bitrate-kbps 1000)
            'vbr? #t
            'complexity 10
            'sample-rate sample-rate)))

(define (flac-settings compression-level sample-rate bits-per-sample)
  (let ((h (make-hash)))
    (hash-set! h 'compression-level compression-level)
    (unless (eq? sample-rate 'source) (hash-set! h 'sample-rate sample-rate))
    (unless (eq? bits-per-sample 'source) (hash-set! h 'bits-per-sample bits-per-sample))
    h))

(define (format-summary fmt)
  (if (hash? fmt)
      (format "rate=~a, channels=~a, bits=~a, frames=~a"
              (hash-ref fmt 'sample-rate "?")
              (hash-ref fmt 'channels "?")
              (hash-ref fmt 'bits-per-sample "?")
              (hash-ref fmt 'total-frames (hash-ref fmt 'total-samples "?")))
      "unknown"))

(define (tag-summary tag-copy)
  (if (hash? tag-copy)
      (format "method=~a, success=~a, picture=~a~a"
              (hash-ref tag-copy 'method "?")
              (hash-ref tag-copy 'success? "?")
              (hash-ref tag-copy 'picture? #f)
              (let ((size (hash-ref tag-copy 'picture-size #f))
                    (mt (hash-ref tag-copy 'picture-mimetype #f)))
                (if size (format ", ~a bytes, ~a" size mt) "")))
      "unknown"))

(define (display-result result)
  (displayln "")
  (displayln "Encoder result")
  (displayln "--------------")
  (displayln (format "encoder        : ~a" (hash-ref result 'encoder '?)))
  (displayln (format "input          : ~a" (hash-ref result 'input '?)))
  (displayln (format "output         : ~a" (hash-ref result 'output '?)))
  (displayln (format "frames read    : ~a" (hash-ref result 'frames-read '?)))
  (displayln (format "frames written : ~a" (hash-ref result 'frames-written '?)))
  (displayln (format "input format   : ~a" (format-summary (hash-ref result 'input-format #f))))
  (displayln (format "output format  : ~a" (format-summary (hash-ref result 'output-format #f))))
  (displayln (format "tag copy       : ~a" (tag-summary (hash-ref result 'tag-copy #f))))
  result)

(define (make-progress-callback)
  (define last-pct -1)
  (lambda (h)
    (let ((p (hash-ref h 'progress #f)))
      (when (number? p)
        (let ((pct (inexact->exact (round (* 100 p)))))
          (when (not (= pct last-pct))
            (set! last-pct pct)
            (printf "\rprogress : ~a%" pct)
            (flush-output))
          (when (or (>= pct 100) (eq? (hash-ref h 'phase #f) 'finished))
            (newline)))))))

(define (encoder-test input-file output-file encoder settings #:copy-tags? [copy-tags? #t])
  (let* ((enc (encoder-symbol encoder))
         (out (if output-file output-file (default-output-file enc))))
    (when (file-exists? out) (delete-file out))
    (displayln (format "Encoding ~a" input-file))
    (displayln (format "      -> ~a" out))
    (displayln (format "encoder : ~a" enc))
    (displayln (format "settings: ~a" settings))
    (display-result (audio-encode input-file out settings
                                  #:encoder enc
                                  #:copy-tags? copy-tags?
                                  #:progress-callback (make-progress-callback)))))

(define (encoder-test-opus [input-file test-file3]
                           [output-file #f]
                           #:bitrate-kbps [bitrate-kbps 160]
                           #:sample-rate [sample-rate 'source]
                           #:copy-tags? [copy-tags? #t])
  (encoder-test input-file output-file 'opus
                (opus-settings bitrate-kbps (setting-value sample-rate))
                #:copy-tags? copy-tags?))

(define (encoder-test-flac [input-file test-file3]
                           [output-file #f]
                           #:compression-level [compression-level 8]
                           #:sample-rate [sample-rate 'source]
                           #:bits-per-sample [bits-per-sample 'source]
                           #:copy-tags? [copy-tags? #t])
  (encoder-test input-file output-file 'flac
                (flac-settings compression-level
                               (setting-value sample-rate)
                               (setting-value bits-per-sample))
                #:copy-tags? copy-tags?))

(module+ main
  (sl-log-to-display)

  (define encoder 'opus)
  (define input-file test-file3)
  (define output-file #f)
  (define copy-tags? #t)
  (define bitrate-kbps 160)
  (define compression-level 8)
  (define sample-rate 'source)
  (define bits-per-sample 'source)

  (command-line
   #:program "encoder-test.rkt"
   #:once-each
   (("-e" "--encoder") e "Encoder: opus or flac. Default: opus."
    (set! encoder (encoder-symbol e)))
   (("-i" "--input") f "Input audio file. Default: tests.rkt test-file3."
    (set! input-file f))
   (("-o" "--output") f "Output audio file. Default: temp test file."
    (set! output-file f))
   (("--sample-rate") r "Target sample rate, e.g. 48000, or source. Default: source."
    (set! sample-rate (setting-value r)))
   (("--bits-per-sample") b "Target FLAC bits per sample, e.g. 16/24, or source. Default: source."
    (set! bits-per-sample (setting-value b)))
   (("--bitrate-kbps") b "Opus bitrate in kbps. Default: 160."
    (set! bitrate-kbps (or (string->number b)
                           (raise-argument-error 'encoder-test "number" b))))
   (("--compression-level") n "FLAC compression level. Default: 8."
    (set! compression-level (or (string->number n)
                                (raise-argument-error 'encoder-test "number" n))))
   (("--no-tags") "Do not copy tags/pictures to the output file."
    (set! copy-tags? #f))
   #:args rest
   (cond ((null? rest) (void))
         ((null? (cdr rest)) (set! input-file (car rest)))
         ((null? (cddr rest)) (set! input-file (car rest)) (set! output-file (cadr rest)))
         (else (raise-user-error 'encoder-test "too many positional arguments: ~a" rest))))

  (case encoder
    ((opus)
     (encoder-test-opus input-file output-file
                        #:bitrate-kbps bitrate-kbps
                        #:sample-rate sample-rate
                        #:copy-tags? copy-tags?))
    ((flac)
     (encoder-test-flac input-file output-file
                        #:compression-level compression-level
                        #:sample-rate sample-rate
                        #:bits-per-sample bits-per-sample
                        #:copy-tags? copy-tags?))
    (else (raise-argument-error 'encoder-test "opus or flac" encoder))))