275 lines
10 KiB
Racket
275 lines
10 KiB
Racket
#lang racket
|
|
|
|
(require racket-webview
|
|
racket/runtime-path
|
|
racket/gui
|
|
racket-sprintf
|
|
open-app
|
|
xml
|
|
"utils.rkt"
|
|
"music-library.rkt"
|
|
"translate.rkt"
|
|
"playlist.rkt"
|
|
"player.rkt"
|
|
"libraries.rkt"
|
|
)
|
|
|
|
(provide
|
|
(all-from-out racket-webview)
|
|
settings%
|
|
)
|
|
|
|
(define-runtime-path rkt-gui-dir "gui")
|
|
|
|
(define library-dlg%
|
|
(class wv-dialog%
|
|
(init-field [kind #f] [result-cb (λ args #f)]
|
|
[id (new-id)] [name ""] [local-path ""]
|
|
[host ""] [prefixes ""])
|
|
(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-local-path #f)
|
|
(define btn-browse #f)
|
|
(define lbl-host #f)
|
|
(define lbl-prefixes #f)
|
|
(define inp-local-path #f)
|
|
(define inp-name #f)
|
|
(define inp-host #f)
|
|
(define inp-prefixes #f)
|
|
|
|
(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-local-path set-innerHTML! (tr 'local-path))
|
|
(send lbl-host set-innerHTML! (tr 'host))
|
|
(send lbl-prefixes set-innerHTML! (tr 'prefixes))
|
|
(send btn-browse set-innerHTML! (tr 'browse))
|
|
)
|
|
|
|
(define (get el)
|
|
(let ((str (send el get)))
|
|
(string-trim str)))
|
|
|
|
(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-local-path (send this element 'lbl-local-path))
|
|
(set! lbl-host (send this element 'lbl-host))
|
|
(set! lbl-prefixes (send this element 'lbl-prefixes))
|
|
(set! inp-name (send this element 'name))
|
|
(set! inp-local-path (send this element 'local-path))
|
|
(set! btn-browse (send this element 'browse))
|
|
(set! inp-host (send this element 'host))
|
|
(set! inp-prefixes (send this element 'prefixes))
|
|
|
|
(send inp-name set! name)
|
|
(send inp-local-path set! local-path)
|
|
(send inp-host set! host)
|
|
(send inp-prefixes set! prefixes)
|
|
|
|
(send this set-labels)
|
|
|
|
(send this bind! 'browse 'click (λ (el evt data)
|
|
(send this select-library)))
|
|
|
|
(send this bind! 'ok 'click (λ (el evt data)
|
|
(let ((name (get inp-name))
|
|
(local-path (get inp-local-path))
|
|
(host (get inp-host))
|
|
(prefixes (get inp-prefixes)))
|
|
(result-cb id name local-path host prefixes)
|
|
(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])
|
|
(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 lbl-language #f)
|
|
(define lbl-name #f)
|
|
(define lbl-local-path #f)
|
|
(define lbl-host #f)
|
|
(define lbl-prefixes #f)
|
|
(define lbl-lib #f)
|
|
(define div-language #f)
|
|
(define sel-language #f)
|
|
|
|
(define libs (new libraries% [settings settings]))
|
|
|
|
(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 lbl-language set-innerHTML! (tr 'language))
|
|
(send lbl-name set-innerHTML! (tr 'name))
|
|
(send lbl-local-path set-innerHTML! (tr 'local-path))
|
|
(send lbl-host set-innerHTML! (tr 'host))
|
|
(send lbl-prefixes set-innerHTML! (tr 'prefixes))
|
|
(send lbl-lib set-innerHTML! (tr 'lbl-libary-path))
|
|
)
|
|
|
|
(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))
|
|
(local-path (send entry get-local-path))
|
|
(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 '((class "path")) local-path)
|
|
(list 'td '((class "host")) 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)
|
|
(send libs update-library new-lib)))
|
|
)))
|
|
))))
|
|
|
|
(define/public (add-library)
|
|
(let* ((cb (λ (id name local-path host prefixes)
|
|
(send libs add-library (new library% [id id]
|
|
[name name] [local-path local-path]
|
|
[host host] [prefixes prefixes] [current #f]))
|
|
(send this update-libraries)))
|
|
(dlg (new library-dlg% [parent this]
|
|
[settings (send settings clone 'library-dlg)]
|
|
[kind 'add] [result-cb cb])))
|
|
(send dlg show)))
|
|
|
|
(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! lbl-language (send this element 'lbl-language))
|
|
(set! lbl-lib (send this element 'lbl-libary-path))
|
|
(set! lbl-name (send this element 'lbl-name))
|
|
(set! lbl-local-path (send this element 'lbl-local-path))
|
|
(set! lbl-host (send this element 'lbl-host))
|
|
(set! lbl-prefixes (send this element 'lbl-prefixes))
|
|
(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 update-libraries)
|
|
)
|
|
)
|
|
(info-rktplayer "page loaded")
|
|
)
|
|
|
|
(begin
|
|
#t)
|
|
)
|
|
)
|