#lang racket/base

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

(provide placed-player)

(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-duration -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)
        (decoder #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)
      (set! play-thread
            (thread (λ ()
                      (set! feeding-audio #t)
                      (audio-read ao-dec)
                      (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)
                                      'done
                                      (cond
                                        ((eq? bufsize #f) (set! bufsize nbfs) (loop))
                                        ((= nbfs 0) (set! bufsize 0) 'done)
                                        ((> nbfs bufsize) (set! bufsize nbfs) 'done)
                                        (else (set! bufsize nbfs) (sleep 0.1) (loop)))
                                      )
                                  )
                                )
                              (when (= bufsize 0)
                                (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.3)
              (when (eq? player-state 'paused)
                (loop)))
            (when (eq? player-state 'playing)
              (with-ao-h 'no-op (ao-pause ao-h #f))
              (state "check-paused: player-stat = playing" 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 type)
        (set! decoder-buf-info buf-info)

        (with-ao-h 'no-op
          (when (not (and
                      (= current-bits bits-per-sample)
                      (= current-rate rate)
                      (= current-channels channels)))
            (ao-close ao-h)
            (set! ao-h #f)))
        
        (when (eq? ao-h #f)
          (set! ao-h (ao-open-live bits-per-sample
                                   rate channels
                                   'native-endian))
          (set! current-bits bits-per-sample)
          (set! current-rate rate)
          (set! current-channels channels)
          )

        (check-volume)
        (with-ao-h 'no-op
            (ao-play ao-h current-file-id second duration buffer buf-len ao-type)
          )
        (check-paused)

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

        (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 (with-ao-h 0 (ao-at-second ao-h))))
                
                (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! current-duration -1)
      (set! decoder-buf-info #f)
      (set! decoder-meta #f)
      )
    
    (define (stop-and-cleanup)
      (unless (eq? ao-dec #f)
        (audio-stop ao-dec))
      (with-ao-h 'no-op 
          (ao-clear-async ao-h)
        (ao-close ao-h))
      (thread-wait play-thread)
      (set! ao-dec #f)
      (set! ao-h #f)
      (set! player-state 'stopped)
      (cleanup)
      (state "stop-and-cleanup: stopped/cleaned" evt)
      player-state
      )

    (define (start file)
      
      (when feeding-audio
        (set! feed-interrupted #t)
        (audio-stop ao-dec)
        (let loop ()
          (if feeding-audio
              (begin
                (sleep 0.1)
                (loop))
              (with-ao-h 'no-op (ao-clear-async ao-h))
              )
          )
        )
      
      (set! ao-dec (audio-open file audio-meta audio-play))
      (set! current-file-id (+ current-file-id 1))
      (let ((f (build-path file)))
        (set! files-playing (cons
                             (cons current-file-id f)
                             (filter (λ (e)
                                    (= (car e) (- current-file-id 1)))
                                  files-playing))))
      (when (eq? player-state 'stopped)
        (set! player-state 'playing))
      (audio-read-worker))

    (define (pause paused)
      (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 (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)
                                                  (eq? (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 (or (eq? m-id #f) (= m-id 0) )
            (cb (list 'state h))))
        )
      )
                        
    (let loop ()
      (let* ((data (get))
             (cmd (car data)))
        
        (early-return
         ((? (eq? cmd 'quit) => (stop-and-cleanup)
             ~ (begin
                 (state "quit" evt 'force)
                 (put '(quit)))))

         (with-handlers ([exn:fail? (λ (e)
                                      (if (eq? ch-evt #f)
                                          (raise e)
                                          (evt (list 'exception e))))])
           (if (eq? cmd 'init)
               (begin
                (set! ch-out (cadr data))
                (set! ch-evt (caddr data))
                (put '(initialized)))
               (begin
                 (when (or (eq? ch-out #f) (eq? ch-evt #f))
                   (error "placed player not initialized"))
                 (cond
                   ((eq? cmd 'buf-seconds)
                    (set! min-buf-secs (if (< (cadr data) 2) 2 (cadr data)))
                    (set! max-buf-secs (if (> (caddr data) 30) 30 (caddr data)))
                    (put '(ok))
                    )
                   ((eq? cmd 'open)
                    (let ((file (cadr data)))
                      (start file)
                      (put '(ok))
                      ))
                   ((eq? cmd 'seek)
                    (let ((percentage (cadr data)))
                      (seek percentage)
                      (put '(ok))))
                   ((eq? cmd 'pause)
                    (let ((paused (cadr data)))
                      (pause paused)
                      (put '(ok))))
                   ((eq? cmd 'paused)
                    (put (list (eq? player-state 'paused))))
                   ((eq? cmd 'volume)
                    (let ((percentage (cadr data)))
                      (volume percentage)
                      (put '(ok))))
                   ((eq? cmd 'get-volume)
                    (put (list current-volume)))
                   ((eq? cmd 'stop)
                    (stop-and-cleanup)
                    (put '(ok)))
                   ((eq? cmd 'state)
                    (state "'state command" put))
                   (else
                    (error (format "Unknown command ~a" cmd)))
                   )
                 )
               )
           )
         (loop)))
      )
    )
  )