#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 (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) ) )