Adding settings.

2026-07-08 00:09:45 +02:00
parent 5e332522e3
commit f949e2dbb3
10 changed files with 438 additions and 75 deletions
@@ -0,0 +1,96 @@
+#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"
+         )
+
+(provide
+ (all-from-out racket-webview)
+ settings%
+ )
+
+(define-runtime-path rkt-gui-dir "gui")
+
+(define settings%
+  (class wv-dialog%
+    (init-field [log-file #f])
+    (inherit-field settings icon parent)
+
+    (super-new
+     [html-path "settings.html"]
+     [title "Racket Music Player - Settings"]
+     [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-language #f)
+    (define lbl-name #f)
+    (define lbl-local-path #f)
+    (define lbl-host #f)
+    (define lbl-prefixes #f)
+    (define div-language #f)
+    (define sel-language #f)
+
+    (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 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))
+      )
+
+
+    (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-language (send this element 'lbl-language))
+          (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 (λ args (displayln args)))
+          (send this bind! 'cancel 'click (λ args (displayln args)))
+          (send this bind! 'dev 'click (λ args (send this devtools)))
+          )
+        )
+
+      (info-rktplayer "page loaded"))
+          
+
+
+    (begin
+      #t)
+    )
+  )