Compare commits

..

3 Commits

Author SHA1 Message Date
hans f949e2dbb3 Adding settings. 2026-07-08 00:09:45 +02:00
hans 5e332522e3 oke 2026-07-02 14:55:48 +02:00
hans adb552c618 Callbacks etc. 2026-07-02 14:53:00 +02:00
10 changed files with 441 additions and 76 deletions
+1
View File
@@ -19,3 +19,4 @@ compiled/
*.dep
/*.bak
/gui/*.bak
+51 -26
View File
@@ -11,6 +11,7 @@
"translate.rkt"
"playlist.rkt"
"player.rkt"
"settings.rkt"
)
(provide
@@ -24,15 +25,14 @@
(define player-menu
(λ ()
(wv-menu 'main-menu
(wv-menu-item 'm-file (tr "File")
#:submenu
(wv-menu
(wv-menu-item 'm-add-tab (tr "Add Playlist"))
(wv-menu-item 'm-select-library-dir (tr "Select Music Library Folder"))
(wv-menu-item 'm-set-lang (tr "Set language"))
(wv-menu-item 'm-quit (tr "Quit") #:separator #t)))
(wv-menu-item 'm-file (tr 'file)
#:submenu (wv-menu 'file-menu
(wv-menu-item 'm-select-library-dir (tr 'select-library-dir))
(wv-menu-item 'm-settings (tr 'settings))
(wv-menu-item 'm-quit (tr 'quit) #:separator #t)
)
)
))
)))
(define rktplayer%
(class wv-window%
@@ -60,11 +60,12 @@
(define el-format #f)
(define el-channels #f)
(define el-bits #f)
(define cfg (send settings clone 'settings))
(define current-tab 0)
(define music-library
(let ((path (format "~a" (send settings get 'music-library (find-system-path 'home-dir)))))
(let ((path (format "~a" (send cfg get 'music-library (find-system-path 'home-dir)))))
(when (eq? (system-type 'os) 'windows)
(set! path (string-replace path "/" "\\")))
(dbg-rktplayer "music-library: ~a" path)
@@ -79,7 +80,7 @@
(define/public (update-volume)
(let ((el (send this element 'volume-percentage)))
(let ((percentage (send player get-volume)))
(send el set-innerHTML! (sprintf "%s %d%" (tr "Volume:") percentage)))
(send el set-innerHTML! (sprintf "%s %d%" (tr 'volume) percentage)))
)
)
@@ -157,7 +158,7 @@
(send this bind! 'album-image 'contextmenu
(λ (el evt data)
(let ((mnu (wv-menu 'image-menu
(wv-menu-item 'm-booklet (tr "Open booklet")
(wv-menu-item 'm-booklet (tr 'open-booklet)
#:callback (λ () (send this open-booklet booklet-file #t)))))
(clientX (hash-ref data 'clientX 60))
(clientY (hash-ref data 'clientY 60)))
@@ -188,20 +189,20 @@
(let ((el (send this element 'paused)))
(cond ((or (eq? st 'playing) (eq? st 'play))
(set-play-button "buttons/pause.svg")
(send el set-innerHTML! '(span (tr "playing"))))
(send el set-innerHTML! (list 'span (tr 'playing))))
((eq? st 'stopped)
(set-play-button "buttons/play.svg")
(send el set-innerHTML! '(span (tr "stopped"))))
(send el set-innerHTML! (list 'span (tr 'stopped))))
((eq? st 'paused)
(set-play-button "buttons/play.svg")
(send el set-innerHTML! '(span ((class "blink")) (tr "paused"))))
(send el set-innerHTML! (list 'span '((class "blink")) (tr 'paused))))
((eq? st 'quit)
(void))
(else
(warn-rktplayer "Unkown state for update-state ~a" st)
(send el set-innerHTML! (list 'span
'((class "blink"))
(format "~a: ~a" (tr "Unknown state") st))))
(format "~a: ~a" (tr 'unknown-state) st))))
))
(set! state st)
)
@@ -250,9 +251,9 @@
(define/public (tab-context evt tab-id tab-idx)
(let ((items (list
(wv-menu-item 'm-tab-rename (tr "Rename playlist") #:callback (λ () (send this rename-tab! tab-id tab-idx)))
(wv-menu-item 'm-tab-drop (tr "Remove playlist") #:callback (λ () (send this drop-tab! tab-id tab-idx)))
(wv-menu-item 'm-tab-add (tr "Add playlist") #:callback (λ () (send this add-tab)))
(wv-menu-item 'm-tab-rename (tr 'rename-playlist) #:callback (λ () (send this rename-tab! tab-id tab-idx)))
(wv-menu-item 'm-tab-drop (tr 'remove-playlist) #:callback (λ () (send this drop-tab! tab-id tab-idx)))
(wv-menu-item 'm-tab-add (tr 'add-playlist) #:callback (λ () (send this add-tab)))
)
)
)
@@ -321,8 +322,8 @@
(define (update-audio-info rate channels bits audio-format)
(let ((format-num (λ (x) (if (= x 0) "-" x)))
(format-dec (λ (x) (if (eq? x 'none) "-" x))))
(send el-bits set-innerHTML! (format "~a ~a" (format-num bits) (tr "bits")))
(send el-channels set-innerHTML! (format "~a ~a" (format-num channels) (tr "channels")))
(send el-bits set-innerHTML! (format "~a ~a" (format-num bits) (tr 'bits)))
(send el-channels set-innerHTML! (format "~a ~a" (format-num channels) (tr 'channels)))
(send el-rate set-innerHTML! (format "~a Hz" (format-num rate)))
(send el-format set-innerHTML! (format "~a" (format-dec audio-format)))
)
@@ -403,6 +404,7 @@
(send this set-menu! (player-menu))
(send this connect-menu! 'm-quit (λ () (send this quit)))
(send this connect-menu! 'm-select-library-dir (λ () (send this select-library)))
(send this connect-menu! 'm-settings (λ () (send this settings-dlg)))
(send this connect-menu! 'm-add-tab (λ () (send this add-tab)))
(dbg-rktplayer "page-loaded, playlist = ~a" playlist)
@@ -496,7 +498,9 @@
(map (λ (e)
(set! nr (+ nr 1))
(list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr)))
(directory-list current-music-path)))))
(if (directory-exists? current-music-path)
(directory-list current-music-path)
'())))))
(unless (path-equal? current-music-path music-library)
(set! l (cons (list "lib-up" "" "lib-up") l))
)
@@ -540,20 +544,20 @@
(define/public (context-for-path evt path)
(let ((items (list
(wv-menu-item 'm-play-this (tr "Play this") #:callback (λ () (send this play-path path))))))
(wv-menu-item 'm-play-this (tr 'play-this) #:callback (λ () (send this play-path path))))))
(when (file-exists? path)
(set! items (append items
(list
(wv-menu-item 'm-add-this (tr "Add this") #:callback (λ () (send this add-path path)))))))
(wv-menu-item 'm-add-this (tr 'add-this) #:callback (λ () (send this add-path path)))))))
(when (file-exists? (build-path path "booklet.pdf"))
(set! items (append items
(list
(wv-menu-item 'm-booklet (tr "Open booklet") #:callback (λ () (send this open-booklet path))) ;; todo check if pdf file exists
(wv-menu-item 'm-booklet (tr 'open-booklet) #:callback (λ () (send this open-booklet path))) ;; todo check if pdf file exists
))))
(set! items (append items
(list
(wv-menu-item 'm-folder (tr "Open containing folder") #:callback (λ () (send this open-folder path)))
(wv-menu-item 'm-folder (tr 'open-containing-folder) #:callback (λ () (send this open-folder path)))
)))
(let* ((mnu (wv-menu 'library-popup items))
(clientX (hash-ref evt 'clientX 60))
@@ -564,6 +568,21 @@
)
)
(define play-remote #f)
(define/public (toggle-remote)
(info-rktplayer "Toggling remote playing")
(set! play-remote (not play-remote))
;(displayln (format "player = ~a" player))
(if play-remote
(send player change-player 'remote
#:host "hans@mahler.thuis.local"
#:basepaths '(("\\\\panderleou\\music" . "/muziek")
("//panderleou/music" . "/muziek")
))
(send player change-player 'local))
(info-rktplayer "Playing remote: ~a" play-remote)
)
(define/public (play-path path)
(dbg-rktplayer "Playing ~a" path)
(let ((pl (new playlist% [start-map path] [settings (send settings clone 'playlists)] [id current-tab])))
@@ -672,7 +691,7 @@
(define/public (select-library)
(let ((dir (send this choose-dir
(tr "Choose the folder containing your music library")
(tr 'choose-lib-folder)
(if (string? music-library) music-library (path->string music-library))
)))
(if (eq? dir 'showing)
@@ -687,6 +706,12 @@
)
)
(define/public (settings-dlg)
(let ((dlg (new settings% [settings (send settings clone 'settings-dlg)]
[parent this])))
(send dlg show)))
(define/public (show-hide)
(let ((st (send this window-state)))
(if (eq? st 'hidden)
+30
View File
@@ -0,0 +1,30 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>RktPlayer - A music player - Settings</title>
<script src="menu.js"></script>
</head>
<body>
<div class="pane">
<div class="keyval">
<label for="language" id="lbl-language">Languages:</label>
<span id="language">Languages</span>
</div>
<label id="lbl-libary-path">Library path:</label>
<table class="libraries">
<thead id="lib-head">
<tr><th id="lbl-name"></th><th id="lbl-local-path"></th><th id="lbl-host"></th><th id="lbl-prefixes"></th></tr>
</thead>
<tbody id="lib-body">
</tbody>
</table>
<div class="button-box">
<button id="ok">OK</button>
<button id="cancel">Cancel</button>
<button id="dev">devtools</button>
</div>
</div>
</body>
</html>
+28 -2
View File
@@ -9,7 +9,23 @@ body {
height: calc(100vh - 2em - 20px);
width: calc(100% - 10px);
display: flex;
flex-direction: column;
flex-direction: column;
padding: 3px;
}
.keyval {
width: 100%;
padding-bottom: 5px;
}
.keyval label {
display: inline-block;
width: calc(30% - 5px);
}
.keyval span {
display: inline-block;
width: calc(70% - 10px);
}
.buttons {
@@ -352,4 +368,14 @@ input.v-slider {
}
}
select, option {
all: revert;
}
.pane {
display: block !important;
}
+55 -20
View File
@@ -20,6 +20,10 @@
[buffer-min-seconds 4]
)
(define player-kind 'local)
(define player-host #f)
(define player-basepaths #f)
(define player #f)
(define playlist #f)
(define state 'stopped)
@@ -43,40 +47,71 @@
(define (clear-music-ids!)
(lru-clear track-cache))
;;(define x 0)
(define (audio-state-cb handle player-state st*)
(set! full-state st*)
(let ((st (audio-state player)))
(when (or (eq? st 'paused) (eq? st 'playing))
(time-updater (audio-at-second player)
(audio-duration player))
(when (not (= music-id (audio-music-id player)))
(set! music-id (audio-music-id player))
(let ((track-nr (music-id->track-nr music-id)))
(if (eq? track-nr #f)
(error "Unexpected: no track-nr for given music-id")
(track-nr-updater track-nr))))
;;(when (< x 5)
;; (displayln st*)
;; (set! x (+ x 1)))
(unless (or (not (eq? player handle)) (eq? player #f))
(let ((st (audio-state player)))
(when (or (eq? st 'paused) (eq? st 'playing))
(time-updater (audio-at-second player)
(audio-duration player))
(when (not (= music-id (audio-music-id player)))
(set! music-id (audio-music-id player))
(let ((track-nr (music-id->track-nr music-id)))
(if (eq? track-nr #f)
(warn-rktplayer "Unexpected: no track-nr for given music-id")
(track-nr-updater track-nr))))
)
(state-updater st)
(repeat-updater repeat)
(if (or (eq? player-state 'quit) (eq? player-state 'stopped))
(audio-info-cb 0 0 0 'none)
(audio-info-cb (audio-rate player) (audio-channels player)
(audio-bits player) (audio-decoder player)))
)
(state-updater st)
(repeat-updater repeat)
(if (or (eq? player-state 'quit) (eq? player-state 'stopped))
(audio-info-cb 0 0 0 'none)
(audio-info-cb (audio-rate player) (audio-channels player)
(audio-bits player) (audio-decoder player)))
)
)
(define (on-eof-stream-cb handle)
(let ((track-nr (music-id->track-nr music-id)))
(send this next)))
(when (and (eq? player handle) (not (eq? player #f)))
(let ((track-nr (music-id->track-nr music-id)))
(send this next))))
;(define ap (make-audio-player audio-player-state audio-player-eof
; #:remote-host "hans@mahler.thuis.local"
; #:replace-base-paths '(("\\\\panderleou\\music" . "/muziek"))))
(define (check-player)
;(displayln "check-player called")
(when (eq? player #f)
(set! player (make-audio-player audio-state-cb on-eof-stream-cb))
(set! player
(if (eq? player-kind 'local)
(make-audio-player audio-state-cb on-eof-stream-cb)
(make-audio-player audio-state-cb on-eof-stream-cb
#:remote-host player-host
#:replace-base-paths player-basepaths)))
(audio-ao-buf-ms! player 500)
(audio-buf-seconds! player buffer-min-seconds buffer-max-seconds)
))
(define/public (change-player kind #:host [host #f] #:basepaths [basepaths #f])
(let ((op player))
(unless (eq? player #f)
(set! player #f)
(audio-quit! op)
;(displayln "Player quit")
)
;(displayln "HE!")
(set! player-kind kind)
(set! player-host host)
(set! player-basepaths basepaths)
;(displayln (format "kind: ~a, host: ~a, bp: ~a, player: ~a" player-kind player-host player-basepaths player))
))
(define/public (get-volume)
(check-player)
(audio-volume player))
+4
View File
@@ -3,6 +3,7 @@
(require racket/gui
"gui.rkt"
"tray.rkt"
"translate.rkt"
simple-ini/class
racket-audio
racket-webview
@@ -16,7 +17,9 @@
(define-runtime-path rkt-gui-dir "gui")
(define log-file (build-path (find-system-path 'cache-dir) ".rktplayer.log"))
(displayln log-file)
(sl-log-to-file log-file)
(void (current-opusfile-output-format 's24))
;(sl-log-to-display)
(define (my-file-getter url)
@@ -59,6 +62,7 @@
[file-getter my-file-getter]
))
)
(set-lang! (send ini get 'settings 'language 'en))
(let* ((window (new rktplayer% [wv-context context] [log-file log-file]))
(tray (new rktplayer-tray% [rktplayer-gui window]))
)
+96
View File
@@ -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)
)
)
+148 -22
View File
@@ -1,26 +1,53 @@
#lang racket
(provide tr)
(provide tr
__
languages
set-lang!
current-lang
)
(define tr_map (make-hash))
(define (add-tr sentence language translated-sentence)
(define (add-tr id language translated-sentence)
(let ((lang-hash (hash-ref tr_map language (make-hash))))
(hash-set! lang-hash sentence translated-sentence)
(hash-set! lang-hash id translated-sentence)
(hash-set! tr_map language lang-hash)))
(define-syntax add2
(syntax-rules ()
((_ s (l ts))
(add-tr s l ts))))
((_ id (l ts))
(add-tr id l ts))))-
(define-syntax add
(syntax-rules ()
((_ s l1 ...)
((_ id l1)
(add2 id l1))
((_ id l1 l2 ...)
(begin
(add2 s l1)
...))))
(add2 id l1)
(add id l2 ...)
))))
(define-syntax add**
(syntax-rules ()
((_ (id l1 ...))
(add id l1 ...)
)
)
)
(define-syntax add*
(syntax-rules ()
((_ t1)
(add** t1))
((_ t1 t2 ...)
(begin
(add** t1)
(add* t2 ...)
))
)
)
(define language 'en)
@@ -29,27 +56,126 @@
(define (set-lang! l)
(set! language l))
(define (tr s)
(if (eq? language 'en)
s
(let ((lang-hash (hash-ref tr_map language (make-hash))))
(let ((translated (hash-ref lang-hash s (format "~a:~a" language s))))
translated
)
)
)
(define (current-lang)
language
)
(define (tr* id lang)
(let ((lang-hash (hash-ref tr_map lang (make-hash))))
(hash-ref lang-hash id #f)))
(define (tr id)
(let ((s (tr* id language)))
(if (eq? s #f)
(let ((en-s (tr* id 'en)))
(if (eq? en-s #f)
(format "~a:~a" language id)
(format "~a:~a" language en-s)))
s)))
(define (__ s)
(tr s))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Translations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(add "Select Music Library Folder"
(add*
('select-library-dir
('en "Select Music Library Folder")
('nl "Selecteer map met Muziek Bibliotheek"))
(add "Choose the folder containing your music library"
('choose-lib-folder
('en "Choose the folder containing your music library")
('nl "Kies de map met de Muziek Bibliotheek"))
(add "Quit"
('quit
('en "Quit")
('nl "Beëindigen"))
(add "channels"
('channels
('en "channels")
('nl "kanalen"))
('language
('en "Language")
('nl "Taal"))
('name
('en "Name")
('nl "Naam"))
('local-path
('en "Local Path")
('nl "Lokale Path"))
('host
('en "Host")
('nl "Host"))
('prefixes
('en "Prefixes")
('nl "Prefixen"))
('ok
('en "OK")
('nl "OK"))
('cancel
('en "Cancel")
('nl "Annuleren"))
('settings
('en "Settings")
('nl "Instellingen"))
('add-playlist
('en "Add Playlist")
('nl "Voeg afspeellijst toe"))
('volume
('en "Volume")
('nl "Volume"))
('file
('en "File")
('nl "Bestand"))
('playing
('en "playing")
('nl "speelt"))
('stopped
('en "stopped")
('nl "gestopt"))
('paused
('en "paused")
('nl "gepauzeerd"))
('unknown-state
('en "Unknown state")
('nl "Onbekende status"))
('rename-playlist
('en "Rename playlist")
('nl "Hernoem afspeellijst"))
('remove-playlist
('en "Remove playlist")
('nl "Verwijder afspeellijst"))
('play-this
('en "Play this")
('nl "Speel dit"))
('add-this
('en "Add this")
('nl "Voeg toe"))
('open-booklet
('en "Open booklet")
('nl "Open boekje"))
('open-containing-folder
('en "Open containing folder")
('nl "Open map met bestand"))
('show-window
('en "Show window")
('nl "Toon venster"))
('hide-window
('en "Hide window")
('nl "Verberg venster"))
('pause-play
('en "Pause / Play")
('nl "Pauze / Afspelen"))
('racket-music-player
('en "Racket Music Player")
('nl "Racket Muziek Speler"))
('bits
('en "bits")
('nl "bits"))
('play
('en "Play")
('nl "Afspelen"))
)
+5 -5
View File
@@ -20,10 +20,10 @@
(let ((mnu (wv-menu 'tray-menu
(wv-menu-item 'm-hide-show
(if (eq? (send rktplayer-gui window-state) 'hidden)
(tr "Show window")
(tr "Hide window")))
(wv-menu-item 'm-pause-play (tr "Pause / Play"))
(wv-menu-item 'm-quit (tr "Quit"))
(tr 'show-window)
(tr 'hide-window)))
(wv-menu-item 'm-pause-play (tr 'pause-play))
(wv-menu-item 'm-quit (tr 'quit))
)
)
)
@@ -49,7 +49,7 @@
#t)
(super-new [icon (build-path rkt-gui-dir "rktplayer.png")]
[tooltip (tr "Racket Music Player")])
[tooltip (tr 'racket-music-player)])
(begin
(send rktplayer-gui set-window-state-change-callback!
+23 -1
View File
@@ -18,9 +18,11 @@
info-rktplayer
warn-rktplayer
fatal-rktplayer
sync-log-rktplayer
(all-from-out simple-log)
list-drop!
path-equal?
make-select-list
)
@@ -137,4 +139,24 @@
#f)
)
)
)
)
(define (make-select-list id items selected)
(let ((slct (list 'select (list (list 'id (format "~a" id))))))
(for-each
(λ (item)
(let ((value (car item))
(label (cadr item)))
(set! slct
(append slct
(list
(if (equal? value selected)
(list 'option
(list (list 'value (format "~a" value)) (list 'selected "selected"))
label)
(list 'option
(list (list 'value (format "~a" value)))
label))))))
)
items)
slct))