Compare commits

..

6 Commits

Author SHA1 Message Date
hans 186b3bb8d7 Wijzigingen. 2026-08-04 22:31:25 +02:00
hans e54f6f4a5f DLNA playback 2026-07-31 17:03:19 +02:00
hans 727e0643af multiple libraries 2026-07-29 13:27:48 +02:00
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
17 changed files with 2327 additions and 199 deletions
+1
View File
@@ -19,3 +19,4 @@ compiled/
*.dep
/*.bak
/gui/*.bak
+373
View File
@@ -0,0 +1,373 @@
#lang racket
(require racket/class
racket/path
(prefix-in rad: racket-audio-dlna)
"utils.rkt")
(provide dlna-player%)
(define dlna-player%
(class object%
(init-field [renderer #f]
[settings #f]
[time-updater (lambda (time-s length-s) #t)]
[track-nr-updater (lambda (nr) #t)]
[state-updater (lambda (state) #t)]
[repeat-updater (lambda (state) #t)]
[audio-info-cb (lambda (rate channels bits kind) #t)]
[buffer-max-seconds 10]
[buffer-min-seconds 4]
[server-url #f]
[server-port 8734] ;8080]
[listen-ip #f]
[poll-seconds 1.0]
[volume-poll-seconds 5.0])
(define player #f)
(define playlist #f)
(define state 'stopped)
(define repeat 'no-repeat)
(define current-track-nr #f)
(define current-uri #f)
(define prepared-next-track-nr #f)
(define playing-seen? #f)
(define stop-requested? #f)
(define stopped-polls 0)
(define renderer-reachable? #t)
(define running #t)
(define poll-thread #f)
(define (check-player)
(when (eq? renderer #f)
(raise-arguments-error
'dlna-player%
"no media renderer has been configured"
"renderer" renderer))
(when (eq? player #f)
(unless (eq? server-url #f)
(warn-rktplayer
"server-url is ignored; racket-audio-dlna determines the server URL"))
(set! player
(rad:make-dlna-player
renderer
#:listen-ip listen-ip
#:port server-port
#:path "/rktplayer/"
#:poll-seconds poll-seconds
#:volume-poll-seconds volume-poll-seconds))))
(define (normalize-state st)
(cond
[(or (eq? st 'playing)
(eq? st 'transitioning))
'playing]
[(eq? st 'paused) 'paused]
[(or (eq? st 'stopped)
(eq? st 'no-media))
'stopped]
[else st]))
(define (set-state! st)
(unless (eq? state st)
(set! state st)
(state-updater state))
(repeat-updater repeat)
(when (or (eq? state 'stopped)
(eq? state 'quit))
(audio-info-cb 0 0 0 'none)))
(define (file-format file)
(let ((match
(and file
(regexp-match
#px"(?i:[.]([a-z0-9]+))$"
(path->string file)))))
(if match
(string->symbol (string-downcase (cadr match)))
'none)))
(define (track-audio-info! track)
(if track
(audio-info-cb
(or (rad:dlna-track-info-sample-rate track) 0)
(or (rad:dlna-track-info-channels track) 0)
0
(file-format (rad:dlna-track-info-file track)))
(audio-info-cb 0 0 0 'none)))
(define (normalized-file file)
(with-handlers ([exn:fail? (lambda (_) (format "~a" file))])
(path->string (path->complete-path file))))
(define (same-file? file1 file2)
(and file1
file2
((if (eq? (system-type 'os) 'windows)
string-ci=?
string=?)
(normalized-file file1)
(normalized-file file2))))
(define (playlist-track-file nr)
(send (send playlist track nr) get-file))
(define (playlist-track-nr file)
(and playlist
(for/first ([nr (in-range (send playlist length))]
#:when (same-file? file (playlist-track-file nr)))
nr)))
(define (next-track-nr nr)
(let ((length (send playlist length)))
(cond
[(eq? repeat 'repeat-one) nr]
[(eq? repeat 'repeat-all)
(if (= (+ nr 1) length) 0 (+ nr 1))]
[(< (+ nr 1) length) (+ nr 1)]
[else #f])))
(define (prepare-next-track!)
(when (and player
playlist
(exact-nonnegative-integer? current-track-nr))
(let ((nr (next-track-nr current-track-nr)))
(cond
[(eq? nr #f)
(set! prepared-next-track-nr #f)]
[(not (equal? nr prepared-next-track-nr))
(with-handlers
([exn:fail?
(lambda (e)
(set! prepared-next-track-nr #f)
(warn-rktplayer
"Could not prepare next DLNA track: ~a"
(exn-message e)))])
(rad:dlna-player-set-next-file!
player
(playlist-track-file nr))
(set! prepared-next-track-nr nr))]))))
(define (update-current-track! info)
(let* ((track (rad:dlna-info-track info))
(file (and track (rad:dlna-track-info-file track)))
(nr (cond
[(and (exact-nonnegative-integer?
prepared-next-track-nr)
(same-file?
file
(playlist-track-file prepared-next-track-nr)))
prepared-next-track-nr]
[else (playlist-track-nr file)])))
(when (exact-nonnegative-integer? nr)
(set! current-track-nr nr)
(set! prepared-next-track-nr #f)
(track-nr-updater nr)
(track-audio-info! track)
(prepare-next-track!))))
(define (poll-renderer)
(when player
(let ((info (rad:dlna-player-info player)))
(if (not (rad:dlna-info-reachable? info))
(when renderer-reachable?
(set! renderer-reachable? #f)
(warn-rktplayer "DLNA renderer is not reachable"))
(let* ((new-state
(normalize-state (rad:dlna-info-state info)))
(uri (rad:dlna-info-uri info))
(position (rad:dlna-info-position info))
(duration (rad:dlna-info-duration info)))
(unless renderer-reachable?
(dbg-rktplayer "DLNA renderer is reachable again"))
(set! renderer-reachable? #t)
(when (and (string? uri)
(not (string=? uri ""))
(not (equal? uri current-uri)))
(set! current-uri uri)
(set! stopped-polls 0)
(update-current-track! info))
(when (or (eq? new-state 'playing)
(eq? new-state 'paused))
(when (and (number? position)
(number? duration))
(time-updater position duration))
(track-audio-info! (rad:dlna-info-track info)))
(cond
[(eq? new-state 'playing)
(set! playing-seen? #t)
(set! stopped-polls 0)]
[(and (eq? new-state 'stopped)
stop-requested?)
(set! stop-requested? #f)
(set! stopped-polls 0)]
[(and (eq? new-state 'stopped)
playing-seen?)
(set! stopped-polls (+ stopped-polls 1))
;; Give SetNextAVTransportURI one poll to take over.
(when (or (eq? prepared-next-track-nr #f)
(> stopped-polls 1))
(set! playing-seen? #f)
(set! stopped-polls 0)
(send this next))])
(set-state! new-state))))))
(define (poll)
(let loop ()
(when running
(sleep poll-seconds)
(when running
(with-handlers
([exn:fail?
(lambda (e)
(warn-rktplayer
"Could not update DLNA player state: ~a"
(exn-message e)))])
(poll-renderer))
(loop)))))
(define/public (change-player kind
#:host [host #f]
#:basepaths [basepaths #f])
(void kind host basepaths)
(warn-rktplayer
"change-player is not supported by dlna-player%"))
(define/public (get-volume)
(check-player)
(or (rad:dlna-info-volume
(rad:dlna-player-info player))
0))
(define/public (set-volume! percentage)
(check-player)
(rad:dlna-player-volume! player percentage))
(define/public (set-list! playlist*)
(when player
(with-handlers ([exn:fail? (lambda (_) (void))])
(rad:dlna-player-stop! player)))
(set! playlist playlist*)
(set! current-track-nr #f)
(set! current-uri #f)
(set! prepared-next-track-nr #f)
(set! playing-seen? #f)
(set! stop-requested? #f)
(set! stopped-polls 0)
(set-state! 'stopped))
(define/public (playlist! playlist*)
(check-player)
(set-list! playlist*))
(define/public (play playlist*)
(send this playlist! playlist*)
(send this play-track 0))
(define/public (play-track nr)
(check-player)
(when (and playlist
(>= nr 0)
(< nr (send playlist length)))
(let ((file (playlist-track-file nr)))
(rad:dlna-player-play! player file)
(let ((info (rad:dlna-player-info player)))
(set! current-track-nr nr)
(set! current-uri (rad:dlna-info-uri info))
(set! prepared-next-track-nr #f)
(set! playing-seen? #t)
(set! stop-requested? #f)
(set! stopped-polls 0)
(track-nr-updater nr)
(track-audio-info! (rad:dlna-info-track info))
(set-state! 'playing)
(prepare-next-track!)))))
(define/public (next)
(check-player)
(if (eq? current-track-nr #f)
(warn-rktplayer
"No track-nr set (yet), so can't play anything next")
(let ((nr (next-track-nr current-track-nr)))
(if (eq? nr #f)
(send this stop)
(send this play-track nr)))))
(define/public (previous)
(check-player)
(if (eq? current-track-nr #f)
(warn-rktplayer
"No track-nr set (yet), so can't play anything previous")
(let ((nr current-track-nr))
(cond
[(eq? repeat 'repeat-one)
(send this play-track nr)]
[(eq? repeat 'repeat-all)
(send this play-track
(if (= nr 0)
(- (send playlist length) 1)
(- nr 1)))]
[else
(send this play-track (max 0 (- nr 1)))]))))
(define/public (pause!)
(check-player)
(rad:dlna-player-pause! player)
(set-state! 'paused))
(define/public (play!)
(check-player)
(rad:dlna-player-resume! player)
(set-state! 'playing))
(define/public (pause-unpause)
(check-player)
(if (eq? state 'paused)
(send this play!)
(send this pause!)))
(define/public (stop)
(check-player)
(set! stop-requested? #t)
(set! playing-seen? #f)
(set! stopped-polls 0)
(rad:dlna-player-stop! player)
(set-state! 'stopped))
(define/public (seek percentage)
(check-player)
(rad:dlna-player-seek-percentage! player percentage))
(define/public (get-repeat)
(check-player)
repeat)
(define/public (repeat! r)
(check-player)
(set! repeat r)
(repeat-updater repeat)
(prepare-next-track!))
(define/public (quit)
(when running
(set! running #f)
(unless (eq? poll-thread #f)
(kill-thread poll-thread)
(set! poll-thread #f))
(unless (eq? player #f)
(rad:dlna-player-close! player)
(set! player #f))
(set-state! 'quit)))
(super-new)
(begin
(void settings
buffer-max-seconds
buffer-min-seconds)
(set! poll-thread (thread poll))
(dbg-rktplayer "dlna-player% initialized"))))
+40
View File
@@ -0,0 +1,40 @@
#lang racket
(require racket-upnp)
(provide check-dlna-players)
(define running-sem (make-semaphore 1))
(define running #f)
(define (check-dlna-players gui)
(let ((can-check (begin
(semaphore-wait running-sem)
(let ((rng running))
(if rng
(begin
(semaphore-post running-sem)
#f)
(begin
(set! running #t)
(semaphore-post running-sem)
#t))))))
(if can-check
(void
(thread
(λ ()
(let ((r (query-media-renderers)))
(let ((r* (map (λ (r)
(list (media-renderer-name r)
r))
r)))
(send gui set-dlna-renderers! r*)
(semaphore-wait running-sem)
(set! running #f)
(semaphore-post running-sem)
)))))
(void
(send gui dlna-query-busy))
)
)
)
+143 -44
View File
@@ -11,6 +11,10 @@
"translate.rkt"
"playlist.rkt"
"player.rkt"
"dlna-player.rkt"
"settings.rkt"
"libraries.rkt"
"dlna.rkt"
)
(provide
@@ -22,17 +26,31 @@
(define player-menu
(λ ()
(λ (renderers connector)
(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)
))
(wv-menu-item 'm-players (tr 'players)
#:submenu (apply wv-menu
(append
(list 'dlna-menu
(wv-menu-item 'm-play-local (tr 'play-local))
(wv-menu-item 'm-check-dlna (tr 'check-dlna)))
(let ((rndr-idx 0))
(map (λ (r)
(let* ((idx rndr-idx)
(id (string->symbol
(format "m-renderer-~a" idx))))
(set! rndr-idx (+ rndr-idx 1))
(connector id idx)
(wv-menu-item id (car r) #:separator (= idx 0))))
renderers))))
)
)))
(define rktplayer%
(class wv-window%
@@ -60,11 +78,18 @@
(define el-format #f)
(define el-channels #f)
(define el-bits #f)
(define el-message #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* ((libs (new libraries% [settings cfg]))
(lib (send libs current-library))
(dir (if (eq? lib #f)
(find-system-path 'home-dir)
(send lib get-local-path)))
(path (format "~a" dir)))
(when (eq? (system-type 'os) 'windows)
(set! path (string-replace path "/" "\\")))
(dbg-rktplayer "music-library: ~a" path)
@@ -79,7 +104,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)))
)
)
@@ -114,6 +139,18 @@
)
)
(define/public (message! msg #:clear [clear #f])
(when (eq? el-message #f)
(set! el-message (send this element 'message)))
(unless (eq? el-message #f)
(send el-message set-innerHTML! msg)
(when clear
(void
(thread (λ ()
(sleep 10)
(send this message! "" #:clear #f)))))
))
(define current-track-nr #f)
(define (update-track-nr nr)
@@ -157,7 +194,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 +225,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 +287,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 +358,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)))
)
@@ -339,7 +376,14 @@
)
)
(define player (new player%
(define player #f)
(define dlna-renderers '())
(define/public (play-local)
(unless (eq? player #f)
(send player stop)
(send player quit))
(set! player (new player%
[time-updater update-time]
[track-nr-updater update-track-nr]
[state-updater update-state]
@@ -347,6 +391,49 @@
[audio-info-cb update-audio-info]
[settings settings]
))
(unless (eq? playlist #f)
(send player playlist! playlist))
)
(define/public (play-to-dlna renderer-idx)
(let* ((entry (list-ref dlna-renderers renderer-idx))
(renderer (cadr entry)))
(unless (eq? player #f)
(send player stop)
(send player quit))
(set! player
(new dlna-player%
[renderer renderer]
[time-updater update-time]
[track-nr-updater update-track-nr]
[state-updater update-state]
[repeat-updater update-repeat]
[audio-info-cb update-audio-info]
[settings settings]))
(unless (eq? playlist #f)
(send player playlist! playlist))))
(define/public (dlna-query-busy)
(send this message! (tr 'dlna-query-busy) #:clear #t))
(define/public (set-dlna-renderers! renderers)
(set! dlna-renderers renderers)
(send this message! (format (tr 'dlna-renderers-count) (length renderers)) #:clear #t)
(let ((connector-list '()))
(send this set-menu! (player-menu renderers (λ (id idx)
(set! connector-list
(cons
(λ ()
(send this connect-menu! id
(λ ()
(displayln (format "dlna playback: ~a" idx))
(send this play-to-dlna idx))))
connector-list)))))
(for-each (λ (c) (c)) connector-list)
#t))
(define/public (check-dlna)
(check-dlna-players this))
(define inner-html-handlers (make-hash))
@@ -400,10 +487,13 @@
(set! el-channels (send this element 'channels))
(set! el-format (send this element 'format))
(send this set-menu! (player-menu))
(send this set-menu! (player-menu '() (λ (id idx) #t)))
(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)))
(send this connect-menu! 'm-play-local (λ () (send this play-local)))
(send this connect-menu! 'm-check-dlna (λ () (send this check-dlna)))
(dbg-rktplayer "page-loaded, playlist = ~a" playlist)
(send this update-tabs)
@@ -496,7 +586,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 +632,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 +656,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])))
@@ -639,6 +746,7 @@
(let* ((volume-meter (send this element 'volume-meter))
(volume-display (send volume-meter display))
)
(display "volume-display = ") (write volume-display) (newline)
(if (eq? volume-display 'block)
(send volume-meter display 'none)
(begin
@@ -670,22 +778,11 @@
(super quit)
)
(define/public (select-library)
(let ((dir (send this choose-dir
(tr "Choose the folder containing your music library")
(if (string? music-library) music-library (path->string music-library))
)))
(if (eq? dir 'showing)
'done
(unless (eq? dir #f)
(set! music-library dir)
(send settings set! 'music-library dir)
(set! current-music-path #f)
(send this update-library)
)
)
)
)
(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)))
@@ -709,6 +806,8 @@
#f)
(begin
(dbg-rktplayer "Initializing local player")
(play-local)
(dbg-rktplayer "Initalizing gui")
(dbg-rktplayer "ICON: ~a" (get-field icon this))
(let ((lang (send settings get 'lang 'en)))
+802
View File
@@ -0,0 +1,802 @@
#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"
"settings.rkt"
"libraries.rkt"
"dlna.rkt"
)
(provide
(all-from-out racket-webview)
rktplayer%
)
(define-runtime-path rkt-gui-dir "gui")
(define player-menu
(λ (renderers connector)
(wv-menu 'main-menu
(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)
))
(wv-menu-item 'm-players (tr 'players)
#:submenu (apply wv-menu
(append
(list 'dlna-menu
(wv-menu-item 'm-play-local (tr 'play-local))
(wv-menu-item 'm-check-dlna (tr 'check-dlna)))
(let ((rndr-idx 0))
(map (λ (r)
(let* ((idx rndr-idx)
(id (string->symbol
(format "m-renderer-~a" idx))))
(set! rndr-idx (+ rndr-idx 1))
(connector id idx)
(wv-menu-item id (car r) #:separator (= idx 0))))
renderers))))
)
)))
(define rktplayer%
(class wv-window%
(init-field [log-file #f])
(inherit-field settings icon)
(super-new
[html-path "rktplayer.html"]
[title "Racket Music Player"]
[icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f]
)
(define initialized (make-semaphore 0))
(define closed #f)
(define el-seeker #f)
(define el-volume #f)
(define el-vol-perc #f)
(define el-library #f)
(define el-playlist #f)
(define el-at #f)
(define el-length #f)
(define el-rate #f)
(define el-format #f)
(define el-channels #f)
(define el-bits #f)
(define el-message #f)
(define cfg (send settings clone 'settings))
(define current-tab 0)
(define music-library
(let* ((libs (new libraries% [settings cfg]))
(lib (send libs current-library))
(dir (if (eq? lib #f)
(find-system-path 'home-dir)
(send lib get-local-path)))
(path (format "~a" dir)))
(when (eq? (system-type 'os) 'windows)
(set! path (string-replace path "/" "\\")))
(dbg-rktplayer "music-library: ~a" path)
path))
(define current-music-path #f)
(define playlist #f)
(define current-at-seconds 0)
(define current-length-seconds 0)
(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)))
)
)
(define (update-time at-seconds length-seconds)
(let ((as (inexact->exact (round at-seconds)))
(ls (inexact->exact (round length-seconds))))
(when (or (not (= current-at-seconds as))
(not (= current-length-seconds ls)))
(set! current-at-seconds as)
(set! current-length-seconds ls)
(let ((as-str (sprintf "%02d:%02d:%02d"
(quotient as 3600)
(quotient (remainder as 3600) 60)
(remainder (remainder as 3600) 60)))
(ls-str (sprintf "%02d:%02d:%02d"
(quotient ls 3600)
(quotient (remainder ls 3600) 60)
(remainder (remainder ls 3600) 60)))
)
(unless closed
(send el-at set-innerHTML! as-str)
(send el-length set-innerHTML! ls-str)
(let ((seeker (if (= ls 0)
0.0
(exact->inexact (/ (* 100 as) ls)))))
(send el-seeker set! (format "~a" seeker)))
)
)
(send this update-volume)
)
)
)
(define/public (message! msg #:clear [clear #f])
(when (eq? el-message #f)
(set! el-message (send this element 'message)))
(unless (eq? el-message #f)
(send el-message set-innerHTML! msg)
(when clear
(void
(thread (λ ()
(sleep 10)
(send this message! "" #:clear #f)))))
))
(define current-track-nr #f)
(define (update-track-nr nr)
(unless (or (eq? playlist #f)
(= (send playlist length) 0))
(dbg-rktplayer "update-track-nr ~a" nr)
(let ((id (λ () (send playlist track-id current-track-nr))) ;string->symbol (format "track-~a" (+ current-track-nr 1)))))
(ct current-track-nr))
(dbg-rktplayer "Removing current")
(unless (eq? current-track-nr #f)
(dbg-rktplayer (format "current old track: ~a" (id)))
(let ((el (send this element (id))))
(send el remove-class! "current")))
(set! current-track-nr nr)
(dbg-rktplayer "Adding current")
(unless (eq? current-track-nr #f)
(dbg-rktplayer "current new track: ~a" (id))
(let ((el (send this element (id))))
(send el add-class! "current"))
(dbg-rktplayer "Getting cover image")
(let* ((track (send playlist track current-track-nr))
(img-file (build-path (find-system-path 'cache-dir) "rktplayer-cover-image"))
(stored-file (send track image->file img-file))
)
(dbg-rktplayer "image mimetype: ~a" (send track image->mimetype))
(dbg-rktplayer "stored-file = ~a" stored-file)
(unless (eq? stored-file #f)
(dbg-rktplayer "Setting album art")
(let ((el (send this element 'album-art)))
(let ((html (format "<img id=\"album-image\" src=\"/get-image?~a&~a\" />"
(format "~a" stored-file)
(current-milliseconds))))
(dbg-rktplayer "Html = ~a" html)
(send el set-innerHTML! html)
(when (send track has-booklet?)
(let ((booklet-file (send track booklet-file)))
(send this bind! 'album-image 'contextmenu
(λ (el evt data)
(let ((mnu (wv-menu 'image-menu
(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)))
(send this popup-menu! mnu clientX clientY))))))
)))
)
)
(dbg-rktplayer "Done updating track")
)
)
)
(define state #f)
(define current-play-image "buttons/play.svg")
(define (set-play-button img)
(unless (string=? current-play-image img)
(set! current-play-image img)
(let ((btn (send this element 'play-img)))
(send btn set-attr! (list 'src img))
)
)
)
(define (update-state st)
(unless (eq? st state)
(dbg-rktplayer "Changing to state ~a" st)
(let ((el (send this element 'paused)))
(cond ((or (eq? st 'playing) (eq? st 'play))
(set-play-button "buttons/pause.svg")
(send el set-innerHTML! (list 'span (tr 'playing))))
((eq? st 'stopped)
(set-play-button "buttons/play.svg")
(send el set-innerHTML! (list 'span (tr 'stopped))))
((eq? st 'paused)
(set-play-button "buttons/play.svg")
(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))))
))
(set! state st)
)
)
(define/public (update-tabs)
(dbg-rktplayer "playlist = ~a" playlist)
(let* ((tabs (send playlist tab-count))
(html "")
(tab-el (send this element 'tabs))
(idx 0)
)
(while (< idx tabs)
(let ((tab-name (send playlist get-tab-name idx)))
(set! html (string-append
html
(xexpr->string
(list 'span (list (list 'id (format "tab~a" idx))
'(class "tab"))
tab-name))))
)
(set! idx (+ idx 1)))
(send tab-el set-innerHTML! html)
(send this bind! "#tabs > span" 'click
(λ (el evt data)
(let* ((tab-id (send el id))
(tab-idx (string->number (substring (format "~a" tab-id) 3)))
)
(send this set-tab! tab-idx))))
(send this bind! "#tabs > span" 'contextmenu
(λ (el evt data)
(let* ((tab-id (send el id))
(tab-idx (string->number (substring (format "~a" tab-id) 3)))
)
(send this tab-context data tab-id tab-idx))))
(let ((id (string->symbol (format "tab~a" current-tab))))
(let ((el (send this element id)))
(send el add-class! 'current))
)
)
)
(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)))
)
)
)
(let* ((mnu (wv-menu 'tab-popup items))
(clientX (hash-ref evt 'clientX 60))
(clientY (hash-ref evt 'clientY 60))
)
(send this popup-menu! mnu clientX clientY)
)
)
)
(define/public (log-file! file)
(set log-file file))
(define/public (drop-tab! tab-id tab-idx)
(when (= current-tab tab-idx)
(send this stop))
(send playlist drop-tab! tab-idx)
(send this set-tab! 0)
)
(define/public (rename-tab! tab-id tab-idx)
(let* ((inp-id (string->symbol (format "tab-input~a" tab-idx)))
(tab-el-id (string->symbol (format "tab~a" tab-idx)))
(html (list 'input (list (list 'id (format "~a" inp-id))
(list 'name (format "~a" inp-id))
'(type "text")
(list 'value (send playlist get-tab-name tab-idx))
)))
(tab-el (send this element tab-el-id))
(unbind-events (λ ()
(send this unbind! inp-id 'change)
(send this unbind! inp-id 'blur)))
)
(send tab-el set-innerHTML! html)
(send this unbind! tab-el-id '(click contextmenu))
(send this bind! inp-id 'change
(λ (el evt data)
(let ((tab-name (hash-ref data 'value (send playlist get-tab-name tab-idx))))
(send playlist set-tab-name! tab-idx tab-name)
(unbind-events)
(send this update-tabs))))
(send this bind! inp-id 'blur
(λ (el evt data)
(unbind-events)
(send this update-tabs)))
(let ((inp-el (send this element inp-id)))
(send inp-el focus!))
)
)
(define/public (set-tab! tab-idx)
(send this stop)
(set! current-tab tab-idx)
(send playlist load-tab tab-idx)
(send this update-tabs)
(send this update-playlist)
)
(define/public (add-tab)
(send playlist add-tab!)
(send this update-tabs))
(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-rate set-innerHTML! (format "~a Hz" (format-num rate)))
(send el-format set-innerHTML! (format "~a" (format-dec audio-format)))
)
)
(define (update-repeat state)
(let ((img (if (eq? state 'no-repeat)
"buttons/repeat-off.svg"
(if (eq? state 'repeat-one)
"buttons/repeat-one.svg"
"buttons/repeat.svg"))))
(let ((el (send this element 'repeat-img)))
(send el set-attr! (list 'src img)))
)
)
(define player #f)
(define dlna-renderers '())
(define/public (play-local)
(unless (eq? player #f)
(send player stop)
(send player quit))
(set! player (new player%
[time-updater update-time]
[track-nr-updater update-track-nr]
[state-updater update-state]
[repeat-updater update-repeat]
[audio-info-cb update-audio-info]
[settings settings]
))
(unless (eq? playlist #f)
(send player playlist! playlist))
)
(define/public (play-to-dlna renderer-idx)
(let ((renderer (list-ref dlna-renderers renderer-idx)))
(displayln (format "Play to ~a" (car renderer)))))
(define/public (dlna-query-busy)
(send this message! (tr 'dlna-query-busy) #:clear #t))
(define/public (set-dlna-renderers! renderers)
(set! dlna-renderers renderers)
(send this message! (format (tr 'dlna-renderers-count) (length renderers)) #:clear #t)
(send this set-menu! (player-menu renderers (λ (id idx)
(send this connect-menu! id
(λ ()
(displayln (format "dlna playback: ~a" idx))
(send this play-to-dlna idx))))))
#t)
(define/public (check-dlna)
(check-dlna-players this))
(define inner-html-handlers (make-hash))
(define/override (page-loaded oke)
(semaphore-wait initialized)
(semaphore-post initialized)
(super page-loaded oke)
(let ((el (send this element 'log-file)))
(send el set-innerHTML! (format "~a" log-file)))
(ww-connect 'play play-or-pause)
(ww-connect 'stop stop)
(ww-connect 'prev previous-track)
(ww-connect 'next next-track)
(ww-connect 'repeat repeat)
(ww-connect 'volume volume)
(ww-connect 'devtools devtools)
(set! el-seeker (send this element 'seek))
(dbg-rktplayer "el-seeker: ~a" (send el-seeker get))
(let ((seek-reactor (webview-delayed-reactor 0.3
(λ (percentage)
;(displayln (format "el-seeker: ~a" percentage))
(send this seek-to percentage)))))
(send el-seeker on-change! seek-reactor))
(set! el-volume (send this element 'volume-range))
(set! el-vol-perc (send this element 'volume-perc))
(dbg-rktplayer "el-volume: ~a" (send el-volume get))
(let ((volume-reactor (webview-delayed-reactor 1.0
(λ (volume-range)
(let ((percentage (* volume-range volume-range)))
(send this set-volume! percentage)))
#:update (λ (val)
(let ((p (* val val)))
(send el-vol-perc set-innerHTML! (sprintf "%d%" p))
)))))
(send el-volume on-change! volume-reactor))
(set! el-library (send this element 'library))
(set! el-playlist (send this element 'tracks))
(set! el-at (send this element 'time))
(set! el-length (send this element 'totaltime))
(set! el-rate (send this element 'rate))
(set! el-bits (send this element 'bits))
(set! el-channels (send this element 'channels))
(set! el-format (send this element 'format))
(send this set-menu! (player-menu '() (λ (id idx) #t)))
(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)))
(send this connect-menu! 'm-play-local (λ () (send this play-local)))
(send this connect-menu! 'm-check-dlna (λ () (send this check-dlna)))
(dbg-rktplayer "page-loaded, playlist = ~a" playlist)
(send this update-tabs)
(send this update-library)
(send this update-playlist)
(when (eq? state #f)
(update-audio-info 0 0 0 'none)
(update-state 'stopped))
)
(define el-dragged #f)
(define/public (update-playlist)
(let* ((html (send playlist to-html))
(result (send el-playlist set-innerHTML! html))
)
(dbg-rktplayer "result: ~a" result)
(send this set-attr! "table.tracks tr" '(draggable "true"))
(send this bind! "table.tracks tr" 'click
(λ (el evt data)
(let* ((track-id (send el attr/symbol 'id))
(idx (send playlist index track-id))
)
(send this play-track idx)
)
)
)
(send this bind! "table.tracks tr" 'contextmenu
(λ (el evt data)
(let ((mnu (wv-menu 'track-menu
(wv-menu-item 'm-drop-track "Drop track"
#:callback (λ ()
(send playlist drop-id (send el id))
(update-playlist))
)
)
)
(clientX (hash-ref data 'clientX 60))
(clientY (hash-ref data 'clientY 60))
)
(send this popup-menu! mnu clientX clientY))))
(let ((from-idx #f)
(to-idx #f))
(send this bind! "table.tracks tr" 'dragstart
(λ (el evt data)
(set! el-dragged el)
(dbg-rktplayer "Dragging element ~a" (send el id))
(set! from-idx (send playlist index (send el id)))
)
#t)
(send this bind! "table.tracks tr" 'dragover
(λ (el evt data)
#t)
)
(send this bind! "table.tracks tr" 'drop
(λ (el evt data)
(dbg-rktplayer "Element dropped on ~a" (send el id))
(set! to-idx (send playlist index (send el id)))
(when (and (integer? from-idx) (integer? to-idx)
(not (= from-idx to-idx)))
(send playlist move-track from-idx to-idx)
(update-playlist)
)
)
)
)
(update-track-nr current-track-nr)
)
(send this update-volume)
)
(define/public (scroll-top id)
(send this run-js
(format
(string-append "{ let el_id = '~a';"
" console.log('id = ' + el_id);"
" let el = document.getElementById(el_id);"
" console.log(el);"
" el.scrollTop = 0;"
"}")
id)))
(define/public (update-library)
(when (eq? current-music-path #f)
(set! current-music-path music-library))
(let* ((nr 0)
(l (filter (λ (r) (music-lib-relevant? (cadr r)))
(map (λ (e)
(set! nr (+ nr 1))
(list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr)))
(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))
)
(let ((html (mktable l 'music-library library-formatter)))
(let ((result (send el-library set-innerHTML! html)))
(dbg-rktplayer "set-innerHTML!: ~a" result)
(send this scroll-top 'library)
(dbg-rktplayer "Binding...")
(send this bind! "td.library-entry" 'click
(λ (el evt data)
(dbg-rktplayer "~a ~a" evt data)
(dbg-rktplayer "id:~a, file:~a" (send el attr 'id) (send el attr 'file))
(let ((path (send el attr 'file)))
(unless (eq? path #f)
(send this path-choosen path)))))
(send this bind! "td.library-entry" 'contextmenu
(λ (el evt data)
(dbg-rktplayer "~a ~a" evt data)
(let ((path (send el attr 'file)))
(unless (eq? path #f)
(send this context-for-path data path)))
))
(dbg-rktplayer "Done...")
))
)
)
(define/public (path-choosen path)
(let ((path-part (if (equal? path "↰") ".." (format "~a" path))))
(let ((npath (if (string=? path-part "..")
(build-path current-music-path path-part)
path)))
(when (directory-exists? npath)
(set! current-music-path (normalize-path npath))
(send this update-library)
)
)
)
)
(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))))))
(when (file-exists? path)
(set! items (append items
(list
(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
))))
(set! items (append items
(list
(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))
(clientY (hash-ref evt 'clientY 60))
)
(send this popup-menu! mnu clientX clientY)
)
)
)
(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])))
(set! current-track-nr #f)
(send pl read-tracks)
(set! playlist pl)
(send this update-playlist)
(send player play pl)
(dbg-rktplayer "number of tracks: ~a" (send playlist length))
)
)
(define/public (add-path path)
(send playlist add-track path)
(send this update-playlist)
)
(define/public (open-booklet path . is-file*)
(let* ((is-file (if (null? is-file*) #f (eq? (car is-file*) #t)))
(booklet (if is-file path (build-path path "booklet.pdf"))))
(dbg-rktplayer "Open booklet ~a" booklet)
(open-app booklet)))
(define/public (open-folder path)
(dbg-rktplayer "path: ~a" path)
(open-file-manager path))
;(let ((folder (if (file-exists? path) (path-only path) path)))
; (open-file-manager folder)))
(define/public (play-or-pause)
(cond
((eq? state 'playing)
(send player pause!))
((eq? state 'paused)
(send player play!))
(else
(play-track 0))
)
)
(define/public (stop)
(dbg-rktplayer "Stop")
(send player stop)
(update-track-nr #f))
(define/public (play-track idx)
(unless (= (send playlist length) 0)
(send player play-track idx)))
(define/public (pause)
(send player pause-unpause))
(define/public (next-track)
(send player next)
)
(define/public (previous-track)
(send player previous)
)
(define/public (repeat)
(let ((r (send player get-repeat)))
(let ((nr (cond
((eq? r 'no-repeat) 'repeat-all)
((eq? r 'repeat-all) 'repeat-one)
(else 'no-repeat))))
(send player repeat! nr)
)
)
)
(define/public (volume)
(let* ((volume-meter (send this element 'volume-meter))
(volume-display (send volume-meter display))
)
(if (eq? volume-display 'block)
(send volume-meter display 'none)
(begin
(send volume-meter display 'block)
(send el-volume set!
(sqrt (send player get-volume)))
(send el-vol-perc set-innerHTML!
(sprintf "%d%" (send player get-volume))))
)
)
)
(define/public (set-volume! percentage)
(send player set-volume! percentage)
(send this update-volume)
)
(define/public (seek-to percentage)
(dbg-rktplayer "Seeking to percentage: ~a" percentage)
(send player seek percentage)
)
(define/override (quit)
(dbg-rktplayer "Quitting")
(send player quit)
(set! closed #t)
(send this close)
(dbg-rktplayer "Calling super -> quit")
(super quit)
)
(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)
(send this present)
(send this hide)
)
)
)
(define window-state-change-callback (λ () #t))
(define/public (set-window-state-change-callback! f)
(set! window-state-change-callback f))
(define/override (window-state-changed st)
(window-state-change-callback))
(define/override (can-close?)
(show-hide)
#f)
(begin
(dbg-rktplayer "Initializing local player")
(play-local)
(dbg-rktplayer "Initalizing gui")
(dbg-rktplayer "ICON: ~a" (get-field icon this))
(let ((lang (send settings get 'lang 'en)))
(dbg-rktplayer "RktPlayer started, current language: ~a" lang))
(set! playlist (new playlist% [settings (send settings clone 'playlists)]))
(send player set-list! playlist)
(dbg-rktplayer "playlist = ~a" playlist)
(semaphore-post initialized)
)
)
)
+41
View File
@@ -0,0 +1,41 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>RktPlayer - A music player - library entry</title>
</head>
<body>
<div class="pane">
<div class="keyval">
<label for="kind" id="lbl-kind">Action:</label>
<span id="kind">Action</span>
</div>
<hr />
<div class="keyval">
<label for="name" id="lbl-name">Name:</label>
<input type="text" id="name" />
</div>
<div class="keyval">
<label for="local-path" id="lbl-local-path">Local path:</label>
<div class="file-box">
<input id="local-path" type="text" />
<button id="browse">Browse</button>
</div>
</div>
<div class="keyval">
<label for="host" id="lbl-host">Host:</label>
<input type="text" id="host" />
</div>
<div class="keyval">
<label for="prefixes" id="lbl-prefixes">Prefixes:</label>
<textarea type="text" id="prefixes"></textarea>
</div>
</div>
<div class="button-box">
<button id="ok">OK</button>
<button id="cancel">Cancel</button>
<button id="dev">devtools</button>
</div>
</body>
</html>
+2 -1
View File
@@ -5,7 +5,7 @@
<meta charset="UTF-8" />
<title>RktPlayer - A music player</title>
<!--<script src="../../webui-wire/js/menu.js"></script>-->
<script src="menu.js"></script>
<!--<script src="menu.js"></script>-->
</head>
<body>
<div class="pane">
@@ -54,6 +54,7 @@
<span class="info" id="channels"></span>
<span class="info" id="format"></span>
<span class="info" id="paused"></span>
<span class="info" id="message"></span>
<div class="right">
<span class="info" id="volume-percentage"></span>
<span class="info" id="log-file"></span>
+36
View File
@@ -0,0 +1,36 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>RktPlayer - A music player - Settings</title>
</head>
<body>
<div class="pane">
<div class="keyval">
<label for="language" id="lbl-language">Languages:</label>
<span id="language">Languages</span>
</div>
<hr />
<label id="lbl-libary-path">Library path:</label>
<hr />
<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="add">Add Library</button>
<button id="edit">Edit Library</button>
<button id="remove">Remove Library</button>
</div>
</div>
<div class="button-box">
<button id="ok">OK</button>
<button id="cancel">Cancel</button>
<button id="dev">devtools</button>
</div>
</body>
</html>
+62 -4
View File
@@ -10,6 +10,50 @@ body {
width: calc(100% - 10px);
display: flex;
flex-direction: column;
padding: 3px;
}
hr {
border: none;
border-top: 1px solid #909090;
margin: 5px 0;
}
.file-box {
display: inline-block;
width: 100%;
}
.file-box span {
display: inline-block;
width: calc(70% - 5px);
}
.file-box button {
display: inline-block;
width: calc(30% - 5px);
}
.keyval {
width: 100%;
padding-bottom: 5px;
}
.keyval label {
display: inline-block;
width: calc(30% - 5px);
}
.keyval span, .keyval input, .keyval select,
.keyval textarea, .keyval .file-box {
display: inline-block;
width: calc(70% - 10px);
}
.button-box {
border-top: 1px solid #909090;
width: 100%;
padding-top: 5px;
}
.buttons {
@@ -228,22 +272,26 @@ table.tracks td.title, table.tracks td.album {
}
table.tracks tr, table.tracks td {
table.tracks tr, table.tracks td,
table.libraries tr, table.libraries td {
cursor: default;
user-select: none;
}
table.tracks tr:hover {
table.tracks tr:hover, table.libraries tbody tr:hover {
background: #e0e0e0;
color: black;
transition: all 0.5s ease-in;
}
table.tracks tr:hover.current {
table.tracks tr:hover.current,
table.libraries tbody tr:hover.current
{
color: #955c12;
}
table.tracks tr.current {
table.tracks tr.current,
table.libraries tbody tr.current {
font-weight: bold;
color: #f3961e;
}
@@ -353,3 +401,13 @@ input.v-slider {
}
select, option {
all: revert;
}
.pane {
display: block !important;
}
+30
View File
@@ -0,0 +1,30 @@
#lang info
(define pkg-authors '(hnmdijkema))
(define version "0.1.1")
(define license 'MIT)
(define collection "rktplayer")
(define pkg-desc "rktplayer - A music player written in racket")
(define deps
'("racket/gui" "racket/base" "racket"
"finalizer" "draw-lib" "net-lib"
"simple-log" "simple-ini" "racket-sprintf"
"early-return" "let-assert"
"uni-channel" "port-channel"
"rackunit-lib"
)
)
(define build-deps
'("racket-doc"
"draw-doc"
"rackunit-lib"
"scribble-lib"
))
(define test-omit-paths 'all)
+125
View File
@@ -0,0 +1,125 @@
#lang racket/base
(require racket/class
"utils.rkt"
)
(provide libraries%
library%
)
(define library%
(class object%
(init-field [id (new-id)] [name ""] [local-path ""]
[host ""] [prefixes ""] [current #f])
(super-new)
(define/public (get-id) id)
(define/public (get-name) name)
(define/public (get-local-path) local-path)
(define/public (get-host) host)
(define/public (get-prefixes) prefixes)
(define/public (is-current?) current)
(define/public (get-current) current)
(define/public (set-current! c) (set! current c))
(define/public (->list)
(list id name local-path host prefixes current))
))
(define libraries%
(class object%
(init-field [settings settings])
(super-new)
(define libs #f)
(define cfg (send settings clone 'settings))
(define (to-library e)
(let ((f (lambda (id n lp h p . c)
(let ((cc (if (null? c) #f (car c))))
(new library% [id id]
[name n] [local-path lp]
[host h] [prefixes p] [current cc])
))))
(apply f e)
)
)
(define (from-library l)
(send l ->list))
(define/public (libraries)
(when (eq? libs #f)
(let ((cfg-libs (send cfg get 'libraries '())))
(dbg-rktplayer "libraries from ini: ~a" cfg-libs)
(set! libs (sort (map to-library cfg-libs)
(lambda (a b)
(string<? (send a get-name) (send b get-name)))))
(dbg-rktplayer "libs: ~a" (map (λ (x) (list (send x get-id) (send x get-name))) libs))
))
libs)
(define/public (set-libraries! libs*)
(send cfg set! 'libraries (map from-library libs*))
(set! libs #f))
(define/public (count)
(length (send this libraries)))
(define/public (library-id idx)
(let ((libs (send this libraries)))
(if (and (>= idx 0) (< idx (length libs)))
(send (list-ref libs idx) get-id)
#f)))
(define/public (get-library id)
(let ((libs (send this libraries)))
(letrec ((f (λ (libs)
(if (null? libs)
#f
(let* ((lib (car libs))
(lib-id (send lib get-id)))
(dbg-rktplayer "symbol? lib-id: ~a, lib-id: ~a (~a) eq? ~a" (symbol? lib-id) lib-id (send lib get-name) id)
(if (eq? lib-id id)
lib
(f (cdr libs))))))))
(f libs))))
(define/public (remove-library id)
(let ((libs (send this libraries)))
(send this set-libraries! (filter (λ (lib)
(not (eq? (send lib get-id) id)))
libs))))
(define/public (add-library l)
(let ((libs (send this libraries)))
(send this set-libraries! (cons l libs))
(set! libs #f)
(send l get-id)))
(define/public (update-library l)
(let ((libs (send this libraries))
(id (send l get-id)))
(send this set-libraries! (map (λ (lib)
(if (eq? (send lib get-id) id)
l
lib))
libs))))
(define/public (current-library)
(letrec ((f (lambda (libs)
(if (null? libs)
(if (= (send this count) 0)
#f (send this get-library
(send this library-id 0)))
(let ((l (car libs)))
(if (send l is-current?)
l
(f (cdr libs))))))
))
(f (send this libraries))))
))
+43 -5
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)
@@ -44,8 +48,13 @@
(lru-clear track-cache))
;;(define x 0)
(define (audio-state-cb handle player-state st*)
(set! full-state st*)
;;(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)
@@ -54,7 +63,7 @@
(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")
(warn-rktplayer "Unexpected: no track-nr for given music-id")
(track-nr-updater track-nr))))
)
(state-updater st)
@@ -65,18 +74,44 @@
(audio-bits player) (audio-decoder player)))
)
)
)
(define (on-eof-stream-cb handle)
(when (and (eq? player handle) (not (eq? player #f)))
(let ((track-nr (music-id->track-nr music-id)))
(send this next)))
(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))
@@ -97,9 +132,12 @@
(clear-music-ids!)
)
(define/public (play playlist*)
(define/public (playlist! playlist*)
(check-player)
(set-list! playlist*)
(set-list! playlist*))
(define/public (play playlist*)
(send this playlist! playlist*)
(send this play-track 0))
(define/public (play-track nr)
+10 -2
View File
@@ -3,6 +3,7 @@
(require racket/gui
"gui.rkt"
"tray.rkt"
"translate.rkt"
simple-ini/class
racket-audio
racket-webview
@@ -16,8 +17,12 @@
(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)
;(sl-log-to-display)
(define store (sl-log-to-store))
(void (current-opusfile-output-format 's24))
(define (my-file-getter url)
(dbg-rktplayer "my-file-getter - url = ~a" url)
@@ -59,6 +64,8 @@
[file-getter my-file-getter]
))
)
(displayln (format "ini file: ~a" (send ini get-file)))
(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]))
)
@@ -103,7 +110,8 @@
(webview-wait-for-quit)
(send rktplayer-tray close)
(webview-exit)
(exit))
;(exit)
)
)
)
)
+274
View File
@@ -0,0 +1,274 @@
#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)
)
)
+183 -21
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)
@@ -30,26 +57,161 @@
(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"))
('library-add
('en "Add")
('nl "Toevoegen"))
('library-edit
('en "Edit")
('nl "Bewerken"))
('library-remove
('en "Remove")
('nl "Verwijderen"))
('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"))
('lbl-libary-path
('en "Library path:")
('nl "Muziek Bibliotheek pad:"))
('settings-title
('en "Racket Music Player - Settings")
('nl "Racket Muziek Speler - Instellingen"))
('settings-library
('en "Racket Music Player - Library Entry")
('nl "Racket Muziek Speler - Muziek Bibliotheek Entry"))
('browse
('en "Browse")
('nl "Bladeren"))
('dlna-renderers-count
('en "Found ~a DLNA Players")
('nl "~a DLNA Spelers gevonden"))
('dlna-query-busy
('en "Busy querying DLNA Media Renderers")
('nl "Bezig DLNA Media Rendeerers op te vragen"))
('play-local
('en "Play music on current hardware")
('nl "Muziek afspelen op huidige hardware"))
('check-dlna
('en "Search DLNA Players on network")
('nl "Zoek DLNA Spelers op het netwerk"))
('players
('en "Audio Players")
('nl "Muziek Spelers"))
)
+15 -7
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,9 @@
#t)
(super-new [icon (build-path rkt-gui-dir "rktplayer.png")]
[tooltip (tr "Racket Music Player")])
[tooltip (tr 'racket-music-player)])
(define last-state #f)
(begin
(send rktplayer-gui set-window-state-change-callback!
@@ -57,9 +59,15 @@
(let ((st (send rktplayer-gui window-state)))
(if (eq? st 'minimized)
(begin
(dbg-rktplayer "state = ~a, hiding window" st)
(if (eq? last-state 'minimized)
(begin
(dbg-rktplayer "state = ~a, presenting window" st)
(send rktplayer-gui present)
(send rktplayer-gui hide))
(set! last-state 'presented))
(begin
(dbg-rktplayer "state = ~a, hiding window" st)
(send rktplayer-gui hide)
(set! last-state 'minimized))))
(adjust-menu))
)
)
+32
View File
@@ -18,9 +18,12 @@
info-rktplayer
warn-rktplayer
fatal-rktplayer
sync-log-rktplayer
(all-from-out simple-log)
list-drop!
path-equal?
make-select-list
new-id
)
@@ -138,3 +141,32 @@
)
)
)
(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))
(define (new-id)
(let* ((s (current-milliseconds))
(r (random 1000000))
(id (string->symbol (format "id-~a-~a" s r))))
id))