#lang racket/base

(require racket/place
         racket/async-channel
         "libao.rkt"
         "audio-decoder.rkt"
         "private/utils.rkt"
         early-return
         )

(provide placed-player
         audio-known-exts?
         )

(define get-current-seconds current-seconds)

(define (eq-seconds? s1 s2)
  (let ((s1* (inexact->exact (round s1)))
        (s2* (inexact->exact (round s2))))
    (= s1* s2*)))

(define (placed-player ch-in)
  (let ((ch-evt #f)
        (ch-out #f)
        (ao-h #f)
        (ao-mutex (make-mutex))
        (ao-dec #f)
        (current-seconds 0)
        (current-deci-seconds 0)
        (stored-seconds -1)
        (current-file-id 0)
        (files-playing '())
        (current-bits -1)
        (current-rate -1)
        (current-channels -1)
        (current-volume 100.0)
        (req-volume 100.0)
        (max-buf-secs 4)
        (min-buf-secs 2)
        (play-thread #f)
        (player-state 'stopped)
        (decoder-buf-info #f)
        (decoder-meta #f)
        (feeding-audio #f)
        (feed-interrupted #f)
        )
    
    (define-syntax with-ao-h
      (syntax-rules (ao-h ao-mutex)
        ((_ r b1 ...)
         (with-mutex ao-mutex
           (if (ao-valid? ao-h)
               (begin b1 ...)
               r)))))

    (define (put data)
      (if (place-channel? ch-out)
          (place-channel-put ch-out data)
          (async-channel-put ch-out data)))

    (define (evt data)
      (if (place-channel? ch-evt)
          (place-channel-put ch-evt data)
          (async-channel-put ch-evt data)))

    (define (get)
      (if (place-channel? ch-in)
          (place-channel-get ch-in)
          (async-channel-get ch-in)))
          
    (define (audio-read-worker ao-dec file-id)
      (set! feeding-audio #t)
      (set! play-thread
            (thread (λ ()
                      (with-handlers ([exn:fail?
                                       (λ (e)
                                         (dbg-sound "Exception in audio-read-worker: ~a" e)
                                         (set! feeding-audio #f)
                                         (set! feed-interrupted #f)
                                         (set! player-state 'stopped)
                                         (evt (list 'exception (exn-message e))))])
                        (dynamic-wind
                         void
                         (λ ()
                           (dbg-sound "audio-read start")
                           (audio-read ao-dec)
                           (dbg-sound "audio-read end")
                           )
                         (λ () (set! feeding-audio #f)))
                        (state "audio-read-worker: just after audio-read" evt)
                        (if feed-interrupted
                            (set! feed-interrupted #f)
                            (begin
                              (evt '(audio-done))
                              (let ((bufsize #f))
                                (let loop ()
                                  (let ((nbfs (with-ao-h 'done
                                                (ao-bufsize-async ao-h))))
                                    (if (eq? nbfs 'done)
                                        (begin
                                          (set! bufsize 0)
                                          'done)
                                        (cond
                                          ((eq? bufsize #f) (set! bufsize nbfs) (loop))
                                          ((= nbfs 0) (set! bufsize 0) 'done)
                                          ((> nbfs bufsize) (set! bufsize nbfs) 'done)
                                          (else
                                           (check-paused)
                                           (set! bufsize nbfs)
                                           (sleep 0.1)
                                           (loop)))
                                        )
                                    )
                                  )
                                ;; Alleen de actuele worker mag de globale spelerstatus beëindigen.
                                ;; Een oude drain-worker mag hoogstens zichzelf opruimen.
                                (when (and (= bufsize 0) (= file-id current-file-id))
                                  (set! player-state 'stopped)
                                  (state "audio-read-worker: after read with bufsize 0" evt))
                                )
                              )
                            )
                        )
                      )
                    )
            )
      )

    (define (check-volume)
      (unless (= req-volume current-volume)
        (set! current-volume req-volume)
        (with-ao-h 'no-op
            (ao-set-volume! ao-h current-volume))
        (state "check-volume: volume changed" evt)
        )
      )
    
    (define (check-paused)
      (if (eq? player-state 'paused)
          (begin
            (with-ao-h 'no-op (ao-pause ao-h #t))
            (state "check-paused: player-state = paused" evt)
            (let loop ()
              (sleep 0.1)
              (when (eq? player-state 'paused)
                (loop)))
            ; If the player is no longer paused, we unpause the ao stream,
            ; also if the player is no longer playing (i.e. player-state = stopped)
            ; in which case, we expect ao-clear-async to have been executed, which
            ; means the playing queue is empty. 
            (with-ao-h 'no-op (ao-pause ao-h #f))
            (state (format "check-paused: player-state = ~a" player-state) evt)
            #t)
          #f))

    (define (audio-play type ao-type handle buf-info buffer buf-len)
      (let* ((sample (hash-ref buf-info 'sample))
             (rate (hash-ref buf-info 'sample-rate))
             (second (/ (* sample 1.0) (* rate 1.0)))
             (bits-per-sample (hash-ref buf-info 'bits-per-sample))
             (bytes-per-sample (/ bits-per-sample 8))
             (channels (hash-ref buf-info 'channels))
             (bytes-per-sample-all-channels (* channels bytes-per-sample))
             (duration (hash-ref buf-info 'duration))
             )

        (set! decoder-buf-info buf-info)

        (when (not (and
                    (= current-bits bits-per-sample)
                    (= current-rate rate)
                    (= current-channels channels)))
          ; If we need to reopen the ao device with different bit-rates,
          ; we need to wait until the ao sample queue is empty
          (let loop ()
            (let* ((s (with-ao-h -1 (ao-at-second ao-h))))
              (unless (or (= s -1) (eq-seconds? stored-seconds s))
                (set! stored-seconds s)
                (state "audio-play: seconds changes (III)" evt)))
            (let ((bufsize (with-ao-h 0 (ao-bufsize-async ao-h))))
              (if (= bufsize 0)
                  (with-mutex ao-mutex
                    (when (ao-valid? ao-h)
                      (ao-close ao-h))
                    (set! ao-h #f))
                  (begin (sleep 0.1) (loop)))))
          )
        
        (with-mutex ao-mutex
          (when (eq? ao-h #f)
            (dbg-sound "opening ao-h for ~a ~a" current-file-id files-playing) 
            (set! ao-h (ao-open-live bits-per-sample
                                     rate channels
                                     'native-endian))
            )
          (with-ao-h 'no-op
            (ao-set-volume! ao-h current-volume)
            (set! current-bits bits-per-sample)
            (set! current-rate rate)
            (set! current-channels channels)
            )
          )

        (check-volume)
        (with-ao-h 'no-op
          (when (not (eq? player-state 'stopped))
            (ao-play ao-h current-file-id second duration buffer buf-len ao-type)
            ))
        (check-paused)

        (let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
               (s (inexact->exact (round (* s* 10)))))
          (unless (= s current-deci-seconds)
            (set! current-deci-seconds s)
            (set! current-seconds s*))) 

        (unless (eq-seconds? stored-seconds current-seconds)
          (set! stored-seconds current-seconds)
          (state "audio-play: seconds changed (I)" evt))

        (let* ((buf-size (with-ao-h 0 (ao-bufsize-async ao-h)))
               (buf-seconds (exact->inexact (/ buf-size
                                               bytes-per-sample-all-channels
                                               rate)))
               )
          (when (> buf-seconds max-buf-secs)
            (let waiter ()
              (when (not (check-paused))
                (sleep 0.3))
              (let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
                     (s (inexact->exact (round (*  s* 10)))))

                (unless (= s current-deci-seconds)
                  (set! current-deci-seconds s)
                  (set! current-seconds s*))
                
                (unless (eq-seconds? stored-seconds current-seconds)
                  (set! stored-seconds current-seconds)
                  (state "audio-play: seconds changed (II)" evt))
                
                (let ((buf-seconds-left (exact->inexact
                                         (/ (with-ao-h 0 (ao-bufsize-async ao-h))
                                            bytes-per-sample-all-channels
                                            rate))))
                  (when (>= buf-seconds-left min-buf-secs)
                    (waiter)))))
            ))
        )
      )

    (define (audio-meta type ao-type handle meta)
      (set! decoder-meta meta)
      #t)

    (define (cleanup)
      (set! files-playing '())
      (set! current-seconds 0)
      (set! current-deci-seconds 0)
      (set! stored-seconds -1)
      (set! current-file-id 0)
      (set! current-bits -1)
      (set! current-rate -1)
      (set! current-channels -1)
      (set! decoder-buf-info #f)
      (set! decoder-meta #f)
      )
    
    (define (stop-and-cleanup)
      (dbg-sound "stop and cleanup called")
      (set! feed-interrupted #t)

      (with-ao-h 'no-op (ao-clear-async ao-h))
      (set! player-state 'stopped)
      (unless (eq? ao-dec #f)
        (audio-stop ao-dec))
      (set! ao-dec #f)

      (with-ao-h 'no-op (ao-clear-async ao-h))
      
      (when (thread? play-thread) (thread-wait play-thread))
      (set! play-thread #f)

      (with-mutex ao-mutex
        (when (ao-valid? ao-h)
          (ao-close ao-h)
          )
        (set! ao-h #f))

      (set! feed-interrupted #f)
      (set! feeding-audio #f)
      
      (cleanup)
      
      (state "stop-and-cleanup: stopped/cleaned" evt 'force)
      
      player-state
      )

    (define (start file)
      (dbg-sound "starting ~a" file)
      (when feeding-audio
        (dbg-sound "interrupting feed")
        (set! feed-interrupted #t)
        (with-ao-h 'no-op (ao-clear-async ao-h))
        (set! player-state 'stopped)
        (when (audio-handle? ao-dec)
          (audio-stop ao-dec))
        (dbg-sound "clearing ao-h queue")
        (with-ao-h 'no-op (ao-clear-async ao-h))
        (dbg-sound "waiting for feed to stop")
        (let loop ()
          (if feeding-audio
              (begin
                (sleep 0.1)
                (loop))
              (with-ao-h 'no-op (ao-clear-async ao-h))
              )
          )
        (dbg-sound "waiting for play thread")
        (when (thread? play-thread) (thread-wait play-thread))
        (dbg-sound "oke done")
        )

      
      ;(set! current-file-id (+ current-file-id 1))
      (set! current-file-id (+ (* (get-current-seconds) 10000) (random 1000)))
      (let ((f (build-path file)))
        (set! files-playing (cons
                             (cons current-file-id f)
                             (filter (λ (e)
                                    (= (car e) (- current-file-id 1)))
                                  files-playing))))
      (set! ao-dec (audio-open file audio-meta audio-play))
      
      (when (eq? player-state 'stopped)
        (set! player-state 'playing))
      (audio-read-worker ao-dec current-file-id)
      current-file-id)

    (define (pause paused)
      (when (or (eq? player-state 'paused)
                (eq? player-state 'playing))
        (set! player-state (if paused 'paused 'playing))))
      
    (define (seek percentage)
      (with-ao-h 'no-op
          (ao-clear-async ao-h))
      (unless (eq? ao-dec #f)
        (audio-seek ao-dec percentage)))

    (define (volume percentage)
      (set! req-volume percentage))

    (define (ao-buf-ms)
      (ao-playback-buf-ms))

    (define (ao-buf-ms! ms)
      (let ((the-ms (if (< ms 50) 50 (if (> ms 1000) 1000 ms))))
        (ao-set-playback-buf-ms! the-ms)
        (ao-buf-ms)))

    (define (state msg cb . force)
      (let ((h (make-hash)))
        (with-mutex ao-mutex
          (let ((m-id (if (ao-valid? ao-h) (ao-at-music-id ao-h) #f)))
            (hash-set! h 'decoder (if (audio-handle? ao-dec) (audio-kind ao-dec) #f))
            (hash-set! h 'msg msg)
            (hash-set! h 'file (let ((r (filter (λ (e)
                                                  (and (not (eq? m-id #f)) (= (car e) m-id)))
                                                files-playing)))
                                 (if (null? r) #f (cdar r))))
            (hash-set! h 'state player-state)
            (hash-set! h 'valid-ao-handle (ao-valid? ao-h))
            (hash-set! h 'duration (if (ao-valid? ao-h) (ao-music-duration ao-h) #f))
            (hash-set! h 'at-second (if (ao-valid? ao-h) (ao-at-second ao-h) #f))
            (hash-set! h 'at-music-id m-id)
            (hash-set! h 'volume current-volume)
            (hash-set! h 'buf-size (if (ao-valid? ao-h) (ao-bufsize-async ao-h) 0))
            (hash-set! h 'reuse-buf-len (if (ao-valid? ao-h)
                                            (ao-reuse-buf-len-async ao-h)
                                            #f))
            (hash-set! h 'sample-queue-len (if (ao-valid? ao-h)
                                               (ao-sample-queue-len-async ao-h)
                                               #f))
            (hash-set! h 'bits current-bits)
            (hash-set! h 'rate current-rate)
            (hash-set! h 'channels current-channels)
            (hash-set! h 'decoder-meta decoder-meta)
            (hash-set! h 'decoder-buf-info decoder-buf-info)
            )
          )

        (let ((m-id (hash-ref h 'at-music-id)))
          (unless (and (null? force) (or (eq? m-id #f) (= m-id 0)))
            (cb (list 'state h))))
        )
      )

    (let loop ()
      (let* ((data (get))
             (cmd (car data))
             (in-rpc #f))

        (define-syntax do-rpc
          (syntax-rules (in-rpc)
            ((_ b1 ...)
             (begin
               (set! in-rpc #t)
               (let ((r (begin b1 ...)))
                 (set! in-rpc #f)
                 (put r))))))
        
        (with-handlers ([exn:fail? (λ (e)
                                     (if (eq? ch-evt #f)
                                         (raise e)
                                         (begin
                                           (evt (list 'exception
                                                      (exn-message e)))
                                           (when in-rpc
                                             (put (list 'error
                                                        (exn-message e)))
                                             (set! in-rpc #f))
                                           (loop))
                                         ))])

           (cond
             ((eq? cmd 'quit) (do-rpc
                               (stop-and-cleanup)
                               (state "quit" evt 'force)
                               '(quit)))
             ((eq?  cmd 'init) (do-rpc
                                (set! ch-out (cadr data))
                                (set! ch-evt (caddr data))
                                '(initialized))
                               (loop))
             (else 
              (when (or (eq? ch-out #f) (eq? ch-evt #f))
                (error "placed player not initialized"))
          
              (unless (eq? cmd 'quit)
                (cond
                  ((eq? cmd 'buf-seconds)
                   (do-rpc
                    (let* ((clamp (λ (x) (min 30 (max 2 x))))
                           (a (clamp (cadr data)))
                           (b (clamp (caddr data))))
                      (set! min-buf-secs (min a b))
                      (set! max-buf-secs (max a b))
                      '(ok))))
                  ((eq? cmd 'open)
                   (do-rpc 
                    (let ((file (cadr data)))
                      (let ((id (start file)))
                        (list (list 'ok id))))))
                  ((eq? cmd 'seek)
                   (do-rpc 
                    (let ((percentage (cadr data)))
                      (seek percentage)
                      '(ok))))
                  ((eq? cmd 'pause)
                   (do-rpc
                    (let ((paused (cadr data)))
                      (pause paused)
                      '(ok))))
                  ((eq? cmd 'paused)
                   (do-rpc
                    (list (eq? player-state 'paused))))
                  ((eq? cmd 'volume)
                   (do-rpc
                    (let ((percentage (cadr data)))
                      (volume (exact->inexact percentage))
                      '(ok))))
                  ((eq? cmd 'get-volume)
                   (do-rpc
                    (list current-volume)))
                  ((eq? cmd 'stop)
                   (do-rpc
                    (stop-and-cleanup)
                    '(ok)))
                  ((eq? cmd 'state)
                   (do-rpc
                    (let ((st #f))
                      (state "'state command" (λ (s) (set! st s)) 'force)
                      st)))
                  ((eq? cmd 'ao-buf-ms)
                   (do-rpc
                    (if (null? (cdr data))
                        (list (ao-buf-ms))
                        (list (ao-buf-ms! (cadr data))))
                    ))
                  (else
                   (do-rpc
                    (list 'error (format "Unknown command ~a" cmd))))
                  )
                (loop)
                )
              )
             )
          )
        )
      )
    )
  )