#lang racket/base

(require racket/place
         racket/contract
         racket/async-channel
         racket/runtime-path
         racket/string
         "audio-errors.rkt"
         uni-channel
         "audio-placed-player.rkt"
         "opusfile-decoder.rkt"
         "private/utils.rkt"
         "private/remote-utils.rkt"
         (prefix-in ffi: ffi/unsafe)
         )

(provide make-audio-player
         audio-play!
         audio-pause!
         audio-paused?
         audio-stop!
         audio-quit!
         audio-seek!
         audio-volume!
         audio-volume
         audio-at-second
         audio-duration
         audio-state
         audio-bits
         audio-channels
         audio-decoder
         audio-music-id
         audio-rate
         audio-full-state
         audio-file
         audio-play?
         audio-buf-seconds!
         audio-ao-buf-ms!
         audio-ao-buf-ms
         audio-known-exts?
         audio-parameterize!
         audio-param!
         audio-param
         replace-base-path
         )

(define-runtime-path placed-player-module "audio-placed-player.rkt")


(define-struct audio-play
  (valid? cb-state cb-eof-stream rpc au-place evt-thread state replace-base-paths)
  #:mutable
  #:transparent
  )

(define audio-play-struct? audio-play?)
(set! audio-play? (λ (h)
                    (and (audio-play-struct? h)
                         (audio-play-valid? h))))


(define (percentage? p)
  (and (number? p) (>= p 0)))

(define (any? x)
  #t)

(define (max-percentage? n)
  (λ (p) (and (percentage? p)
              (<= p n))))

(define (is-return? retval sym)
  ;(displayln retval)
  (if (list? retval)
      (if (null? retval)
          #f
          (eq? (car retval) sym))
      #f))

(define-struct internal-audio-retval
  (kind code info retval)
  #:transparent
  )

(define (to-ret-value ret)
  (displayln ret)
  (if (list? ret)
      (if (null? ret)
          (raise-audio-error 'audio-error "audio-player: no return value, empty list returned")
          (let ((r (car ret)))
            (displayln ret)
            (if (eq? r 'error)
              (let ((code (cadr ret))
                    (msg (caddr ret)))
                (err-sound "Got an error: ~a - ~a" code msg)
                (make-internal-audio-retval 'error code msg 'error))
              (make-internal-audio-retval 'retval #f #f r))))
      (if (eq? ret 'error)
        (make-internal-audio-retval 'error 'audio-error "An undefined error was raised in the audio-player" 'error)
        (make-internal-audio-retval 'retval #f #f ret))))

(define (is-event? evt sym)
  (is-return? evt sym))

(define (evt-data evt)
  (cadr evt))

(define (correct-to-os-path h replacements)
  (let ((file (hash-ref h 'file #f)))
    (letrec ((f (λ (l fl)
                  (if (null? l)
                      fl
                      (let ((bp-remote (cdar l))
                            (bp-local (caar l)))
                        (f (cdr l) (string-replace fl bp-remote bp-local)))))))
      (unless (eq? file #f)
        (let* ((delim (if (eq? (system-type 'os) 'windows) "\\" "/"))
               (file* (string-replace
                       (string-replace
                        (f replacements (format "~a" file)) "/" delim)
                       "\\" delim)))
          (hash-set! h 'file (build-path file*))))
    h)))

(define-syntax assert
  (syntax-rules ()
    ((_ cond message ...)
     (unless cond (error (format message ...))))))

(define/contract (make-audio-player cb-state cb-eof-stream
                                    #:use-place [use-place (place-enabled?)]
                                    #:remote-host [remote-host #f]
                                    #:replace-base-paths [replace-base-paths '()])
  (->* (procedure? procedure?)
       (#:use-place boolean?
        #:remote-host (or/c #f string?)
        #:replace-base-paths replace-base-paths?)
       audio-play?)
  (let ((cmd-ch #f)
        (ret-ch #f)
        (evt-ch #f)
        (cmd-put #f)
        (ret-get #f)
        (evt-get #f)
        (au-pl #f)
        (dead-guard #f)
        (rpc #f)
        (rpc-mutex (make-mutex))
        )
    (cond
      [remote-host
       ;; Remote mode is deliberately narrow: make-audio-player only needs
       ;; a host and optional base-path replacements.  SSH, Racket and module
       ;; details are encapsulated in private/remote-utils.rkt and its config.
       (let-values (((cmd-ch* ret-ch* evt-ch* proc dead-guard*)
                     (start-remote-placed-player remote-host)))
         (set! cmd-ch cmd-ch*)
         (set! ret-ch ret-ch*)
         (set! evt-ch evt-ch*)
         (set! au-pl proc)
         (set! dead-guard dead-guard*))]
      [use-place
       ;; dynamic-place returns the command place-channel.  The raw channel
       ;; is kept for place-dead-evt, while normal traffic is sent through
       ;; a uni-channel wrapper.
       (let ((raw-cmd-ch (dynamic-place placed-player-module 'placed-player)))
         (set! cmd-ch (make-uni-channel raw-cmd-ch))
         (set! au-pl raw-cmd-ch)
         (set! dead-guard (lambda () (let ((evt (place-dead-evt au-pl)))
                                       (sync evt))))
         (let-values (((ret-ch-in ret-ch-out) (place-channel))
                      ((evt-ch-in evt-ch-out) (place-channel)))
           ;; Do not send uni-channel structs through a place-channel: they
           ;; contain procedures and are not place-message values.  Send the
           ;; raw channels and let the worker wrap them on its own side.
           (set! ret-ch (make-uni-channel ret-ch-in))
           (set! evt-ch (make-uni-channel evt-ch-in))
           (uni-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out))
           (assert (is-return? (uni-channel-get ret-ch) 'initialized)
                   "Unexpected: not 'initialized returned from 'init command")))]
      [else
       (let ((raw-cmd-ch (make-async-channel)))
         (set! cmd-ch (make-uni-channel raw-cmd-ch))
         (set! au-pl (thread (lambda () (placed-player raw-cmd-ch))))
         (set! dead-guard (lambda () (let ((evt (thread-dead-evt au-pl)))
                                       (sync evt))))
         (let ((raw-ret-ch (make-async-channel))
               (raw-evt-ch (make-async-channel)))
           ;; As in place mode, pass raw channels during init and keep
           ;; uni-channel wrappers on each side for all subsequent traffic.
           (set! ret-ch (make-uni-channel raw-ret-ch))
           (set! evt-ch (make-uni-channel raw-evt-ch))
           (uni-channel-put cmd-ch (list 'init raw-ret-ch raw-evt-ch))
           (assert (is-return? (uni-channel-get ret-ch) 'initialized)
                   "Unexpected: not 'initialized returned from 'init command")))])
    (set! cmd-put (λ (data) (uni-channel-put cmd-ch data)))
    (set! ret-get (λ () (to-ret-value (uni-channel-get ret-ch))))
    (set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000)
                                                (uni-channel-get-evt evt-ch))))
    (set! rpc (lambda (cmd . args)
                (with-mutex rpc-mutex
                  (define args*
                    (if (and (eq? cmd 'open) (pair? args))
                        (cons (replace-base-path (car args) replace-base-paths) (cdr args))
                        args))
                  (cmd-put (cons cmd args*))
                  (ret-get))))

    (let* ((handle #f)
           (cb-state* (λ (st st-hash) (cb-state handle st st-hash)))
           (cb-eof*   (λ () (cb-eof-stream handle))))
      (set! handle (make-audio-play #t
                                   cb-state* cb-eof*
                                   rpc
                                   au-pl
                                   #f
                                   (make-hash)
                                   replace-base-paths))
      (set-audio-play-evt-thread! handle
            (thread
             (λ ()
               (let loop ()
                 (if (audio-play-valid? handle)
                     (let ((e (evt-get 500)))
                       (cond ((eq? e #f) (void))
                             ((is-event? e 'state)
                              (let* ((data (evt-data e))
                                     (h (hash-copy (car data))))
                                (correct-to-os-path h replace-base-paths)
                                (set-audio-play-state! handle h)
                                (cb-state* (cadr data) h)))
                             ((is-event? e 'audio-done) (cb-eof*))
                             ((is-event? e 'exception)
                              (err-sound "audio-player: exception event: ~a" e))
                             (else (warn-sound "audio-player: unknown event ~a" e))
                             )
                       (loop))
                     'done)))))

      (thread (λ ()
                (dbg-sound "guarding audio-placed-player")
                (dead-guard)
                (dbg-sound "audio-placed-player has stopped")
                (set-audio-play-valid?! handle #f)
                (set-audio-play-rpc! handle #f)
                (set-audio-play-au-place! handle #f)
                (set-audio-play-evt-thread! handle #f)
                (set-audio-play-cb-state! handle #f)
                (set-audio-play-cb-eof-stream! handle #f)
                (when (hash? (audio-play-state handle))
                  (let ((h (hash-copy (audio-play-state handle))))
                    (hash-set! h 'state 'invalid)
                    (correct-to-os-path h replace-base-paths)
                    (set-audio-play-state! handle h)))
                (dbg-sound "audio-play handle invalidated and cleaned of references")
                ))

      (ffi:register-finalizer handle
                          (λ (h)
                            (when (audio-play? h)
                              (rpc 'quit))))

      (audio-parameterize! handle)
      handle)
    )
  )

(define-syntax ap-rpc 
  (syntax-rules ()
    ((_ handle cmd args ...)
     (let ((rv ((audio-play-rpc handle) cmd args ...)))
        (displayln rv)
        (if (eq? (internal-audio-retval-kind rv) 'error)
          (raise-audio-error (internal-audio-retval-code rv) (internal-audio-retval-info rv))
          (internal-audio-retval-retval rv))))
    )
  )

(define/contract (audio-play! handle audio-file)
  (->  audio-play? path-string? number?)
  (ap-rpc handle 'open audio-file))

(define/contract (audio-pause! handle paused)
  (-> audio-play? boolean? symbol?)
  (ap-rpc handle 'pause paused))

(define/contract (audio-paused? handle)
  (-> audio-play? boolean?)
  (ap-rpc handle 'paused))

(define/contract (audio-stop! handle)
  (-> audio-play? symbol?)
  (ap-rpc handle 'stop))

(define/contract (audio-quit! handle)
  (-> audio-play? (or/c number? boolean? symbol?))
  (let ((r (ap-rpc handle 'quit)))
    (set-audio-play-valid?! handle #f)
    r))

(define/contract (audio-seek! handle percentage)
  (-> audio-play? (max-percentage? 100) symbol?)
  (ap-rpc handle 'seek percentage))

(define/contract (audio-volume! handle percentage)
  (-> audio-play? percentage? symbol?)
  (ap-rpc handle 'volume percentage))

(define/contract (audio-volume handle)
  (-> audio-play? percentage?)
  (ap-rpc handle 'get-volume))

(define/contract (audio-full-state handle)
  (-> audio-play? hash?)
  (audio-play-state handle))

(define-syntax get-state
  (syntax-rules ()
    ((_ handle id def)
     (hash-ref (audio-play-state handle) id def))))

(define/contract (audio-at-second handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'at-second #f))

(define/contract (audio-duration handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'duration #f))

(define/contract (audio-channels handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'channels #f))

(define/contract (audio-state handle)
  (-> audio-play-struct? symbol?)
  (if (audio-play-valid? handle)
      (get-state handle 'state 'initialized)
      'invalid))

(define/contract (audio-bits handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'bits #f))

(define/contract (audio-rate handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'rate #f))

(define/contract (audio-decoder handle)
  (-> audio-play? (or/c symbol? boolean?))
  (get-state handle 'decoder #f))

(define/contract (audio-music-id handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'at-music-id #f))

(define/contract (audio-file handle)
  (-> audio-play? (or/c path-string? boolean?))
  (get-state handle 'file #f))

(define/contract (audio-buf-seconds! handle min max)
  (-> audio-play? number? number? (or/c symbol? boolean?))
  (let ((from (if (< min 1) 1 (if (> min 10) 10 min)))
        (until (if (< max min) (+ min 1) (if (> max 30) 30 max))))
    (ap-rpc handle 'buf-seconds from until)))

(define/contract (audio-ao-buf-ms! handle ms)
  (-> audio-play? integer? (or/c integer? boolean?))
  (ap-rpc handle 'ao-buf-ms ms))

(define/contract (audio-ao-buf-ms handle)
  (-> audio-play? (or/c integer? boolean?))
  (ap-rpc handle 'ao-buf-ms))

(define/contract (audio-param! handle param value)
  (-> audio-play? symbol? any? any?)
  (ap-rpc handle 'param! param value))

(define/contract (audio-param handle param)
  (-> audio-play? symbol? any?)
  (ap-rpc handle 'param param))

(define/contract (audio-parameterize! handle)
  (-> audio-play? void?)
  (void
   (let* ((opus-fmt (current-opusfile-output-format))
          (opus-bits (if (eq? opus-fmt 's24) 24 16))
          )
     (audio-param! handle 'opus-bits opus-bits)
     )
   )
  )