#lang racket

(require racket-webview
         racket/runtime-path
         racket/gui
         racket-sprintf
         open-app
         xml
         (prefix-in upnp: racket-upnp)
         "../misc/utils.rkt"
         "translate.rkt"
         "../play/playlist.rkt"
         "../play/base/player.rkt"
         "../library/libraries-config.rkt"
         "../library/library-factory.rkt"
         "../play/base/renderer.rkt"
         )

(provide
  (all-from-out racket-webview)
  settings%
  )

(define-runtime-path rkt-gui-dir "html")

(define library-dlg%
  (class wv-dialog%
    (init-field [kind 'filesystem] [result-cb (λ args #f)]
                [id (new-id)] [name ""] [local-path ""]
                [host ""] [item-limit 100]
                [kind-editable? #t])
    (inherit-field settings icon parent)

    (super-new
      [html-path "library-dialog.html"]
      [title (tr 'settings-library)]
      [icon (build-path rkt-gui-dir "rktplayer.png")]
      [quit-on-close #f]
      )

    (define initialized #f)
    (define btn-ok #f)
    (define btn-cancel #f)
    (define lbl-name #f)
    (define lbl-kind #f)
    (define lbl-local-path #f)
    (define btn-browse #f)
    (define lbl-media-server #f)
    (define lbl-media-server-root #f)
    (define lbl-media-server-item-limit #f)
    (define btn-refresh-media-servers #f)
    (define btn-media-server-root-up #f)
    (define div-filesystem-fields #f)
    (define div-media-server-fields #f)
    (define txt-media-server-root #f)
    (define sel-library-kind #f)
    (define sel-media-server #f)
    (define sel-media-server-container #f)
    (define inp-local-path #f)
    (define inp-name #f)
    (define inp-media-server-item-limit #f)
    (define media-servers '())
    (define media-server-containers '())
    (define media-server-root-id
      (if (and (eq? kind 'media-server)
               (not (string=? local-path "")))
          local-path
          "0"))
    (define media-server-root-path '())
    (define media-server-root-parents '())
    (define media-server-root-request 0)

    (define/public (set-labels)
      (send btn-ok set-innerHTML! (tr 'ok))
      (send btn-cancel set-innerHTML! (tr 'cancel))
      (send lbl-name set-innerHTML! (tr 'name))
      (send lbl-kind set-innerHTML! (tr 'library-kind))
      (send lbl-local-path set-innerHTML! (tr 'local-path))
      (send lbl-media-server set-innerHTML! (tr 'media-servers))
      (send lbl-media-server-root
            set-innerHTML!
            (tr 'media-server-root))
      (send lbl-media-server-item-limit
            set-innerHTML!
            (tr 'media-server-item-limit))
      (send btn-browse set-innerHTML! (tr 'browse))
      (send btn-refresh-media-servers set-innerHTML! (tr 'refresh))
      (send btn-media-server-root-up set-innerHTML! (tr 'up))
      )

    (define/private (media-server-label server)
      (format "~a (~a)"
              (upnp:media-server-name server)
              (upnp:media-server-address server)))

    (define/private (update-media-servers!)
      (let* ((items
             (if (null? media-servers)
                 (list
                  (list -1
                        (tr 'no-media-servers)))
                 (for/list ((server
                             (in-list media-servers))
                            (idx (in-naturals)))
                   (list idx
                         (media-server-label server)))))
             (selected-idx
              (or
               (for/first ((server (in-list media-servers))
                           (idx (in-naturals))
                           #:when
                           (member host
                                   (filter
                                    values
                                    (list
                                     (upnp:upnp-device-udn server)
                                     (upnp:media-server-name server)
                                     (upnp:media-server-address server)))))
                 idx)
               (if (null? media-servers)
                   -1
                   0))))
        (send sel-media-server
              set-options!
              items
              selected-idx)))

    (define/public (refresh-media-servers)
      (set! media-servers '())
      (update-media-servers!)
      (send btn-refresh-media-servers
            set-innerHTML!
            (tr 'searching))
      (void
       (thread
        (lambda ()
          (with-handlers
              ((exn:fail?
                (lambda (exception)
                  (warn-rktplayer
                   "Could not query UPnP media servers: ~a"
                   (exn-message exception))
                  (set! media-servers '())
                  (update-media-servers!)
                  (set! media-server-containers '())
                  (update-media-server-root!)
                  (send btn-refresh-media-servers
                        set-innerHTML!
                        (tr 'refresh)))))
            (set! media-servers
                  (upnp:query-media-servers))
            (update-media-servers!)
            (load-media-server-root!)
            (send btn-refresh-media-servers
                  set-innerHTML!
                  (tr 'refresh)))))))

    (define/private (selected-media-server)
      (let* ((idx
              (string->number
               (get sel-media-server))))
        (and idx
             (>= idx 0)
             (< idx (length media-servers))
             (list-ref media-servers idx))))

    (define/private (current-library-kind)
      (string->symbol
       (get sel-library-kind)))

    (define/private (update-library-kind!)
      (case (current-library-kind)
        ((filesystem)
         (send div-filesystem-fields display 'block)
         (send div-media-server-fields display 'none))
        ((media-server)
         (send div-filesystem-fields display 'none)
         (send div-media-server-fields display 'block))))

    (define/private (media-server-root-label)
      (if (null? media-server-root-path)
          (if (string=? media-server-root-id "0")
              "/"
              (format "~a" media-server-root-id))
          (string-append
           "/"
           (string-join
            media-server-root-path
            " / "))))

    (define/private (update-media-server-root!
                     [status #f])
      (let ((items
             (cond
               (status
                (list
                 (list -1 status)))
               ((null? media-server-containers)
                (list
                 (list -1
                       (tr 'no-media-server-containers))))
               (else
                (cons
                 (list -1
                       (tr 'select-media-server-container))
                 (for/list
                     ((container
                       (in-list media-server-containers))
                      (idx (in-naturals)))
                   (list
                    idx
                    (upnp:media-entry-title
                     container))))))))
        (send txt-media-server-root
              set-innerHTML!
              (media-server-root-label))
        (send sel-media-server-container
              set-options!
              items
              -1)))

    (define/private (load-media-server-root!)
      (set! media-server-root-request
            (add1 media-server-root-request))
      (let ((request media-server-root-request)
            (server (selected-media-server))
            (container-id media-server-root-id))
        (set! media-server-containers '())
        (update-media-server-root!
         (tr 'searching))
        (if server
            (void
             (thread
              (lambda ()
                (with-handlers
                    ((exn:fail?
                      (lambda (exception)
                        (warn-rktplayer
                         "Could not browse UPnP media-server container ~a: ~a"
                         container-id
                         (exn-message exception))
                        (when (= request
                                 media-server-root-request)
                          (set! media-server-containers '())
                          (update-media-server-root!)))))
                  (let ((containers
                         (filter
                          (lambda (entry)
                            (and
                             (upnp:media-container? entry)
                             (string?
                              (upnp:media-entry-id entry))))
                          (upnp:media-server-browse
                           server
                           container-id
                           #:count
                           (current-media-server-item-limit)))))
                    (when (= request
                             media-server-root-request)
                      (set! media-server-containers
                            containers)
                      (update-media-server-root!)))))))
            (update-media-server-root!))))

    (define/private (reset-media-server-root!)
      (set! media-server-root-id "0")
      (set! media-server-root-path '())
      (set! media-server-root-parents '())
      (load-media-server-root!))

    (define/private (open-media-server-container!)
      (let ((idx
             (string->number
              (get sel-media-server-container))))
        (when (and idx
                   (>= idx 0)
                   (< idx
                      (length media-server-containers)))
          (let ((container
                 (list-ref media-server-containers
                           idx)))
            (set! media-server-root-parents
                  (cons
                   (list media-server-root-id
                         media-server-root-path)
                   media-server-root-parents))
            (set! media-server-root-id
                  (upnp:media-entry-id
                   container))
            (set! media-server-root-path
                  (append
                   media-server-root-path
                   (list
                    (upnp:media-entry-title
                     container))))
            (load-media-server-root!)))))

    (define/private (media-server-root-up!)
      (cond
        ((not
          (null? media-server-root-parents))
         (let ((parent
                (car media-server-root-parents)))
           (set! media-server-root-id
                 (car parent))
           (set! media-server-root-path
                 (cadr parent))
           (set! media-server-root-parents
                 (cdr media-server-root-parents))
           (load-media-server-root!)))
        ((not
          (string=? media-server-root-id "0"))
         (reset-media-server-root!))))

    (define (get el)
      (let ((str (send el get)))
        (string-trim str)))

    (define/private (current-media-server-item-limit)
      (let ((value
             (send inp-media-server-item-limit get)))
        (if (exact-positive-integer? value)
            value
            100)))

    (define/public (select-library)
      (let* ((music-library (get inp-local-path))
             (dir (send this choose-dir
                        (tr 'choose-lib-folder)
                        music-library
                        )))
        (displayln "Directory kiezen")
        (if (eq? dir 'showing)
            'done
            (unless (eq? dir #f)
              (send inp-local-path set! dir))
            )
        )
      )

    (define/override (page-loaded oke)
      (unless initialized
        (when oke
          (set! initialized #t)
          (set! btn-ok (send this element 'ok))
          (set! btn-cancel (send this element 'cancel))
          (set! lbl-name (send this element 'lbl-name))
          (set! lbl-kind (send this element 'lbl-kind))
          (set! lbl-local-path (send this element 'lbl-local-path))
          (set! lbl-media-server (send this element 'lbl-media-server))
          (set! lbl-media-server-root
                (send this element
                      'lbl-media-server-root))
          (set! lbl-media-server-item-limit
                (send this element
                      'lbl-media-server-item-limit))
          (set! div-filesystem-fields
                (send this element
                      'filesystem-fields))
          (set! div-media-server-fields
                (send this element
                      'media-server-fields))
          (set! txt-media-server-root
                (send this element
                      'media-server-root))
          (set! sel-library-kind
                (send this element
                      'selected-library-kind))
          (set! sel-media-server
                (send this element
                      'selected-media-server))
          (set! sel-media-server-container
                (send this element
                      'selected-media-server-container))
          (set! inp-name (send this element 'name))
          (set! inp-local-path (send this element 'local-path))
          (set! inp-media-server-item-limit
                (send this element
                      'media-server-item-limit))
          (set! btn-browse (send this element 'browse))
          (set! btn-refresh-media-servers
                (send this element
                      'refresh-media-servers))
          (set! btn-media-server-root-up
                (send this element
                      'media-server-root-up))

          (send inp-name set! name)
          (send inp-local-path set! local-path)
          (send inp-media-server-item-limit
                set!
                (format "~a" item-limit))
          (send sel-library-kind
                set-options!
                (list
                 (list 'filesystem
                       (tr 'filesystem))
                 (list 'media-server
                       (tr 'media-server)))
                kind)
          (unless kind-editable?
            (send sel-library-kind
                  set-attr!
                  '((disabled "disabled"))))

          (send this set-labels)
          (update-library-kind!)
          (update-media-server-root!)

          (send sel-library-kind
                on-change!
                (lambda (value)
                  (update-library-kind!)))
          (send sel-media-server
                on-change!
                (lambda (value)
                  (reset-media-server-root!)))
          (send sel-media-server-container
                on-change!
                (lambda (value)
                  (open-media-server-container!)))
          (send this refresh-media-servers)

          (send this bind! 'browse 'click (λ (el evt data)
                                            (send this select-library)))
          (send this bind!
                'refresh-media-servers
                'click
                (lambda (element event data)
                  (send this refresh-media-servers)))
          (send this bind!
                'media-server-root-up
                'click
                (lambda (element event data)
                  (media-server-root-up!)))

          (send this bind! 'ok 'click (λ (el evt data)
                                        (let ((name (get inp-name))
                                              (library-kind
                                               (string->symbol
                                                (get sel-library-kind)))
                                              (local-path (get inp-local-path)))
                                          (case library-kind
                                            ((filesystem)
                                             (result-cb
                                              id
                                              name
                                              library-kind
                                              local-path
                                              host
                                              (current-media-server-item-limit))
                                             (send this close))
                                            ((media-server)
                                             (let ((server
                                                    (selected-media-server)))
                                               (when server
                                                 (result-cb
                                                  id
                                                  (if (string=? name "")
                                                      (upnp:media-server-name
                                                       server)
                                                      name)
                                                  library-kind
                                                  media-server-root-id
                                                  (or
                                                   (upnp:upnp-device-udn
                                                    server)
                                                   (upnp:media-server-name
                                                    server))
                                                  (current-media-server-item-limit))
                                                 (send this close))))))))
          (send this bind! 'cancel 'click (λ (el evt data) (send this close)))
          (send this bind! 'dev 'click (λ args (send this devtools)))
          )
        ))
    )
  )

(define settings%
  (class wv-dialog%
    (init-field
     [log-file #f]
     [renderers '()]
     [libraries-changed-callback (lambda () (void))]
     [cache-cleared-callback (lambda () (void))])
    (inherit-field settings icon parent)

    (super-new
      [html-path "settings.html"]
      [title (tr 'settings-title)]
      [icon (build-path rkt-gui-dir "rktplayer.png")]
      [quit-on-close #f]
      )

    (define initialized #f)
    (define btn-ok #f)
    (define btn-cancel #f)
    (define btn-add #f)
    (define btn-edit #f)
    (define btn-remove #f)
    (define btn-clear-cache #f)
    (define lbl-language #f)
    (define lbl-name #f)
    (define lbl-kind #f)
    (define lbl-local-path #f)
    (define lbl-host #f)
    (define lbl-lib #f)
    (define lbl-renderers #f)
    (define lbl-renderer-name #f)
    (define lbl-volume-curve #f)
    (define renderer-body #f)
    (define div-language #f)
    (define sel-language #f)

    (define libs
      (send (get-library-factory)
            get-libraries-config))

    (define cfg (send settings clone 'settings))

    (define/public (set-labels)
      (send btn-ok set-innerHTML! (tr 'ok))
      (send btn-cancel set-innerHTML! (tr 'cancel))
      (send btn-add set-innerHTML! (tr 'library-add))
      (send btn-edit set-innerHTML! (tr 'library-edit))
      (send btn-remove set-innerHTML! (tr 'library-remove))
      (send btn-clear-cache
            set-innerHTML!
            (tr 'clear-cache))
      (send lbl-language set-innerHTML! (tr 'language))
      (send lbl-name set-innerHTML! (tr 'name))
      (send lbl-kind set-innerHTML! (tr 'library-kind))
      (send lbl-local-path set-innerHTML! (tr 'local-path))
      (send lbl-host set-innerHTML! (tr 'host))
      (send lbl-lib set-innerHTML! (tr 'lbl-libary-path))
      (send lbl-renderers set-innerHTML! (tr 'renderers))
      (send lbl-renderer-name set-innerHTML! (tr 'name))
      (send lbl-volume-curve
            set-innerHTML!
            (tr 'logarithmic-volume))
      )

    (define/public (update-renderers)
      (let ((rows
             (for/list ((renderer (in-list renderers))
                        (idx (in-naturals)))
               (list
                'tr
                (list (list 'id
                            (format "renderer-~a" idx)))
                (list 'td
                      '((class "name"))
                      (send renderer get-name))
                (list
                 'td
                 '((class "volume-curve"))
                 (list
                  'input
                  (append
                   (list
                    '(type "checkbox")
                    '(class "renderer-volume-curve")
                    (list 'id
                          (format "renderer-volume-curve-~a"
                                  idx)))
                   (if (eq? (send renderer
                                  get-volume-curve)
                            'logarithmic)
                       '((checked "checked"))
                       '()))))))))
        (send renderer-body
              set-innerHTML!
              (apply string-append
                     (map xexpr->string rows)))
        (send this
              bind!
              "table.renderers input.renderer-volume-curve"
              'change
              (lambda (el evt data)
                (let ((idx
                       (string->number
                        (substring
                         (format "~a" (send el id))
                         (string-length
                          "renderer-volume-curve-")))))
                  (send (list-ref renderers idx)
                        set-volume-curve!
                        (if (send el get)
                            'logarithmic
                            'linear)))))))

    (define/public (update-libraries)
      (let ((count (send libs count)))
        (letrec ((f (λ (i)
                      (if (= i count)
                          '()
                          (cons
                            (let* ((id (send libs library-id i))
                                   (entry (begin
                                            (dbg-rktplayer "index = ~a, id = ~a, symbol? id = ~a" i id (symbol? id))
                                            (send libs get-library id)))
                                   (name (send entry get-name))
                                   (kind (send entry get-kind))
                                   (local-path (send entry get-root))
                                   (host (send entry get-host))
                                   (tr-attr (if (send entry is-current?)
                                                '((class "current"))
                                                '((class "none"))))
                                   )
                              (list 'tr (append (list (list 'id (format "~a" id)))
                                                tr-attr)
                                    (list 'td (list '(class "name")) name)
                                    (list 'td (list '(class "kind"))
                                          (tr kind))
                                    (list 'td '((class "path"))
                                          (format "~a" local-path))
                                    (list 'td '((class "host"))
                                          (or host ""))))
                            (f (+ i 1)))))))
          (let* ((tbl (f 0))
                 (el (send this element 'lib-body))
                 (html (if (= count 0)
                           ""
                           (apply string-append (map xexpr->string tbl)))))
            (displayln html)
            (send el set-innerHTML! html)
            (send this bind! "table.libraries tr" 'click
                  (lambda (el evt data)
                    (let* ((new-id (string->symbol (send el attr 'id)))
                           (new-lib (send libs get-library new-id))
                           (cur-lib (send libs current-library))
                           )
                      (displayln new-id)
                      (displayln new-lib)
                      (displayln cur-lib)
                      (unless (eq? cur-lib #f)
                        (let ((cur-el (send this element (send cur-lib get-id))))
                          (send cur-el remove-class! 'current)
                          (send cur-lib set-current! #f)))
                      (unless (eq? new-id #f)
                        (let ((new-el (send this element new-id)))
                          (displayln new-el)
                          (displayln (send new-el attr 'id))
                          (send new-el set-attr! '(test "NEE!"))
                          (send new-el add-class! "current")
                          (send new-lib set-current! #t)))
                      (libraries-changed-callback)
                      )))
            ))))

    (define/public (add-library)
      (let* ((cb (λ (id name kind root host item-limit)
                   (send libs add-library
                         (library-item
                          id
                          name
                          kind
                          1
                          root
                          (if (string=? host "")
                              #f
                              host)
                          item-limit
                          #f))
                   (send this update-libraries)
                   (libraries-changed-callback)))
             (dlg (new library-dlg% [parent this]
                    [settings (send settings clone 'library-dlg)]
                    [kind 'filesystem] [result-cb cb])))
        (send dlg show)))

    (define/public (edit-library)
      (let ((entry
             (send libs current-library)))
        (when entry
          (let* ((id (send entry get-id))
                 (kind (send entry get-kind))
                 (kind-version
                  (send entry get-kind-version))
                 (current
                  (send entry is-current?))
                 (cb
                  (lambda (id name kind root host item-limit)
                    (send libs
                          update-item!
                          (library-item
                           id
                           name
                           kind
                           kind-version
                           root
                           (if (string=? host "")
                               #f
                               host)
                           item-limit
                           current))
                    (send this update-libraries)
                    (libraries-changed-callback)))
                 (dlg
                  (new library-dlg%
                       [parent this]
                       [settings
                        (send settings
                              clone
                              'library-dlg)]
                       [id id]
                       [name
                        (send entry get-name)]
                       [kind kind]
                       [kind-editable? #f]
                       [local-path
                        (format
                         "~a"
                         (send entry get-root))]
                       [host
                        (or
                         (send entry get-host)
                         "")]
                       [item-limit
                        (send entry get-item-limit)]
                       [result-cb cb])))
            (send dlg show)))))

    (define/public (remove-library)
      (let ((entry
             (send libs current-library)))
        (when entry
          (send libs
                remove-library
                (send entry get-id))
          (let ((new-current
                 (send libs current-library)))
            (when new-current
              (send new-current
                    set-current!
                    #t)))
          (libraries-changed-callback)
          (send this update-libraries))))

    (define/override (page-loaded oke)
      (unless initialized
        (when oke
          (set! initialized #t)
          (set! btn-ok (send this element 'ok))
          (set! btn-cancel (send this element 'cancel))
          (set! btn-add (send this element 'add))
          (set! btn-edit (send this element 'edit))
          (set! btn-remove (send this element 'remove))
          (set! btn-clear-cache
                (send this element 'clear-cache))
          (set! lbl-language (send this element 'lbl-language))
          (set! lbl-lib (send this element 'lbl-libary-path))
          (set! lbl-renderers
                (send this element 'lbl-renderers))
          (set! lbl-renderer-name
                (send this element 'lbl-renderer-name))
          (set! lbl-volume-curve
                (send this element 'lbl-volume-curve))
          (set! renderer-body
                (send this element 'renderer-body))
          (set! lbl-name (send this element 'lbl-name))
          (set! lbl-kind (send this element 'lbl-kind))
          (set! lbl-local-path (send this element 'lbl-local-path))
          (set! lbl-host (send this element 'lbl-host))
          (set! div-language (send this element 'language))

          (send this set-labels)

          (send div-language set-innerHTML! (make-select-list 'sel-lang (languages) (current-lang)))

          (send this bind! 'sel-lang 'change (λ (el evt data)
                                               (let ((lang (string->symbol
                                                             (format "~a" (hash-ref data 'value (current-lang))))))
                                                 (set-lang! lang)
                                                 (send cfg set! 'language lang)
                                                 (send this set-labels))))

          (send this bind! 'ok 'click (λ (el evt data) (send this close)))
          (send this bind! 'cancel 'click (λ (el evt data) (send this close)))
          (send this bind! 'dev 'click (λ args (send this devtools)))
          (send this bind! 'add 'click (λ (el evt data) (send this add-library)))
          (send this bind! 'edit 'click (λ (el evt data) (send this edit-library)))
          (send this bind! 'remove 'click (λ (el evt data) (send this remove-library)))
          (send this bind!
                'clear-cache
                'click
                (lambda (el evt data)
                  (cache-cleared-callback)))

          (send this update-libraries)
          (send this update-renderers)
          )
        )
      (info-rktplayer "page loaded")
      )

    (begin
      #t)
    )
  )