#lang racket

(require racket/class
         racket/path
         (prefix-in rad: racket-audio-dlna)
         "../library/base/media-resource.rkt"
         "base/renderer.rkt"
         "../misc/utils.rkt")

(provide dlna-player%)

(define dlna-player%
  (class object%
    (init-field [renderer #f]
                [settings #f]
                [time-updater (lambda (time-s length-s) #t)]
                [track-nr-updater (lambda (nr) #t)]
                [state-updater (lambda (state) #t)]
                [error-updater
                 (lambda (kind detail) #t)]
                [repeat-updater (lambda (state) #t)]
                [audio-info-cb (lambda (rate channels bits kind) #t)]
                [buffer-max-seconds 10]
                [buffer-min-seconds 4]
                [server-url #f]
                [server-port 8734] ;8080]
                [listen-ip #f]
                [poll-seconds 1.0]
                [volume-poll-seconds 5.0])

    (define player #f)
    (define playlist #f)
    (define state 'stopped)
    (define repeat 'no-repeat)
    (define current-track-nr #f)
    (define current-uri #f)
    (define prepared-next-track-nr #f)
    (define playing-seen? #f)
    (define playback-progress-seen? #f)
    (define playback-failure-active? #f)
    (define play-request-ms #f)
    (define stop-requested? #f)
    (define stopped-polls 0)
    (define renderer-reachable? #t)
    (define playback-start-timeout-ms 8000)
    (define running #t)
    (define poll-thread #f)

    (define (now-ms)
      (current-inexact-milliseconds))

    (define (track-title nr)
      (let ((track
             (and playlist
                  (exact-nonnegative-integer? nr)
                  (send playlist track nr))))
        (if track
            (send track get-title)
            "")))

    (define (report-playback-failure! detail)
      (set! playing-seen? #f)
      (set! playback-progress-seen? #f)
      (set! playback-failure-active? #t)
      (set! play-request-ms #f)
      (set! stopped-polls 0)
      (error-updater 'playback-failed detail))

    (define (renderer-command! name command)
      (with-handlers
          ((exn:fail?
            (lambda (e)
              (warn-rktplayer
               "Could not execute DLNA command ~a: ~a"
               name
               (exn-message e))
              (error-updater
               'renderer-command-failed
               (send renderer get-name))
              #f)))
        (command)
        #t))

    (define (check-player)
      (unless (is-a? renderer renderer%)
        (raise-arguments-error
         'dlna-player%
         "no media renderer has been configured"
         "renderer" renderer))
      (when (eq? player #f)
        (unless (eq? server-url #f)
          (warn-rktplayer
           "server-url is ignored; racket-audio-dlna determines the server URL"))
        (set! player
              (rad:make-dlna-player
               (send renderer get-device)
               #:listen-ip listen-ip
               #:port server-port
               #:path "/rktplayer/"
               #:poll-seconds poll-seconds
               #:volume-poll-seconds volume-poll-seconds))))

    (define (normalize-state st)
      (cond
        [(eq? st 'playing) 'playing]
        [(eq? st 'transitioning) 'starting]
        [(eq? st 'paused) 'paused]
        [(or (eq? st 'stopped)
             (eq? st 'no-media))
         'stopped]
        [else st]))

    (define (set-state! st)
      (unless (eq? state st)
        (set! state st)
        (state-updater state))
      (repeat-updater repeat)
      (when (or (eq? state 'stopped)
                (eq? state 'quit))
        (audio-info-cb 0 0 0 'none)))

    (define (file-format file)
      (let* ((value
              (cond
                ((path? file) (path->string file))
                ((string? file) file)
                (else #f)))
             (match
              (and value
                   (regexp-match
                    #px"(?i:[.]([a-z0-9]+)(?:[?#].*)?$)"
                    value))))
        (if match
            (string->symbol (string-downcase (cadr match)))
            'none)))

    (define (track-audio-info! track)
      (if track
          (audio-info-cb
           (or (rad:dlna-track-info-sample-rate track) 0)
           (or (rad:dlna-track-info-channels track) 0)
           0
           (file-format (rad:dlna-track-info-file track)))
          (audio-info-cb 0 0 0 'none)))

    (define (normalized-file file)
      (with-handlers ([exn:fail? (lambda (_) (format "~a" file))])
        (path->string (path->complete-path file))))

    (define (same-file? file1 file2)
      (and file1
           file2
           ((if (eq? (system-type 'os) 'windows)
                string-ci=?
                string=?)
            (normalized-file file1)
            (normalized-file file2))))

    (define (playlist-track-file nr)
      (let* ((track (send playlist track nr))
             (resource
              (and track
                   (send track get-resource))))
        (and resource
             (is-a? resource media-resource%)
             (send resource get-file))))

    (define (playlist-track-uri nr)
      (let ((track (send playlist track nr)))
        (and track
             (send (send track get-resource)
                   get-uri))))

    (define (playlist-track-info nr)
      (let* ((track (send playlist track nr))
             (resource (send track get-resource)))
        (rad:dlna-track-info
         (or (send resource get-file)
             (send resource get-uri))
         (send track get-title)
         (send track get-artist)
         (send track get-album)
         #f
         #f
         (send track get-number)
         (send track get-length)
         #f
         #f
         #f)))

    (define (playlist-track-mime-type nr)
      (send (send (send playlist track nr)
                  get-resource)
            get-mime-type))

    (define (playlist-track-protocol-info nr)
      (send (send (send playlist track nr)
                  get-resource)
            get-protocol-info))

    (define (playlist-track-nr file uri)
      (and playlist
           (for/first ([nr (in-range (send playlist length))]
                       #:when
                       (or (same-file?
                            file
                            (playlist-track-file nr))
                           (and (string? uri)
                                (equal?
                                 uri
                                 (playlist-track-uri nr)))))
             nr)))

    (define (next-track-nr nr)
      (if (eq? repeat 'repeat-one)
          nr
          (send playlist
                next-valid-track-index
                nr
                (eq? repeat 'repeat-all))))

    (define (prepare-next-track!)
      (when (and player
                 playlist
                 (exact-nonnegative-integer? current-track-nr))
        (let ((nr (next-track-nr current-track-nr)))
          (cond
            [(eq? nr #f)
             (set! prepared-next-track-nr #f)]
            [(not (equal? nr prepared-next-track-nr))
             (let ((file (playlist-track-file nr)))
               (with-handlers
                   ([exn:fail?
                     (lambda (e)
                       (set! prepared-next-track-nr #f)
                       (warn-rktplayer
                        "Could not prepare next DLNA track: ~a"
                        (exn-message e)))])
                 (if file
                     (rad:dlna-player-set-next-file!
                      player
                      file)
                     (rad:dlna-player-set-next-uri!
                      player
                      (playlist-track-uri nr)
                      #:mime-type
                      (playlist-track-mime-type nr)
                      #:protocol-info
                      (playlist-track-protocol-info nr)
                      #:track
                      (playlist-track-info nr)))
                 (set! prepared-next-track-nr nr)))]))))

    (define (update-current-track! info)
      (let* ((track (rad:dlna-info-track info))
             (file (and track (rad:dlna-track-info-file track)))
             (uri (rad:dlna-info-uri info))
             (nr (cond
                   [(and (exact-nonnegative-integer?
                          prepared-next-track-nr)
                         (or
                          (same-file?
                           file
                           (playlist-track-file
                            prepared-next-track-nr))
                          (and (string? uri)
                               (equal?
                                uri
                                (playlist-track-uri
                                 prepared-next-track-nr)))))
                    prepared-next-track-nr]
                   [else
                    (playlist-track-nr file uri)])))
        (when (exact-nonnegative-integer? nr)
          (unless (equal? nr current-track-nr)
            (set! playback-progress-seen? #f)
            (set! play-request-ms (now-ms)))
          (set! current-track-nr nr)
          (set! prepared-next-track-nr #f)
          (track-nr-updater nr)
          (track-audio-info! track)
          (prepare-next-track!))))

    (define (poll-renderer)
      (when player
        (let ((info (rad:dlna-player-info player)))
          (if (not (rad:dlna-info-reachable? info))
              (when renderer-reachable?
                (set! renderer-reachable? #f)
                (warn-rktplayer "DLNA renderer is not reachable")
                (error-updater
                 'renderer-unreachable
                 (send renderer get-name)))
              (let* ((new-state
                      (normalize-state (rad:dlna-info-state info)))
                     (uri (rad:dlna-info-uri info))
                     (position (rad:dlna-info-position info))
                     (duration (rad:dlna-info-duration info))
                     (playback-failed? #f))
                (unless renderer-reachable?
                  (dbg-rktplayer "DLNA renderer is reachable again"))
                (set! renderer-reachable? #t)

                (when (and (string? uri)
                           (not (string=? uri ""))
                           (not (equal? uri current-uri)))
                  (set! current-uri uri)
                  (set! stopped-polls 0)
                  (update-current-track! info))

                (when (or (eq? new-state 'playing)
                          (eq? new-state 'starting)
                          (eq? new-state 'paused))
                  (when (and (number? position)
                             (> position 0))
                    (set! playback-progress-seen? #t))
                  (when (and (number? position)
                             (number? duration))
                    (time-updater position duration))
                  (track-audio-info! (rad:dlna-info-track info)))

                (when (and playing-seen?
                           (not playback-progress-seen?)
                           play-request-ms
                           (>= (- (now-ms)
                                  play-request-ms)
                               playback-start-timeout-ms))
                  (set! playback-failed? #t)
                  (report-playback-failure!
                   (track-title current-track-nr)))

                (unless (or playback-failed?
                            playback-failure-active?)
                  (cond
                  [(eq? new-state 'playing)
                   (set! playing-seen? #t)
                   (set! stopped-polls 0)]
                  [(and (eq? new-state 'stopped)
                        stop-requested?)
                   (set! stop-requested? #f)
                   (set! stopped-polls 0)]
                  [(and (eq? new-state 'stopped)
                        playing-seen?)
                   (cond
                     ((and
                       (not playback-progress-seen?)
                       play-request-ms
                       (< (- (now-ms)
                             play-request-ms)
                          5000))
                      (void))
                     ((not playback-progress-seen?)
                      (report-playback-failure!
                       (track-title current-track-nr)))
                     (else
                      (set! stopped-polls
                            (+ stopped-polls 1))
                      ;; Give SetNextAVTransportURI one poll to take over.
                      (when (or
                             (eq? prepared-next-track-nr #f)
                             (> stopped-polls 1))
                        (set! playing-seen? #f)
                        (set! stopped-polls 0)
                        (send this next))))]))

                (set-state!
                 (cond
                   ((or playback-failed?
                        playback-failure-active?)
                    'stopped)
                   ((and playing-seen?
                         (not playback-progress-seen?))
                    'starting)
                   (else new-state))))))))

    (define (poll)
      (let loop ()
        (when running
          (sleep poll-seconds)
          (when running
            (with-handlers
                ([exn:fail?
                  (lambda (e)
                    (warn-rktplayer
                     "Could not update DLNA player state: ~a"
                     (exn-message e)))])
              (poll-renderer))
            (loop)))))

    (define/public (change-player kind
                                  #:host [host #f]
                                  #:basepaths [basepaths #f])
      (void kind host basepaths)
      (warn-rktplayer
       "change-player is not supported by dlna-player%"))

    (define/public (get-volume)
      (check-player)
      (send renderer
            device-volume->logical
            (or (rad:dlna-info-volume
                 (rad:dlna-player-info player))
                0)))

    (define/public (set-volume! percentage)
      (check-player)
      (renderer-command!
       'volume
       (lambda ()
         (rad:dlna-player-volume!
          player
          (send renderer
                logical-volume->device
                percentage)))))

    (define/public (set-list! playlist*)
      (when player
        (with-handlers ([exn:fail? (lambda (_) (void))])
          (rad:dlna-player-stop! player)))
      (set! playlist playlist*)
      (set! current-track-nr #f)
      (set! current-uri #f)
      (set! prepared-next-track-nr #f)
      (set! playing-seen? #f)
      (set! playback-progress-seen? #f)
      (set! playback-failure-active? #f)
      (set! play-request-ms #f)
      (set! stop-requested? #f)
      (set! stopped-polls 0)
      (set-state! 'stopped))

    (define/public (playlist! playlist*)
      (check-player)
      (set-list! playlist*))

    (define/public (play playlist*)
      (send this playlist! playlist*)
      (let ((track-nr
             (send playlist
                   first-valid-track-index)))
        (when track-nr
          (send this play-track track-nr))))

    (define/public (play-track nr)
      (check-player)
      (when (and playlist
                 (>= nr 0)
                 (< nr (send playlist length)))
        (with-handlers
            ((exn:fail?
              (lambda (e)
                (warn-rktplayer
                 "Could not play DLNA track: ~a"
                 (exn-message e))
                (report-playback-failure!
                 (track-title nr))
                (set-state! 'stopped))))
          (let ((file (playlist-track-file nr)))
            (if file
                (rad:dlna-player-play! player file)
                (rad:dlna-player-play-uri!
                 player
                 (playlist-track-uri nr)
                 #:mime-type
                 (playlist-track-mime-type nr)
                 #:protocol-info
                 (playlist-track-protocol-info nr)
                 #:track
                 (playlist-track-info nr)))
            (when (or file
                      (playlist-track-uri nr))
              (let ((info (rad:dlna-player-info player)))
                (set! current-track-nr nr)
                (set! current-uri (rad:dlna-info-uri info))
                (set! prepared-next-track-nr #f)
                (set! playing-seen? #t)
                (set! playback-progress-seen? #f)
                (set! playback-failure-active? #f)
                (set! play-request-ms (now-ms))
                (set! stop-requested? #f)
                (set! stopped-polls 0)
                (track-nr-updater nr)
                (track-audio-info! (rad:dlna-info-track info))
                (set-state! 'starting)
                (prepare-next-track!)))))))

    (define/public (next)
      (check-player)
      (if (eq? current-track-nr #f)
          (warn-rktplayer
           "No track-nr set (yet), so can't play anything next")
          (let ((nr (next-track-nr current-track-nr)))
            (if (eq? nr #f)
                (send this stop)
                (send this play-track nr)))))

    (define/public (previous)
      (check-player)
      (if (eq? current-track-nr #f)
          (warn-rktplayer
           "No track-nr set (yet), so can't play anything previous")
          (let ((nr current-track-nr))
            (if (eq? repeat 'repeat-one)
                (send this play-track nr)
                (let ((previous-track-nr
                       (send playlist
                             previous-valid-track-index
                             nr
                             (eq? repeat 'repeat-all))))
                  (send this
                        play-track
                        (or previous-track-nr
                            nr)))))))

    (define/public (pause!)
      (check-player)
      (when (renderer-command!
             'pause
             (lambda ()
               (rad:dlna-player-pause! player)))
        (set-state! 'paused)))

    (define/public (play!)
      (check-player)
      (when (renderer-command!
             'play
             (lambda ()
               (rad:dlna-player-resume! player)))
        (set-state! 'playing)))

    (define/public (pause-unpause)
      (check-player)
      (if (eq? state 'paused)
          (send this play!)
          (send this pause!)))

    (define/public (stop)
      (set! stop-requested? #t)
      (set! playing-seen? #f)
      (set! playback-progress-seen? #f)
      (set! playback-failure-active? #f)
      (set! play-request-ms #f)
      (set! stopped-polls 0)
      (unless (eq? player #f)
        (renderer-command!
         'stop
         (lambda ()
           (rad:dlna-player-stop! player))))
      (set-state! 'stopped))

    (define/public (seek percentage)
      (check-player)
      (renderer-command!
       'seek
       (lambda ()
         (rad:dlna-player-seek-percentage!
          player
          percentage))))

    (define/public (get-repeat)
      (check-player)
      repeat)

    (define/public (repeat! r)
      (check-player)
      (set! repeat r)
      (repeat-updater repeat)
      (prepare-next-track!))

    (define/public (quit)
      (when running
        (set! running #f)
        (unless (eq? poll-thread #f)
          (kill-thread poll-thread)
          (set! poll-thread #f))
        (unless (eq? player #f)
          (rad:dlna-player-close! player)
          (set! player #f))
        (set-state! 'quit)))

    (super-new)

    (begin
      (void settings
            buffer-max-seconds
            buffer-min-seconds)
      (set! poll-thread (thread poll))
      (dbg-rktplayer "dlna-player% initialized"))))